CWindow Examples

[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_HelloWorld.pbtpl
' Contents: Template - CWindow Hello World
' 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.
' ########################################################################################
#DIM ALL
#COMPILE EXE
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"     ' // CWindow class

' ========================================================================================
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // 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, "CWindow Hello Word", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 300
   ' // Center the window
   pWindow.CenterWindow

   ' // Add two buttons without position or size (they will be resized in the WM_SIZE message).
   pWindow.AddButton(pWindow.hwnd, %IDOK,     "&Ok",   0, 0, 0, 0)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Quit", 0, 0, 0, 0)
   ' // Force resizing of the buttons
   pWindow.Resize

   

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

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

   LOCAL hDC AS DWORD
   LOCAL pPaint AS PAINTSTRUCT
   LOCAL rc AS RECT

   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 the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_PAINT
         ' // Draw the text
         hDC = BeginPaint(hwnd, pPaint)
         GetClientRect hwnd, rc
         SetBkMode hDC, %TRANSPARENT
         SetTextColor hDC, %BLUE
         DrawText hDC, "Hello, World!", -1, rc, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
         EndPaint hwnd, pPaint
         FUNCTION = %TRUE
         EXIT FUNCTION

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Get the client area of the main window
            GetClientRect hwnd, rc
            ' // Resize the buttons
            pWindow.MoveWindow GetDlgItem(hwnd, %IDOK), pWindow.ClientWidth - 185, pWindow.ClientHeight - 35, 75, 23, %TRUE
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 95, pWindow.ClientHeight - 35, 75, 23, %TRUE
         END IF

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_GradientHelloWorld.pbtpl
' Contents: Template - CWindow Hello World with gradient
' 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.
' ########################################################################################
#DIM ALL
#COMPILE EXE
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"     ' // CWindow class

' ========================================================================================
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // 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, "CWindow Hello World with gradient", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 300
   ' // Center the window
   pWindow.CenterWindow

   ' // Add two buttons without position or size (they will be resized in the WM_SIZE message).
   pWindow.AddButton(pWindow.hwnd, %IDOK,     "&Ok",   0, 0, 0, 0)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Quit", 0, 0, 0, 0)

   ' // Force resizing of the buttons
   pWindow.Resize

   

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

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

' ========================================================================================
' Gradient fill procedure
' ========================================================================================
SUB DrawGradient (BYVAL hDC AS DWORD)

   LOCAL rectFill   AS RECT
   LOCAL rectClient AS RECT
   LOCAL fStep      AS SINGLE
   LOCAL hBrush     AS DWORD
   LOCAL lOnBand    AS LONG

   GetClientRect WindowFromDC(hDC), rectClient
   fStep = rectClient.nbottom / 200

   FOR lOnBand = 0 TO 199
      SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
      hBrush = CreateSolidBrush(RGB(0, 0, (255 - lOnBand)))
      FillRect hDC, rectFill, hBrush
      DeleteObject hBrush
   NEXT

END SUB
' ========================================================================================

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

   LOCAL hDC AS DWORD
   LOCAL pPaint AS PAINTSTRUCT
   LOCAL rc AS RECT

   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 the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_PAINT
         ' // Draw the text
         hDC = BeginPaint(hwnd, pPaint)
         GetClientRect hwnd, rc
         SetBkMode hDC, %TRANSPARENT
         SetTextColor hDC, %WHITE
         DrawText hDC, "Hello, World!", -1, rc, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
         EndPaint hwnd, pPaint
         FUNCTION = %TRUE
         EXIT FUNCTION

      CASE %WM_ERASEBKGND
         ' // Draw the gradient
         hDC = wParam
         DrawGradient hDC
         FUNCTION = %TRUE
         EXIT FUNCTION

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the buttons
            pWindow.MoveWindow GetDlgItem(hwnd, %IDOK), pWindow.ClientWidth - 185, pWindow.ClientHeight - 35, 75, 23, %TRUE
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 95, pWindow.ClientHeight - 35, 75, 23, %TRUE
         END IF

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_HTML5_AudioPlayer.pbtpl
' Contents: Template - CWindow with HTML5 Audio Player
' 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.
' ########################################################################################
#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEWEBBROWSER = 1            ' // Use the WebBrowser control
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

' // Identifier
%IDC_WEBBROWSER = 101

' ########################################################################################
' Main
' ########################################################################################
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ 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, "HTML5 Audio Player", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 200
   ' // Center the window
   pWindow.CenterWindow

   ' // Build the html page
   LOCAL s AS WSTRING

   s = "<!doctype html>" & $CRLF
   s += "<head>" & $CRLF
   s += "   <title>Audio Element Sample</title>" & $CRLF
   s += "   <meta http-equiv='X-UA-Compatible' content='IE=9' />" & $CRLF
   s += "</head>" & $CRLF
   s += "<body>" & $CRLF
   s += "    <h1>Audio Element Sample</h1>" & $CRLF
   s += "    <!-- Display the audio player with control buttons. -->" & $CRLF
   s += "    <!-- Remember to change the path of the url of the audio file. -->" & $CRLF
   s += "    <audio src='C:\Users\Pepe\Tests\Kalimba.mp3' controls autoplay loop>" & $CRLF
   s += "        HTML5 audio not supported" & $CRLF
   s += "    </audio>" & $CRLF
   s += "</body>" & $CRLF
   s += "</html>" & $CRLF

   ' // Save the script as a temporary file
   LOCAL bstrTempFileName AS WSTRING
   bstrTempFileName = AfxSaveTempFile(s, "", "TMP", "html", 1)

   ' // Create the WebBrowser control with the embedded map
   pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrTempFileName, NOTHING, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)

   

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

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

   LOCAL rc AS RECT

   SELECT CASE uMsg

      CASE %WM_SYSCOMMAND
         ' // Capture this message and send a WM_CLOSE message
         ' // Note: Needed with some OCXs, that otherwise remain in memory
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Get the client area of the main window
            GetClientRect hwnd, rc
            ' // Resize the control
            MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, LO(WORD, lParam), HI(WORD, lParam), %TRUE
         END IF

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_ListBox.pbtpl
' Contents: Template - CWindow with a ListBox
' 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.
' ########################################################################################
#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"        ' // CWindow class
#INCLUDE ONCE "ListBoxCtrl.inc"    ' // ListBox wrappers

