Assorted Common Controls Examples

[José Roca]

 
The common controls are a set of windows that are implemented by the common control library, Comctl32.dll, which is a DLL included with the Windows operating system. Like other control windows, a common control is a child window that an application uses in conjunction with another window to enable interaction with the user.

[José Roca]

 
The technique used is to process the HDM_LAYOUT message, fill the WINDOWPOS structure with the appropriate size and position of the header control, and change the top position of the rectangle that the header control will occupy.

Code: [Select]

' ########################################################################################
' Microsoft Windows
' File: CW_LV_Multiheader.pbtpl
' Contents: Template - CWindow with a multi header ListView
' Compilers: PBWIN 10.02+, PBCC 6.02+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José 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.
' ########################################################################################

' ########################################################################################
' Mutiline header ListView example
' The technique used is to process the HDM_LAYOUT message, fill the WINDOWPOS structure
' with the appropriate size and position of the header control, and change the top position
' of the rectangle that the header control will occupy.
'   CASE %HDM_LAYOUT
'      LOCAL phdl AS HDLAYOUT PTR
'      phdl = lParam
'      @phdl.@pwpos.hwnd = hwnd
'      @phdl.@pwpos.flags = %SWP_FRAMECHANGED
'      @phdl.@pwpos.x = @phdl.@prc.nLeft
'      @phdl.@pwpos.y = 0
'      @phdl.@pwpos.cx = @phdl.@prc.nRight - @phdl.@prc.nLeft
'      @phdl.@pwpos.cy = 40   ' --> change me
'      @phdl.@prc.nTop = 40   ' --> change me
'      FUNCTION = -1
'      EXIT FUNCTION
' ########################################################################################

#COMPILE EXE
#DIM ALL

%UNICODE = 1
#INCLUDE ONCE "CWindow.inc"        ' // CWindow class
#INCLUDE ONCE "ListViewCtrl.inc"   ' // ListView control wrapper functions
#INCLUDE ONCE "HeaderCtrl.inc"     ' // Header control wrapper functions

%IDC_LISTVIEW = 1001

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
'   SetProcessDPIAware

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   LOCAL hwnd AS DWORD
   hwnd = pWindow.CreateWindow(%NULL, "Multiline Header ListView", 0, 0, 0, 0, -1, -1, CODEPTR(WindowProc))
   ' // Change the class style to avoid flicker
   pWindow.ClassStyle = %CS_DBLCLKS
   ' // Set the client size
   pWindow.SetClientSize 565, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a subclassed ListView control
   LOCAL hListView AS DWORD
   LOCAL rc AS RECT
   GetClientRect hwnd, rc
   LOCAL dwStyle AS DWORD
   dwStyle = %WS_CHILD OR %WS_VISIBLE OR %LVS_REPORT OR %LVS_SINGLESEL OR %LVS_SHOWSELALWAYS
   hListView = pWindow.AddListView(hwnd, %IDC_LISTVIEW, "", 0, 0, 0, 0, dwStyle, -1, CODEPTR(ListView_SubclassProc))

   ' // Add some extended styles
   LOCAL dwExStyle AS DWORD
   dwExStyle = ListView_GetExtendedListViewStyle(hListView)
   dwExStyle = dwExStyle OR %LVS_EX_FULLROWSELECT OR %LVS_EX_GRIDLINES
   ListView_SetExtendedListViewStyle(hListView, dwExStyle)

   ' // Get the handle of the ListView header control and subclass it
   LOCAL hLvHeader AS DWORD
   hLvHeader = ListView_GetHeader(hListView)
   IF hLvHeader THEN SetProp hLvHeader, "OLDWNDPROC", SetWindowLong(hLvHeader, %GWL_WNDPROC, CODEPTR(ListViewHeader_SubclassProc))

   ' // Add the header's column names
   ListView_AddColumn(hListView, 0, "Customer" & $CRLF & "number", 80, 1)
   ListView_AddColumn(hListView, 1, "Name" & $CRLF & "First, last", 160, 0)
   ListView_AddColumn(hListView, 2, "Telephone" & $CRLF & "number", 160, 0)
   ListView_AddColumn(hListView, 3, "Street" & $CRLF & "address", 80, 0)
   ListView_AddColumn(hListView, 4, "Action" & $CRLF & "items", 80, 1)
   ' // If High DPI aware, scale the widths
