\    File: Toolbar.f
\  Author: Jeff Kelm
\ Created: 09-Sep-1998
\ Updated: 20-May-1999
\ A bitmap button-style toolbar class

Comment:  Revision History (most recent first)
19990520
 - Changed TooltipToolbar definition to use GenericToolbar to
   eliminate TOOLBARCLASSNAME which was removed from WinBase.f.
19981231
 - Incorporated the new ChildWindow class.
19981120
 - create a seperate TooltipToolbar class
 - Changed  'ToolbarStyle: self'  to  'ToolbarStyle: [ self ]'
   in Create: method so style will inherit properly
19981118
 - eliminated tbarID instance variable and GetID: method
   (handled by BaseWindow)
 - eliminated tooltip methods (handle now with seperate tooltip
   control)
19981117
 - General cosmetic updates
 - redefined to use BaseWindow superclass and call BasicWin.f
 - eliminated SetParent: from Create: set by CreateWindowEx now
Comment;



NEEDS BasicWin.f
CR  .( Loading Toolbar class...)



\ =====================
\ Generic Toolbar class
\ =====================
:Class GenericToolbar  <Super ChildWindow

   INT images         \ number of images in the bitmap
   INT NextButton     \ index of next button to be defined
   Record: tbAddbitmap   \ toolbar bitmap data structure
       INT hInst       \ handle to module instance (NULL)
       INT uID         \ resource identifier (bitmap handle)
   ;Record
   Record: tbButton   \ toolbar button data structure
       INT   iBitmap     \ Zero-based index of image to use
       INT   idCommand   \ identifier associated with the button
       BYTE  fsState     \ Button state flags
       BYTE  fsStyle     \ Button style
       Align             \ padding to word align dwData
       INT   dwData      \ Application-defined value
       INT   iString     \ Zero-based index of button string
   ;RecordSize: sizeof(tbButton)

   :M DefStyle: ( -- style)   \ default toolbar style
      DefStyle: super
      WS_BORDER OR
      ;M

   :M DefClassName: ( -- ClassName)   \ default class name
      Z" ToolbarWindow32"
      ;M

   :M Create: ( hParent)   \ create an empty toolbar window
      Create: super
      \ post-creation initialization
      TBSTATE_ENABLED TO fsState   \ default button state
      TBSTYLE_BUTTON TO fsStyle    \ default button style
      0 sizeof(tbButton) TB_BUTTONSTRUCTSIZE
         SendMessage: self DROP
      ;M

:M LoadBitmap: ( n hBmp)   \ loads n images from bitmap
      TO uID  TO images  NULL TO hInst
      tbAddbitmap rel>abs images TB_ADDBITMAP
         SendMessage: self  DROP
      ;M

:M LoadStdBmp: ( -- )   \ load the system default toolbar bitmap
      IDB_STD_SMALL_COLOR TO uId  15 TO images
         HINST_COMMCTRL to hInst
      tbAddbitmap rel>abs images TB_ADDBITMAP
         SendMessage: self  DROP
      ;M

:M GetBitmap: ( -- hBmp)   \ returns handle to toolbar bitmap
      uID
      ;M

\ default button behavior
\ TBSTYLE_BUTTON, TBSTYLE_GROUP,
\ toggles between pressed and unpressed
\ TBSTYLE_CHECK, TBSTYLE_CHECKGROUP
\ seperation between buttons
\ or TBSTYLE_SEP
:M SetButtonStyle: ( fsState id)   \ set specified button to this state
      ( tbd) TO fsStyle DROP
      ;M

:M GetButtonStyle: ( id -- fsStyle)
      0 SWAP TB_COMMANDTOINDEX SendMessage: self
      tbButton rel>abs SWAP TB_GETBUTTON
         SendMessage: self ?WinError
      fsStyle
      ;M

\ TBSTATE_CHECKED, TBSTATE_PRESSED,
\ TBSTATE_ENABLED, TBSTATE_HIDDEN, TBSTATE_INDETERMINATE,
\ or TBSTATE_WRAP   \ A line break follows the button. The
                    \ button must also have the TBSTATE_ENABLED
                    \ state