%IDC_LISTBOX = 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
   IF AfxGetWindowsVersion => 6 THEN 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 hwndMain AS DWORD
   hwndMain = pWindow.CreateWindow(%NULL, "CWindow with a ListBox", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Change the window style to avoid flicker
   pWindow.ClassStyle = %CS_DBLCLKS
   ' // Set the client size
   pWindow.SetClientSize(320, 375)
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a listbox
   LOCAL hListBox AS DWORD
   hListBox = pWindow.AddListbox(hwndMain, %IDC_LISTBOX, "", 0, 0, 0, 0)
   pWindow.SetWindowPos hListBox, %NULL, 8, 8, 300, 320, %SWP_NOZORDER

   ' // Fill the list box
   LOCAL i AS LONG
   FOR i = 1 TO 50
      ListBox_AddString(hListBox, "Item " & FORMAT$(i, "00"))
   NEXT

   ' // Select the first item
   ListBox_SetCurSel hListBox, 0

   ' // Add a cancel button
   pWindow.AddButton(hwndMain, %IDCANCEL, "&Cancel", 233, 338, 75, 23)

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

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

   ' // Process window mesages
   SELECT CASE uMsg

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)

            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

            CASE %IDC_LISTBOX
               SELECT CASE HI(WORD, wParam)
                  CASE %LBN_DBLCLK
                     ' // Get the handle of the Listbox
                     LOCAL hListBox AS DWORD
                     hListBox = GetDlgItem(hwnd, %IDC_LISTBOX)
                     ' // Get the current selection
                     LOCAL curSel AS LONG
                     curSel = ListBox_GetCurSel(hListBox)
                     MSGBOX ListBox_GetText(hListBox, curSel)
                     EXIT FUNCTION
               END SELECT

         END SELECT

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_LV_CustomDraw.pbtpl
' Contents: Template - CWindow with a custom draw ListView
' Compilers: PBWIN 10.02+, PBCC 6.02+
' Headers: Windows API headers 2.04+
' 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.
' ########################################################################################

#COMPILE EXE
#DIM ALL

%UNICODE = 1
#INCLUDE ONCE "CWindow.inc"        ' // CWindow class
#INCLUDE ONCE "ListViewCtrl.inc"   ' // ListView 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

   ' // 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, "Custom Draw ListView", 0, 0, 0, 0, 0, 0, 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 ListView control
   LOCAL hListView AS DWORD
   hListView = pWindow.AddListView(hwnd, %IDC_LISTVIEW, "", 0, 0, 0, 0)

   ' // 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)

   ' // Add the header's column names
   LOCAL i AS LONG
   FOR i = 0 TO 4
      ListView_AddColumn(hListView, i, "Column" & STR$(i), 110)
   NEXT

   ' // Populate the ListView with some data
   FOR i = 0 to 29
      ListView_AddItem(hListView, i, 0, "Column 0 Row" + STR$(i))
      ListView_SetItemText(hListView, i, 1, "Column 1 Row" + STR$(i))
      ListView_SetItemText(hListView, i, 2, "Column 2 Row" + STR$(i))
      ListView_SetItemText(hListView, i, 3, "Column 3 Row" + STR$(i))
      ListView_SetItemText(hListView, i, 4, "Column 4 Row" + STR$(i))
   NEXT

   ' // Select the fist item
   ListView_SelectItem hListView, 0
   ' // Set the focus in the ListView
   SetFocus hListView

   ' // 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 pWindow AS IWindow           ' // Reference to the IWindow interface

   LOCAL pNmh  AS NMHDR PTR            ' // Pointer to a NMHDR structure
   LOCAL pLvNm AS NMLISTVIEW PTR       ' // Pointer to a NMLISTVIEW structure
   LOCAL pLvCd AS NMLVCUSTOMDRAW PTR   ' // Pointer to a NMLVCUSTOMDRAW structure

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // 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)
            ' // End the application by sending a %WM_CLOSE message
            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)
            pWindow.MoveWindow hListView, 5, 5, pWindow.ClientWidth - 10, pWindow.ClientHeight - 10, %TRUE
         END IF

      CASE %WM_NOTIFY
         ' // Processs notify messages sent by the list view control
         pNmh = lParam
         SELECT CASE @pNmh.idFrom
            CASE %IDC_LISTVIEW
               pLvNm = lParam
               SELECT CASE @pLvNm.hdr.code
                  CASE %NM_CUSTOMDRAW
                     pLvCd = lParam
                     SELECT CASE @pLvCd.nmcd.dwDrawStage
                        CASE %CDDS_PREPAINT, %CDDS_ITEMPREPAINT
                           ' // Tell the list view to send the %CDDS_ITEMPREPAINT OR %CDDS_SUBITEM notification message
                           FUNCTION = %CDRF_NOTIFYSUBITEMDRAW
                           EXIT FUNCTION
                        CASE %CDDS_ITEMPREPAINT OR %CDDS_SUBITEM
                           IF @pLvCd.iSubItem = 0 THEN
                              ' // Paint the first column with a gray background
                              @pLvCd.clrTextBk = %LTGRAY
                              @pLvCd.clrText = %BLACK
                           ELSE
                              IF (@pLvCd.nmcd.dwItemSpec MOD 2) = 0 THEN
                                 ' // Paint the columns of odd rows with a white background
                                 @pLvCd.clrTextBk = %WHITE
                                 @pLvCd.clrText = %BLACK
                              ELSE
                                 ' // Paint the columns of even rows with a pale turquoise background
                                 @pLvCd.clrTextBk = %RGB_PaleTurquoise
                                 @pLvCd.clrText = %BLACK
                              END IF
                           END IF
                           ' // Tell the list view to draw itself
                           FUNCTION = %CDRF_DODEFAULT
                           EXIT FUNCTION
                     END SELECT
               END SELECT
          END SELECT

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

   END SELECT

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

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_LV_CustomDraw_HDPI.pbtpl
' Contents: Template - CWindow with a custom draw ListView (High DPI)
' Compilers: PBWIN 10.02+, PBCC 6.02+
' Headers: Windows API headers 2.04+
' 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.
' ########################################################################################

