CWindow - Release candidate 01
I have made some small changes and added a new class, CTabPage, that derives from CWindow and deals with the pages for a Tab Control. The attached file contains the new CWindow.inc.
Tab Control example
This template demonstrates how to use the new CTabPage class:
' ########################################################################################
' Microsoft Windows
' File: CW_TabCtrl_HDPI.fbtpl
' Contents: CWindow Tab Control template (High DPI)
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2015-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"
USING Afx.CWindowClass
CONST IDC_TAB = 1001
CONST IDC_EDIT1 = 1002
CONST IDC_EDIT2 = 1003
CONST IDC_BTNSUBMIT = 1004
CONST IDC_COMBO = 1005
CONST IDC_LISTBOX = 1006
' // Forward declarations
DECLARE FUNCTION TabPage1_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION TabPage2_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DECLARE FUNCTION TabPage3_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
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
FUNCTION = 0
SELECT CASE AS CONST uMsg
CASE WM_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_NOTIFY
DIM nPage AS DWORD ' // Page number
DIM pTabPage AS CTabPage PTR ' // Tab page object reference
DIM tci AS TCITEMW ' // TCITEMW structure
DIM ptnmhdr AS NMHDR PTR ' // Information about a notification message
ptnmhdr = CAST(NMHDR PTR, lParam)
SELECT CASE ptnmhdr->idFrom
CASE IDC_TAB
SELECT CASE ptnmhdr->code
CASE TCN_SELCHANGE
' // Show the selected page
nPage = SendMessage(ptnmhdr->hwndFrom, TCM_GETCURSEL, 0, 0)
tci.mask = TCIF_PARAM
IF SendMessageW(ptnmhdr->hwndFrom, TCM_GETITEMW, nPage, CAST(lParam, @tci)) THEN
IF tci.lParam THEN
pTabPage = CAST(CTabPage PTR, tci.lParam)
ShowWindow pTabPage->hTabPage, SW_SHOW
END IF
END IF
CASE TCN_SELCHANGING
' // Hide the current page
nPage = SendMessage(ptnmhdr->hwndFrom, TCM_GETCURSEL, 0, 0)
tci.mask = TCIF_PARAM
IF SendMessageW(ptnmhdr->hwndFrom, TCM_GETITEMW, nPage, CAST(lParam, @tci)) THEN
IF tci.lParam THEN
pTabPage = CAST(CTabPage PTR, tci.lParam)
ShowWindow pTabPage->hTabPage, SW_HIDE
END IF
END IF
END SELECT
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, "CWindow with a Tab Control", @WndProc)
pWindow.SetClientSize(500, 320)
pWindow.Center
' // Add a tab control
DIM hTab AS HWND = pWindow.AddControl("Tab", pWindow.hWindow, IDC_TAB, "", 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 42)
' // Create the first tab page
DIM pTabPage1 AS CTabPage PTR = NEW CTabPage
pTabPage1->InsertPage(hTab, 0, "Tab 1", -1, @TabPage1_WndProc)
' // Add controls to the first page
pTabPage1->AddControl("Label", pTabPage1->hTabPage, -1, "First name", 15, 15, 121, 21)
pTabPage1->AddControl("Label", pTabPage1->hTabPage, -1, "Last name", 15, 50, 121, 21)
pTabPage1->AddControl("Edit", pTabPage1->hTabPage, IDC_EDIT1, "", 165, 15, 186, 21)
pTabPage1->AddControl("Edit", pTabPage1->hTabPage, IDC_EDIT2, "", 165, 50, 186, 21)
pTabPage1->AddControl("Button", pTabPage1->hTabPage, IDC_BTNSUBMIT, "Submit", 340, 185, 76, 26, BS_DEFPUSHBUTTON)
' // Create the second tab page
DIM pTabPage2 AS CTabPage PTR = NEW CTabPage
pTabPage2->InsertPage(hTab, 1, "Tab 2", -1, @TabPage2_WndProc)
' // Add controls to the second page
DIM hComboBox AS HWND = pTabPage2->AddControl("ComboBox", pTabPage2->hTabPage, IDC_COMBO, "", 20, 20, 191, 105)
' // Create the third tab page
DIM pTabPage3 AS CTabPage PTR = NEW CTabPage
pTabPage3->InsertPage(hTab, 2, "Tab 3", -1, @TabPage3_WndProc)
' // Add controls to the third page
' DIM hListBox AS HWND = pTabPage3->AddControl("ListBox", pTabPage3->hTabPage, IDC_LISTBOX, "", 15, 20, 161, 120)
DIM hListBox AS HWND = pTabPage3->AddControl("ListBox", pTabPage3->hTabPage, IDC_LISTBOX)
pTabPage3->SetWindowPos hListBox, NULL, 15, 20, 161, 120, SWP_NOZORDER
' // Fill the controls with some data
DIM i AS LONG = 1, wszText AS WSTRING * 260
FOR i = 1 TO 9
wszText = "Item " & RIGHT("00" & STR(i), 2)
SendMessageW(hComboBox, CB_ADDSTRING, 0, CAST(LPARAM, @wszText))
SendMessageW(hListBox, LB_ADDSTRING, 0, CAST(LPARAM, @wszText))
NEXT
' // Select the first item in the combo box and the list box
SendMessageW(hComboBox, CB_SETCURSEL, 0, 0)
SendMessageW(hListBox, LB_SETCURSEL, 0, 0)
' // Add a button
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 415, 292, 75, 23)
' // Display the first tab page
ShowWindow pTabPage1->hTabPage, SW_SHOW
' // Set the focus to the first tab
SendMessageW hTab, TCM_SETCURFOCUS, 0, 0
' // Dispatch messages
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Delete the tab pages
Delete pTabPage3
Delete pTabPage2
Delete pTabPage1
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 1 window procedure
' ========================================================================================
FUNCTION TabPage1_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDC_BTNSUBMIT
IF HIWORD(wParam) = BN_CLICKED THEN
MessageBoxW(hWnd, "Submit", "Tab 1", MB_OK)
EXIT FUNCTION
END IF
END SELECT
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 2 window procedure
' ========================================================================================
FUNCTION TabPage2_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hBrush AS HBRUSH, rc AS RECT, tlb AS LOGBRUSH
SELECT CASE uMsg
CASE WM_ERASEBKGND
GetClientRect hWnd, @rc
' Create custom brush
tlb.lbStyle = BS_SOLID
tlb.lbColor = &H00CB8734
tlb.lbHatch = 0
hBrush = CreateBrushIndirect(@tlb)
' Erase background
FillRect CAST(HDC, wParam), @rc, hBrush
DeleteObject hBrush
FUNCTION = TRUE
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 3 window procedure
' ========================================================================================
FUNCTION TabPage3_WndProc(BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hBrush AS HBRUSH, rc AS RECT, tlb AS LOGBRUSH
SELECT CASE uMsg
CASE WM_ERASEBKGND
GetClientRect hWnd, @rc
' Create custom brush
tlb.lbStyle = BS_SOLID
tlb.lbColor = &H0000FF00
tlb.lbHatch = 0
hBrush = CreateBrushIndirect(@tlb)
' Erase background
FillRect CAST(HDC, wParam), @rc, hBrush
DeleteObject hBrush
FUNCTION = TRUE
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
I smile every time I see Jose Roca posting code!
I have to remove two declares:
DECLARE FUNCTION AfxWideCharToUtf8 (BYVAL lpWideCharStr AS LPCWCH) AS STRING
DECLARE FUNCTION AfxUtf8ToAnsi (BYVAL strUtf8 AS STRING) AS STRING
I was playing with some new functions that I have moved to AfxStr.inc
' ========================================================================================
' Converts an unicode string to an UTF8 encoded string.
' ========================================================================================
FUNCTION AfxWideCharToUtf8 (BYVAL lpWideCharStr AS LPCWCH) AS STRING
DIM hr AS LONG, buffer AS STRING
' // Get the number of bytes required for the buffer for ANSI string
hr = WideCharToMultiByte(CP_UTF8, 0, lpWideCharStr, lstrlenW(lpWideCharStr), NULL, 0, NULL, NULL)
IF hr = 0 THEN EXIT FUNCTION
' // Allocate a string of the needed size
buffer = SPACE(hr)
' // Convert to UTF8 and return the result
hr = WideCharToMultiByte(CP_UTF8, 0, lpWideCharStr, lstrlenW(lpWideCharStr), STRPTR(buffer), LEN(buffer), NULL, NULL)
IF hr = 0 THEN EXIT FUNCTION
FUNCTION = buffer
END FUNCTION
' ========================================================================================
' ========================================================================================
' Converts an unicode string to an UTF8 encoded string.
' ========================================================================================
FUNCTION AfxUtf8ToAnsi (BYVAL strUtf8 AS STRING) AS STRING
DIM hr AS LONG, buffer AS STRING
' // Get the number of bytes required for the buffer for WIDE string
hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), NULL, 0)
IF hr = 0 THEN EXIT FUNCTION
' // Convert to Unicode
buffer = SPACE(hr * 2)
DIM bstrHandle AS BSTR = SysAllocStringByteLen(STRPTR(buffer), LEN(buffer))
hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), bstrHandle, hr * 2)
' // Convert to to ansi
IF hr THEN
buffer = SPACE(hr)
hr = WideCharToMultiByte(CP_ACP, 0, bstrHandle, SysStringLen(bstrHandle), STRPTR(buffer), LEN(buffer), NULL, NULL)
END IF
IF bstrHandle THEN SysFreeString bstrHandle
FUNCTION = buffer
END FUNCTION
' ========================================================================================
' ========================================================================================
' Converts an UTF8 encoded string to an unicode string.
' ========================================================================================
FUNCTION AfxUtf8ToWideChar (BYVAL strUtf8 AS STRING) AS BSTR
DIM hr AS LONG, buffer AS STRING
' // Get the number of bytes required for the buffer for WIDE string
hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), NULL, 0)
IF hr = 0 THEN EXIT FUNCTION
' // Convert to Unicode
buffer = SPACE(hr * 2)
DIM bstrHandle AS WSTRING PTR = SysAllocStringByteLen(STRPTR(buffer), LEN(buffer))
hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), bstrHandle, hr * 2)
FUNCTION = bstrHandle
' // Alternate way
' DIM pwBuffer AS WSTRING PTR
' pwBuffer = CAllocate(hr * 2)
' IF pwBuffer = NULL THEN EXIT FUNCTION
' hr = MultiByteToWideChar(CP_UTF8, 0, STRPTR(strUtf8), LEN(strUtf8), pwBuffer, hr * 2)
' FUNCTION = pwBuffer
END FUNCTION
' ========================================================================================
Upcoming changes:
Added support for Tri-state check buttons
I simply have added
CASE "CHECK3STATE"
' Adds a 3 state checkbox to the window.
wsClassName = "Button"
IF dwStyle = 0 THEN dwStyle = WS_VISIBLE OR WS_TABSTOP OR BS_AUTO3STATE OR BS_LEFT OR BS_VCENTER
to the CWindow.AddControl method.
Changed the class name of the GroupBox control from "Static" to "Button". The fact that PowerBASIC calls a "Frame" control to what it is a GroupBox control did confuse me.
Added support for Rich Edit controls. Will work with XP+.
A couple of tricks:
CWindow will use by default as class names "FBWindowClass:xxx", where xxx is a count number. However, you can use your own class name very easily, e.g.
DIM pWindow AS CWindow = "MyClassName"
It also calculates the scaling ratio automatically according the DPI setting, but you can change it, e.g.
pWindow.DPI = 96 ' or any other value
With a value of 96 you disable scaling.
With any other value, it will scale according this value instead of the DPI setting, e.g.
pWindow.DPI = 150
Scale as if the DPI was 150.
The beauty (as Chris will say) of this class is that it is 100 SDK compatible.
The following example embeds a progress bar into a status bar:
' ########################################################################################
' Microsoft Windows
' File: CW_SBwithPB.fbtpl - Template
' Contents: Demonstrates the use of the StatusBar and ProgressBar controls.
' Comments: In this example, the progress bar has been made child of the status bar.
' 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"
USING Afx.CWindowClass
CONST IDC_START = 1001
CONST IDC_STATUSBAR = 1002
CONST IDC_PROGRESSBAR = 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_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_START
' // Retrieve the handle to the progress bar
DIM hProgressBar AS HWND = GetDlgItem(GetDlgItem(hwnd, IDC_STATUSBAR), IDC_PROGRESSBAR)
' *** Test code ***
' // Sets the step increment
SendMessageW(hProgressBar, PBM_SETSTEP, 1, 0)
' // Draws the bar
DIM i AS LONG
FOR i = 1 TO 100
' // Advances the current position for a progress bar by the step
' // increment and redraws the bar to reflect the new position
SendMessageW(hProgressBar, PBM_STEPIT, 0, 0)
SLEEP 10
NEXT
' // Clears the bar by reseting its position to 0
SendMessageW(hProgressBar, PBM_SETPOS, 0, 0)
END SELECT
CASE WM_SIZE
' // Resizes the status bar
DIM hStatusBar AS HWND = GetDlgItem(hwnd, IDC_STATUSBAR)
SendMessageW hStatusBar, WM_SIZE, wParam, lParam
' // Redraws it
InvalidateRect hStatusBar, NULL, TRUE
EXIT FUNCTION
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, "Status bar with progress bar", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
pWindow.Center
' // Add a button
pWindow.AddControl("Button", pWindow.hWindow, IDC_START, "&Start", 20, 20, 75, 23)
' // Add a status bar
DIM hStatusbar AS HWND = pWindow.AddControl("Statusbar", pWindow.hWindow, IDC_STATUSBAR)
' // Set the parts
DIM rgParts(1 TO 2) AS LONG
rgParts(1) = pWindow.ScaleX(160)
rgParts(2) = -1
IF SendMessageW(hStatusBar, SB_SETPARTS, 2, CAST(LPARAM, @rgParts(1))) <> 0 THEN
SendMessageW(hStatusBar, SB_SIMPLE, FALSE, 0)
END IF
' // Add a progress bar to the status bar
DIM hProgressBar AS HWND = pWindow.AddControl("ProgressBar", hStatusbar, IDC_PROGRESSBAR, "", 0, 2, 160, 18)
' // Set the range
SendMessageW(hProgressBar, PBM_SETRANGE32, 0, 100)
' // Set the initial position
SendMessageW(hProgressBar, PBM_SETPOS, 0, 0)
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
Although the main windows and the controls are Unicode aware, you can use ansi strings with them, e.g. using SendMessageA instead of SendMessageW. Windows checks if the target window is Unicode and does the conversion. Therefore, there is no need to have both ansi and unicode support in the class.
The opposite is not true, i.e. you can't use Unicode with an ansi control.
I just have learned that instead of
DIM rgParts(1 TO 2) AS LONG
rgParts(1) = pWindow.ScaleX(160)
rgParts(2) = -1
we can use
DIM rgParts(1 TO 2) AS LONG = {pWindow.ScaleX(160), -1}
I like these nice shortcuts.
Continuing my monologue, I'm writing small tests to check for errors in the AddControl method.
There was an small one in the UpDown control, in which this line
' // Correct for Windows using a default size for the updown control
SetWindowPos hCtl, NULL, x, y, nWidth, nHeight, SWP_NOZORDER
should be
' // Correct for Windows using a default size for the updown control
this.SetWindowPos hCtl, NULL, x, y, nWidth, nHeight, SWP_NOZORDER
This example has some interest, showing how to create, resize and processing notifications for an Header control.
' ########################################################################################
' Microsoft Windows
' File: CW_HeaderCtrl.fbtpl - Template
' Contents: Demonstrates the use of the Header 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
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx.CWindowClass
CONST IDC_HEADER = 1001
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_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_NOTIFY
DIM ptnmhdr AS NMHDR PTR = CAST(NMHDR PTR, lParam)
SELECT CASE ptnmhdr->idFrom
CASE IDC_HEADER
SELECT CASE ptnmhdr->code
CASE HDN_ITEMCLICKW
DIM ptnmh AS NMHEADERW PTR = CAST(NMHEADERW PTR, lParam)
MessageBoxW hwnd, "You have clicked item " & WSTR$(ptnmh->iItem + 1), "", MB_OK
EXIT FUNCTION
' CASE HDN_ITEMDBLCLICK
' DIM ptnmh AS NMHEADERW PTR = CAST(NMHEADERW PTR, lParam)
' MessageBoxW hwnd, "You have clicked item " & WSTR$(ptnmh->iItem + 1), "", MB_OK
' EXIT FUNCTION
END SELECT
END SELECT
CASE WM_SIZE
' // Resize the header control
DIM hHeader AS HWND = GetDlgItem(hwnd, IDC_HEADER)
DIM thdl AS HDLAYOUT, twp AS WINDOWPOS, trc AS RECT
GetClientRect hwnd, @trc
thdl.prc = @trc
thdl.pwpos = @twp
SendMessageW hHeader, HDM_LAYOUT, 0, CAST(LPARAM, @thdl)
SetWindowPos hHeader, NULL, twp.x, twp.y, twp.cx, twp.cy, SWP_NOZORDER OR SWP_NOACTIVATE
EXIT FUNCTION
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, "Header control", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
pWindow.Center
DIM hHeader AS HWND = pWindow.AddControl("Header", pWindow.hWindow, IDC_HEADER, "", 0, 0, pWindow.ClientWidth, 23)
DIM thdi AS HDITEM
DIM wszItem AS WSTRING * 260
' Insert items
wszItem = "Item 1"
thdi.Mask = HDI_WIDTH OR HDI_FORMAT OR HDI_TEXT
thdi.fmt = HDF_LEFT OR HDF_STRING
thdi.cxy = pWindow.ScaleX(80)
thdi.pszText = @wszItem
SendMessage hHeader, HDM_INSERTITEM, 1, CAST(LPARAM, @thdi)
wszItem = "Item 2"
SendMessage hHeader, HDM_INSERTITEM, 2, CAST(LPARAM, @thdi)
wszItem = "Item 3"
SendMessage hHeader, HDM_INSERTITEM, 3, CAST(LPARAM, @thdi)
wszItem = "Item 4"
SendMessage hHeader, HDM_INSERTITEM, 4, CAST(LPARAM, @thdi)
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
Month Calendar control example.
' ########################################################################################
' Microsoft Windows
' File: CW_MonthCal.fbtpl - Template
' Contents: Demonstrates the use of the Month Calendar 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
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx.CWindowClass
CONST IDC_MONTHCAL = 1001
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
DIM pWindow AS CWindow PTR
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_NOTIFY
' // Process notification messages
DIM ptnmsc AS NMSELCHANGE PTR = CAST(NMSELCHANGE PTR, lParam)
' // Get selected date
IF ptnmsc->nmhdr.code = MCN_SELCHANGE THEN
DIM wszDate AS WSTRING * 260
wszDate = "Day: " & WSTR$(ptnmsc->stSelStart.wDay) & " " & _
"Month: " & WSTR$(ptnmsc->stSelStart.wMonth) & " " & _
"Year: " & WSTR$(ptnmsc->stSelStart.wYear)
SendMessageW hwnd, WM_SETTEXT, 0, CAST(LPARAM, @wszDate)
' Note: Don't use MessageBox here or you will get non-stop messages!
EXIT FUNCTION
END IF
CASE WM_SIZE
IF wParam <> SIZE_MINIMIZED THEN
' // Resize the buttons
pWindow = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
pWindow->MoveWindow GetDlgItem(hwnd, IDC_MONTHCAL), 10, 10, pWindow->ClientWidth - 20, pWindow->ClientHeight - 20, TRUE
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 month calendar", @WndProc)
pWindow.SetClientSize(400, 220)
pWindow.Center
' // Add a button
pWindow.AddControl("SysMonthCal32", pWindow.hWindow, IDC_MONTHCAL, "", _
10, 10, pWindow.ClientWidth - 20, pWindow.CLientHeight - 20)
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
Quote from: Jose Roca on April 06, 2016, 08:25:39 AM
The beauty (as Chris will say) of this class is that it is 100 SDK compatible.
The following example embeds a progress bar into a status bar:
' ########################################################################################
' Microsoft Windows
' File: CW_SBwithPB.fbtpl - Template
' Contents: Demonstrates the use of the StatusBar and ProgressBar controls.
' Comments: In this example, the progress bar has been made child of the status bar.
' 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"
USING Afx.CWindowClass
CONST IDC_START = 1001
CONST IDC_STATUSBAR = 1002
CONST IDC_PROGRESSBAR = 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_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_START
' // Retrieve the handle to the progress bar
DIM hProgressBar AS HWND = GetDlgItem(GetDlgItem(hwnd, IDC_STATUSBAR), IDC_PROGRESSBAR)
' *** Test code ***
' // Sets the step increment
SendMessageW(hProgressBar, PBM_SETSTEP, 1, 0)
' // Draws the bar
DIM i AS LONG
FOR i = 1 TO 100
' // Advances the current position for a progress bar by the step
' // increment and redraws the bar to reflect the new position
SendMessageW(hProgressBar, PBM_STEPIT, 0, 0)
SLEEP 10
NEXT
' // Clears the bar by reseting its position to 0
SendMessageW(hProgressBar, PBM_SETPOS, 0, 0)
END SELECT
CASE WM_SIZE
' // Resizes the status bar
DIM hStatusBar AS HWND = GetDlgItem(hwnd, IDC_STATUSBAR)
SendMessageW hStatusBar, WM_SIZE, wParam, lParam
' // Redraws it
InvalidateRect hStatusBar, NULL, TRUE
EXIT FUNCTION
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, "Status bar with progress bar", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
pWindow.Center
' // Add a button
pWindow.AddControl("Button", pWindow.hWindow, IDC_START, "&Start", 20, 20, 75, 23)
' // Add a status bar
DIM hStatusbar AS HWND = pWindow.AddControl("Statusbar", pWindow.hWindow, IDC_STATUSBAR)
' // Set the parts
DIM rgParts(1 TO 2) AS LONG
rgParts(1) = pWindow.ScaleX(160)
rgParts(2) = -1
IF SendMessageW(hStatusBar, SB_SETPARTS, 2, CAST(LPARAM, @rgParts(1))) <> 0 THEN
SendMessageW(hStatusBar, SB_SIMPLE, FALSE, 0)
END IF
' // Add a progress bar to the status bar
DIM hProgressBar AS HWND = pWindow.AddControl("ProgressBar", hStatusbar, IDC_PROGRESSBAR, "", 0, 2, 160, 18)
' // Set the range
SendMessageW(hProgressBar, PBM_SETRANGE32, 0, 100)
' // Set the initial position
SendMessageW(hProgressBar, PBM_SETPOS, 0, 0)
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
Hi Jose,
This example did not "work" for me when I ran it. It actually does work but the ProgressBar is not initially visible. I used Spy.exe to confirm that it existed but did not have the WS_VISIBLE style set. I looked at your code for cWindow and I see that you are not defining a default dwStyle for the ProgressBar (other than the WS_CHILD that gets added afterwards).
CASE "PROGRESSBAR", "MSCTLS_PROGRESS32"
' Adds a progress bar to the window.
wsClassName = "msctls_progress32"
bSetFont = FALSE
Probably should be....
CASE "PROGRESSBAR", "MSCTLS_PROGRESS32"
' Adds a progress bar to the window.
wsClassName = "msctls_progress32"
bSetFont = FALSE
IF dwStyle = 0 THEN dwStyle = WS_VISIBLE
Yes. I did notice it when I wrote the example (I'm writing these tests to see if there are bugs) and changed the code to:
CASE "PROGRESSBAR", "MSCTLS_PROGRESS32"
' Adds a progress bar to the window.
IF dwStyle = 0 THEN dwStyle = WS_VISIBLE
wsClassName = "msctls_progress32"
bSetFont = FALSE
but forgot to point it here.
Thanks very much.
Size Box control example.
' ########################################################################################
' Microsoft Windows
' File: CW_SizeBox.fbtpl - Template
' Contents: Demonstrates the use of the SizeBox 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
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx.CWindowClass
CONST IDC_SIZEBOX = 1001
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_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
IF wParam <> SIZE_MINIMIZED THEN
DIM hSizeBox AS HWND = GetDlgItem(hWnd, IDC_SIZEBOX)
' // Reposition the sizebox
' Hide the sizebox if the window is maximized
IF wParam = SIZE_MAXIMIZED THEN
ShowWindow hSizeBox, SW_HIDE
' Reposition and show the sizebox
ELSE
DIM cx AS LONG = GetSystemMetrics(SM_CXVSCROLL)
DIM cy AS LONG = GetSystemMetrics(SM_CYHSCROLL)
SetWindowPos hSizeBox, NULL, LOWORD(lParam) - cx, HIWORD(lParam) - cy, cx, cy, SWP_NOZORDER OR SWP_SHOWWINDOW
END IF
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
' // Create the main window with default coordinates
DIM pWindow AS CWindow
pWindow.Create(NULL, "Size box", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
pWindow.Center
' // Add a size box control (it will be positioned and displayed in the WM_SIZE message)
pWindow.AddControl("SizeBox", pWindow.hWindow, IDC_SIZEBOX)
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
Toolbar example.
' ########################################################################################
' Microsoft Windows
' File: CW_Toolbar.fbtpl
' Contents: CWindow with a toolbar
' 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"
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
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 a tool bar
' ========================================================================================
SUB AddToolbarButtons (BYVAL hToolBar AS HWND)
' // 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
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
END SUB
' ========================================================================================
' ========================================================================================
' 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
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_SIZE
IF wParam <> SIZE_MINIMIZED THEN
' // Update the size and position of the Toolbar control
SendMessageW GetDlgItem(hWnd, IDC_TOOLBAR), TB_AUTOSIZE, 0, 0
' // Resize the buttons
pWindow = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, TRUE
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 toolbar", @WndProc)
' // Disable background erasing
pWindow.ClassStyle = CS_DBLCLKS
' // Set the client size
pWindow.SetClientSize(300, 150)
' // Center the window
pWindow.Center
' // Add a button
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close")
' // Add a tooolbar
DIM hToolBar AS HWND = pWindow.AddControl("Toolbar", pWindow.hWindow, IDC_TOOLBAR)
' // Flat toolbar
' DIM hToolBar AS HWND = pWindow.AddControl("Toolbar", pWindow.hWindow, IDC_TOOLBAR, "", 0, 0, 0, 0, _
' WS_VISIBLE OR WS_CLIPCHILDREN OR WS_CLIPSIBLINGS OR CCS_TOP OR TBSTYLE_FLAT)
' // Add the toolbar buttons
AddToolbarButtons hToolBar
' // Size the toolbar
SendMessageW hToolBar, TB_AUTOSIZE, 0, 0
' // Process event messages
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
IPAddress control example.
' ########################################################################################
' Microsoft Windows
' File: CW_IPAddress.fbtpl - Template
' Contents: Demonstrates the use of the IPAddress control.
' Remarks: An Internet Protocol (IP) address control allows the user to enter an IP address
' in an easily understood format. This control also allows the application to obtain the
' address in numeric form rather than in text form.
' 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"
USING Afx.CWindowClass
CONST IDC_IPADDRESS = 1001
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_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_IPADDRESS
IF HIWORD(wParam) = EN_CHANGE THEN
' *** Put your code here ***
' Sample code: Get the address in string form
' DIM wszText AS WSTRING * 260
' GetWindowTextW(GetDlgItem(hwnd, IDC_IPADDRESS), @wszText, 260)
' OutputDebugStringW wszText
END IF
END SELECT
CASE WM_NOTIFY
DIM ptnmhdr AS NMHDR PTR = CAST(NMHDR PTR, lParam)
SELECT CASE ptnmhdr->idFrom
CASE IDC_IPADDRESS
IF ptnmhdr->code = IPN_FIELDCHANGED THEN
' *** Put your code here ***
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
' // Create the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "IPAddress", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
pWindow.Center
' // Add an IPAddress control
DIM hCtl AS HWND = pWindow.AddControl("IPAddress", pWindow.hWindow, IDC_IPADDRESS, "", 120, 50, 120, 23)
SetFocus hCtl
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ########################################################################################
' Microsoft Windows
' File: CW_TreeView.fbtpl
' Contents: Template - CWindow with a TreeView
' Compiler: Free Basic
' 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"
#define IDC_TREEVIEW 1001
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)
' ========================================================================================
' Inserts a new item in a tree-view control.
' ========================================================================================
FUNCTION TreeView_AddItemW (BYVAL hwndTV AS HWND, BYVAL hParent AS HTREEITEM, BYVAL hInsertAfter AS HTREEITEM, BYVAL iImage AS LONG, BYVAL iSelectedImage AS LONG, BYREF wszText AS WSTRING) AS HTREEITEM
DIM tvinsert AS TVINSERTSTRUCTW
tvinsert.hParent = hParent
tvinsert.hInsertAfter = hInsertAfter
tvinsert.Item.iImage = iImage
tvinsert.Item.iSelectedImage = iSelectedImage
tvinsert.Item.mask = TVIF_TEXT OR TVIF_IMAGE OR TVIF_SELECTEDIMAGE
tvinsert.Item.pszText = @wszText
tvinsert.Item.cchTextMax = LEN(wszText)
FUNCTION = CAST(HTREEITEM, SendMessageW(hwndTV, TVM_INSERTITEM, 0, CAST(LPARAM, @tvinsert)))
END FUNCTION
' ========================================================================================
' ========================================================================================
' Window procedure
' ================================================================e========================
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)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_NOTIFY
DIM ptnmhdr AS NMHDR PTR = CAST(NMHDR PTR, lParam)
SELECT CASE ptnmhdr->idFrom
CASE IDC_TREEVIEW
IF ptnmhdr->code = CULNG(NM_DBLCLK) THEN
' // Retrieve the handle of the TreeView
DIM hTreeView AS HWND = GetDlgItem(hwnd, IDC_TREEVIEW)
' // Retrieve the selected item
DIM hItem AS HTREEITEM = CAST(HTREEITEM, SendMessageW(hTreeView, TVM_GETNEXTITEM, TVGN_CARET, CAST(LPARAM, NULL)))
' // Retrieve the text of the selected item
DIM tvi AS TVITEMW
DIM wszText AS WSTRING * 260
tvi.hitem = hItem
tvi.mask = TVIF_TEXT
tvi.psztext = @wszText
tvi.cchtextmax = SIZEOF(wszText)
SendMessageW(hTreeView, TVM_GETITEMW, 0, CAST(LPARAM, @tvi))
MessageBox hwnd, wszText, "", MB_OK
EXIT FUNCTION
END IF
END SELECT
CASE WM_DESTROY
' // End the application
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Pass unprocessed messages to DefWindowProc
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 TreeView", @WndProc)
pWindow.ClassStyle = CS_DBLCLKS ' // Change the window style to avoid flicker
pWindow.SetClientSize(320, 375)
pWindow.Center
' // Add a TreeView
DIM hTreeView AS HWND
hTreeView = pWindow.AddControl("TreeView", pWindow.hWindow, IDC_TREEVIEW, "")
pWindow.SetWindowPos hTreeView, NULL, 8, 8, 300, 320, SWP_NOZORDER
' // Add items to the TreeView
DIM AS HTREEITEM hRoot, hNode, hItem, hSubNode
' // Create the root node
hRoot = TreeView_AddItemW(hTreeView, 0, TVI_ROOT, 0, 0, "Root")
' // Create a node
hNode = TreeView_AddItemW(hTreeView, hRoot, 0, 0, 0, "Node 1")
' // Insert items in the node
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 1")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 2")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 3")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 4")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 5")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 1 Item 6")
' // Expand the node
SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)
' // Create another node
hNode = TreeView_AddItemW(hTreeView, hRoot, 0, 0, 0, "Node 2")
' // Insert items in the node
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 1")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 2")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 3")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 4")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 5")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 2 Item 6")
' // Expand the node
SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)
' // Expand the node
SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)
' // Create another node
hNode = TreeView_AddItemW(hTreeView, hRoot, 0, 0, 0, "Node 3")
' // Insert items in the node
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 1")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 2")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 3")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 4")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 5")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 3 Item 6")
' // Expand the node
SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)
' // Create another node
hNode = TreeView_AddItemW(hTreeView, hRoot, 0, 0, 0, "Node 4")
' // Insert items in the node
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 1")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 2")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 3")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 4")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 5")
hItem = TreeView_AddItemW(hTreeView, hNode, 0, 0, 0, "Node 4 Item 6")
' // Expand the node
SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hNode)
' // Expand the root node
SendMessageW hTreeView, TVM_EXPAND, CAST(WPARAM, TVE_EXPAND), CAST(LPARAM, hRoot)
' // Add a cancel button
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Cancel", 233, 338, 75, 23)
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ########################################################################################
' Microsoft Windows
' File: CW_BufferedAnimation.fbtpl - Template
' Contents: Demonstrates the use of BeginBufferedAnimation.
' Note: Click the left mouse button of the mouse to start the animation.
' Remarks: Minimum operating systems: Windows Vista, Windows 7
' 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 "win/uxtheme.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx.CWindowClass
#define ANIMATION_DURATION 500
#define IDC_LABEL 1001
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)
' ========================================================================================
' Paints the icon
' ========================================================================================
SUB PaintIt (BYVAL hwnd AS HWND, BYVAL hdc AS HDC, BYVAL nState AS LONG)
DIM rc AS RECT
GetClientRect(hwnd, @rc)
FillRect(hdc, @rc, GetStockObject(WHITE_BRUSH))
LoadIcon (NULL, IDI_APPLICATION)
DIM hIcon AS HICON = LoadIcon(NULL, IIF(nState = 1, IDI_APPLICATION, IDI_ERROR))
IF hIcon THEN
DrawIcon(hdc, 10, 10, hIcon)
DestroyIcon(hIcon)
END IF
END SUB
' ========================================================================================
' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM hdc AS HDC ' // Device context handle
DIM ps AS PAINTSTRUCT ' // PAINTSTRUCT structure
DIM animParams AS BP_ANIMATIONPARAMS ' // Animation parameters
DIM hbpAnimation AS HANIMATIONBUFFER ' // Handle to the buffered paint animation
DIM hdcFrom AS HDC ' // Handle of the DC where the application should paint the initial state of the animation
DIM hdcTo AS HDC ' // Handle of the DC where the application should paint the final state of the animation
DIM rc AS RECT ' // Coordinates of the window's client area
STATIC fCurrentState AS LONG ' // Boolean flag
STATIC fNewState AS LONG ' // Boolean flag
SELECT CASE uMsg
CASE WM_CREATE
fCurrentState = CTRUE
fNewState = CTRUE
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_LBUTTONDOWN
' // Start animation
fNewState = NOT fCurrentState
InvalidateRect(hwnd, NULL, CTRUE)
EXIT FUNCTION
CASE WM_PAINT
hdc = BeginPaint(hwnd, @ps)
IF hdc THEN
' // See if this paint was generated by a soft-fade animation
IF BufferedPaintRenderAnimation(hwnd, hdc) = 0 THEN
animParams.cbSize = SIZEOF(BP_ANIMATIONPARAMS)
animParams.style = BPAS_LINEAR
' // Check if animation is needed. If not set dwDuration to 0
animParams.dwDuration = IIF(fCurrentState <> fNewState, ANIMATION_DURATION, 0)
GetClientRect(hwnd, @rc)
hbpAnimation = BeginBufferedAnimation(hwnd, hdc, @rc, _
BPBF_COMPATIBLEBITMAP, NULL, @animParams, @hdcFrom, @hdcTo)
IF hbpAnimation THEN
IF hdcFrom THEN
PaintIt(hwnd, hdcFrom, fCurrentState)
END IF
IF hdcTo THEN
PaintIt(hwnd, hdcTo, fNewState)
END IF
fCurrentState = fNewState
EndBufferedAnimation(hbpAnimation, CTRUE)
ELSE
PaintIt(hwnd, hdc, fCurrentState)
END IF
END IF
EndPaint hwnd, @ps
END IF
EXIT FUNCTION
CASE WM_CTLCOLORSTATIC
' // Return the handle of the brush used to paint background
IF GetDlgCtrlID(CAST(HWND, lParam)) = IDC_LABEL THEN
FUNCTION = CAST(LRESULT, GetStockObject(WHITE_BRUSH))
EXIT FUNCTION
END IF
CASE WM_SIZE
' // Stops the buffered animation
BufferedPaintStopAllAnimations hwnd
EXIT FUNCTION
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
' // Required: Initialize buffered painting for the current thread.
IF FAILED(BufferedPaintInit) THEN EXIT FUNCTION
' // Create the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "Buffered animation", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
pWindow.Center
' // Add a label
pWindow.AddControl("Label", pWindow.hWindow, IDC_LABEL, " Click the icon with the mouse left button", 70, 10, 235, 23)
' // Process events
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Required: Closes down buffered painting for the current thread.
BufferedPaintUnInit
END FUNCTION
' ========================================================================================
' ########################################################################################
' Microsoft Windows
' File: CW_Label.fbtpl - Template
' Contents: Demonstrates the use of the Label 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
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
USING Afx.CWindowClass
CONST IDC_LABEL = 1001
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_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_CTLCOLORSTATIC
IF GetDlgCtrlID(CAST(HWND, lParam)) = IDC_LABEL THEN
' // Set the background and text colors
SetBkColor CAST(HDC, wParam), &h00ED9564
SetTextColor CAST(HDC, wParam), &h00FFFFFF
' // Return handle of brush used to paint background
FUNCTION = CAST(LRESULT, GetPropW(CAST(HWND, lParam), "BRUSH"))
EXIT FUNCTION
END IF
CASE WM_DESTROY
' // Destroy custom brush
DeleteObject CAST(HGDIOBJ, RemovePropW(GetDlgItem(hwnd, IDC_LABEL), "BRUSH"))
' // End the application
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
' // Create the main windows
DIM pWindow AS CWindow
pWindow.Create(NULL, "CWindow with a label control", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
pWindow.Center
' // Add a label control
DIM hLabel AS HWND = pWindow.AddControl("Label", pWindow.hWindow, IDC_LABEL, "This is a label", 100, 50, 150, 23)
' // Create custom brush for the label
DIM tlb AS LOGBRUSH
tlb.lbStyle = BS_SOLID
tlb.lbColor = &h00ED9564
DIM hBrush AS HBRUSH = CreateBrushIndirect(@tlb)
SetPropw hLabel, "BRUSH", hBrush
' // Process events
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ########################################################################################
' Microsoft Windows
' File: CW_Menu.fbtpl
' Contents: CWindow with a menu
' 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"
USING Afx.CWindowClass
' // Menu identifiers
#define IDM_NEW 1001 ' New file
#define IDM_OPEN 1002 ' Open file...
#define IDM_SAVE 1003 ' Save file
#define IDM_SAVEAS 1004 ' Save file as...
#define IDM_EXIT 1005 ' Exit
#define IDM_UNDO 2001 ' Undo
#define IDM_CUT 2002 ' Cut
#define IDM_COPY 2003 ' Copy
#define IDM_PASTE 2004 ' Paste
#define IDM_TILEH 3001 ' Tile hosizontal
#define IDM_TILEV 3002 ' Tile vertical
#define IDM_CASCADE 3003 ' Cascade
#define IDM_ARRANGE 3004 ' Arrange icons
#define IDM_CLOSE 3005 ' Close
#define IDM_CLOSEALL 3006 ' Close all
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)
' ========================================================================================
' Build the menu
' ========================================================================================
FUNCTION BuildMenu () AS HMENU
DIM hMenu AS HMENU
DIM hPopUpMenu AS HMENU
hMenu = CreateMenu
hPopUpMenu = CreatePopUpMenu
AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&File"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_NEW, "&New" & CHR(9) & "Ctrl+N"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_OPEN, "&Open..." & CHR(9) & "Ctrl+O"
AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVE, "&Save" & CHR(9) & "Ctrl+S"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVEAS, "Save &As..."
AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_EXIT, "E&xit" & CHR(9) & "Alt+F4"
hPopUpMenu = CreatePopUpMenu
AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&Edit"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_UNDO, "&Undo" & CHR(9) & "Ctrl+Z"
AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CUT, "Cu&t" & CHR(9) & "Ctrl+X"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_COPY, "&Copy" & CHR(9) & "Ctrl+C"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_PASTE, "&Paste" & CHR(9) & "Ctrl+V"
hPopUpMenu = CreatePopUpMenu
AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&Window"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_TILEH, "&Tile Horizontal"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_TILEV, "Tile &Vertical"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CASCADE, "Ca&scade"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_ARRANGE, "&Arrange &Icons"
AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CLOSE, "&Close" & CHR(9) & "Ctrl+F4"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CLOSEALL, "Close &All"
FUNCTION = hMenu
END FUNCTION
' ========================================================================================
' ========================================================================================
' 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
CASE IDM_NEW ' IDM_OPEN, IDM_SAVE, etc.
MessageBox hwnd, "New option clicked", "Menu", MB_OK
EXIT FUNCTION
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, "CWindow with a menu", @WndProc)
pWindow.SetClientSize(400, 250)
pWindow.Center
' // Add a button
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 280,180, 75, 23)
' // Create the menu
DIM hMenu AS HMENU = BuildMenu
SetMenu pWindow.hWindow, hMenu
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ########################################################################################
' Microsoft Windows
' File: CW_ContextMenu.fbtpl
' Contents: CWindow with a context menu
' 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"
USING Afx.CWindowClass
#define IDC_LABEL 1001
' // Menu identifiers
#define IDM_NEW 1001 ' New file
#define IDM_OPEN 1002 ' Open file...
#define IDM_SAVE 1003 ' Save file
#define IDM_SAVEAS 1004 ' Save file as...
#define IDM_EXIT 1005 ' Exit
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
CASE IDM_NEW ' IDM_OPEN, IDM_SAVE, etc.
MessageBox hwnd, "New option clicked", "Menu", MB_OK
EXIT FUNCTION
END SELECT
CASE WM_CONTEXTMENU
' // Build the context menu
DIM hPopUpMenu AS HMENU = CreatePopUpMenu
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_NEW, "&New" & CHR(9) & "Ctrl+N"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_OPEN, "&Open..." & CHR(9) & "Ctrl+O"
AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVE, "&Save" & CHR(9) & "Ctrl+S"
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVEAS, "Save &As..."
AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
AppendMenuW hPopUpMenu, MF_ENABLED, IDM_EXIT, "E&xit" & CHR(9) & "Alt+F4"
DIM pt AS POINT
GetCursorPos @pt
TrackPopupMenu hPopupMenu, 0, pt.x, pt.y, 0, hwnd, NULL
DestroyMenu hPopupMenu
EXIT FUNCTION
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 context menu", @WndProc)
pWindow.SetClientSize(400, 230)
pWindow.Center
' // Add a label
pWindow.AddControl("Label", pWindow.hWindow, IDC_LABEL, " Click the mouse right button", 110, 20, 175, 23)
' // Add a button
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 280,180, 75, 23)
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
After installing the latest version of the compiler, the BufferedPaint example stopped working.
It happens that they have changed the value of True from 1 to -1.
Now we have to use CTrue.
The following equates are duplicated and must be remmed.
WinNT.bi
const JOB_OBJECT_LIMIT_RESERVED3 = &h00008000
const JOB_OBJECT_LIMIT_RESERVED4 = &h00010000
const JOB_OBJECT_LIMIT_RESERVED5 = &h00020000
const JOB_OBJECT_LIMIT_RESERVED6 = &h00040000
WinGdi.bi
const DM_UPDATE = 1
const DM_COPY = 2
const DM_PROMPT = 4
const DM_MODIFY = 8
#define DM_IN_BUFFER DM_MODIFY
#define DM_IN_PROMPT DM_PROMPT
#define DM_OUT_BUFFER DM_COPY
#define DM_OUT_DEFAULT DM_UPDATE
const DC_FIELDS = 1
const DC_PAPERS = 2
const DC_PAPERSIZE = 3
const DC_MINEXTENT = 4
const DC_MAXEXTENT = 5
const DC_BINS = 6
const DC_DUPLEX = 7
const DC_SIZE = 8
const DC_EXTRA = 9
const DC_VERSION = 10
const DC_DRIVER = 11
const DC_BINNAMES = 12
const DC_ENUMRESOLUTIONS = 13
const DC_FILEDEPENDENCIES = 14
const DC_TRUETYPE = 15
const DC_PAPERNAMES = 16
const DC_ORIENTATION = 17
const DC_COPIES = 18
WinUser.bi
const MF_END = &h00000080
imm.bi
const MOD_ALT = &h0001
const MOD_CONTROL = &h0002
const MOD_SHIFT = &h0004
commctrl.bi
const TBNRF_HIDEHELP = &h1
const TBNRF_ENDCUSTOMIZE = &h2
' ########################################################################################
' Microsoft Windows
' File: CW_ButtonOwnerdraw2.fbtpl - Template
' Contents: Ownerdraw button with just an image.
' 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"
USING Afx.CWindowClass
CONST IDC_BUTTON = 1001
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_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_BUTTON
IF HIWORD(wParam) = BN_CLICKED THEN
MessageBoxW hwnd, "Button clicked", "", MB_OK
EXIT FUNCTION
END IF
END SELECT
CASE WM_DRAWITEM
SCOPE
DIM pWindow AS CWindow PTR = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
DIM pDis AS DRAWITEMSTRUCT PTR = CAST(DRAWITEMSTRUCT PTR, lParam)
IF pDis->CtlId <> IDC_BUTTON THEN EXIT FUNCTION
' Icon identifiers in User32.dll. Hacked with ResourceHacker.
' IDI_APPLICATION = 100, IDI_WARNING = 101, IDI_QUESTION = 102, IDI_ERROR = 103
' IDI_INFORMATION = 104, IDI_WINLOGO = 105, IDI_SHIELD = 106
' Used here to make the example simpler.
' Normally, you will load an icon or bitmap from a file or resource.
DIM hIcon AS HICON = LoadImageW(GetModuleHandle("User32"), MAKEINTRESOURCEW(103), IMAGE_ICON, _
pWindow->ScaleX(50), pWindow->ScaleY(50), LR_DEFAULTCOLOR)
IF hIcon THEN
DrawStateW pDis->hDC, NULL, NULL, CAST(LPARAM, hIcon), 0, 0, 0, 0, 0, DST_ICON
DestroyIcon hIcon
END IF
END SCOPE
FUNCTION = CTRUE
EXIT FUNCTION
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 ownerdraw button", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
pWindow.Center
DIM hButton AS HWND = pWindow.AddControl("CUSTOMBUTTON", pWindow.hWindow, IDC_BUTTON, "&Ownerdraw button", 150, 50, 50, 50)
' Alternate way:
' DIM hButton AS HWND = pWindow.AddControl("Button", pWindow.hWindow, IDC_BUTTON, "&Ownerdraw button", 150, 50, 50, 50, BS_OWNERDRAW)
SetFocus hButton
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================
' ########################################################################################
' Microsoft Windows
' File: CW_ButtonOwnerdraw3.fbtpl - Template
' Contents: Ownerdraw button with "normal" and "hot" images.
' When the mouse enters the button, the image changes to "hot",
' and when it leaves the normal image is restored.
' 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"
USING Afx.CWindowClass
CONST IDC_BUTTON = 1001
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_COMMAND
SELECT CASE LOWORD(wParam)
' // If ESC key pressed, close the application sending an WM_CLOSE message
CASE IDCANCEL
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_DRAWITEM
SCOPE
DIM pWindow AS CWindow PTR = CAST(CWindow PTR, GetPropW(hwnd, "CWINDOWPTR"))
DIM pDis AS DRAWITEMSTRUCT PTR = CAST(DRAWITEMSTRUCT PTR, lParam)
IF pDis->CtlId <> IDC_BUTTON THEN EXIT FUNCTION
' Icon identifiers in User32.dll. Hacked with ResourceHacker.
' IDI_APPLICATION = 100, IDI_WARNING = 101, IDI_QUESTION = 102, IDI_ERROR = 103
' IDI_INFORMATION = 104, IDI_WINLOGO = 105, IDI_SHIELD = 106
' Used here to make the example simpler.
' Normally, you will load an icon or bitmap from a file or resource.
DIM hIcon AS HICON
IF GetPropW(GetDlgItem(hwnd, IDC_BUTTON), "HOT") = 0 THEN
hIcon = LoadImageW(GetModuleHandle("User32"), MAKEINTRESOURCEW(102), IMAGE_ICON, _
pWindow->ScaleX(50), pWindow->ScaleY(50), LR_DEFAULTCOLOR)
ELSE
hIcon = LoadImageW(GetModuleHandle("User32"), MAKEINTRESOURCEW(103), IMAGE_ICON, _
pWindow->ScaleX(50), pWindow->ScaleY(50), LR_DEFAULTCOLOR)
END IF
IF hIcon THEN
DrawStateW pDis->hDC, NULL, NULL, CAST(LPARAM, hIcon), 0, 0, 0, 0, 0, DST_ICON
DestroyIcon hIcon
END IF
END SCOPE
FUNCTION = CTRUE
EXIT FUNCTION
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Processes messages for the subclassed Button window.
' ========================================================================================
FUNCTION Button_SubclassProc ( _
BYVAL hwnd AS HWND, _ ' // Control window handle
BYVAL uMsg AS UINT, _ ' // Type of message
BYVAL wParam AS WPARAM, _ ' // First message parameter
BYVAL lParam AS LPARAM _ ' // Second message parameter
) AS LRESULT
SELECT CASE uMsg
CASE WM_GETDLGCODE
' // All keyboard input
FUNCTION = DLGC_WANTALLKEYS
EXIT FUNCTION
CASE WM_LBUTTONDOWN
MessageBoxW(GetParent(hwnd), "Click", "FreeBasic", MB_OK)
EXIT FUNCTION
CASE WM_KEYDOWN
SELECT CASE LOWORD(wParam)
CASE VK_ESCAPE
SendMessageW(GetParent(hwnd), WM_CLOSE, 0, 0)
EXIT FUNCTION
END SELECT
CASE WM_MOUSEMOVE
' // Tracks the mouse movement and stores the hot state
DIM trackMouse AS TRACKMOUSEEVENT
IF GetPropW(hwnd, "HOT") = 0 THEN
trackMouse.cbSize = SIZEOF(trackMouse)
trackMouse.dwFlags = TME_LEAVE
trackMouse.hwndTrack = hwnd
trackMouse.dwHoverTime = 1
TrackMouseEvent(@trackMouse)
SetPropW hwnd, "HOT", CAST(HANDLE, CTRUE)
InvalidateRect hwnd, NULL, 0
UpdateWindow hwnd
END IF
EXIT FUNCTION
CASE WM_MOUSELEAVE
' // Removes the hot state and redraws the button
RemovePropW hwnd, "HOT"
InvalidateRect hwnd, NULL, 0
UpdateWindow hwnd
EXIT FUNCTION
CASE WM_DESTROY
' // REQUIRED: Remove control subclassing
SetWindowLongPtrW hwnd, GWLP_WNDPROC, CAST(LONG_PTR, RemovePropW(hwnd, "OLDWNDPROC"))
END SELECT
FUNCTION = CallWindowProcW(GetPropW(hwnd, "OLDWNDPROC"), 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
' // Create the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "CWindow with ownerdraw button", @WndProc, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT)
pWindow.Center
' // Add a subclassed ownerdraw button
DIM hButton AS HWND = pWindow.AddControl("CustomButton", pWindow.hWindow, IDC_BUTTON, "", 150, 50, 50, 50, 0, 0, 0, CAST(WNDPROC, @Button_SubclassProc))
SetFocus hButton
FUNCTION = pWindow.DoEvents(nCmdShow)
END FUNCTION
' ========================================================================================