MODULE GLOBALS

INTEGER::   hFrame,     &     !Handle of the frame window
            hInst,      &     !Instance handle
            hMDI,       &     !Handle of the MDI client window
            hToolbar,   &     !Toolbar handle
            lpfnOldFrameProc  !Address of the default MDI windos procedure

INTEGER,PARAMETER::     &     !Define our own message for toolbar creation.
                              !Should be > WM_USER=#0400
            WM_CREATETOOLBAR=#0500
            

END MODULE GLOBALS
!===================================================================
PROGRAM QWToolbar

USE DFLIB
USE DFWIN
USE GLOBALS

IMPLICIT NONE

LOGICAL::               bSt
TYPE(WindowConfig)::    WConf
TYPE(T_RECT)::          Rect
CHARACTER*15::          sClass
INTEGER::               iSt, jTop, jBottom, jLeft, jRight, jWidth, jHeight

INTERFACE
      INTEGER(4) FUNCTION FrameWndProc(hWnd,Msg,wParam,lParam)
      !DEC$ATTRIBUTES STDCALL::  FrameWndProc
      INTEGER::      hWnd,Msg,wParam,lParam
      END FUNCTION
END INTERFACE

iSt=SETEXITQQ(QWIN$EXITNOPERSIST)

hFrame=GETHWNDQQ(QWIN$FRAMEWINDOW)           !Handle of the frame window
hInst=GetWindowLong(hFrame,GWL_HINSTANCE)    !Instance handle (needed to load resources)

iSt=SetWindowText(hFrame,"QuickWin Toolbar Sample")

hMDI = GetWindow(hFrame, GW_CHILD)          !MDI parent window (the dark surface beneath childs)


!Subclass the Frame window with FrameWndProc. lpfnOldFrameProc is the
!address of default ("Old") Frame window procedure
lpfnOldFrameProc=SetWindowLong(hFrame,GWL_WNDPROC,LOC(FrameWndProc))

!This is a user-defined message sent to Frame window to create toolbar.
!Note that a direct call to CreateMyToolbar from here would fail (i.e.
!the toolbar would be created, but "dead", since QW has two threads:
!"primary", where mouse and menu callbacks, along with QW internal
!stuff is executed, and "secondary", where PROGRAM is executed).
!This, secondary thread does not contain a message loop; the primary
!(where FrameWndProc is executed) has.
iSt=SendMessage(hFrame,WM_CREATETOOLBAR,0,0)


iSt=SETACTIVEQQ(0)

WConf%numxpixels=200
WConf%numypixels=100
WConf%numtextcols=0
WConf%numtextrows=0
WConf%numcolors=256
WConf%fontsize=#0008000C
WConf%title=' 'C
bSt = SETWINDOWCONFIG(WConf)
IF (.NOT.bSt) bSt = SETWINDOWCONFIG(WConf)

iSt=SETBKCOLOR(7)
CALL CLEARSCREEN($GCLEARSCREEN)

DO WHILE (.TRUE.)
   CALL SLEEPQQ(500)
END DO

END PROGRAM
!==================================================================
!Subclassed procedure of Frame client window
INTEGER FUNCTION FrameWndProc(hWnd,Msg,wParam,lParam)
!DEC$ATTRIBUTES STDCALL::      FrameWndProc

USE DFWIN
!DEC$IF (_DF_VERSION_ <=650)
USE COMCTL
!DEC$ENDIF
USE GLOBALS

INTEGER::               hWnd,Msg,wParam,lParam
INTEGER::               iSt, ID, iState, itbHeight
TYPE(T_RECT)::          tbRect, mdiRect
TYPE(T_NMHDR)::         NMH; POINTER(pNMH, NMH)
TYPE(T_NMTTDISPINFO)::  DI; POINTER(pDI, DI)

INCLUDE "Resource.fd"

SELECT CASE(Msg)
CASE (WM_CREATETOOLBAR)
      !Request for toolbar creation
      CALL CreateMyToolbar
      FrameWndProc=0