#COMPILE EXE
#DIM ALL

%UNICODE = 1
#INCLUDE ONCE "CWindow.inc"        ' // CWindow class
#INCLUDE ONCE "ListViewCtrl.inc"   ' // ListView 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, "Custom Draw ListView (High DPI)", 0, 0, 0, 0, 0, 0, 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 ListView control
   LOCAL hListView AS DWORD
   hListView = pWindow.AddListView(hwnd, %IDC_LISTVIEW, "", 0, 0, 0, 0)

   ' // 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)

   ' // Add the header's column names
   LOCAL i AS LONG
   FOR i = 0 TO 4
      ListView_AddColumn(hListView, i, "Column" & STR$(i), pWindow.ScaleX(110))
   NEXT

   ' // Populate the ListView with some data
   FOR i = 0 to 29
      ListView_AddItem(hListView, i, 0, "Column 0 Row" + STR$(i))
      ListView_SetItemText(hListView, i, 1, "Column 1 Row" + STR$(i))
      ListView_SetItemText(hListView, i, 2, "Column 2 Row" + STR$(i))
      ListView_SetItemText(hListView, i, 3, "Column 3 Row" + STR$(i))
      ListView_SetItemText(hListView, i, 4, "Column 4 Row" + STR$(i))
   NEXT

   ' // Select the fist item
   ListView_SelectItem hListView, 0
   ' // Set the focus in the ListView
   SetFocus hListView

   ' // 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 pWindow AS IWindow           ' // Reference to the IWindow interface

   LOCAL pNmh  AS NMHDR PTR            ' // Pointer to a NMHDR structure
   LOCAL pLvNm AS NMLISTVIEW PTR       ' // Pointer to a NMLISTVIEW structure
   LOCAL pLvCd AS NMLVCUSTOMDRAW PTR   ' // Pointer to a NMLVCUSTOMDRAW structure

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // 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)
            ' // End the application by sending a %WM_CLOSE message
            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)
            pWindow.MoveWindow hListView, 5, 5, pWindow.ClientWidth - 10, pWindow.ClientHeight - 10, %TRUE
         END IF

      CASE %WM_NOTIFY
         ' // Processs notify messages sent by the list view control
         pNmh = lParam
         SELECT CASE @pNmh.idFrom
            CASE %IDC_LISTVIEW
               pLvNm = lParam
               SELECT CASE @pLvNm.hdr.code
                  CASE %NM_CUSTOMDRAW
                     pLvCd = lParam
                     SELECT CASE @pLvCd.nmcd.dwDrawStage
                        CASE %CDDS_PREPAINT, %CDDS_ITEMPREPAINT
                           ' // Tell the list view to send the %CDDS_ITEMPREPAINT OR %CDDS_SUBITEM notification message
                           FUNCTION = %CDRF_NOTIFYSUBITEMDRAW
                           EXIT FUNCTION
                        CASE %CDDS_ITEMPREPAINT OR %CDDS_SUBITEM
                           IF @pLvCd.iSubItem = 0 THEN
                              ' // Paint the first column with a gray background
                              @pLvCd.clrTextBk = %LTGRAY
                              @pLvCd.clrText = %BLACK
                           ELSE
                              IF (@pLvCd.nmcd.dwItemSpec MOD 2) = 0 THEN
                                 ' // Paint the columns of odd rows with a white background
                                 @pLvCd.clrTextBk = %WHITE
                                 @pLvCd.clrText = %BLACK
                              ELSE
                                 ' // Paint the columns of even rows with a pale turquoise background
                                 @pLvCd.clrTextBk = %RGB_PaleTurquoise
                                 @pLvCd.clrText = %BLACK
                              END IF
                           END IF
                           ' // Tell the list view to draw itself
                           FUNCTION = %CDRF_DODEFAULT
                           EXIT FUNCTION
                     END SELECT
               END SELECT
          END SELECT

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

   END SELECT

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

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


[José Roca]

Code Select Expand


' ########################################################################################
' 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
   IF AfxGetWindowsVersion => 6 THEN 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]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_MDI.pbtpl
' Contents: Template - CWindow MDI Framwwork
' 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.
' ########################################################################################
#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEMDI = 1                   ' // Use MDI
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

' // Edit control identifier
%IDC_EDIT     = 101

' // Menu identifiers
%IDM_NEW      = 1001   ' New file
%IDM_OPEN     = 1002   ' Open file...
%IDM_SAVE     = 1003   ' Save file
%IDM_SAVEAS   = 1004   ' Save file as...
%IDM_EXIT     = 1005   ' Exit

%IDM_UNDO     = 2001   ' Undo
%IDM_CUT      = 2002   ' Cut
%IDM_COPY     = 2003   ' Copy
%IDM_PASTE    = 2004   ' Paste

%IDM_TILEH    = 3001   ' Tile hosizontal
%IDM_TILEV    = 3002   ' Tile vertical
%IDM_CASCADE  = 3003   ' Cascade
%IDM_ARRANGE  = 3004   ' Arrange icons
%IDM_CLOSE    = 3005   ' Close
%IDM_CLOSEALL = 3006   ' Close all


' ########################################################################################
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // 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, "MDI with CWindow", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Change the window style to avoid flicker
   pWindow.ClassStyle = %CS_DBLCLKS
   ' // Set the client size
   pWindow.SetClientSize 650, 400
   ' // Center the window
   pWindow.CenterWindow

   ' // Create a menu
   LOCAL hMenu AS DWORD
   hMenu = BuildMenu
   SetMenu pWindow.hwnd, hMenu

   '// Create a MDI client child window
   LOCAL hwindowMenu AS DWORD
   hwindowMenu = GetSubMenu(hMenu, 2)
   pWindow.CreateMDIWindow(101, 0, 0, 0, 0, 0, 0, hwindowMenu, CODEPTR(MDIWindowProc))

   

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

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

