Module cStatusPane.pkg

     1// cStatusPane class
     2Use VDFBase.pkg
     3Use Commctrl.pkg
     4
     5Define IMAGE_BITMAP for 0
     6Define IMAGE_ICON   for 1
     7Define IMAGE_CURSOR for 2
     8
     9Define LR_DEFAULTCOLOR     for |CI$0000
    10Define LR_MONOCHROME       for |CI$0001
    11Define LR_COLOR            for |CI$0002
    12Define LR_COPYRETURNORG    for |CI$0004
    13Define LR_COPYDELETEORG    for |CI$0008
    14Define LR_LOADFROMFILE     for |CI$0010
    15Define LR_LOADTRANSPARENT  for |CI$0020
    16Define LR_DEFAULTSIZE      for |CI$0040
    17Define LR_VGACOLOR         for |CI$0080
    18Define LR_LOADMAP3DCOLORS  for |CI$1000
    19Define LR_CREATEDIBSECTION for |CI$2000
    20Define LR_COPYFROMRESOURCE for |CI$4000
    21Define LR_SHARED           for |CI$8000
    22
    23
    24Enumeration_List // Alignment styles
    25    Define asLeft
    26    Define asCenter
    27    Define asRight
    28End_Enumeration_List
    29
    30Enumeration_List // Bevel styles
    31    Define bsLowered for 0
    32    Define bsNone    for SBT_NOBORDERS
    33    Define bsRaised  for SBT_POPOUT
    34End_Enumeration_List
    35
    36Register_Procedure OnClick
    37Register_Procedure OnDoubleClick
    38Register_Procedure OnRightClick
    39Register_Procedure OnDoubleRightClick
    40
    41{ ClassLibrary=Windows }
    42{ HelpTopic=cStatusPane }
    43Class cStatusPane is a cObject
    44    Procedure Construct_Object
    45        Forward Send Construct_Object
    46
    47        { Visibility=Private }
    48        Property String private_psTooltip
    49        { Visibility=Private }
    50        Property Integer private_peAlignment asLeft
    51        { Visibility=Private }
    52        Property Integer private_peBevel     bsLowered
    53        { Visibility=Private }
    54        Property Integer private_piWidth
    55        { Visibility=Private }
    56        Property String  private_psLabel
    57        Property Handle  phIcon
    58        { Visibility=Private }
    59        Property String  private_psIcon
    60        Property Handle phmOnClick            msg_OnClick
    61        Property Handle phmOnRightClick       msg_OnRightClick
    62        Property Handle phmOnDoubleClick      msg_OnDoubleClick
    63        Property Handle phmOnDoubleRightClick msg_OnDoubleRightClick
    64    End_Procedure
    65
    66    Procedure End_Construct_Object
    67        Forward Send End_Construct_Object
    68        Delegate Send DoAddPane self
    69    End_Procedure
    70
    71    { MethodType=Event NoDoc=True }
    72    Procedure Destroy_Object
    73        Integer iVoid
    74        Handle hIcon
    75
    76        Delegate Send DoRemovePane self
    77
    78        // Destroy the Icon, if used...
    79        Get phIcon To hIcon
    80        If hIcon Move (DestroyIcon(hIcon)) To iVoid
    81        Forward Send Destroy_Object
    82    End_Procedure
    83
    84    { MethodType=Property }
    85    Procedure Set psToolTip String sToolTip
    86        If (sToolTip <> private_psToolTip (Self)) Begin
    87            Set private_psToolTip To sToolTip
    88            Delegate Send DoUpdatePanes
    89        End
    90    End_Procedure // Set psToolTip
    91
    92    { MethodType=Property }
    93    Function psToolTip Returns String
    94        String sToolTip
    95
    96        Get private_psToolTip To sToolTip
    97
    98        Function_Return sToolTip
    99    End_Function // psToolTip
   100
   101    { MethodType=Property }
   102    Procedure Set psIcon String sIcon
   103        Integer iVoid hIcon
   104        // If there is an existing icon, destroy it...
   105        Get phIcon To hIcon
   106        If hIcon Begin
   107            Move (DestroyIcon(hIcon)) To iVoid
   108        End
   109
   110        Set private_psIcon To sIcon
   111        Move (LoadImage (GetModuleHandle (0), sIcon, IMAGE_ICON, 16, 16, 0)) To hIcon
   112        If (hIcon = 0) Begin // Icon was not included as resource
   113           Get_File_Path sIcon To sIcon
   114           If (sIcon <> "") Begin
   115               Move (LoadImage (0, sIcon, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)) To hIcon
   116           End
   117           Else Begin
   118               Move 0 To hIcon
   119           End
   120        End
   121
   122        Set phIcon To hIcon // no icon is loaded
   123
   124        Delegate Send DoUpdatePanes
   125    End_Procedure
   126
   127    { MethodType=Property }
   128    Function psIcon Returns String
   129      Function_Return (private_psIcon(self))
   130    End_Function
   131
   132    { MethodType=Property }
   133    Procedure Set psLabel String sLabel
   134        If (sLabel <> private_psLabel(self)) Begin
   135            Set private_psLabel To sLabel
   136            Delegate Send DoUpdatePanes
   137        End
   138    End_Procedure
   139    { MethodType=Property }
   140    Function psLabel Returns String
   141        Function_Return (private_psLabel(self))
   142    End_Function
   143
   144    { MethodType=Property }
   145    Procedure Set peBevel Integer eBevelStyle
   146        Handle hWnd
   147        Integer iVoid
   148
   149        Set private_peBevel To eBevelStyle
   150        Delegate Send DoUpdatePanes
   151        If (eBevelStyle = bsNone) Begin
   152            Get Window_Handle of (Parent(self)) To hWnd
   153            If hWnd Move (InvalidateRect(hWnd, 0, True)) To iVoid
   154        End
   155    End_Procedure
   156    { MethodType=Property }
   157    Function peBevel Returns Integer
   158        Function_Return (private_peBevel(self))
   159    End_Function
   160
   161    { MethodType=Property }
   162    Procedure Set piWidth Integer iWidth
   163        Set private_piWidth To iWidth
   164        Delegate Send DoRestructure
   165    End_Procedure
   166    { MethodType=Property }
   167    Function piWidth Returns Integer
   168        Function_Return (private_piWidth(self))
   169    End_Function
   170
   171    { MethodType=Property }
   172    Procedure Set peAlignment Integer eAlignmentStyle
   173        Set private_peAlignment To eAlignmentStyle
   174        Delegate Send DoUpdatePanes
   175    End_Procedure
   176    { MethodType=Property }
   177    Function peAlignment Returns String
   178      Function_Return (private_peAlignment(self))
   179    End_Function
   180
   181    { MethodType=Event }
   182    Procedure OnClick
   183    End_Procedure
   184    { MethodType=Event }
   185    Procedure OnDoubleClick
   186    End_Procedure
   187    { MethodType=Event }
   188    Procedure OnRightClick
   189    End_Procedure
   190    { MethodType=Event }
   191    Procedure OnDoubleRightClick
   192    End_Procedure
   193
   194End_Class
   195
   196