CWindow class, release candidate nº 2.
' ########################################################################################
' Microsoft Windows
' File: CW_Rebar.fbtpl
' Contents: CWindow with a rebar control
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define unicode
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx.CWindowClass
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(""), NULL, COMMAND(), SW_NORMAL)
CONST IDC_TOOLBAR = 1001
CONST IDC_CBBOX = 1002
CONST IDC_REBAR = 1003
enum
IDM_CUT = 28000
IDM_COPY, IDM_PASTE, IDM_UNDO, IDM_REDOW, IDM_DELETE, IDM_FILENEW, IDM_FILEOPEN
IDM_FILESAVE, IDM_PRINTPRE, IDM_PROPERTIES, IDM_HELP, IDM_FIND, IDM_REPLACE, IDM_PRINT
end enum
' ========================================================================================
' Adds a button to the toolbar
' ========================================================================================
FUNCTION ToolBar_AddButtonW (BYVAL hToolBar AS HWND, BYVAL idxBitmap AS LONG, BYVAL idCommand AS LONG, _
BYVAL fsState AS UBYTE = 0, BYVAL fsStyle AS UBYTE = 0, BYVAL dwData AS DWORD_PTR = 0, _
BYVAL pwszText AS WSTRING PTR = NULL) AS LONG
DIM tb AS TBBUTTON, idxString AS INT_PTR
IF fsState = 0 THEN fsState = TBSTATE_ENABLED
IF pwszText <> NULL THEN
IF LEN(*pwszText) = 0 THEN idxString = -1 ELSE idxString = CAST(INT_PTR, pwszText)
END IF
tb.iBitmap = idxBitmap : tb.idCommand = idCommand : tb.fsState = fsState
tb.fsStyle = fsStyle : tb.dwData = dwData : tb.iString = idxString
FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(WPARAM, @tb))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Adds a separator to the toolbar
' ========================================================================================
FUNCTION ToolBar_AddSeparatorW (BYVAL hToolBar AS HWND, BYVAL nWidth AS LONG = 0) AS LONG
DIM tb AS TBBUTTON
tb.iBitmap = nWidth : tb.idCommand = 0 : tb.fsState = TBSTATE_ENABLED
tb.fsStyle = TBSTYLE_SEP : tb.dwData = 0 : tb.iString = -1
FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(LPARAM, @tb))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Create the toolbar
' ========================================================================================
FUNCTION CreateToolbar (BYVAL pWindow AS CWindow PTR) AS HWND
' // Add a tooolbar
DIM hToolBar AS HWND = pWindow->AddControl("Toolbar", pWindow->hWindow, IDC_TOOLBAR, "", 0, 0, 0, 0, _
WS_CHILD OR WS_VISIBLE OR TBSTYLE_TOOLTIPS OR TBSTYLE_FLAT OR CCS_NODIVIDER OR CCS_NORESIZE OR CCS_NOPARENTALIGN)
' // Allow drop down arrows
SendMessageW hToolBar, TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS
' // Add a bitmap with the button images
DIM ttbab AS TBADDBITMAP
ttbab.hInst = HINST_COMMCTRL
IF AfxIsProcessDPIAware THEN
ttbab.nId = IDB_STD_LARGE_COLOR
ELSE
ttbab.nId = IDB_STD_SMALL_COLOR
END IF
SendMessageW(hToolBar, TB_ADDBITMAP, 0, CAST(LPARAM, @ttbab))
' // Add buttons to the toolbar
Toolbar_AddButtonW hToolBar, STD_CUT, IDM_CUT
Toolbar_AddButtonW hToolBar, STD_COPY, IDM_COPY
Toolbar_AddButtonW hToolBar, STD_PASTE, IDM_PASTE
Toolbar_AddButtonW hToolBar, STD_DELETE, IDM_DELETE
ToolBar_AddSeparatorW hToolBar
Toolbar_AddButtonW hToolBar, STD_UNDO, IDM_UNDO
Toolbar_AddButtonW hToolBar, STD_REDOW, IDM_REDOW
ToolBar_AddSeparatorW hToolBar
Toolbar_AddButtonW hToolBar, STD_FILENEW, IDM_FILENEW, 0, BTNS_DROPDOWN
Toolbar_AddButtonW hToolBar, STD_FILEOPEN, IDM_FILEOPEN
Toolbar_AddButtonW hToolBar, STD_FILESAVE, IDM_FILESAVE
Toolbar_AddButtonW hToolBar, STD_PRINTPRE, IDM_PRINTPRE
ToolBar_AddSeparatorW hToolBar
Toolbar_AddButtonW hToolBar, STD_FIND, IDM_FIND
Toolbar_AddButtonW hToolBar, STD_REPLACE, IDM_REPLACE
ToolBar_AddSeparatorW hToolBar
Toolbar_AddButtonW hToolBar, STD_PROPERTIES, IDM_PROPERTIES
Toolbar_AddButtonW hToolBar, STD_PRINT, IDM_PRINT
ToolBar_AddSeparatorW hToolBar
Toolbar_AddButtonW hToolBar, STD_HELP, IDM_HELP
' // Size the toolbar
SendMessageW hToolBar, TB_AUTOSIZE, 0, 0
' // Return the toolbar handle
FUNCTION = hToolbar
END FUNCTION
' ========================================================================================
' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM pWindow AS CWindow PTR
DIM rc AS RECT
SELECT CASE uMsg
CASE WM_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' CASE IDM_CUT ' etc.
' MessageBoxW hwnd, "You have clicked the Cut button", "Toolbar", MB_OK
' EXIT FUNCTION
END SELECT
CASE WM_NOTIFY
' -------------------------------------------------------
' Notification messages are handled here.
' The TTN_GETDISPINFO message is sent by a ToolTip control
' to retrieve information needed to display a ToolTip window.
' ------------------------------------------------------
DIM ptnmhdr AS NMHDR PTR ' // Information about a notification message
DIM ptttdi AS NMTTDISPINFO PTR ' // Tooltip notification message information
DIM wszTooltipText AS WSTRING * 260 ' // Tooltip text
ptnmhdr = CAST(NMHDR PTR, lParam)
SELECT CASE ptnmhdr->code
' // The height of the rebar has changed
CASE RBN_HEIGHTCHANGE
' // Get the coordinates of the client area
GetClientRect hwnd, @rc
' // Send a WM_SIZE message to resize the controls
SendMessageW hwnd, WM_SIZE, SIZE_RESTORED, MAKELONG(rc.Right - rc.Left, rc.Bottom - rc.Top)
' // Toolbar tooltips
CASE TTN_GETDISPINFO
ptttdi = CAST(NMTTDISPINFO PTR, lParam)
ptttdi->hinst = NULL
wszTooltipText = ""
SELECT CASE ptttdi->hdr.hwndFrom
CASE SendMessageW(GetDlgItem(GetDlgItem(hwnd, IDC_REBAR), IDC_TOOLBAR), TB_GETTOOLTIPS, 0, 0)
SELECT CASE ptttdi->hdr.idFrom
CASE IDM_CUT : wszTooltipText = "Cut"
CASE IDM_COPY : wszTooltipText = "Copy"
CASE IDM_PASTE : wszTooltipText = "Paste"
CASE IDM_UNDO : wszTooltipText = "Undo"
CASE IDM_REDOW : wszTooltipText = "Redo"
CASE IDM_DELETE : wszTooltipText = "Delete"
CASE IDM_FILENEW : wszTooltipText = "File New"
CASE IDM_FILEOPEN : wszTooltipText = "File Open"
CASE IDM_FILESAVE : wszTooltipText = "File Save"
CASE IDM_PRINTPRE : wszTooltipText = "Print Preview"
CASE IDM_PROPERTIES : wszTooltipText = "Properties"
CASE IDM_HELP : wszTooltipText = "Help"
CASE IDM_FIND : wszTooltipText = "Find"
CASE IDM_REPLACE : wszTooltipText = "Replace"
CASE IDM_PRINT : wszTooltipText = "Print"
END SELECT
IF LEN(wszTooltipText) THEN ptttdi->lpszText = @wszTooltipText
END SELECT
CASE TBN_DROPDOWN
DIM ptbn AS TBNOTIFY PTR = CAST(TBNOTIFY PTR, lParam)
SELECT CASE ptbn->iItem
CASE IDM_FILENEW
DIM rc AS RECT
SendMessageW(ptbn->hdr.hwndFrom, TB_GETRECT, ptbn->iItem, CAST(LPARAM, @rc))
MapWindowPoints(ptbn->hdr.hwndFrom, HWND_DESKTOP, CAsT(LPPOINT, @rc), 2)
DIM hPopupMenu AS HMENU = CreatePopUpMenu
AppendMenuW hPopupMenu, MF_ENABLED, 10001, "Option 1"
AppendMenuW hPopupMenu, MF_ENABLED, 10002, "Option 2"
AppendMenuW hPopupMenu, MF_ENABLED, 10003, "Option 3"
AppendMenuW hPopupMenu, MF_ENABLED, 10004, "Option 4"
AppendMenuW hPopupMenu, MF_ENABLED, 10005, "Option 5"
TrackPopupMenu(hPopupMenu, 0, rc.Left, rc.Bottom, 0, hwnd, NULL)
DestroyMenu hPopupMenu
END SELECT
END SELECT
CASE WM_SIZE
IF wParam <> SIZE_MINIMIZED THEN
' // Update the size and position of the Rebar control
SendMessageW GetDlgItem(hwnd, IDC_REBAR), WM_SIZE, wParam, lParam
' // Resize the button
pWindow = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, CTRUE
EXIT FUNCTION
END IF
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
DIM pWindow AS CWindow
pWindow.Create(NULL, "CWindow with a rebar", @WndProc)
' // Disable background erasing
pWindow.ClassStyle = CS_DBLCLKS
' // Set the client size
pWindow.SetClientSize(600, 250)
' // Center the window
pWindow.Center
' // Add a button
DIM hButton AS HWND = pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close")
' // Create a rebar control
DIM hRebar AS HWND = pWindow.AddControl("Rebar", pWindow.hWindow, IDC_REBAR)
' Create the toolbar
DIM hToolbar AS HWND = CreateToolbar(@pWindow)
' // Add the band containing the toolbar control to the rebar
' // The size of the REBARBANDINFO is different in Vista/Windows 7
DIM rc AS RECT, wszText AS WSTRING * 260
DIM rbbi AS REBARBANDINFO
IF AfxWindowsVersion >= 600 AND AfxComCtlVersion >= 600 THEN
rbbi.cbSize = REBARBANDINFO_V6_SIZE
ELSE
rbbi.cbSize = REBARBANDINFO_V3_SIZE
END IF
' // Insert the toolbar in the rebar control
rbbi.fMask = RBBIM_STYLE OR RBBIM_CHILD OR RBBIM_CHILDSIZE OR _
RBBIM_SIZE OR RBBIM_ID OR RBBIM_IDEALSIZE OR RBBIM_TEXT
rbbi.fStyle = RBBS_CHILDEDGE
rbbi.hwndChild = hToolbar
rbbi.cxMinChild = 250 * pWindow.rxRatio
rbbi.cyMinChild = HIWORD(SendMessageW(hToolBar, TB_GETBUTTONSIZE, 0, 0))
rbbi.cx = 250 * pWindow.rxRatio
rbbi.cxIdeal = 250 * pWindow.rxRatio
wszText = "Toolbar"
rbbi.lpText = @wszText
'// Insert band into rebar
SendMessageW hRebar, RB_INSERTBAND, -1, CAST(LPARAM, @rbbi)
' // Insert a combobox in the rebar control
DIM hCbBox AS HWND = pWindow.AddControl("ComboBox", pWindow.hWindow, IDC_CBBOX, "", 0, 0, 0, 50 * pWindow.rxRatio)
GetWindowRect hCbBox, @rc
rbbi.fMask = RBBIM_STYLE OR RBBIM_CHILD OR RBBIM_CHILDSIZE OR _
RBBIM_SIZE OR RBBIM_ID OR RBBIM_IDEALSIZE OR RBBIM_TEXT
rbbi.fStyle = RBBS_FIXEDSIZE OR RBBS_CHILDEDGE
rbbi.hwndChild = hCbBox
rbbi.cxMinChild = 200 * pWindow.rxRatio
rbbi.cyMinChild = rc.Bottom - rc.Top
rbbi.cx = 200 * pWindow.rxRatio
rbbi.cxIdeal = 200 * pWindow.rxRatio
wszText = "Combobox"
rbbi.lpText = @wszText
'// Insert band into rebar
SendMessageW hRebar, RB_INSERTBAND, -1, CAST(LPARAM, @rbbi)
' // Process event messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
I have adapted my XpButton control to FreeBasic using a class. This technique makes it somewhat easier to use the control and will allow me to extend the functionality of CWindow without adding bloat to that class.
' ########################################################################################
' Microsoft Windows
' File: CW_XpButton.fbtpl
' Contents: CWindow XpButton example
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define unicode
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/CXpButton.inc"
USING Afx.CWindowClass
USING Afx.CXpButtonClass
CONST IDC_BUTTON1 = 1001
CONST IDC_BUTTON2 = 1002
CONST IDC_BUTTON3 = 1003
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(""), NULL, COMMAND(), SW_NORMAL)
' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
AfxSetProcessDPIAware
DIM pWindow AS CWindow
pWindow.Create(NULL, "XpButton example", @WndProc)
pWindow.SetClientSize(215, 142)
pWindow.Center
DIM pXpButton1 AS CXpButton = CXpButton(@pWindow, IDC_BUTTON1, "&Ok", 50, 20, 114, 26)
pXpButton1.SetIconFromFile ExePath & "\16_OK.ICO", XPBI_NORMAL
pXpButton1.SetIconFromFile ExePath & "\16_OKHOT.ICO", XPBI_HOT
pXpButton1.SetToggle CTRUE
pXpButton1.SetCursor LoadCursor(NULL, IDC_CROSS)
pXpButton1.SetImageMargin 10
DIM pXpButton2 AS CXpButton = CXpButton(@pWindow, IDC_BUTTON2, "&Cancel", 50, 55, 114, 26)
pXpButton2.SetIconFromFile ExePath & "\16_CANCEL.ICO", XPBI_NORMAL
pXpButton2.SetIconFromFile ExePath & "\16_CANCELDISABLED.ICO", XPBI_DISABLED
pXpButton2.SetImagePos XPBI_RIGHT OR XPBI_VCENTER
pXpButton2.SetTextFormat DT_RIGHT OR DT_VCENTER OR DT_SINGLELINE
EnableWindow pXpButton2.hWindow, FALSE ' Disable the button
DIM pXpButton3 AS CXpButton = CXpButton(@pWindow, IDC_BUTTON3, "&Classic Button", 50, 90, 114, 26)
SetFocus pXpButton1.hWindow
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================