' ========================================================================================
' Build the menu
' ========================================================================================
FUNCTION BuildMenu () AS DWORD

   LOCAL hMenu AS DWORD
   LOCAL hPopUpMenu AS DWORD

   hMenu = CreateMenu
   hPopUpMenu = CreatePopUpMenu
      AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hPopUpMenu, "&File"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_NEW, "&New" & $TAB & "Ctrl+N"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_OPEN, "&Open..." & $TAB & "Ctrl+O"
         AppendMenu hPopUpMenu, %MF_SEPARATOR, 0, ""
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_SAVE, "&Save" & $TAB & "Ctrl+S"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_SAVEAS, "Save &As..."
         AppendMenu hPopUpMenu, %MF_SEPARATOR, 0, ""
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_EXIT, "E&xit" & $TAB & "Alt+F4"
   hPopUpMenu = CreatePopUpMenu
      AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hPopUpMenu, "&Edit"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_UNDO, "&Undo" & $TAB & "Ctrl+Z"
         AppendMenu hPopUpMenu, %MF_SEPARATOR, 0, ""
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_CUT, "Cu&t" & $TAB & "Ctrl+X"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_COPY, "&Copy" & $TAB & "Ctrl+C"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_PASTE, "&Paste" & $TAB & "Ctrl+V"
   hPopUpMenu = CreatePopUpMenu
      AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hPopUpMenu, "&Window"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_TILEH, "&Tile Horizontal"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_TILEV, "Tile &Vertical"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_CASCADE, "Ca&scade"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_ARRANGE, "&Arrange &Icons"
         AppendMenu hPopUpMenu, %MF_SEPARATOR, 0, ""
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_CLOSE, "&Close" & $TAB & "Ctrl+F4"
         AppendMenu hPopUpMenu, %MF_ENABLED, %IDM_CLOSEALL, "Close &All"
   FUNCTION = hMenu

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

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

   LOCAL hwndClient AS DWORD    ' // Handle of the MDI client window
   LOCAL hwndActive AS DWORD    ' // Active window
   LOCAL ptnmhdr AS NMHDR PTR   ' // Information about a notification message
   LOCAL hMdi AS DWORD          ' // MDI child window handle
   STATIC nIdx AS LONG          ' // Counter

   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

   ' // MDI client window handle
   hwndClient = CWindow_GetMDIClientHandle(hwnd)

   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_SYSCOMMAND
         ' // Capture this message and send a WM_CLOSE message
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      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

            ' // New window
            CASE %IDM_NEW
               IF hwndClient THEN
                  nIdx += 1
                  hMdi = CreateMdiChild("PBFrameClass", hwndClient, "", 0)
'                  hMdi = CreateMdiChild("PBFrameClass", hwndClient, "", %WS_MAXIMIZE)
                  SetWindowText hMdi, "MDI Child Window" & STR$(nIdx)
               END IF
               EXIT FUNCTION

            ' // Tile horizontally
            CASE %IDM_TILEH
               IF hwndClient THEN SendMessage hwndClient, %WM_MDITILE, %MDITILE_HORIZONTAL, 0
               EXIT FUNCTION

            ' // Tile vertically
            CASE %IDM_TILEV
               IF hwndClient THEN SendMessage hwndClient, %WM_MDITILE, %MDITILE_VERTICAL, 0
               EXIT FUNCTION

            ' // Cascade windows
            CASE %IDM_CASCADE
               IF hwndClient THEN SendMessage hwndClient, %WM_MDICASCADE, 0, 0
               EXIT FUNCTION

            ' // Arrange icons
            CASE %IDM_ARRANGE
               IF hwndClient THEN SendMessage hwndClient, %WM_MDIICONARRANGE, 0, 0
               EXIT FUNCTION

            CASE %IDM_CLOSE
               ' // Close the active window
               IF hwndClient THEN
                  hwndActive = SendMessage(hwndClient, %WM_MDIGETACTIVE, 0, 0)
                  IF ISTRUE SendMessage(hwndActive, %WM_QUERYENDSESSION, 0, 0) THEN
                     SendMessage hwndClient, %WM_MDIDESTROY, hwndActive, 0
                  END IF
               END IF
               EXIT FUNCTION

            CASE %IDM_CLOSEALL
               ' // Close all the MDI child windows
               IF hwndClient THEN
                  EnumChildWindows hwndClient, CODEPTR(CWindow_CloseEnumProc), 0
               END IF
               EXIT FUNCTION

            ' // Exit the application
            CASE %IDM_EXIT
               SendMessage hwnd, %WM_CLOSE, 0, 0
               EXIT FUNCTION

         END SELECT

         ' // Pass unprocessed messages to the active MDI child and then to DefFrameProc()
         hwndActive = SendMessage(hwndClient, %WM_MDIGETACTIVE, 0, 0)
         IF IsWindow(hwndActive) THEN SendMessage hwndActive, %WM_COMMAND, wParam, lParam

      CASE %WM_NOTIFY
         ptnmhdr = lParam
         SELECT CASE @ptnmhdr.idFrom
            ' ...
            ' ...
         END SELECT

         ' // Pass unprocessed messages to the active MDI child and then to DefFrameProc()
         hwndActive = SendMessage(hwndClient, %WM_MDIGETACTIVE, 0, 0)
         IF ISTRUE IsWindow(hwndActive) THEN SendMessage hwndActive, %WM_NOTIFY, wParam, lParam

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            IF hwndClient THEN
               pWindow.MoveWindow hwndClient, 0, 0, pWindow.ClientWidth + 2, pWindow.ClientHeight + 2, %TRUE
            END IF
         END IF
         ' // Note: This message is not passed to DefFrameProc when space
         ' // is being reserved in the client area of the MDI frame
         ' // or controls on the MDI frame are resizeable.
         EXIT FUNCTION

      CASE %WM_CLOSE

         ' // Attempt to close all MDI child windows
         EnumChildWindows hwndClient, CODEPTR(CWindow_CloseEnumProc), 0
         ' // If child windows are still open abort closing the application
         IF GetWindow(hwndClient, %GW_CHILD) THEN EXIT FUNCTION

      CASE %WM_QUERYENDSESSION

         ' // Attempt to close all MDI child windows
         EnumChildWindows hwndClient, CODEPTR(CWindow_CloseEnumProc), 0
         ' // If child windows are still open abort closing the application
         IF GetWindow(hwndClient, %GW_CHILD) THEN EXIT FUNCTION

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

   END SELECT

   IF hwndClient THEN
   ' // The DefFrameProc function provides default processing for any window
   ' // messages that the window procedure of a multiple-document interface (MDI)
   ' // frame window does not process. All window messages that are not explicitly
   ' // processed by the window procedure must be passed to the DefFrameProc
   ' // function, not the DefWindowProc function.
      FUNCTION = DefFrameProc(hwnd, hwndClient, uMsg, wParam, lParam)
   ELSE
   ' // The DefWindowProc function calls the default window procedure to provide
   ' // default processing for any window messages that an application does not process.
   ' // This function ensures that every message is processed. DefWindowProc
   ' // is called with the same parameters received by the window procedure.
      FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
   END IF

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

