Module cToolbar.pkg

     1Use LanguageText.pkg
     2Use cWinControl.pkg
     3Use cToolbar_h.pkg
     4Use cCollection.pkg
     5Use cToolbarButton.pkg
     6
     7Use cImageList.pkg
     8
     9Register_Function pbTooltips       Returns Integer
    10Register_Function pbFlat           Returns Integer
    11Register_Function pbList           Returns Integer
    12Register_Function pbWrapable       Returns Integer
    13Register_Function pbNoDivider      Returns Integer
    14Register_Function peAlign          Returns Integer
    15Register_Function piBorderVert     Returns Integer
    16Register_Function piBorderHorz     Returns Integer
    17Register_Function piButtonWidthMin Returns Integer
    18Register_Function piButtonWidthMax Returns Integer
    19Register_Function piTextRowsMax    Returns Integer
    20
    21// Events:
    22Register_Procedure OnRightClick
    23
    24Define I_IMAGECALLBACK  for -1
    25Define I_IMAGENONE      for -2
    26Enum_List // Image Indexes
    27    Define iiCallBack for I_IMAGECALLBACK
    28    Define iiNoImage  for I_IMAGENONE
    29End_Enum_List
    30
    31{ HelpTopic=cToolbar }
    32Class cToolbar is a cWinControl
    33    Procedure Construct_Object
    34        Set External_class_Name "cVdfToolbar" To "ToolbarWindow32"
    35        Forward Send Construct_Object
    36        // Note: the Pointer_Only value of Focus_Mode is an internal, private use
    37        //       of this non-documented property. It is a workaround, for sizing
    38        //       logic, and you should not infer that this setting is in any way
    39        //       supported, because it is not.
    40        Set Focus_Mode To Pointer_Only
    41        Set Skip_State to True // keeps this out of next/prior object consideration
    42
    43        Property Handle phoButtons
    44        { Visibility=Private }
    45        Property Integer private_pbTooltips   True
    46        { Visibility=Private }
    47        Property Integer private_pbFlat       True
    48        { Visibility=Private }
    49        Property Integer private_pbList       False
    50        { Visibility=Private }
    51        Property Integer private_pbWrapable   False
    52        { Visibility=Private }
    53        Property Integer private_pbShowLabels False
    54        { Visibility=Private }
    55        Property Integer private_pbNoDivider  False
    56        { Visibility=Private }
    57        Property Integer private_peAlign      alTop
    58        { Visibility=Private }
    59        Property Integer private_piBorderVert 6
    60        { Visibility=Private }
    61        Property Integer private_piBorderHorz 7
    62        { Visibility=Private }
    63        Property Integer private_piButtonWidthMin -1
    64        { Visibility=Private }
    65        Property Integer private_piButtonWidthMax -1
    66        { Visibility=Private }
    67        Property Integer private_piTextRowsMax 1
    68        Property Handle  phoImageList // design time only
    69        Property Handle  phoImageListDisabled // design time only
    70        Property handle  phoImageListHot // design time only
    71        { Visibility=Private }
    72        Property Integer private_piIndent
    73        { Category=Appearance }
    74        Property Integer piButtonWidth 24 // design-time only
    75        { Category=Appearance }
    76        Property Integer piButtonHeight 22 // design-time only
    77        { Category=Behavior }
    78        Property Boolean pbInMdiPanel True // design-time only
    79        { Category=Appearance }
    80        Property String  psDisabledSuffix ( "("+C_$Unavailable+")" )
    81
    82        Object oButtons is an cCollection
    83            Delegate Set phoButtons To self
    84        End_Object
    85
    86    End_Procedure
    87
    88    Procedure End_Construct_Object
    89        If (pbInMdiPanel(self)) Delegate Set Toolbar_Id To self // assumes a single Toolbar in a MDI-Frame.
    90        Forward Send End_Construct_Object
    91    End_Procedure
    92
    93    { MethodType=Event NoDoc=True }
    94    Procedure Deactivating
    95        Handle hoClient
    96
    97        Forward Send DeActivating
    98        If (pbInMdiPanel(self)) Begin
    99            Delegate Get Client_Id To hoClient
   100            If hoClient Begin
   101                Send Remove_Border_Object of hoClient self amTOP
   102            End
   103        End
   104    End_Procedure
   105
   106    { MethodType=Property }
   107    { InitialValue=True }
   108    { Category=Appearance }
   109    Procedure Set pbTooltips Boolean bToolTips
   110        Set private_pbTooltips To bTooltips
   111    End_Procedure
   112    { MethodType=Property }
   113    Function pbTooltips Returns Boolean
   114        Function_Return (private_pbTooltips(self))
   115    End_Function
   116
   117    Function NumberOfButtons Returns Integer
   118        Function_Return (CountOfObjects(phoButtons(self)))
   119    End_Function
   120
   121    { Visibility=Private }
   122    Procedure DoRestructure
   123        Integer iButton icButton iWidth icWidth iVoid
   124        Handle hWnd
   125        Handle hoButton hoButtons
   126        String  sItems
   127        Pointer lpItems
   128
   129        Broadcast Send private_DoStaticCreate
   130
   131        Get Window_Handle To hWnd
   132        If hWnd Begin
   133            Get phoButtons To hoButtons
   134
   135            Get NumberOfButtons To icButton
   136
   137            For iButton from 0 To (icButton -1)
   138                Get ObjectFromIndex of (phoButtons(self)) iButton To hoButton
   139                // Add the button...
   140                Send DoAppendButton hoButton
   141            Loop
   142        End
   143    End_Procedure
   144
   145    { Visibility=Private }
   146    Procedure private_DoAddButton Handle hoButton Handle hoBefore Boolean bAdd
   147        // Private method to add or insert a button
   148        Integer iStyle iState bEnabled eStyle bGrouped iString iImage
   149
   150        String sTbButton sLabel
   151        Pointer lpsTbButton lpsLabel
   152        ZeroType tTbButton To sTbButton
   153        GetAddress of sTbButton To lpsTbButton
   154
   155        If (private_pbEnabled(hoButton))       Add TBSTATE_ENABLED       To iState
   156        If (private_pbWrap(hoButton))          Add TBSTATE_WRAP          To iState
   157        If (private_pbPressed(hoButton))       Add TBSTATE_PRESSED       To iState
   158        If (private_pbChecked(hoButton))       Add TBSTATE_CHECKED       To iState
   159        If (private_pbIndeterminate(hoButton)) Add TBSTATE_INDETERMINATE To iState
   160        If (private_pbVisible(hoButton)=False) Add TBSTATE_HIDDEN        To iState
   161
   162        Get peStyle of hoButton To eStyle
   163        If      (eStyle = bsButton)    Move TBSTYLE_BUTTON   To iStyle
   164        Else If (eStyle = bsSeparator) Move TBSTYLE_SEP      To iStyle
   165        Else If (eStyle = bsCheck)     Move TBSTYLE_CHECK    To iStyle
   166        Else If (eStyle = bsDropDown)  Move TBSTYLE_DROPDOWN To iStyle
   167
   168        Get pbGrouped of hoButton To bGrouped
   169        If bGrouped Add TBSTYLE_GROUP To iStyle
   170
   171        If (private_pbAutosize(hoButton)) Add TBSTYLE_AUTOSIZE To iStyle
   172
   173        Get piImage of hoButton To iImage
   174        //Add TBSTYLE_WHOLEDROPDOWN To iStyle
   175
   176        // Add the Strings...
   177        If (private_pbShowLabels(self)) Begin
   178            Get psLabel of hoButton To sLabel
   179            Move (ToAnsi(sLabel)) To sLabel
   180            Append sLabel (Character(0)) // parameters must be double-zero terminated
   181            GetAddress of sLabel To lpsLabel
   182            Get WindowsMessage TB_ADDSTRING 0 lpsLabel To iString
   183            Put iString  To sTbButton at tTbButton.iString
   184        End
   185
   186        Put iImage   To sTbButton at tTbButton.iBitmap
   187        Put hoButton To sTbButton at tTbButton.idCommand
   188        Put iState   To sTbButton at tTbButton.fsState
   189        Put iStyle   To sTbButton at tTbButton.fsStyle
   190        Put 0        To sTbButton at tTbButton.dwData
   191
   192        If bAdd Send Windows_Message TB_ADDBUTTONS 1 lpsTbButton
   193        Else    Send Windows_Message TB_INSERTBUTTON (IndexFromObject(phoButtons(self), hoBefore)) lpsTbButton
   194
   195    End_Procedure
   196
   197    { Visibility=Private }
   198    Procedure DoAppendButton Handle hoButton
   199        Send private_DoAddButton hoButton 0 True
   200    End_Procedure
   201
   202    { Visibility=Private }
   203    Procedure DoInsertButton Handle hoButton Handle hoBefore
   204        Send private_DoAddButton hoButton hoBefore False
   205    End_Procedure
   206
   207    { Visibility=Private }
   208    Procedure DoRemoveButton Handle hoButton
   209        Handle hoButtons
   210
   211        Get phoButtons To hoButtons
   212        If (Object_id(hoButtons)) Send DoRemoveObject of hoButtons hoButton
   213    End_Procedure
   214
   215    { Visibility=Private }
   216    Procedure DoAddButton Handle hoButton
   217        // internal: do not use!
   218        Send DoAppendObject of (phoButtons(self)) hoButton
   219    End_Procedure
   220
   221    { MethodType=Event Visibility=Private }
   222    Procedure Notify Integer wParam Integer lParam
   223        Integer iVoid iCode hoButton
   224        Boolean bHotItemCanEnter
   225        Integer iPane xMouse yMouse dwHitInfo
   226        Handle hmOnDropDown hmOnRightClick hmOnHotItemEntering hmOnHotItemLeaving
   227        Handle hoButtonLeaving hoButtonEntering dwFlags
   228        String sNmHdr sNmToolbar sNmTbGetInfoTip sNmTbHotItem sTooltip sNmMouse
   229        Pointer lpsNmHdr lpsNmToolbar lpsNmTbGetInfoTip lpsTooltip lpsNmTbHotItem lpsNmMouse
   230        Address aTooltip
   231
   232        ZeroType tNmHdr To sNmHdr
   233        GetAddress of sNmHdr To lpsNmHdr
   234        Move (CopyMemory(lpsNmHdr, lParam, tNmHdr_size)) To iVoid
   235
   236        GetBuff from sNmHdr at tNmHdr.code   To iCode
   237        If (iCode = TBN_DROPDOWN) Begin
   238            ZeroType tNmToolbar To sNmToolbar
   239            GetAddress of sNmToolbar To lpsNmToolbar
   240            Move (CopyMemory(lpsNmToolbar, lParam, tNmToolbar_size)) To iVoid
   241            GetBuff from sNmToolbar at tNmToolbar.iItem To hoButton
   242
   243            Get phmOnDropDown of hoButton To hmOnDropDown
   244            If (hmOnDropDown = msg_OnDropDown) Send OnDropDown of hoButton // send event to button
   245            Else                               Send hmOnDropDown hoButton    // send event, passing button-handle
   246            Procedure_Return TBDDRET_DEFAULT
   247        End
   248        Else If (iCode = TBN_GETINFOTIP) Begin
   249            ZeroType tNmTbGetInfoTip To sNmTbGetInfoTip
   250            GetAddress of sNmTbGetInfoTip To lpsNmTbGetInfoTip
   251            Move (CopyMemory(lpsNmTbGetInfoTip, lParam, tNmTbGetInfoTip_size)) To iVoid
   252            GetBuff from sNmTbGetInfoTip at tNmTbGetInfoTip.iItem To hoButton
   253            GetBuff from sNmTbGetInfoTip at tNmTbGetInfoTip.pszText To lpsTooltip
   254
   255            Get psTooltip of hoButton To sTooltip
   256            If (sTooltip <> "") Begin
   257                Repeat
   258                    Replace "\n" In sTooltip with (Character(10))
   259                Until (finderr)
   260                Move (ToAnsi(sTooltip)) To sToolTip
   261                GetAddress of sTooltip To aTooltip
   262                Move (CopyMemory(lpsTooltip, aTooltip, Length(sTooltip) +1)) To iVoid
   263            End
   264        End
   265        Else If (iCode = NM_CUSTOMDRAW) Begin
   266        End
   267        Else If (iCode = NM_KEYDOWN) Begin
   268        End
   269        Else If (iCode = NM_CLICK) Begin
   270            // Don't need to do anything as this is handled by Command
   271        End
   272        Else If (iCode = TBN_HOTITEMCHANGE) Begin
   273            ZeroType tNmTbHotItem To sNmTbHotItem
   274            GetAddress of sNmTbHotItem To lpsNmTbHotItem
   275            Move (CopyMemory(lpsNmTbHotItem, lParam, tNmTbHotItem_size)) To iVoid
   276            GetBuff from sNmTbHotItem at tNmTbHotItem.idOld   To hoButtonLeaving
   277            GetBuff from sNmTbHotItem at tNmTbHotItem.idNew   To hoButtonEntering
   278            GetBuff from sNmTbHotItem at tNmTbHotItem.dwFlags To dwFlags
   279
   280            If (dwFlags IAND HICF_ENTERING) Move 0 To hoButtonLeaving
   281            If (dwFlags IAND HICF_LEAVING)  Move 0 To hoButtonEntering
   282
   283            // Send OnHotItemEntering
   284            If hoButtonEntering Begin
   285                Get phmOnHotItemEntering of hoButtonEntering To hmOnHotItemEntering
   286                If (hmOnHotItemEntering = msg_OnHotItemEntering) Get hmOnHotItemEntering of hoButtonEntering hoButtonLeaving To bHotItemCanEnter // send to button
   287                Else                                             Get hmOnHotItemEntering hoButtonEntering hoButtonLeaving    To bHotItemCanEnter
   288            End
   289
   290            // Send OnHotItemLeaving
   291            If hoButtonLeaving Begin
   292                Get phmOnHotItemLeaving of hoButtonLeaving To hmOnHotItemLeaving
   293                If (hmOnHotItemLeaving = msg_OnHotItemLeaving) Send hmOnHotItemLeaving of hoButtonLeaving hoButtonEntering // send to button
   294                Else                                           Send hmOnHotItemLeaving hoButtonLeaving hoButtonEntering
   295            End
   296
   297            If (bHotItemCanEnter =1) Procedure_Return 1
   298        End
   299//        Else If (iCode = NM_LDOWN) Begin
   300                // Although the doc says this event is fired, this symbol is not defined in the Win headers at this time.
   301//            ShowLn 'Left Button Down'
   302//        End
   303        Else If (iCode = NM_RCLICK) Begin
   304            ZeroType tNmMouse To sNmMouse
   305            GetAddress of sNmMouse To lpsNmMouse
   306            Move (CopyMemory(lpsNmMouse, lParam, tNmMouse_size)) To iVoid
   307            GetBuff from sNmMouse at tNmMouse.dwItemSpec To hoButton
   308            GetBuff from sNmMouse at tNmMouse.pt.x       To xMouse
   309            GetBuff from sNmMouse at tNmMouse.pt.y       To yMouse
   310            GetBuff from sNmMouse at tNmMouse.dwHitInfo  To dwHitInfo
   311
   312
   313            // We either send the event to the Toolbar or the ToolbarButton
   314            If (hoButton =-1) Begin // If hoButton =-1, click was on Toolbar, not button.
   315                Send OnRightClick xMouse yMouse dwHitInfo // send to self
   316            End
   317            Else Begin  // send to button
   318                Get phmOnRightClick of hoButton To hmOnRightClick
   319                If (hmOnRightClick <> msg_OnRightClick) Send hmOnRightClick self xMouse yMouse dwHitInfo
   320                Else                                    Send hmOnRightClick of hoButton xMouse yMouse dwHitInfo // send to self
   321            End
   322        End
   323        Else If (iCode = NM_RDBLCLK) Begin
   324            // The Double-Right click interface is inconsistent with the right-click interface.
   325            // For now, we wont expose this.
   326        End
   327        Else If (iCode = TTN_SHOW) Begin
   328            GetBuff from sNmHdr at tNmHdr.idFrom To hoButton
   329            Send DoShowHint hoButton
   330        End
   331        Else If (iCode = TTN_POP) Begin
   332            GetBuff from sNmHdr at tNmHdr.idFrom To hoButton
   333            Send DoHideHint hoButton
   334        End
   335
   336        //Else ShowLn 'Notify=' iCode
   337
   338    End_Procedure
   339
   340    { Visibility=Private }
   341    Procedure DoShowHint Handle hoButton
   342        Handle hoStatusBar bDisabled
   343        String sStatusHelp
   344        Send OnShowHint of hoButton
   345        Delegate Get Statusbar_Id to hoStatusBar
   346        If hoStatusBar Begin
   347           Get psStatusHelp of hoButton To sStatusHelp
   348           If ( sStatusHelp<>'' and pbEnabled(hoButton)=False) Begin
   349              Append sStatusHelp " " (psDisabledSuffix(self))
   350           End
   351           If (sStatusHelp <> '') Begin
   352              Send Initialize_Menu of hoStatusBar
   353              Send Show_Status_Help of hoStatusBar sStatusHelp
   354           End
   355        End
   356     End_Procedure
   357
   358    { Visibility=Private }
   359    Procedure DoHideHint Handle hoButton
   360        Handle hoStatusBar
   361        Delegate Get Statusbar_Id to hoStatusBar
   362        If hoStatusBar Send Exit_Menu to hoStatusBar
   363        Send OnHideHint of hoButton
   364    End_Procedure
   365
   366    { Visibility=Private MethodType=Event }
   367    Procedure Command Integer wParam Integer lParam
   368        // send the OnClick event to the appropriate cToolbarButton
   369        Handle hoButton hmOnClick
   370        If (Hi(wParam) = BN_CLICKED) Begin
   371            Move (Low(wParam)) To hoButton
   372            Get phmOnClick of hoButton To hmOnClick
   373            If (hmOnClick = msg_OnClick) Send hmOnClick of hoButton // send event to button
   374            Else                         Send hmOnClick hoButton    // send event, passing button-handle
   375        End
   376    End_Procedure
   377
   378    { MethodType=Property }
   379    { InitialValue=True }
   380    { Category=Appearance }
   381    Procedure Set pbFlat Boolean bFlat
   382        Set private_pbFlat To bFlat
   383    End_Procedure
   384    { MethodType=Property }
   385    Function pbFlat Returns Integer
   386        Function_Return (private_pbFlat(self))
   387    End_Function
   388
   389    { MethodType=Property }
   390    { InitialValue=False }
   391    { Category=Appearance }
   392    Procedure Set pbList Boolean bList
   393        Set private_pbList To bList
   394    End_Procedure
   395    { MethodType=Property }
   396    Function pbList Returns Boolean
   397        Function_Return (private_pbList(self))
   398    End_Function
   399
   400    { MethodType=Property }
   401    { InitialValue=False }
   402    { Category=Appearance }
   403    Procedure Set pbWrapable Boolean bWrapable
   404        Set private_pbWrapable To bWrapable
   405    End_Procedure
   406    { MethodType=Property }
   407    Function pbWrapable Returns Boolean
   408        Function_Return (private_pbWrapable(self))
   409    End_Function
   410
   411    { MethodType=Property }
   412    { InitialValue=False }
   413    { Category=Appearance }
   414    Procedure Set pbShowLabels Boolean bShowLabels
   415        Set private_pbShowLabels To bShowLabels
   416    End_Procedure
   417    { MethodType=Property }
   418    Function pbShowLabels Returns Boolean
   419        Function_Return (private_pbShowLabels(self))
   420    End_Function
   421
   422    { MethodType=Property }
   423    { InitialValue=False }
   424    { Category=Appearance }
   425    Procedure Set pbNoDivider Boolean bNoDivider
   426        Set private_pbNoDivider To bNoDivider
   427    End_Procedure
   428    { MethodType=Property }
   429    Function pbNoDivider Returns Boolean
   430        Function_Return (private_pbNoDivider(self))
   431    End_Function
   432
   433    { MethodType=Property }
   434    { EnumList="alBottom, alNone, alTop" }
   435    { InitialValue=alTop }
   436    { Category=Appearance }
   437    Procedure Set peAlign Integer eAlign
   438        // How should the toolbar be aligned? Top, bottom or none.
   439        Set private_peAlign To eAlign
   440    End_Procedure
   441    { MethodType=Property }
   442    Function peAlign Returns Integer
   443        Function_Return (private_peAlign(self))
   444    End_Function
   445
   446    { MethodType=Property }
   447    { InitialValue=0 }
   448    { Category=Appearance }
   449    Procedure Set piIndent Integer iIndent
   450        Set private_piIndent To iIndent
   451        Send Windows_Message TB_SETINDENT iIndent 0
   452    End_Procedure
   453    { MethodType=Property }
   454    Function piIndent Returns Integer
   455        Function_Return (private_piIndent(self))
   456    End_Function
   457
   458    { MethodType=Property }
   459    { InitialValue=7 }
   460    { Category=Appearance }
   461    Procedure Set piBorderHorz Integer iBorderHorz
   462        Set private_piBorderHorz To iBorderHorz
   463        Send Windows_Message TB_SETPADDING 0 (65536 *iBorderHorz + piBorderVert(self))
   464    End_Procedure
   465    { MethodType=Property }
   466    Function piBorderHorz Returns Integer
   467        Function_Return (private_piBorderHorz(self))
   468    End_Function
   469
   470    { MethodType=Property }
   471    { InitialValue=6 }
   472    { Category=Appearance }
   473    Procedure Set piBorderVert Integer iBorderVert
   474        Set private_piBorderVert To iBorderVert
   475        Send Windows_Message TB_SETPADDING 0 (65536 *piBorderHorz(self) + iBorderVert)
   476    End_Procedure
   477    { MethodType=Property }
   478    Function piBorderVert Returns Integer
   479//        Integer cxyPadding
   480//        If (Window_Handle(self)) Begin
   481//            Get WindowsMessage TB_GETPADDING 0 0 To cxyPadding
   482//            Showln 'x=' (Low(cxyPadding)) ' y=' (Hi(cxyPadding))
   483//        End
   484//        Else
   485        Function_Return (private_piBorderVert(self))
   486    End_Function
   487
   488    { MethodType=Property }
   489    { InitialValue=-1 }
   490    { Category=Appearance }
   491    Procedure Set piButtonWidthMin Integer iButtonWidthMin
   492        Integer iButtonWidthMax
   493        Get piButtonWidthMax To iButtonWidthMax
   494        If (iButtonWidthMax = -1) Move iButtonWidthMin To iButtonWidthMax // this may not have been set, and we can't use -1
   495        Set private_piButtonWidthMin To iButtonWidthMin
   496        If (iButtonWidthMin <> -1) Send Windows_Message TB_SETBUTTONWIDTH 0 (65536 *iButtonWidthMax + iButtonWidthMin)
   497    End_Procedure
   498    { MethodType=Property }
   499    Function piButtonWidthMin Returns Integer
   500        Function_Return (private_piButtonWidthMin(self))
   501    End_Function
   502
   503    { MethodType=Property }
   504    { InitialValue=-1 }
   505    { Category=Appearance }
   506    Procedure Set piButtonWidthMax Integer iButtonWidthMax
   507        Integer iButtonWidthMin
   508        Get piButtonWidthMin To iButtonWidthMin
   509        If (iButtonWidthMin = -1) Move iButtonWidthMax To iButtonWidthMin // this may not have been set, and we can't use -1
   510        Set private_piButtonWidthMax To iButtonWidthMax
   511        If (iButtonWidthMax <> -1) Send Windows_Message TB_SETBUTTONWIDTH 0 (65536 *iButtonWidthMax +iButtonWidthMin)
   512    End_Procedure
   513    { MethodType=Property }
   514    Function piButtonWidthMax Returns Integer
   515        Function_Return (private_piButtonWidthMax(self))
   516    End_Function
   517
   518    { MethodType=Property }
   519    { InitialValue=1 }
   520    { Category=Appearance }
   521    Procedure Set piTextRowsMax Integer iTextRowsMax
   522        Set private_piTextRowsMax To iTextRowsMax
   523        Send Windows_Message TB_SETMAXTEXTROWS iTextRowsMax 0
   524    End_Procedure
   525    { MethodType=Property }
   526    Function piTextRowsMax Returns Integer
   527        Function_Return (private_piTextRowsMax(self))
   528    End_Function
   529
   530    Procedure DoResize
   531        // Resize the Toolbar!
   532        If (peAlign(self) <> alNone) Send Windows_Message TB_AUTOSIZE 0 0
   533    End_Procedure
   534
   535    { MethodType=Property  NoDoc=True }
   536    Procedure Set GuiSize Integer cy Integer cx
   537        // This message is only here for compatibility with the old Toolbars
   538        // and how they were interacted with by the MDI-interface
   539        Forward Set GuiSize To cy cx
   540        Send DoResize
   541    End_Procedure
   542
   543    { Visibility=Private }
   544    Function Is_Function Integer MsgId Handle hoFocus Boolean bDelegate Returns Integer
   545        Boolean bIsFunction
   546        Handle  hoMainPanel
   547
   548        Get Main_Panel_id to hoMainPanel
   549        If (hoFocus>Desktop and hoMainPanel) ;
   550            Get Is_Function of hoMainPanel MsgId hoFocus bDelegate to bIsFunction
   551        Function_Return bIsFunction
   552    End_Function
   553
   554    Procedure DoSendToFocus Handle hmMessage
   555        Handle hoFocus
   556        Integer iVoid
   557
   558        Get Focus of desktop To hoFocus
   559        If (hoFocus >Desktop) Get hmMessage of hoFocus to iVoid
   560    End_Procedure
   561
   562    Procedure DoSendToDeoFocus Handle hmMessage
   563        Handle  hoFocus
   564        Integer iVoid
   565        Boolean bUnderstood
   566
   567        Get Focus of desktop to hoFocus
   568        Get Is_Function Get_Deo_Object hoFocus TRUE to bUnderstood
   569        If bUnderstood Get hmMessage of hoFocus to iVoid
   570    End_Procedure
   571
   572    { NoDoc=True }
   573    Procedure Add_Focus Handle hoBase Returns Integer
   574        Integer iButtonWidth iButtonHeight
   575        Handle hoClient
   576        Integer iRetVal iVoid
   577        
   578        // it is possible that this can get called when it already is active (part of the
   579        // load envionment and activate logic). If the design time toolbar_state is false
   580        // but the load environment wants a toolbar, this gets called twice (creating two
   581        // toolbars). We want to catch that here.
   582        If (Active_state(Self)) Begin
   583            Procedure_Return 1
   584        End
   585
   586        Forward Get Msg_Add_Focus hoBase To iRetVal
   587
   588        // At this juncture, the window is created, but not visible.
   589        // So, we send messages that must be sent before the control is visible
   590        Send Windows_Message TB_BUTTONSTRUCTSIZE tTbButton_size 0
   591        Send Windows_Message TB_SETEXTENDEDSTYLE 0 TBSTYLE_EX_DRAWDDARROWS
   592        //Send Windows_Message TB_SETEXTENDEDSTYLE 0 TBSTYLE_EX_MIXEDBUTTONS
   593
   594        // Assign Imageslists...
   595        If (phoImagelist(self)) ;
   596            Send Windows_Message TB_SETIMAGELIST 0 (phImagelist(phoImagelist(self)))
   597
   598        If (phoImagelistDisabled(self)) ;
   599            Send Windows_Message TB_SETDISABLEDIMAGELIST 0 (phImagelist(phoImagelistDisabled(self)))
   600
   601        If (phoImagelistHot(self)) ;
   602            Send Windows_Message TB_SETHOTIMAGELIST 0 (phImagelist(phoImagelistHot(self)))
   603
   604        //Send Windows_Message TB_LOADIMAGES IDB_STD_SMALL_COLOR HINST_COMMCTRL
   605
   606        // Set Max Button Size, must be done before any buttons are added (design-time only)
   607        //Send Windows_Message TB_SETBUTTONWIDTH 0 (65536 *20 + 50)
   608
   609        // Set the indent before the first button...
   610        Set piIndent To (piIndent(self))
   611
   612        // Set the button width and height before the any buttons are added...
   613        Get piButtonWidth  To iButtonWidth
   614        Get piButtonHeight To iButtonHeight
   615        //Send Windows_Message TB_SETBUTTONSIZE 0 (65536 * iButtonWidth + iButtonHeight)
   616        Get Windows_Message TB_SETBUTTONSIZE 0 (65536 * iButtonHeight + iButtonWidth) To iVoid
   617
   618        // Set padding. (This is only used for pbAutosize buttons.)
   619        Set piBorderVert To (piBorderVert(self))
   620        Set piBorderHorz To (piBorderHorz(self))
   621
   622        Set piButtonWidthMin To (piButtonWidthMin(self))
   623        Set piButtonWidthMax To (piButtonWidthMax(self))
   624
   625        //Send Windows_Message TB_SETBUTTONWIDTH 0 (65536 *70 + 40)
   626        Send Windows_Message TB_AUTOSIZE 0 0
   627
   628        Set piTextRowsMax To (piTextRowsMax(self))
   629
   630        Send DoRestructure
   631        Send DoResize
   632
   633        // Now add to MDI Frame, if necessary:
   634        If (pbInMdiPanel(self)) Begin
   635            Delegate Get Client_Id To hoClient
   636            If hoClient Send Add_Border_Object of hoClient self amTop
   637        End
   638
   639        Procedure_Return iRetVal
   640
   641    End_Procedure
   642
   643    { MethodType=Event  NoDoc=True }
   644    Procedure Page Integer iState
   645        Handle hoClient
   646
   647        If (iState =1) Begin
   648            Set Window_Style To TBSTYLE_TOOLTIPS (pbTooltips(self))
   649            Set Window_Style To TBSTYLE_FLAT     (pbFlat(self))
   650            Set Window_Style To TBSTYLE_LIST     (pbList(self))
   651            Set Window_Style To TBSTYLE_WRAPABLE (pbWrapable(self))
   652            Set Window_Style To CCS_NODIVIDER    (pbNoDivider(self))
   653
   654            Set Window_Style To CCS_NOPARENTALIGN (peAlign(self) = alNone)
   655            Set Window_Style To CCS_NORESIZE      (peAlign(self) = alNone)
   656            Set Window_Style To CCS_TOP           (peAlign(self) = alTop)
   657            Set Window_Style To CCS_BOTTOM        (peAlign(self) = alBottom)
   658
   659        End
   660        Forward Send Page iState
   661    End_Procedure
   662
   663    { MethodType=Event }
   664    Procedure OnRightClick Integer x Integer y Integer dwHitInfo
   665        // Note that x and y are expressed in screen coordinates, not client coordinates
   666        //Showln 'Right Click (' (Name(self)) ') ' x ' ' y
   667    End_Procedure
   668End_Class
   669
   670
   671