'   ListView_AddColumn(hListView, 0, "Customer" & $CRLF & "number", pWindow.ScaleX(80), 1)
'   ListView_AddColumn(hListView, 1, "Name" & $CRLF & "First, last", pWindow.ScaleX(160), 0)
'   ListView_AddColumn(hListView, 2, "Telephone" & $CRLF & "number", pWindow.ScaleX(160), 0)
'   ListView_AddColumn(hListView, 3, "Street" & $CRLF & "address", pWindow.ScaleX(80), 0)
'   ListView_AddColumn(hListView, 4, "Action" & $CRLF & "items", pWindow.ScaleX(80), 1)

   ' // Populate the ListView with some data
   ListView_AddItem(hListView, 0, 0, "1")
   ListView_SetItemText(hListView, 0, 1, "Doe, John")
   ListView_SetItemText(hListView, 0, 2, "(000) 000-0000")
   ListView_SetItemText(hListView, 0, 3, "No name")
   ListView_SetItemText(hListView, 0, 4, "Unknown")
   ListView_AddItem(hListView, 1, 0, "2")
   ListView_SetItemText(hListView, 1, 1, "Smith, Joe")
   ListView_SetItemText(hListView, 1, 2, "(111) 111-1111")
   ListView_SetItemText(hListView, 1, 3, "No name")
   ListView_SetItemText(hListView, 1, 4, "Unknown")
   ' ... add more data

   

   ' // Force the resizing of the ListView by sending a WM_SIZE message
   SendMessage hwnd, %WM_SIZE, 0, 0

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents

END FUNCTION
' ########################################################################################

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hInstance AS DWORD        ' // Instance handle
   STATIC lpc AS CREATESTRUCT PTR   ' // Pointer to the creation parameters
   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Pointer to the creation parameters
         lpc = lParam
         ' // Instance handle
         hInstance = @lpc.hInstance
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         ' // Resize the ListView control and its header
         IF wParam <> %SIZE_MINIMIZED THEN
            LOCAL hListView AS DWORD
            hListView = GetDlgItem(hwnd, %IDC_LISTVIEW)
            MoveWindow hListView, 0, 0, LO(WORD, lParam), HI(WORD, lParam), %TRUE
            MoveWindow ListView_GetHeader(hListView), 0, 0, LO(WORD, lParam), 40, %TRUE
            ' // If Hifh DPI aware, scale the height of the header
'            MoveWindow ListView_GetHeader(hListView), 0, 0, LO(WORD, lParam), pWindow.ScaleY(40), %TRUE
         END IF

      CASE %WM_DESTROY
         ' // Close the main window
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Processes messages for the subclassed ListView header control.
' ========================================================================================
FUNCTION ListViewHeader_SubclassProc ( _
   BYVAL hwnd   AS DWORD, _                 ' // Control window handle
   BYVAL uMsg   AS DWORD, _                 ' // Type of message
   BYVAL wParam AS DWORD, _                 ' // First message parameter
   BYVAL lParam AS LONG _                   ' // Second message parameter
   ) AS LONG

   ' // REQUIRED: Get the address of the original window procedure
   LOCAL pOldWndProc AS DWORD
   pOldWndProc = GetProp(hwnd, "OLDWNDPROC")

   SELECT CASE uMsg

      CASE %WM_DESTROY
         ' // REQUIRED: Remove control subclassing
         SetWindowLong hwnd, %GWL_WNDPROC, RemoveProp(hwnd, "OLDWNDPROC")

      CASE %HDM_LAYOUT
         ' // Fill the WINDOWPOS structure with the appropriate size and position of the
         ' // header control and change the top position of the rectangle that the header
         ' // control will occupy.
         LOCAL phdl AS HDLAYOUT PTR
         phdl = lParam
         @phdl.@pwpos.hwnd = hwnd
         @phdl.@pwpos.flags = %SWP_FRAMECHANGED
         @phdl.@pwpos.x = @phdl.@prc.nLeft
         @phdl.@pwpos.y = 0
         @phdl.@pwpos.cx = @phdl.@prc.nRight - @phdl.@prc.nLeft
         @phdl.@pwpos.cy = 40   ' --> change me
         @phdl.@prc.nTop = 40   ' --> change me
         ' // If High DPI aware, scale the size