CASE (WM_COMMAND)
      !Click on a menu or toolbar button
      ID=IAND(wParam,#FFFF)         !Button ID
      !TODO add your own handlers here. See "Toolbars" section in SDK help
      !for toolbar messages (TB_xxx)
      SELECT CASE(ID)
      CASE(ID_BUTTON_1)
            iSt=MessageBox(hFrame,"Button 1"C,"Toolbar"C,MB_OK)
      CASE(ID_BUTTON_2)
            iSt=MessageBox(hFrame,"Button 2"C,"Toolbar"C,MB_OK)
      CASE(ID_BUTTON_3)
            iState=SendMessage(hToolbar,TB_GETSTATE,ID,0)
            IF (IAND(iState,TBSTATE_CHECKED).NE.0) THEN
                  iSt=MessageBox(hFrame,"Button 3 pushed"C,"Toolbar"C,MB_OK)
            ELSE
                  iSt=MessageBox(hFrame,"Button 3 released"C,"Toolbar"C,MB_OK)
            END IF
      END SELECT
      FrameWndProc=CallWindowProc(lpfnOldFrameProc,hWnd,Msg,wParam,lParam)
CASE (WM_NOTIFY)
      !Tooltips send a WM_NOTIFY message. 
      !lParam points to NMHDR structure. Its code member contains TTN_GETDISPINFO
      pNMH = lParam
      IF (NMH%code.EQ.TTN_GETDISPINFO) THEN
            !NMTTDISPINFO DI contains NMHDR as the first member. So, we 
            !have to cast lParam to a pointer to DI.
            pDI = lParam
            DI%hInst = GetModuleHandle(0)
            DI%lpszText = wParam
      END IF
      FrameWndProc = CallWindowProc(lpfnOldFrameProc,hWnd,Msg,wParam,lParam)
CASE (WM_SIZE)
      !QuickWin will try to move the MDI client area over the toolbar. We have to 
      !resize hMDI so that it comes below the toolbar.
      iSt = GetClientRect(hWnd, mdiRect)
      iSt = GetWindowRect(hToolbar, tbRect)
      itbHeight = tbRect%Bottom-tbRect%Top
      iSt = MoveWindow(hMDI, 0, itbHeight, mdiRect%Right, mdiRect%Bottom - itbHeight, .TRUE.)
      FrameWndProc = 0
CASE DEFAULT
      !Send all other messages further to normal processing
      FrameWndProc=CallWindowProc(lpfnOldFrameProc,hWnd,Msg,wParam,lParam)
END SELECT

END FUNCTION FrameWndProc
!======================================================================
!Creation of toolbar
SUBROUTINE CreateMyToolbar()

USE DFWIN
!DEC$IF (_DF_VERSION_ >= 650) 
USE COMCTL32, ONLY: CreateToolbarEx
!DEC$ELSE
USE COMCTL
!DEC$ENDIF
USE GLOBALS

IMPLICIT NONE

INCLUDE 'Resource.fd'

INTEGER::               i, iSt, iStyle
TYPE(T_TBBUTTON)::      Button(4)

Button(1)=T_TBBUTTON(0,ID_BUTTON_1,TBSTATE_ENABLED,TBSTYLE_BUTTON,(/0_1,0_1/),0,NULL)
Button(2)=T_TBBUTTON(0,0,TBSTATE_ENABLED,TBSTYLE_SEP,(/0_1,0_1/),0,NULL)
Button(3)=T_TBBUTTON(1,ID_BUTTON_2,TBSTATE_ENABLED,TBSTYLE_BUTTON,(/0_1,0_1/),0,NULL)
Button(4)=T_TBBUTTON(2,ID_BUTTON_3,TBSTATE_ENABLED,TBSTYLE_CHECK,(/0_1,0_1/),0,NULL)

hToolbar=CreateToolbarEx(hFrame,   &                     !Parent window
      WS_CHILD.OR.WS_VISIBLE.OR.WS_CLIPSIBLINGS.OR.TBSTYLE_TOOLTIPS,    &    !Toolbar style
      IDR_TOOLBAR1,           &                          !Bitmap ID
      3,                      &                          !Number of bitmaps
      hInst,                  &                          !Instance handle
      IDR_TOOLBAR1,           &                          !Toolbar ID
      Button,                 &                          !Address of Button array
      4,                      &                          !Number of buttons (incl. separators)
      0,                      &                          !Button width (default)
      0,                      &                          !Button height (default)
      16,                     &                          !Bitmap width 
      15,                     &                          !Bitmap height
      SizeOf(Button(1)))                                 !Size of T_TBBUTTON

END SUBROUTINE CreateMyToolbar