' ========================================================================================
' Default CWindow MDI callback function.
' ========================================================================================
FUNCTION MDIWindowProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hEdit AS DWORD
   LOCAL rc AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' // Retrieve a reference to the CWindow class from the MDI child window handle
         LOCAL pWindow AS IWindow
         pWindow = CWindow_GetObjectFromWindowHandle(hwnd)
         ' // Create and edit control control
         IF ISOBJECT(pWindow) THEN
            GetClientRect hwnd, rc
            pWindow.AddTextBox(hwnd, %IDC_EDIT, "", 0, 0, rc.nRight, rc.nBottom, _
               %WS_CHILD OR %WS_VISIBLE OR %ES_MULTILINE OR %WS_VSCROLL OR %WS_HSCROLL OR %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR %ES_WANTRETURN OR %ES_NOHIDESEL, 0)
            EXIT FUNCTION
         END IF

'      CASE %WM_MDIACTIVATE
'         IF lParam = hwnd THEN
'         END IF
'         EXIT FUNCTION

      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_SIZE
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the window and/or its controls
            hEdit = GetDlgItem(hwnd, %IDC_EDIT)
            MoveWindow hEdit, 0, 0, LO(WORD, lParam), HI(WORD, lParam), %TRUE
         END IF

         ' Don't exit. Let DefMDIChildProc to process the message for
         ' properly resizing of the MDI child window.

'      CASE %WM_DESTROY
'         ' // Do cleanup if needed, such removing properties attached
'         ' // to the MDI child window.
'         EXIT FUNCTION

   END SELECT

   ' // The DefMDIChildProc function provides default processing for any window
   ' // message that the window procedure of a multiple-document interface (MDI)
   ' // child window does not process. A window message not processed by the window
   ' // procedure must be passed to the DefMDIChildProc function, not to the
   ' // DefWindowProc function.
   FUNCTION = DefMDIChildProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEOLECON = 1                ' // Use OLE container
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

%IDC_OCX = 101