'         LOCAL pWindow AS IWindow
'         pWindow = CWindow_GetObjectFromWindowHandle(hwnd)
'         @phdl.@pwpos.cx = pWindow.ScaleX(@phdl.@prc.nRight - @phdl.@prc.nLeft)
'         @phdl.@pwpos.cy = pWindow.ScaleY(40)   ' --> change me
'         @phdl.@prc.nTop = pWindow.ScaleY(40)   ' --> change me
         FUNCTION = -1
         EXIT FUNCTION

   END SELECT

   FUNCTION = CallWindowProc(pOldWndProc, hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Processes messages for the subclassed ListView control.
' ========================================================================================
FUNCTION ListView_SubclassProc ( _
   BYVAL hwnd   AS DWORD, _                 ' // Control window handle
   BYVAL uMsg   AS DWORD, _                 ' // Type of message
   BYVAL wParam AS DWORD, _                 ' // First message parameter
   BYVAL lParam AS LONG _                   ' // Second message parameter
   ) AS LONG

   ' // REQUIRED: Get the address of the original window procedure
   LOCAL pOldWndProc AS DWORD
   pOldWndProc = GetProp(hwnd, "OLDWNDPROC")

   SELECT CASE uMsg

      CASE %WM_DESTROY
         ' // REQUIRED: Remove control subclassing
         SetWindowLong hwnd, %GWL_WNDPROC, RemoveProp(hwnd, "OLDWNDPROC")

      CASE %WM_NOTIFY

         LOCAL pnmh AS NMHDR PTR
         LOCAL pnmcd AS NMCUSTOMDRAW PTR
         LOCAL wszText AS WSTRINGZ * 260

         pnmh = lParam
         SELECT CASE @pnmh.code

            CASE %NM_CUSTOMDRAW
            pnmcd = lParam

               ' // Check the drawing stage
               SELECT CASE @pnmcd.dwDrawStage

                  ' // Prior to painting
                  CASE %CDDS_PREPAINT
                     ' // Tell Windows we want individual notification of each item being drawn
                     FUNCTION = %CDRF_NOTIFYITEMDRAW
                     EXIT FUNCTION

                  ' // Notification of each item being drawn
                  CASE %CDDS_ITEMPREPAINT

                     LOCAL hLvHeader AS DWORD
                     LOCAL nIndex AS DWORD
                     LOCAL nState AS DWORD

                     nIndex = @pnmcd.dwItemSpec
                     nState = @pnmcd.uItemState

                     ' // Get the header item text...
                     LOCAL hdi AS HDITEM
                     hdi.mask = %HDI_TEXT
                     hdi.pszText = VARPTR(wszText)
                     hdi.cchtextmax = SIZEOF(wszText)
                     hLvHeader = ListView_GetHeader(hwnd)
                     Header_GetItem(hLvHeader, nIndex, hdi)

                     ' // Create a new font
                     LOCAL pWindow AS IWindow
                     LOCAL hFont AS DWORD
                     pWindow = CWindow_GetObjectFromWindowHandle(hwnd)
                     hFont = pWindow.CreateFont("Tahoma", 10, %FW_BOLD, %FALSE, %FALSE, %FALSE, %DEFAULT_CHARSET)
                     pWindow = NOTHING
                     ' // Select the font into the current devide context
                     LOCAL hOldFont AS DWORD
                     hOldFont = SelectObject(@pnmcd.hdc, hFont)

                     ' // Draw the button state...
                     IF (nState AND %CDIS_SELECTED) THEN
                        DrawFrameControl @pnmcd.hdc, @pnmcd.rc, %DFC_BUTTON, %DFCS_BUTTONPUSH OR %DFCS_PUSHED
                     ELSE
                        DrawFrameControl @pnmcd.hdc, @pnmcd.rc, %DFC_BUTTON, %DFCS_BUTTONPUSH
                     END IF

                     ' // Paint the background
                     LOCAL hBrush AS DWORD
                     hBrush = CreateSolidBrush(RGB(228,120,51))
                     InflateRect @pnmcd.rc, -2, -2
                     FillRect @pnmcd.hdc, @pnmcd.rc, hBrush

                     SetBkMode @pnmcd.hdc, %TRANSPARENT
                     ' // Change your text color here...
                     SetTextColor @pnmcd.hdc, RGB(92,51,23)

                     ' // Offset the text slightly if depressed...
                     IF (nState AND %CDIS_SELECTED) THEN InflateRect @pnmcd.rc, -2, -2
                     ' // Draw multiline, using CRLF (i.e. wszText = "Customer" & $CRLF & "number")
                     DrawText @pnmcd.hdc, wszText, LEN(wszText), @pnmcd.rc, %DT_CENTER OR %DT_VCENTER 'OR %DT_WORDBREAK
                     ' // Draw multiline using word wrap (i.e. wszText = "Customer number")
                     'DrawText @pnmcd.hdc, wszText, LEN(wszText), @pnmcd.rc, %DT_CENTER OR %DT_VCENTER OR %DT_WORDBREAK
                     ' // Sraw single line with ellipsis... (i.e. wszText = "Customer number")
                     'DrawText @pnmcd.hdc, wszText, LEN(wszText), @pnmcd.rc, %DT_CENTER OR %DT_VCENTER OR %DT_END_ELLIPSIS

                     ' // Cleanup
                     IF hBrush THEN DeleteObject hBrush
                     IF hOldFont THEN SelectObject @pnmcd.hdc, hOldFont
                     IF hFont THEN DeleteObject hFont

                     ' // Tell Windows the item has already been drawn
                     FUNCTION = %CDRF_SKIPDEFAULT
                     EXIT FUNCTION

               END SELECT

         END SELECT

   END SELECT

   FUNCTION = CallWindowProc(pOldWndProc, hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================


[José Roca]

 
Demonstrates the use of the Button_SetImageList wrapper function. Requries Windows XP, Windows Vista or Windows 7.

CWindow version

Code: [Select]

' ########################################################################################
' Demonstrates the use of the Button_SetImageList wrapper function.
' Requries Windows XP, Windows Vista or Windows 7.
' Copyright (c) 2010 José 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.
' ########################################################################################

#COMPILE EXE
#DIM ALL

'/* header files for imported files */
%UNICODE = 1
#INCLUDE ONCE "CWindow.inc"
#INCLUDE ONCE "CommCtrl.inc"
#INCLUDE ONCE "ButtonCtrl.inc"

'/* resource file */
#RESOURCE RES, "EX_CW_Button_SetImageList.res"

' /* Identifiers */
%IDI_EXIT   = 100
%IDC_BUTTON = 1001

' ########################################################################################
' Main
' ########################################################################################
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   ' // Create an instance of the class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "Button_SetImageList Demo", 0, 0, 355, 234, -1, -1, CODEPTR(WindowProc))
   ' // Center it
   pWindow.CenterWindow

   ' // Add the button
   LOCAL hButton AS DWORD
   hButton = pWindow.AddButton(pWindow.hwnd, %IDC_BUTTON, "E&xit", 120, 80, 90, 26, -1, -1)
   SetFocus hButton

   ' // Create and initialize the image list
   LOCAL hImageList AS DWORD
   LOCAL bi AS BUTTON_IMAGELIST
   LOCAL hIcon AS DWORD
   hImageList = ImageList_Create(16, 16, %ILC_MASK OR %ILC_COLOR24, 1, 0)
   IF ISTRUE hImageList THEN
      ' // Set the background color to use for drawing images
      ImageList_SetBkColor hImageList, %CLR_NONE
      ' // Add the icon to the imagelist
      hIcon = LoadImage(GetModuleHandle(""), BYVAL %IDI_EXIT, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
      ImageList_AddIcon(hImageList, hIcon)
      DeleteObject hIcon
   END IF

   ' // Set the imagelist
   bi.himl = hImageList
   bi.uAlign = %BUTTON_IMAGELIST_ALIGN_LEFT
   bi.margin.ntop = 3
   bi.margin.nbottom = 3
   bi.margin.nleft = 3
   bi.margin.nright = 3
   Button_SetImageList(hButton, bi)

   ' // Default message pump (you can replace it with your own)
   pWindow.DoEvents(nCmdShow)

   ImageList_Destroy hImageList

END FUNCTION
' ########################################################################################

' ========================================================================================
' Main callback function.
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   SELECT CASE uMsg

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL, %IDC_BUTTON
               ' // Send a message to close the application
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_DESTROY
         ' // Close the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

SDK version

Code: [Select]

' ########################################################################################
' Demonstrates the use of the Button_SetImageList and Button_GetImageList
' wrapper functions.
' Requries Windows XP, Windows Vista or Windows 7.
' Copyright (c) 2010 José 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.
' ########################################################################################

#DIM ALL
#COMPILE EXE

'/* header files for imported files */
#INCLUDE ONCE "Windows.inc"
#INCLUDE ONCE "CommCtrl.inc"
#INCLUDE ONCE "ButtonCtrl.inc"

'/* resource file */
#RESOURCE RES, "EX_SDK_Button_SetImageList.res"

' /* Constants */
%IDI_EXIT   = 100
%IDC_BUTTON = 1001

'=========================================================================================
' Main
'=========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL wcex          AS WNDCLASSEX               ' class information
   LOCAL uMsg          AS tagMsg                   ' message information
   LOCAL icc           AS INIT_COMMON_CONTROLSEX   ' specifies common control classes to register
   LOCAL hwnd          AS DWORD                    ' handle of main window
#IF %DEF(%UNICODE)
   LOCAL szClassName   AS WSTRINGZ * %MAX_PATH     ' class name
#ELSE
   LOCAL szClassName   AS ASCIIZ * %MAX_PATH       ' class name
#ENDIF

   ' Register the main window class
   szClassName        = "MainWindow_Class"
   wcex.cbSize        = SIZEOF(wcex)                               ' size of WNDCLASSEX structure
   wcex.style         = %CS_DBLCLKS                                ' class styles
   wcex.lpfnWndProc   = CODEPTR(WndProc)                           ' address of window procedure used by class
   wcex.cbClsExtra    = 0                                          ' extra class bytes
   wcex.cbWndExtra    = 0                                          ' extra window bytes
   wcex.hInstance     = hInstance                                  ' instance of the process that is registering the window
   wcex.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)    ' handle of class icon
   wcex.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)        ' handle of class cursor
   wcex.hbrBackground = %COLOR_BTNFACE + 1                         ' brush used to fill background of window's client area
   wcex.lpszMenuName  = %NULL                                      ' resource identifier of the class menu
   wcex.lpszClassName = VARPTR(szClassName)                        ' class name
   wcex.hIconSm       = %NULL                                      ' handle of small icon shown in caption/system Taskbar
   IF ISFALSE RegisterClassEx(wcex) THEN
      FUNCTION = %TRUE
      EXIT FUNCTION
   END IF

   ' Load the common controls library and specify the classes to register.
   icc.dwSize = SIZEOF(icc)
   icc.dwICC  = %ICC_STANDARD_CLASSES
   InitCommonControlsEx icc

   ' Create the Form1 window
   hwnd = CreateWindowEx(%WS_EX_WINDOWEDGE, _                                          ' extended styles
                         "MainWindow_Class", _                                              ' class name
                         "Button_SetImageList Demo", _                                                         ' caption
                         %WS_OVERLAPPEDWINDOW OR %WS_VISIBLE, _                        ' window styles
                         160, 130, _                                                   ' left, top
                         355, 234, _                                                   ' width, height
                         %NULL, %NULL, _                                               ' handle of owner, menu handle
                         hInstance, BYVAL %NULL)                                       ' handle of instance, creation parameters
   ' If window could not be created, return "failure"
   IF ISFALSE hwnd THEN
      FUNCTION = %FALSE
      EXIT FUNCTION
   END IF

   ' Make the window visible; update its client area
   ShowWindow hwnd, nCmdShow
   UpdateWindow hwnd

   ' Main message loop of program.
   ' Acquire and dispatch messages until a WM_QUIT message is received.
   WHILE ISTRUE GetMessage(uMsg, BYVAL %NULL, 0, 0)
      IF ISFALSE IsDialogMessage(hwnd, uMsg) THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   WEND

   FUNCTION = uMsg.wParam

END FUNCTION
'=========================================================================================

'=========================================================================================
' Processes messages for the main window.
'=========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hButton       AS DWORD                ' handle of the button
   LOCAL hImageList    AS DWORD                ' handle of imagelist control
   LOCAL hFont         AS DWORD                ' handle of font used by button
   LOCAL hIcon         AS DWORD                ' handle of icon
   LOCAL bi            AS BUTTON_IMAGELIST     ' BUTTON_IMAGELIST structure

   SELECT CASE uMsg

      CASE %WM_COMMAND

         SELECT CASE LO(WORD, wParam)

            CASE %IDCANCEL, %IDC_BUTTON
               ' // Send a message to clode the application
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

         END SELECT

      CASE %WM_SETFOCUS
         ' Set the keyboard focus to the first control that is
         ' visible, not disabled, and has the WS_TABSTOP style
         SetFocus GetNextDlgTabItem(hwnd, %NULL, %FALSE)

      CASE %WM_CREATE
         ' Create font used by container
         hFont = GetStockObject(%DEFAULT_GUI_FONT)

         ' Create the OK text button
         hButton = CreateWindowEx(%NULL, _                                             ' extended styles
                                  "Button", _                                          ' class name
                                  "E&xit", _                                           ' caption
                                  %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _         ' window styles
                                  %BS_PUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, _       ' class styles
                                  120, 80, _                                           ' left, top
                                  90, 26, _                                            ' width, height
                                  hwnd, %IDC_BUTTON, _                                 ' handle of parent, control ID
                                  GetModuleHandle(""), BYVAL %NULL)                    ' handle of instance, creation parameters
         SendMessage hButton, %WM_SETFONT, hFont, %TRUE

         ' Create and initialize the image list
         hImageList = ImageList_Create(16, 16, %ILC_MASK OR %ILC_COLOR24, 1, 0)
         IF ISTRUE hImageList THEN
            ' Set the background color to use for drawing images
            ImageList_SetBkColor hImageList, %CLR_NONE
            ' Add the icon to the imagelist
            hIcon = LoadImage(GetModuleHandle(""), BYVAL %IDI_EXIT, %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR)
            ImageList_AddIcon(hImageList, hIcon)
            DeleteObject hIcon
         END IF

         ' Set the imagelist
         bi.himl = hImageList
         bi.uAlign = %BUTTON_IMAGELIST_ALIGN_LEFT
         bi.margin.ntop = 3
         bi.margin.nbottom = 3
         bi.margin.nleft = 3
         bi.margin.nright = 3
         Button_SetImageList(hButton, bi)

      CASE %WM_DESTROY
         ' Destroy the image list
         hButton = GetDlgItem(hwnd, %IDC_BUTTON)
         IF Button_GetImageList(hButton, bi) THEN
            ImageList_Destroy bi.himl
         END IF
         ' // Close the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

END FUNCTION
'=========================================================================================