Tweet
Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Vertical toolbar demo, by Borje Hagsten
' Shows a way how to create a vertical toolbar. Also shows a way
' to create a popup toolbar, activated by click on a check button.
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' First, eliminate some unnecessary macros in COMMCTRL.INC
'--------------------------------------------------------------------
%NOANIMATE = 1
%NOBUTTON = 1
%NOCOMBO = 1
%NODATETIMEPICK = 1
%NODRAGLIST = 1
%NOEDIT = 1
%NOFLATSBAPIS = 1
%NOHEADER = 1
%NOHOTKEY = 1
%NOIMAGELIST = 1
%NOIPADDRESS = 1
%NOLIST = 1
%NOLISTVIEW = 1
%NOMONTHCAL = 1
%NONATIVEFONTCTL = 1
%NOPAGESCROLLER = 1
%NOPROGRESS = 1
%NOREBAR = 1
%NOSTATUSBAR = 1
%NOTABCONTROL = 1
' %NOTOOLBAR = 1
%NOTOOLTIPS = 1
%NOTRACKBAR = 1
%NOTREEVIEW = 1
%NOUPDOWN = 1
'--------------------------------------------------------------------
#COMPILE EXE
#INCLUDE "WIN32API.INC"
#INCLUDE "COMMCTRL.INC"
'--------------------------------------------------------------------
%ID_NEW = 101
%ID_OPEN = 102
%ID_TOOL = 103
%ID_TOOLBAR = 200
%ID_POPUPTB = 300
'--------------------------------------------------------------------
GLOBAL hDlg AS LONG, ghTBar AS LONG, ghPopupTBar AS LONG, gTBBRC AS RECT
'--------------------------------------------------------------------
DECLARE CALLBACK FUNCTION DlgCallback
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main procedure
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION PBMAIN() AS LONG
LOCAL s AS STRING, rc AS RECT
DIALOG NEW %HWND_DESKTOP, "Vertical Toolbar demo",,, 320, 200, _
%WS_OVERLAPPEDWINDOW TO hDlg
'no other controls here, so add a dummy control, to avoid first
'button in toolbar from starting in rasied mode (DDT focus problem)
CONTROL ADD LABEL, hDlg, -1, "", 0, 0, 0, 0
'-------------------------------------------------------------------
' Build simple toolbar
'-------------------------------------------------------------------
LOCAL icc As INIT_COMMON_CONTROLSEX
DIM Tbb(5) AS LOCAL TBBUTTON
icc.dwSize= SizeOf(icc)
icc.dwIcc = %ICC_BAR_CLASSES
InitCommonControlsEx icc 'initiate toolbar class
Tbb(0).fsState = %TBSTATE_ENABLED : Tbb(0).fsStyle = %TBSTYLE_BUTTON
Tbb(0).iBitmap = %STD_FILENEW : Tbb(0).idCommand = %ID_NEW : Tbb(1).iString = 0
Tbb(1).fsState = %TBSTATE_ENABLED : Tbb(1).fsStyle = %TBSTYLE_BUTTON
Tbb(1).iBitmap = %STD_FILEOPEN : Tbb(1).idCommand = %ID_OPEN : Tbb(1).iString = 1
Tbb(2).fsState = %TBSTATE_ENABLED : Tbb(2).fsStyle = %TBSTYLE_SEP
Tbb(3).fsState = %TBSTATE_ENABLED : Tbb(3).fsStyle = %TBSTYLE_CHECK
Tbb(3).iBitmap = %STD_HELP : Tbb(3).idCommand = %ID_TOOL : Tbb(3).iString = 2
Tbb(4).fsState = %TBSTATE_ENABLED : Tbb(4).fsStyle = %TBSTYLE_SEP
Tbb(5).fsState = %TBSTATE_ENABLED : Tbb(5).fsStyle = %TBSTYLE_BUTTON
Tbb(5).iBitmap = %STD_DELETE : Tbb(5).idCommand = %IDCANCEL : Tbb(5).iString = 3
ghTBar = CreateToolbarEx(hDlg, %WS_CHILD OR %WS_VISIBLE OR %WS_THICKFRAME OR _
%TBSTYLE_LIST OR %CCS_NORESIZE OR %CCS_NODIVIDER, _
%ID_TOOLBAR, 26, %HINST_COMMCTRL, %IDB_STD_LARGE_COLOR, _
tbb(0), 6, 0, 0, 0, 0, LEN(TBBUTTON))
CALL SetWindowLong(ghTBar, %GWL_STYLE, _
GetWindowLong(ghTBar, %GWL_STYLE) OR %TBSTYLE_FLAT) 'set flat style
s = " &New " & $NUL & " &Open " & $NUL & _
" &Popup " & $NUL & " &Close " & $NUL & $NUL 'build textstring for buttons
CONTROL SEND hDlg, %ID_TOOLBAR, %TB_ADDSTRING, 0, STRPTR(s) 'add text to buttons
CONTROL SEND hDlg, %ID_TOOLBAR, %TB_SETROWS, MAKLNG(6, 0), VARPTR(gTBBRC) 'rc gets size of a button
'-------------------------------------------------------------------
' Build popup toolbar (non-visible at this stage)
' Here I borrow buttons from tbb array above, but should
' of course be own, uniqe ones. This is just a demo, so..
'-------------------------------------------------------------------
ghPopupTBar = CreateToolbarEx(hDlg, %WS_CHILD OR %WS_THICKFRAME OR _
%CCS_NORESIZE OR %CCS_NODIVIDER, _
%ID_POPUPTB, 26, %HINST_COMMCTRL, %IDB_STD_LARGE_COLOR, _
tbb(0), 2, 0, 0, 0, 0, LEN(TBBUTTON))
CALL SetWindowLong(ghPopupTBar, %GWL_STYLE, _
GetWindowLong(ghPopupTBar, %GWL_STYLE) OR %TBSTYLE_FLAT) 'set flat style
CONTROL SEND hDlg, %ID_POPUPTB, %TB_GETITEMRECT, 0, VARPTR(rc) 'get size of first button
SetWindowPos ghPopupTBar, 0, 0, 0, _ 'resize toolbar to buttons
2 * rc.nRight + 7, _ '2 buttons + some for edges
rc.nBottom + 7, _
%SWP_NOMOVE OR %SWP_NOZORDER
'-------------------------------------------------------------------
DIALOG SHOW MODAL hDlg CALL DlgCallback
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main Callback procedure
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CALLBACK FUNCTION DlgCallback
SELECT CASE CBMSG
CASE %WM_INITDIALOG
LOCAL rc AS RECT
CASE %WM_CTLCOLORDLG
FUNCTION = GetSysColorBrush(%COLOR_3DSHADOW) 'set dialog color
CASE %WM_SIZE
MoveWindow ghTBar, -2, -2, gTBBRC.nRight + 7, HIWRD(CBLPARAM) + 4, 0
CASE %WM_LBUTTONDOWN 'mouse click anywhere in dialog
IF IsWindowVisible(ghPopupTBar) THEN 'if popup is visible
ShowWindow ghPopupTBar, %SW_HIDE 'hide it and..
SendMessage ghTBar, %TB_CHECKBUTTON, %ID_TOOL, MAKLNG(0, 0) '.. pop up pressed button
END IF
CASE %WM_COMMAND
SELECT CASE LOWRD(CBWPARAM)
CASE %ID_NEW 'New clicked
BEEP : SendMessage CBHNDL, %WM_LBUTTONDOWN, 0, 0 'pass on to %WM_LBUTTONDOWN
CASE %ID_OPEN 'Open clicked
BEEP : SendMessage CBHNDL, %WM_LBUTTONDOWN, 0, 0 'pass on to %WM_LBUTTONDOWN
CASE %ID_TOOL
IF (GetKeyState(%VK_SPACE) AND &H8000) THEN 'trap and act on spacebar
SendMessage ghTBar, %TB_SETSTATE, %ID_TOOL, _
MAKLNG(%TBSTATE_CHECKED OR %TBSTATE_ENABLED, 0)
SetFocus ghPopupTBar
END IF
IF (SendMessage(ghTBar, %TB_GETSTATE, %ID_TOOL, 0) AND %TBSTATE_CHECKED) THEN
SendMessage ghTBar, %TB_GETITEMRECT, 3, VARPTR(rc) 'get button's position
SetWindowPos ghPopupTBar, 0, rc.nRight + 4, rc.nTop - 3, 0, 0, _ 'move popup there
%SWP_NOSIZE OR %SWP_NOZORDER
ShowWindow ghPopupTBar, %SW_SHOW 'and show it
ELSE
SendMessage CBHNDL, %WM_LBUTTONDOWN, 0, 0 'else, pass on to %WM_LBUTTONDOWN
END IF
CASE %IDCANCEL : DIALOG END CBHNDL
END SELECT
END SELECT
END FUNCTION
------------------