' ========================================================================================
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // 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, "CWindow with OCX", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 300, 300
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a MS Calendar control
   LOCAL hCtl AS DWORD
   hCtl = pWindow.AddOCX(pWindow.hwnd, %IDC_OCX, "MSCAL.Calendar", "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   SetFocus hCtl

   

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

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

   ' // Process window mesages
   SELECT CASE uMsg

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEOLECON = 1                ' // Use OLE container
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "MSCAL.INC"     ' // MSCalendar interfaces

%IDC_OCX = 101

' ========================================================================================
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // 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, "CWindow with OCX and Events", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 300, 300
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a MS Calendar control
   LOCAL hCtl AS DWORD
   hCtl = pWindow.AddOCX(pWindow.hwnd, %IDC_OCX, "MSCAL.Calendar", "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   SetFocus hCtl

   ' // Connect events
   LOCAL pCalEvents AS DCalendarEventsImpl
   pCalEvents = CLASS "CDCalendarEvents"
   IF ISOBJECT(pCalEvents) THEN OC_Advise(hCtl, pCalEvents)

   

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

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

   ' // Process window mesages
   SELECT CASE uMsg

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


' ########################################################################################
' Class CDCalendarEvents
' Interface name = DCalendarEvents
' IID = {8E27C92D-1264-101C-8A2F-040224009C02}
' Event interface for Calendar control
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' ########################################################################################

CLASS CDCalendarEvents GUID$("{D4A44440-33A2-4A55-B0AB-30D70B127E3C}") AS EVENT

INTERFACE DCalendarEventsImpl GUID$("{8E27C92D-1264-101C-8A2F-040224009C02}") AS EVENT

  INHERIT IDispatch

   ' =====================================================================================
   METHOD Click <-600>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DblClick <-601>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyDown <-602> ( _
     BYREF KeyCode AS INTEGER _                         ' __out short *KeyCode
   , BYVAL iShift AS INTEGER _                          ' __in  short Shift
   )                                                    ' void

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyPress <-603> ( _
     BYREF KeyAscii AS INTEGER _                        ' __out short *KeyAscii
   )                                                    ' void

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyUp <-604> ( _
     BYREF KeyCode AS INTEGER _                         ' __out short *KeyCode
   , BYVAL iShift AS INTEGER _                          ' __in  short Shift
   )                                                    ' void

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD BeforeUpdate <2> ( _
     BYREF iCancel AS INTEGER _                         ' __out short *Cancel
   )                                                    ' void

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD AfterUpdate <1>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD NewMonth <3>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD NewYear <4>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

END INTERFACE

END CLASS


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
%USEOLECON = 1                ' // Use OLE container
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "MSCAL.INC"     ' // MSCalendar interfaces

%IDC_OCX = 101

' ========================================================================================
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // 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, "CWindow with OCX and PB Events", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 300, 300
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a MS Calendar control
   LOCAL hCtl AS DWORD
   hCtl = pWindow.AddOCX(pWindow.hwnd, %IDC_OCX, "MSCAL.Calendar", "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   SetFocus hCtl

   ' // Get the IDispatch of the control
   LOCAL pCal AS MSCAL_ICalendar
   LOCAL pCalEvents AS DCalendarEventsImpl
   pCal = OC_GetDispatch(hCtl)
   IF ISOBJECT(pCal) THEN
      ' // Connect events
      pCalEvents = CLASS "CDCalendarEvents"
      IF ISOBJECT(pCalEvents) THEN EVENTS FROM pCal CALL pCalEvents
      pCal = NOTHING
   END IF

   

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

   ' // Disconnect events
   IF ISOBJECT(pCalEvents) THEN EVENTS END pCalEvents

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

   ' // Process window mesages
   SELECT CASE uMsg

      CASE %WM_COMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


' ########################################################################################
' Class CDCalendarEvents
' Interface name = DCalendarEvents
' IID = {8E27C92D-1264-101C-8A2F-040224009C02}
' Event interface for Calendar control
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' ########################################################################################

CLASS CDCalendarEvents GUID$("{D4A44440-33A2-4A55-B0AB-30D70B127E3C}") AS EVENT

INTERFACE DCalendarEventsImpl GUID$("{8E27C92D-1264-101C-8A2F-040224009C02}") AS EVENT

  INHERIT IDispatch

   ' =====================================================================================
   METHOD Click <-600>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD DblClick <-601>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyDown <-602> ( _
     BYREF KeyCode AS INTEGER _                         ' __out short *KeyCode
   , BYVAL iShift AS INTEGER _                          ' __in  short Shift
   )                                                    ' void

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyPress <-603> ( _
     BYREF KeyAscii AS INTEGER _                        ' __out short *KeyAscii
   )                                                    ' void

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD KeyUp <-604> ( _
     BYREF KeyCode AS INTEGER _                         ' __out short *KeyCode
   , BYVAL iShift AS INTEGER _                          ' __in  short Shift
   )                                                    ' void

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD BeforeUpdate <2> ( _
     BYREF iCancel AS INTEGER _                         ' __out short *Cancel
   )                                                    ' void

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD AfterUpdate <1>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD NewMonth <3>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

   ' =====================================================================================
   METHOD NewYear <4>

     ' *** Insert your code here ***
     OutputDebugString FUNCNAME$

   END METHOD
   ' =====================================================================================

END INTERFACE

END CLASS


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"    ' // CWindow class
#INCLUDE ONCE "commdlg.inc"    ' // Common dialogs

' ========================================================================================
' SDK open file dialog.
' ========================================================================================
SUB SdkOpenFileDialog (BYVAL hwnd AS DWORD)

   LOCAL i                AS LONG
   LOCAL nCount           AS LONG
   LOCAL dwStyle          AS DWORD
   LOCAL bstrInitialDir   AS WSTRING
   LOCAL bstrFileSpec     AS WSTRING
   LOCAL bstrDefExtension AS WSTRING
   LOCAL bstrFilter       AS WSTRING
   LOCAL bstrPath         AS WSTRING
   LOCAL bstrFile         AS WSTRING

   bstrInitialDir = CURDIR$
   bstrFileSpec = "*.BAS;*.INC"
   bstrDefExtension = "BAS"
   bstrFilter  = "PB Code Files (*.BAS)|*.BAS|"
   bstrFilter += "PB Include Files (*.INC)|*.INC|"
   bstrFilter += "PB Template Files (*.PBTPL)|*.PBTPL|"
   bstrFilter += "All Files (*.*)|*.*"
   dwStyle = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_ALLOWMULTISELECT

   IF AfxOpenFileDialog(hwnd, "", bstrFileSpec, bstrInitialDir, bstrFilter, bstrDefExtension, dwStyle) THEN
      bstrFileSpec = RTRIM$(bstrFileSpec, CHR$(0))
      nCount = PARSECOUNT(bstrFileSpec, CHR$(0))
      IF nCount = 1 THEN
         ' // Do whatever you need with the file
         MSGBOX bstrFileSpec
      ELSE
         bstrPath = PARSE$(bstrFileSpec, CHR$(0), 1)
         IF RIGHT$(bstrPath, 1) <> "\" THEN bstrPath = bstrPath & "\"
         FOR i = 2 TO nCount
            bstrFile = PARSE$(bstrFileSpec, CHR$(0), i)
            IF LEN(bstrFile) THEN
               ' // Do whatever you need with the file
               MSGBOX bstrPath & bstrFile
            END IF
         NEXT
      END IF
   END IF

END SUB
' ========================================================================================

' ========================================================================================
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // 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, "CWindow with Open File Dialog", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add buttons
   pWindow.AddButton(pWindow.hwnd, %IDOK, "&Start", 0, 0, 75, 23)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23)


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

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 %IDOK
               SdkOpenFileDialog(hwnd)
               EXIT FUNCTION

            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the sample button
            pWindow.MoveWindow GetDlgItem(hwnd, %IDOK), pWindow.ClientWidth - 195, pWindow.ClientHeight - 35, 75, 23, %TRUE
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 95, pWindow.ClientHeight - 35, 75, 23, %TRUE
         END IF

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Include files for external files
#INCLUDE ONCE "CWindow.inc"          ' // CWindow class
#INCLUDE ONCE "CAfxFileDialog.inc"   ' // Open File Dialog class

' ========================================================================================
' Open file dialog (class).
' ========================================================================================
SUB OpenFileDialogClass (BYVAL hwnd AS DWORD)

   LOCAL pofd AS IAfxFileDialog
   pofd = CLASS "CAfxFileDialog"
   IF ISNOTHING(pofd) THEN EXIT SUB

   pofd.DefaultFolder = CURDIR$
   pofd.FileName = "*.BAS;*.INC"
   pofd.DefaultExtension = "BAS"
   pofd.Filter = CHR$("PB Code Files (*.BAS)", 0, "*.BAS", 0) & _
                 CHR$("PB Include Files (*.INC)", 0, "*.INC", 0) & _
                 CHR$("PB Template Files (*.PBTPL)", 0, "*.PBTPL", 0) & _
                 CHR$("All Files (*.*)", 0, "*.*", 0)
   pofd.Options = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_ALLOWMULTISELECT
   IF pofd.ShowOpenDialog THEN
      LOCAL pFiles AS IPowerCollection
      LOCAL vFile AS VARIANT
      pFiles = pofd.Files
      ? "Selected path: " & pofd.SelectedPath
      FOR EACH vFile IN pFiles
         ? VARIANT$$(vFile)
      NEXT
   END IF

END SUB
' ========================================================================================

' ========================================================================================
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   ' // Note: CW_USEDEFAULT is used as the default value When passing 0's as the width and height
   pWindow.CreateWindow(%NULL, "CWindow with Open File Dialog", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add buttons
   pWindow.AddButton(pWindow.hwnd, %IDOK, "&Start", 0, 0, 75, 23)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23)


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

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 %IDOK
               OpenFileDialogClass(hwnd)
               EXIT FUNCTION

            CASE %IDCANCEL
               ' // If the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the sample button
            pWindow.MoveWindow GetDlgItem(hwnd, %IDOK), pWindow.ClientWidth - 195, pWindow.ClientHeight - 35, 75, 23, %TRUE
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 95, pWindow.ClientHeight - 35, 75, 23, %TRUE
         END IF

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


' ########################################################################################
' Renders a spinning colored triangle controlled with both the TIMER function and the mouse.
' This version uses the CWindow class and the GlCtx graphic control
' Compilers: PBWIN 10.01+, PBCC 6.01+
' Headers: Windows API headers 2.02+
' ########################################################################################

#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Header files for imported files
%USEGLCTX = 1
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "GlCtx.inc"     ' // OpenGL control

$WindowCaption = "OpenGL - Spinning Triangle"

%IDC_GLCTX = 1001

GLOBAL pGL AS ISpinningTrianle

' =======================================================================================
' Spinning triangle class
' =======================================================================================
CLASS CSpinningTrianle

   INTERFACE ISpinningTrianle : INHERIT IUnknown

   ' ====================================================================================
   ' All the setup goes here
   ' ====================================================================================
   METHOD SetupScene
      ' // Specify clear values for the color buffers
      glClearColor 0.0!, 0.0!, 0.0!, 0.0!
   END METHOD
   ' ====================================================================================

   ' ====================================================================================
   ' Resizes the scene
   ' ====================================================================================
   METHOD ResizeScene (BYVAL hCtl AS DWORD)
      ' // Get the dimensions of the window
      LOCAL nWidth, nHeight AS LONG
      AfxGetWindowSize(hCtl, nWidth, nHeight)
      ' // Prevent divide by zero making height equal one
      IF nHeight = 0 THEN nHeight = 1
      ' // Reset the current viewport
      glViewport 0, 0, nWidth, nHeight
      ' // Select the projection matrix
      glMatrixMode %GL_PROJECTION
      ' // Reset the projection matrix
      glLoadIdentity
      ' // Calculate the aspect ratio of the window
      gluPerspective 65.0!, nWidth / nHeight, 1.0!, 100.0!
      ' // Select the model view matrix
      glMatrixMode %GL_MODELVIEW
      ' // Reset the model view matrix
      glLoadIdentity
   END METHOD
   ' ====================================================================================

   ' ====================================================================================
   ' Draws the scene
   ' ====================================================================================
   METHOD DrawScene (BYVAL hCtl AS DWORD)

      ' // Get the dimensions of the window
      LOCAL nWidth, nHeight AS LONG
      AfxGetWindowSize(hCtl, nWidth, nHeight)

      LOCAL pt AS POINTAPI
      LOCAL t AS DOUBLE

      GetCursorPos pt
      t = TIMER

      glClear %GL_COLOR_BUFFER_BIT

      ' // Select and setup the modelview matrix
      glMatrixMode %GL_MODELVIEW
      glLoadIdentity
      gluLookAt 0.0!,  1.0!, 0.0!, _   ' Eye-position
                0.0!, 20.0!, 0.0!, _   ' View-point
                0.0!,  0.0!, 1.0!      ' Up-vector

      ' // Draw a rotating colorful triangle
      glTranslatef 0.0!, 14.0!, 0.0!
      glRotatef 0.3! * pt.x + t * 100.0!, 0.0!, 0.0!, 1.0!
      glBegin %GL_TRIANGLES
         glColor3f   1.0!, 0.0!,  0.0!
         glVertex3f -5.0!, 0.0!, -4.0!
         glColor3f   0.0!, 1.0!,  0.0!
         glVertex3f  5.0!, 0.0!, -4.0!
         glColor3f   0.0!, 0.0!,  1.0!
         glVertex3f  0.0!, 0.0!,  6.0!
      glEnd

      ' // Required: Force execution of GL commands in finite time
      glFlush

      ' // Required: Force repainting of the control
      InvalidateRect hCtl, BYVAL %NULL, %TRUE

   END METHOD
   ' ====================================================================================

   ' ====================================================================================
   ' Processes keystrokes
   ' Parameters:
   ' * hwnd = Window hande
   ' * vKeyCode = Virtual key code
   ' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
   ' ====================================================================================
   METHOD ProcessKeystrokes (BYVAL hwnd AS DWORD, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)
      SELECT CASE AS LONG vKeyCode
         CASE %VK_ESCAPE
            ' // Quit if Esc key pressed
            SendMessage hwnd, %WM_CLOSE, 0, 0
      END SELECT
   END METHOD
   ' ====================================================================================

   END INTERFACE

END CLASS
' =======================================================================================

' ========================================================================================
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

   ' // Create an instance of the CWindow 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, "CWindow with a OpenGL Graphic Control", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 600, 380
   ' // Center the window
   pWindow.CenterWindow

   ' // Create an instance of the OpenGL lesson class
   pGL = CLASS "CSpinningTrianle"
   IF ISNOTHING(pGL) THEN EXIT FUNCTION

   ' // Add an OpenGL aware graphic control
   LOCAL hCtl AS DWORD
   hCtl = pWindow.AddGlCtx(hwnd, %IDC_GLCTX, "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   GlCtx_SetResizable hCtl, %TRUE   ' // Make the control resizable

   ' // Show the window
   ShowWindow hwnd, nCmdShow
   UpdateWindow hwnd

   ' // Process Windows messages
   LOCAL bDone    AS LONG
   LOCAL vKeyCode AS LONG
   LOCAL bKeyDown AS LONG
   LOCAL msg      AS tagMSG

   DO UNTIL bDone

      ' // Windows message pump
      DO WHILE PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE)
         IF msg.message = %WM_QUIT THEN
            bDone = %TRUE
         ELSE
            IF msg.message = %WM_KEYDOWN THEN
               vKeyCode = msg.wParam
               bKeyDown = %TRUE
            ELSEIF msg.message = %WM_KEYUP THEN
               vKeyCode = msg.wParam
               bKeyDown = %FALSE
            END IF
            TranslateMessage msg
            DispatchMessage msg
         END IF
      LOOP

      ' // Calculate and display the number of frames per second
      LOCAL t         AS DOUBLE
      LOCAL t0        AS DOUBLE
      LOCAL fps       AS DOUBLE
      LOCAL nFrames   AS LONG
      LOCAL szCaption AS WSTRINGZ * 256

      t = INT(TIMER)
      IF t > t0 OR nFrames = 0 THEN
         fps = nFrames \ (t - t0)
         wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps
         SetWindowText hwnd, szCaption
         t0 = t
         nFrames = 0
      END IF
      nFrames = nFrames + 1

      ' // Draw the scene
      pGL.DrawScene(hCtl)

      ' // Process the keystrokes
      IF vKeyCode THEN
         pGL.ProcessKeystrokes(hwnd, vKeyCode, bKeyDown)
         vKeyCode = 0
      END IF

   LOOP

   FUNCTION = msg.wParam

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_SYSCOMMAND
         ' // Close the window
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         LOCAL hCtl AS DWORD
         hCtl = GetDlgItem(hwnd, %IDC_GLCTX)
         IF wParam <> %SIZE_MINIMIZED THEN
            ' // Resize the control
            pWindow.MoveWindow hCtl, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
            ' // Resize and render the OpenGL scene
            IF ISOBJECT(pGL) THEN
               pGL.SetupScene          ' // Setup the scene
               pGL.ResizeScene(hCtl)   ' // Resize the scene
               pGL.DrawScene(hCtl)     ' // Draw the scene
            END IF
         END IF

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


#COMPILE EXE
#DIM ALL
%UNICODE = 1

' // Header files for imported files
%USEGLCTX = 1
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "GlCtx.inc"     ' // GLCtx control

%IDC_GLCTX = 1001

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Specify clear values for the color buffers
   glClearColor 0.0!, 0.0!, 0.0!, 0.0!
   ' Specify the clear value for the depth buffer
   glClearDepth 1.0!
   ' Specify the value used for depth-buffer comparisons
   glDepthFunc %GL_LESS
   ' Enable depth comparisons and update the depth buffer
   glEnable %GL_DEPTH_TEST
   ' Select smooth shading
   glShadeModel %GL_SMOOTH

END SUB
' =======================================================================================

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Prevent divide by zero making height equal one
   IF nHeight = 0 THEN nHeight = 1
   ' Reset the current viewport
   glViewport 0, 0, nWidth, nHeight
   ' Select the projection matrix
   glMatrixMode %GL_PROJECTION
   ' Reset the projection matrix
   glLoadIdentity
   ' Calculate the aspect ratio of the window
   gluPerspective 45.0!, nWidth / nHeight, 0.1!, 100.0!
   ' Select the model view matrix
   glMatrixMode %GL_MODELVIEW
   ' Reset the model view matrix
   glLoadIdentity

END SUB
' =======================================================================================

' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Clear the screen buffer
   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   ' Reset the view
   glLoadIdentity

   ' ------------------------------------------------------------------------------------
   ' Insert your code here
   ' ------------------------------------------------------------------------------------

   ' // Sample code

   glTranslatef -1.5!, 0.0!, -6.0!       ' Move left 1.5 units and into the screen 6.0

   glBegin %GL_TRIANGLES                 ' Drawing using triangles
      glColor3f   1.0!, 0.0!, 0.0!       ' Set the color to red
      glVertex3f  0.0!, 1.0!, 0.0!       ' Top
      glColor3f   0.0!, 1.0!, 0.0!       ' Set the color to green
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glColor3f   0.0!, 0.0!, 1.0!       ' Set the color to blue
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Finished drawing the triangle

   glTranslatef 3.0!,0.0!,0.0!           ' Move right 3 units

   glColor3f 0.5!, 0.5!, 1.0!            ' Set the color to blue one time only
   glBegin %GL_QUADS                     ' Draw a quad
      glVertex3f -1.0!, 1.0!, 0.0!       ' Top left
      glVertex3f  1.0!, 1.0!, 0.0!       ' Top right
      glVertex3f  1.0!,-1.0!, 0.0!       ' Bottom right
      glVertex3f -1.0!,-1.0!, 0.0!       ' Bottom left
   glEnd                                 ' Done drawing the quad

   ' // Required: force execution of GL commands in finite time
   glFlush

END SUB
' =======================================================================================

' ========================================================================================
' 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
   IF AfxGetWindowsVersion => 6 THEN SetProcessDPIAware

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

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "CWindow OpenGL Graphic Control Resizable", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 600, 380
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a GDI+ aware graphic control
   LOCAL hCtl AS DWORD
   hCtl = pWindow.AddGlCtx(pWindow.hwnd, %IDC_GLCTX, "", 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
   GlCtx_SetResizable hCtl, %TRUE

   

   ' // Render the scene
   SetupScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight
   ResizeScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight
   DrawScene hCtl, pWindow.ClientWidth, pWindow.ClientHeight

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

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 the Escape key has been pressed...
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  ' // ... close the application by sending a WM_CLOSE message
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> %SIZE_MINIMIZED THEN
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_GLCTX), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
            ' // Resize and render the OpenGL scene
            ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
            DrawScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
         END IF

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

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)

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