:M SetButtonState: ( fsState id)   \ set specified button to this state
      0 ROT MAKELONG SWAP
      TB_SETSTATE SendMessage: self ?WinError
      ;M

:M GetButtonState: ( id -- fsState)   \ get current state of specified button
      0 SWAP TB_GETSTATE SendMessage: self
      ;M

:M Button: ( id iBmp -- )   \ create the next button with bmp offset iBmp
      TO iBitmap
      TO idCommand
      TBSTATE_ENABLED TO fsState
      TBSTYLE_BUTTON TO fsStyle
      tbButton rel>abs  NextButton  TB_INSERTBUTTON
         SendMessage: self ?WinError
      NextButton 1+ TO NextButton
      ;M

:M Seperator: ( -- )   \ add a seperator to toolbar
      0 TO iBitmap
      0 TO idCommand
      TBSTATE_ENABLED TO fsState
      TBSTYLE_SEP TO fsStyle      \ set to seperator style
      tbButton rel>abs  NextButton  TB_INSERTBUTTON
         SendMessage: self ?WinError
      NextButton 1+ TO NextButton
      ;M

:M GetIndex: ( id -- posn)   \ convert command id to toolbar button offset
      0 SWAP TB_COMMANDTOINDEX SendMessage: self
      ;M

:M GreyButton: ( id)
      0 TRUE makelong SWAP TB_INDETERMINATE
         SendMessage: self ?WinError
      ;M

:M UnGreyButton: ( id)
      0 FALSE makelong SWAP TB_INDETERMINATE
         SendMessage: self ?WinError
      ;M

:M EnableButton: ( id)
      0 TRUE makelong SWAP TB_ENABLEBUTTON SendMessage: self ?WinError
      ;M

:M DisableButton: ( id)
      0 FALSE makelong SWAP TB_ENABLEBUTTON SendMessage: self ?WinError
      ;M

:M ShowButton: ( id)
      0 FALSE makelong SWAP TB_HIDEBUTTON SendMessage: self ?WinError
      ;M

:M HideButton: ( id)
      0 TRUE makelong SWAP TB_HIDEBUTTON SendMessage: self ?WinError
      ;M

:M CheckButton: ( id)
      0 TRUE makelong SWAP TB_CHECKBUTTON SendMessage: self ?WinError
      ;M

:M UncheckButton: ( id)
      0 FALSE makelong SWAP TB_CHECKBUTTON SendMessage: self ?WinError
      ;M

:M Autosize: ( -- )   \ resizes toolbar to fill width of parent window
      0 0 TB_AUTOSIZE SendMessage: self DROP
      ;M

;Class



\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
\ Toolbar class to allow other than default (24 by 22) size buttons
\
:Class SizableToolbar <Super GenericToolbar   \ call with size & parent on stack

:M Create: ( x y hWnd)   \ create blank toolbar with user defined button size
\ was      >R  SWAP 16 LSHIFT OR 0 TB_SETBUTTONSIZE SendMessage: self ?WinError
( is)      >R  SWAP word-join 0 TB_SETBUTTONSIZE SendMessage: self ?WinError
      R>  Create: super
      ;M

;Class



\ ===================================
\ Toolbar class with tooltips enables
\ ===================================
:Class TooltipToolbar  <Super GenericToolbar

:M DefStyle: ( -- style)   \ default toolbar style, override as necessary
      DefStyle: super
      TBSTYLE_TOOLTIPS OR
      ;M

:M Create: ( hParent)   \ create an empty toolbar window
\ was      >R  NULL appInst CreateNewID  R>  0 0 0 0
\ was      WS_CHILD DefStyle: self OR
\ was      NULL TOOLBARCLASSNAME 0
\ was      Call CreateWindowEx  DUP PutHandle: self  ?WinError
( is)   Create: super
      TBSTATE_ENABLED TO fsState   \ default button state
      TBSTYLE_BUTTON TO fsStyle    \ default button style
      0 sizeof(tbButton) TB_BUTTONSTRUCTSIZE
         SendMessage: self DROP
      ;M

:M GetTooltips: ( -- hndl)   \ returns handle to toolbar tooltip window
      0 0 TB_GETTOOLTIPS  SendMessage: self
      ;M

;Class