CWindow Examples

[James C. Fuller]

José,
  Are there any more extensive examples using CWindow.
I only find one or two examples in the Windows API Programming section.

I would very much like to see an example of all (or most) of the controls available with your wrappers if possible.

Maybe just one CWindow with a lot of controls squeezed in or separate demos for each one would be nice.

Thank you for all your hard work.

James

[José Roca]

Adding controls has not any mystery. You just call the approprite AddXXX method. Most of them have the same parameters.

Some examples:

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_BufferedAnimation.pbtpl
' Contents: Template - Demonstrates the use of BeginBufferedAnimation.
' Click the left mouse button of the mouse to start the animation.
' Minimum operating systems: Windows Vista, Windows 7
' Compilers: PBWIN 10.02+, PBCC 6.02+
' Headers: Windows API headers 2.03+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk.
' Portions Copyright (c) Microsoft Corporation. All Rights Reserved.
' 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

' // Header files for imported files
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "uxtheme.inc"

%ANIMATION_DURATION = 500

' ========================================================================================
' Paints the icon
' ========================================================================================
SUB PaintIt (BYVAL hwnd AS DWORD, BYVAL hdc AS DWORD, BYVAL nState AS LONG)

   LOCAL rc AS RECT
   GetClientRect(hwnd, rc)
   FillRect(hdc, rc, GetStockObject(%WHITE_BRUSH))
   LoadIcon (%NULL, BYVAL %IDI_APPLICATION)
   LOCAL IconId AS LONG
   IconId = IIF&(nState = 1, %IDI_APPLICATION, %IDI_ERROR)
   LOCAL hIcon AS DWORD
   hIcon = LoadIcon(%NULL, BYVAL IconId)
   IF hIcon THEN
      DrawIcon(hdc, 10, 10, hIcon)
      DestroyIcon(hIcon)
   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

   ' // Required: Initialize buffered painting for the current thread.
   IF FAILED(BufferedPaintInit) THEN EXIT FUNCTION

   ' // 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, "BufferedPaintSample_WndClass", 0, 0, 0, 0, -1, -1, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 400, 250
   ' // Center the window
   pWindow.CenterWindow

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

   ' // Required: Closes down buffered painting for the current thread.
   BufferedPaintUnInit

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                            ' // Device context handle
   LOCAL ps AS PAINTSTRUCT                       ' // PAINTSTRUCT structure
   LOCAL animParams AS BP_ANIMATIONPARAMS        ' // Animation parameters
   LOCAL hbpAnimation AS DWORD                   ' // Handle to the buffered paint animation
   LOCAL hdcFrom AS DWORD                        ' // Handle of the DC where the application should paint the initial state of the animation
   LOCAL hdcTo AS DWORD                          ' // Handle of the DC where the application should paint the final state of the animation
   LOCAL rc AS RECT                              ' // Coordinates of the window's client area
   STATIC fCurrentState AS LONG                  ' // Boolean flag
   STATIC fNewState AS LONG                      ' // Boolean flag

   SELECT CASE uMsg

      CASE %WM_CREATE
         fCurrentState = %TRUE
         fNewState = %TRUE

      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_LBUTTONDOWN
         ' // Start animation
         fNewState = NOT fCurrentState
         InvalidateRect(hwnd, BYVAL %NULL, %TRUE)
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         IF hdc THEN
            ' // See if this paint was generated by a soft-fade animation
            IF ISFALSE BufferedPaintRenderAnimation(hwnd, hdc) THEN
               animParams.cbSize = SIZEOF(BP_ANIMATIONPARAMS)
               animParams.style = %BPAS_LINEAR
               ' // Check if animation is needed. If not set dwDuration to 0
               animParams.dwDuration = IIF&(fCurrentState <> fNewState, %ANIMATION_DURATION, 0)
               GetClientRect(hwnd, rc)
               hbpAnimation = BeginBufferedAnimation(hwnd, hdc, rc, _
                  %BPBF_COMPATIBLEBITMAP, BYVAL %NULL, animParams, hdcFrom, hdcTo)
               IF hbpAnimation THEN
                  IF hdcFrom THEN
                     PaintIt(hwnd, hdcFrom, fCurrentState)
                  END IF
                  IF hdcTo THEN
                     PaintIt(hwnd, hdcTo, fNewState)
                  END IF
                  fCurrentState = fNewState
                  EndBufferedAnimation(hbpAnimation, %TRUE)
               ELSE
                  PaintIt(hwnd, hdc, fCurrentState)
               END IF
            END IF
            EndPaint hwnd, ps
         END IF
         EXIT FUNCTION

      CASE %WM_SIZE
         BufferedPaintStopAllAnimations hwnd
         EXIT FUNCTION

      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_Button.pbtpl
' Contents: Template - CWindow with a button
' 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

' ========================================================================================
' 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 a button", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a button
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 350, 250, 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
         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_ButtonOwnerdraw.pbtpl
' Contents: Template - CWindow with a ownerdraw button
' Compilers: PBWIN 10.02+, PBCC 6.02+
' Headers: Windows API headers III, v. 1.03+
' Copyright (c) 2012 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

%IDC_BUTTON = 100

' ========================================================================================
' 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 a button", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a button
   LOCAL hButton AS DWORD
   hButton = pWindow.AddButton(pWindow.hwnd, %IDC_BUTTON, "&Ownerdraw button", 300, 250, 150, 23, %BS_OWNERDRAW)
   SetFocus hButton

   

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

   ' // Process window mesages
   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)
            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_DRAWITEM

         LOCAL pDis AS DRAWITEMSTRUCT PTR
         LOCAL hPen AS DWORD, hBrush AS DWORD
         LOCAL hNewFont AS DWORD, rc AS RECT

         pDis = lParam
         IF @pDis.CtlId <> %IDC_BUTTON THEN EXIT FUNCTION
         ' // Get the rectangle that defines the boundaries of the button to be drawn.
         rc = @pDis.rcItem
         ' // Create a new font
         hNewFont = pWindow.CreateFont(IIF$(AfxGetWindowsVersion => 6, "Segoe UI", "Tahoma"), _
                    IIF&(AfxGetWindowsVersion => 6, 9, 8), %FW_NORMAL, %FALSE, %FALSE, %FALSE, %DEFAULT_CHARSET)
         ' // Select the font in the button's device context
         SelectObject(@pDis.hDC, hNewFont)
         ' // Draw the button
         IF (@pDis.itemState AND %ODS_FOCUS) THEN
            hPen = SelectObject(@pDis.hDC, CreatePen(%PS_SOLID, 3, RGB(255,0,0)))
            hBrush = SelectObject(@pDis.hDC, GetSysColorBrush(%COLOR_BTNFACE))
            Rectangle @pDis.hDC, rc.Left, rc.Top, rc.Right, rc.Bottom
            SelectObject @pDis.hDC, hBrush
            DeleteObject SelectObject(@pDis.hDC, hPen)
         ELSE
            FillRect @pDis.hDC, rc, GetSysColorBrush(%COLOR_BTNFACE)
         END IF
         ' // Draw the button's edge
         rc.Left += 3: rc.Top += 3 : rc.Bottom -= 3: rc.Right -= 3
         IF (@pDis.itemState AND %ODS_SELECTED) THEN
            DrawEdge @pDis.hDC, rc, %BDR_SUNKEN, %BF_RECT OR %BF_MIDDLE OR %BF_SOFT
            rc.Left += 2 : rc.Top += 2
         ELSE
            DrawEdge @pDis.hDC, rc, %BDR_RAISED, %BF_RECT OR %BF_MIDDLE OR %BF_SOFT
         END IF
         ' // Draw the button's caption
         SetBkMode @pDis.hDC, %TRANSPARENT
         SetTextColor @pDis.hDC, IIF&((@pDis.itemState AND %ODS_DISABLED), GetSysColor(%COLOR_GRAYTEXT), GetSysColor(%COLOR_BTNTEXT))
         DrawText @pDis.hDC, AfxGetWindowText(@pDis.hWndItem), -1, rc, %DT_CENTER OR %DT_VCENTER ' or %DT_SINGLELINE
         SelectObject @pDis.hDC, DeleteObject(hNewFont)

         FUNCTION = %TRUE
         EXIT FUNCTION

      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_ButtonResize.pbtpl
' Contents: Template - CWindow with a resizable button
' 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

' ========================================================================================
' 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 a resizable button", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a button without coordinates (it will be reiszed in WM_SIZE, below)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23)

   

   ' // Force resizing
   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

   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
            ' // Resize the sample button
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 120, pWindow.ClientHeight - 50, 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_ButtonSubclass.pbtpl
' Contents: Template - CWindow with a subclassed button
' 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

' ========================================================================================
' 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 a subclassed button", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a subclassed button without coordinates (it will be reiszed in WM_SIZE, below)
   pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23, 0, 0, CODEPTR(TextBtn_SubclassProc))

   

   ' // Force resizing
   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

   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
            ' // Resize the sample button
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 120, pWindow.ClientHeight - 50, 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
' ========================================================================================

' ========================================================================================
' Processes messages for the subclassed Button window.
' ========================================================================================
FUNCTION TextBtn_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")
   END SELECT

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

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_ButtonTooltip.pbtpl
' Contents: Template - CWindow with a button with tooltip
' 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

' ========================================================================================
' 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 a button with tooltip", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 500, 320
   ' // Center the window
   pWindow.CenterWindow

   ' // Add a button without coordinates (it will be reiszed in WM_SIZE, below)
   LOCAL hButton AS DWORD
   hButton = pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23)

   ' // Add a tooltip
   pWindow.AddTooltip(hButton, "I'm a button")
   ' // For a balloon tooltip use:
'   pWindow.AddTooltip(hButton, "I'm a button", %TRUE)

   

   ' // Force resizing
   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

   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
            ' // Resize the sample button
            pWindow.MoveWindow GetDlgItem(hwnd, %IDCANCEL), pWindow.ClientWidth - 120, pWindow.ClientHeight - 50, 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_D2DSkeleton.pbtpl
' Contents: Template - Direct2D skeleton
' 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 "d2d1Helper.inc"         ' // Helper class

GLOBAL g_pD2DFactory AS ID2D1Factory   ' // ID2D1Factory interface
GLOBAL g_pD2DHelper AS ID2D1Helper     ' // ID2D1Helper interface

' ========================================================================================
' 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 D2D factory
   D2D1CreateFactory2(%D2D1_FACTORY_TYPE_SINGLE_THREADED, g_pD2DFactory)
   IF ISNOTHING(g_pD2DFactory) THEN EXIT FUNCTION

   ' // Create an instance of the CD2D1Helper class
   g_pD2DHelper = CLASS "CD2D1Helper"
   IF ISNOTHING(g_pD2DHelper) THEN EXIT FUNCTION

   ' // Create the application window.
   pWindow.CreateWindow(%NULL, "Direct2D Demo App", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 300, 300
   ' // Center the window
   pWindow.CenterWindow

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

      ' // Because the render target is a window (as opposed to a bitmap or other
      ' // offscreen surface), drawing is done in response to WM_PAINT messages.
      CASE %WM_PAINT
         ' // Render the scene
         LOCAL ps AS PAINTSTRUCT
         BeginPaint hwnd, ps
         RenderScene hwnd, ps
         EndPaint hwnd, ps
         EXIT FUNCTION

      ' // Don't erase the background to avoid flicker
      CASE %WM_ERASEBKGND
         FUNCTION = 1
         EXIT FUNCTION

      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
' ========================================================================================

' ========================================================================================
' This function draws Direct2D content to a GDI HDC.
' This function will automatically discard device-specific resources if the D3D device
' disappears during function invocation, and will recreate the resources the next time
' it's invoked.
' ========================================================================================
FUNCTION RenderScene (BYVAL hwnd AS DWORD, BYREF ps AS PAINTSTRUCT) AS LONG

   LOCAL hr AS LONG
   STATIC pRenderTarget AS ID2D1DCRenderTarget
   STATIC pBlackBrush AS ID2D1SolidColorBrush

   ' // Create a DC render target.
   IF ISNOTHING(pRenderTarget) THEN
      LOCAL props AS D2D1_RENDER_TARGET_PROPERTIES
      props = g_pD2DHelper.RenderTargetProperties(%D2D1_RENDER_TARGET_TYPE_DEFAULT, _
              g_pD2DHelper.PixelFormat(%DXGI_FORMAT_B8G8R8A8_UNORM, %D2D1_ALPHA_MODE_IGNORE), _
              0, 0, %D2D1_RENDER_TARGET_USAGE_NONE, %D2D1_FEATURE_LEVEL_DEFAULT)
      hr = g_pD2DFactory.CreateDCRenderTarget(props, pRenderTarget)
      IF SUCCEEDED(hr) THEN
         ' // Create a black brush.
         hr = pRenderTarget.CreateSolidColorBrush(g_pD2DHelper.ColorF_3(%D2D1_Black), BYVAL %NULL, pBlackBrush)
      END IF
   END IF

   IF SUCCEEDED(hr) THEN
      ' // Get the dimensions of the client drawing area.
      LOCAL rc AS RECT
      GetClientRect(hwnd, rc)
      ' // Bind the DC to the DC render target.
      hr = pRenderTarget.BindDC(ps.hdc, rc)
      ' // The ID2D1RenderTarget::BeginDraw method signals the start of drawing.
      pRenderTarget.BeginDraw
      ' // The ID2D1RenderTarget::Clear method fills the entire render target with a
      ' // solid color. The color is given as a D2D1_COLOR_F structure.
      pRenderTarget.Clear(g_pD2DHelper.ColorF_3(%D2D1_White))
      ' // Sample code: Draws an ellipse (replace it with your drawing operations)
      pRenderTarget.DrawEllipse(g_pD2DHelper.Ellipse(g_pD2DHelper.Point2F(150.0!, 150.0!), 100.0!, 100.0!), pBlackBrush, 3.0!)
      ' // If High DPI aware, scale the ellipse
      ' // Get the DPI scaling ratios
'      LOCAL rx, ry AS SINGLE
'      AfxGetDesktopDPIRatios(rx, ry)
'      pRenderTarget.DrawEllipse(g_pD2DHelper.Ellipse(g_pD2DHelper.Point2F(150.0! * rx, 150.0! * ry), 100.0! * rx, 100.0! * ry), pBlackBrush, 3.0! * rx)

     
      ' // The BeginDraw, Clear, and DrawEllipse methods all have a void return type.
      ' // If an error occurs during the execution of any of these methods, the error
      ' // is signaled through the return value of the EndDraw method.
      ' // The ID2D1RenderTarget::EndDraw method signals the completion of drawing for
      ' // this frame. All drawing operations must be placed between calls to BeginDraw
      ' // and EndDraw.
      hr = pRenderTarget.EndDraw
   END IF

   ' // Direct2D signals a lost device by returning the error code D2DERR_RECREATE_TARGET
   ' // from the EndDraw method. If you receive this error code, you must re-create the
   ' // render target and all device-dependent resources.
   IF hr = %D2DERR_RECREATE_TARGET THEN
      ' // To discard a resource, simply release the interface for that resource.
      pRenderTarget = NOTHING
      pBlackBrush = NOTHING
      hr = %S_OK
   END IF

   FUNCTION = hr

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_D2DSkeleton_HDPI.pbtpl
' Contents: Template - Direct2D skeleton (High DPI)
' 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 "d2d1Helper.inc"         ' // Helper class

GLOBAL g_pD2DFactory AS ID2D1Factory   ' // ID2D1Factory interface
GLOBAL g_pD2DHelper AS ID2D1Helper     ' // ID2D1Helper interface

' ========================================================================================
' 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 D2D factory
   D2D1CreateFactory2(%D2D1_FACTORY_TYPE_SINGLE_THREADED, g_pD2DFactory)
   IF ISNOTHING(g_pD2DFactory) THEN EXIT FUNCTION

   ' // Create an instance of the CD2D1Helper class
   g_pD2DHelper = CLASS "CD2D1Helper"
   IF ISNOTHING(g_pD2DHelper) THEN EXIT FUNCTION

   ' // Create the application window.
   pWindow.CreateWindow(%NULL, "Direct2D Demo App", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 300, 300
   ' // Center the window
   pWindow.CenterWindow

   

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

      ' // Because the render target is a window (as opposed to a bitmap or other
      ' // offscreen surface), drawing is done in response to WM_PAINT messages.
      CASE %WM_PAINT
         ' // Render the scene
         LOCAL ps AS PAINTSTRUCT
         BeginPaint hwnd, ps
         RenderScene hwnd, ps
         EndPaint hwnd, ps
         EXIT FUNCTION

      ' // Don't erase the background to avoid flicker
      CASE %WM_ERASEBKGND
         FUNCTION = 1
         EXIT FUNCTION

      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
' ========================================================================================

' ========================================================================================
' This function draws Direct2D content to a GDI HDC.
' This function will automatically discard device-specific resources if the D3D device
' disappears during function invocation, and will recreate the resources the next time
' it's invoked.
' ========================================================================================
FUNCTION RenderScene (BYVAL hwnd AS DWORD, BYREF ps AS PAINTSTRUCT) AS LONG

   LOCAL hr AS LONG, dpiX, dpiY AS SINGLE
   STATIC pRenderTarget AS ID2D1DCRenderTarget
   STATIC pBlackBrush AS ID2D1SolidColorBrush

   ' // Create a DC render target.
   IF ISNOTHING(pRenderTarget) THEN
      LOCAL props AS D2D1_RENDER_TARGET_PROPERTIES
      g_pD2DFactory.GetDesktopDpi(dpiX, dpiY)
      props = g_pD2DHelper.RenderTargetProperties(%D2D1_RENDER_TARGET_TYPE_DEFAULT, _
              g_pD2DHelper.PixelFormat(%DXGI_FORMAT_B8G8R8A8_UNORM, %D2D1_ALPHA_MODE_IGNORE), _
              dpiX, dpiY, %D2D1_RENDER_TARGET_USAGE_NONE, %D2D1_FEATURE_LEVEL_DEFAULT)
      hr = g_pD2DFactory.CreateDCRenderTarget(props, pRenderTarget)
      IF SUCCEEDED(hr) THEN
         ' // Create a black brush.
         hr = pRenderTarget.CreateSolidColorBrush(g_pD2DHelper.ColorF_3(%D2D1_Black), BYVAL %NULL, pBlackBrush)
      END IF
   END IF

   IF SUCCEEDED(hr) THEN
      ' // Get the dimensions of the client drawing area.
      LOCAL rc AS RECT
      GetClientRect(hwnd, rc)
      ' // Bind the DC to the DC render target.
      hr = pRenderTarget.BindDC(ps.hdc, rc)
      ' // The ID2D1RenderTarget::BeginDraw method signals the start of drawing.
      pRenderTarget.BeginDraw
      ' // The ID2D1RenderTarget::Clear method fills the entire render target with a
      ' // solid color. The color is given as a D2D1_COLOR_F structure.
      pRenderTarget.Clear(g_pD2DHelper.ColorF_3(%D2D1_White))
      ' // Sample code: Draws an ellipse (replace it with your drawing operations)
      pRenderTarget.DrawEllipse(g_pD2DHelper.Ellipse(g_pD2DHelper.Point2F(150.0!, 150.0!), 100.0!, 100.0!), pBlackBrush, 3.0!)
      ' // The BeginDraw, Clear, and DrawEllipse methods all have a void return type.
      ' // If an error occurs during the execution of any of these methods, the error
      ' // is signaled through the return value of the EndDraw method.
      ' // The ID2D1RenderTarget::EndDraw method signals the completion of drawing for
      ' // this frame. All drawing operations must be placed between calls to BeginDraw
      ' // and EndDraw.
      hr = pRenderTarget.EndDraw
   END IF

   ' // Direct2D signals a lost device by returning the error code D2DERR_RECREATE_TARGET
   ' // from the EndDraw method. If you receive this error code, you must re-create the
   ' // render target and all device-dependent resources.
   IF hr = %D2DERR_RECREATE_TARGET THEN
      ' // To discard a resource, simply release the interface for that resource.
      pRenderTarget = NOTHING
      pBlackBrush = NOTHING
      hr = %S_OK
   END IF

   FUNCTION = hr

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_D2DHwndTarget.pbtpl
' Contents: Template - Direct2D skeleton (Window target)
' 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 "d2d1Helper.inc"         ' // Helper class

GLOBAL g_pD2DFactory AS ID2D1Factory   ' // ID2D1Factory interface
GLOBAL g_pD2DHelper AS ID2D1Helper     ' // ID2D1Helper interface

' ========================================================================================
' 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 D2D factory
   D2D1CreateFactory2(%D2D1_FACTORY_TYPE_SINGLE_THREADED, g_pD2DFactory)
   IF ISNOTHING(g_pD2DFactory) THEN EXIT FUNCTION

   ' // Create an instance of the CD2D1Helper class
   g_pD2DHelper = CLASS "CD2D1Helper"
   IF ISNOTHING(g_pD2DHelper) THEN EXIT FUNCTION

   ' // Create the application window.
   pWindow.CreateWindow(%NULL, "Direct2D Demo App", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 300, 300
   ' // Center the window
   pWindow.CenterWindow

   

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

      ' // Because the render target is a window (as opposed to a bitmap or other
      ' // offscreen surface), drawing is done in response to WM_PAINT messages.
      CASE %WM_PAINT
         ' // Render the scene
         RenderScene hwnd
         EXIT FUNCTION

      ' // Don't erase the background to avoid flicker
      CASE %WM_ERASEBKGND
         FUNCTION = 1
         EXIT FUNCTION

      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
' ========================================================================================

' ========================================================================================
' This function draws Direct2D content to a window.
' This function will automatically discard device-specific resources if the D3D device
' disappears during function invocation, and will recreate the resources the next time
' it's invoked.
' ========================================================================================
FUNCTION RenderScene (BYVAL hwnd AS DWORD) AS LONG

   LOCAL hr AS LONG
   STATIC pRenderTarget AS ID2D1HwndRenderTarget
   STATIC pBlackBrush AS ID2D1SolidColorBrush

   ' // Create a DC render target.
   IF ISNOTHING(pRenderTarget) THEN
      LOCAL rc AS RECT
      GetClientRect(hWnd, rc)
      hr = g_pD2DFactory.CreateHwndRenderTarget(g_pD2DHelper.RenderTargetProperties, _
           g_pD2DHelper.HwndRenderTargetProperties(hwnd, _
           g_pD2DHelper.SizeU(rc.Right - rc.Left, rc.Bottom - rc.Top), %D2D1_PRESENT_OPTIONS_NONE), _
           pRenderTarget)

      IF SUCCEEDED(hr) THEN
         ' // Create a black brush.
         hr = pRenderTarget.CreateSolidColorBrush(g_pD2DHelper.ColorF_3(%D2D1_Black), BYVAL %NULL, pBlackBrush)
      END IF
   END IF

   IF SUCCEEDED(hr) THEN
      ' // The ID2D1RenderTarget::BeginDraw method signals the start of drawing.
      pRenderTarget.BeginDraw
      ' // The ID2D1RenderTarget::Clear method fills the entire render target with a
      ' // solid color. The color is given as a D2D1_COLOR_F structure.
      pRenderTarget.Clear(g_pD2DHelper.ColorF_3(%D2D1_White))
      ' // Sample code: Draws an ellipse (replace it with your drawing operations)
      pRenderTarget.DrawEllipse(g_pD2DHelper.Ellipse(g_pD2DHelper.Point2F(150.0!, 150.0!), 100.0!, 100.0!), pBlackBrush, 3.0!)
      ' // The BeginDraw, Clear, and DrawEllipse methods all have a void return type.
      ' // If an error occurs during the execution of any of these methods, the error
      ' // is signaled through the return value of the EndDraw method.
      ' // The ID2D1RenderTarget::EndDraw method signals the completion of drawing for
      ' // this frame. All drawing operations must be placed between calls to BeginDraw
      ' // and EndDraw.
      hr = pRenderTarget.EndDraw
   END IF

   ' // Direct2D signals a lost device by returning the error code D2DERR_RECREATE_TARGET
   ' // from the EndDraw method. If you receive this error code, you must re-create the
   ' // render target and all device-dependent resources.
   IF hr = %D2DERR_RECREATE_TARGET THEN
      ' // To discard a resource, simply release the interface for that resource.
      pRenderTarget = NOTHING
      pBlackBrush = NOTHING
      hr = %S_OK
   END IF

   FUNCTION = hr

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_DX9_Skeleton.pbtpl
' Contents: Template - CWindow DirectX9 sekeleton
' 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 ONCE "CWindow.inc"
$D3DX_DLLNAME = "d3dx9_35.dll"   ' --> change as needed
#INCLUDE ONCE "D3DX9.INC"

GLOBAL g_hWnd AS DWORD
GLOBAL g_pD3D AS IDirect3D9
GLOBAL g_pD3DDevice AS IDirect3DDevice9

' ========================================================================================
' Initializes Direct3D
' ========================================================================================
FUNCTION InitD3D() AS LONG

   LOCAL hr AS LONG
   LOCAL d3ddm AS D3DDISPLAYMODE

   g_pD3D = Direct3DCreate9(%D3D_SDK_VERSION)
   ' // TO DO: Respond to failure of Direct3DCreate9
   IF ISNOTHING(g_pD3D) THEN EXIT FUNCTION

   IF FAILED(g_pD3D.GetAdapterDisplayMode(%D3DADAPTER_DEFAULT, d3ddm)) THEN
      ' // TO DO: Respond to failure of GetAdapterDisplayMode
      EXIT FUNCTION
   END IF

   hr = g_pD3D.CheckDeviceFormat(%D3DADAPTER_DEFAULT, %D3DDEVTYPE_HAL, _
                                 d3ddm.Format, %D3DUSAGE_DEPTHSTENCIL, _
                                 %D3DRTYPE_SURFACE, %D3DFMT_D16)
   IF FAILED(hr) THEN
      IF hr = %D3DERR_NOTAVAILABLE THEN
         ' // POTENTIAL PROBLEM: We need at least a 16-bit z-buffer!
         EXIT FUNCTION
      END IF
   END IF

   ' //
   ' // Do we support hardware vertex processing? if so, use it.
   ' // If not, downgrade to software.
   ' //

   LOCAL dCaps AS D3DCAPS9

   IF FAILED(g_pD3D.GetDeviceCaps(%D3DADAPTER_DEFAULT, _
                                  %D3DDEVTYPE_HAL, dCaps)) THEN
      ' // TO DO: Respond to failure of GetDeviceCaps
      EXIT FUNCTION
   END IF

   LOCAL dwBehaviorFlags AS DWORD

   IF dCaps.VertexProcessingCaps <> 0 THEN
      dwBehaviorFlags = %D3DCREATE_HARDWARE_VERTEXPROCESSING
   ELSE
      dwBehaviorFlags = %D3DCREATE_SOFTWARE_VERTEXPROCESSING
   END IF

   ' //
   ' // Everything checks out - create a simple, windowed device.
   ' //

   LOCAL d3dpp AS D3DPRESENT_PARAMETERS

   d3dpp.Windowed               = %TRUE
   d3dpp.SwapEffect             = %D3DSWAPEFFECT_DISCARD
   d3dpp.BackBufferFormat       = d3ddm.Format
   d3dpp.EnableAutoDepthStencil = %TRUE
   d3dpp.AutoDepthStencilFormat = %D3DFMT_D16
   d3dpp.PresentationInterval   = %D3DPRESENT_INTERVAL_IMMEDIATE

   IF FAILED(g_pD3D.CreateDevice(%D3DADAPTER_DEFAULT, _
                                 %D3DDEVTYPE_HAL, _
                                 g_hWnd, _
                                 dwBehaviorFlags, _
                                 d3dpp, _
                                 g_pD3DDevice)) THEN
      ' // TO DO: Respond to failure of CreateDevice
   END IF

   FUNCTION = %TRUE

END FUNCTION

' ========================================================================================
' Renders the scene
' ========================================================================================
SUB RenderD3DScene

   g_pD3DDevice.Clear(0, BYVAL %NULL, %D3DCLEAR_TARGET OR %D3DCLEAR_ZBUFFER, _
      D3DCOLOR_COLORVALUE(0.0!,0.0!,1.0!,1.0!), 1.0!, 0)

   g_pD3DDevice.BeginScene

   ' // Render geometry here...
   

   g_pD3DDevice.EndScene

   g_pD3DDevice.Present(BYVAL %NULL, BYVAL %NULL, %NULL, BYVAL %NULL)

END SUB

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS LONG, BYVAL hPrevInstance AS LONG, BYVAL lpCmdLine 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 window
   g_hwnd = pWindow.CreateWindow(%NULL, "Direct3D (DX9) - Initialization", 0, 0, 0, 0, 0, 0, CODEPTR(WndProc))
   ' // Set the client size
   pWindow.SetClientSize 600, 400
   ' // Center the window
   pWindow.CenterWindow

   ' // Show the window
   ShowWindow g_hwnd, nCmdShow
   ' // Update its client area
   UpdateWindow g_hwnd

   IF ISFALSE InitD3D THEN EXIT FUNCTION

   ' // Set the timer
   SetTimer(g_hwnd, 1, 0, %NULL)

   ' // Message loop
   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      TranslateMessage uMsg
      DispatchMessage uMsg
   WEND

   ' // Kill the timer
   KillTimer(g_hwnd, 1)

END FUNCTION

' ========================================================================================
' Main window procedure callback
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   SELECT CASE wMsg

      CASE %WM_SYSCOMMAND
         ' // Disable the Windows screensaver
         IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION
         ' // Close the window
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_TIMER
         ' // Render the scene
         RenderD3DScene
         EXIT FUNCTION

      CASE %WM_KEYDOWN
         SELECT CASE LO(WORD, wParam)
            ' // If the Escape key has been pressed...
            CASE %VK_ESCAPE
               ' // ... close the application by sending a WM_CLOSE message
               SendMessage hwnd, %WM_CLOSE, 0, 0
               EXIT FUNCTION
         END SELECT

      CASE %WM_DESTROY
         ' // Clear resources
         g_pD3DDevice = NOTHING
         g_pD3D = NOTHING
         ' // End the application
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_DX9_Skeleton2.bas
' Contents: Template - CWindow DirectX9 sekeleton
' Description: Demonstrates how to initialize Direct3D.
' Compilers: PBWIN 10.02+, PBCC 6.02+
' Headers: Windows API headers 2.04+
' Copyright (c) 2011 José Roca. Freeware. Use at your own risk
' ########################################################################################

' CSED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
%UNICODE = 1

#INCLUDE ONCE "CWindow.inc"
' DirectX End-User Runtimes (June 2010)
' http://www.microsoft.com/download/en/confirmation.aspx?id=8109
$D3DX_DLLNAME = "d3dx9_43.dll"   ' --> change as needed
#INCLUDE ONCE "D3DX9.INC"

$WindowCaption = "Direct3D (DX9) - Initialization"

GLOBAL pDX9 AS IDX9

' =======================================================================================
' DX9 class
' =======================================================================================
CLASS CDX9

   INSTANCE m_pD3D AS IDirect3D9
   INSTANCE m_pD3DDevice AS IDirect3DDevice9
   INSTANCE m_d3ddm AS D3DDISPLAYMODE
   INSTANCE m_d3dpp AS D3DPRESENT_PARAMETERS

   ' =====================================================================================
   INTERFACE IDX9 : INHERIT IUnknown
   ' =====================================================================================

   ' =====================================================================================
   ' Initializes DirectX9
   ' =====================================================================================
   METHOD InitD3D (BYVAL hwnd AS DWORD) AS LONG

      LOCAL hr AS LONG

      ' // Creates an IDirect3D9 object and returns an interface to it
      m_pD3D = Direct3DCreate9(%D3D_SDK_VERSION)
      ' // TO DO: Respond to failure of Direct3DCreate9
      IF ISNOTHING(m_pD3D) THEN EXIT METHOD

      ' // Retrieves the current display mode of the adapter
      LOCAL d3ddm AS D3DDISPLAYMODE
      hr = m_pD3D.GetAdapterDisplayMode(%D3DADAPTER_DEFAULT, m_d3ddm)
      ' // TO DO: Respond to failure of GetAdapterDisplayMode
      IF hr <> %D3D_OK THEN EXIT METHOD

      hr = m_pD3D.CheckDeviceFormat(%D3DADAPTER_DEFAULT, %D3DDEVTYPE_HAL, _
                                    d3ddm.Format, %D3DUSAGE_DEPTHSTENCIL, _
                                    %D3DRTYPE_SURFACE, %D3DFMT_D16)
      IF FAILED(hr) THEN
         IF hr = %D3DERR_NOTAVAILABLE THEN
            ' // POTENTIAL PROBLEM: We need at least a 16-bit z-buffer!
            EXIT METHOD
         END IF
      END IF

      ' // Do we support hardware vertex processing? if so, use it.
      ' // If not, downgrade to software.
      LOCAL dCaps AS D3DCAPS9
      IF FAILED(m_pD3D.GetDeviceCaps(%D3DADAPTER_DEFAULT, _
                                     %D3DDEVTYPE_HAL, dCaps)) THEN
         ' // TO DO: Respond to failure of GetDeviceCaps
         EXIT METHOD
      END IF

      LOCAL dwBehaviorFlags AS DWORD
      IF dCaps.VertexProcessingCaps <> 0 THEN
         dwBehaviorFlags = %D3DCREATE_HARDWARE_VERTEXPROCESSING
      ELSE
         dwBehaviorFlags = %D3DCREATE_SOFTWARE_VERTEXPROCESSING
      END IF

      ' // Everything checks out - create a simple, windowed device.

      ' // Creates a device to represent the display adapter
      m_d3dpp.Windowed               = %TRUE
      m_d3dpp.SwapEffect             = %D3DSWAPEFFECT_DISCARD
      m_d3dpp.BackBufferFormat       = m_d3ddm.Format
      m_d3dpp.EnableAutoDepthStencil = %TRUE
      m_d3dpp.AutoDepthStencilFormat = %D3DFMT_D16
      m_d3dpp.PresentationInterval   = %D3DPRESENT_INTERVAL_IMMEDIATE

      hr = m_pD3D.CreateDevice (%D3DADAPTER_DEFAULT, %D3DDEVTYPE_HAL, hwnd, _
                                %D3DCREATE_SOFTWARE_VERTEXPROCESSING, m_d3dpp, m_pD3DDevice)
      ' // TO DO: Respond to failure of CreateDevice
      IF hr <> %D3D_OK THEN EXIT METHOD

      ' // Return success
      METHOD = %TRUE

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

   ' =====================================================================================
   ' Renders the scene
   ' =====================================================================================
   METHOD RenderD3DScene

      m_pD3DDevice.Clear(0, BYVAL %NULL, %D3DCLEAR_TARGET OR %D3DCLEAR_ZBUFFER, _
         D3DCOLOR_COLORVALUE(0.0!,0.0!,1.0!,1.0!), 1.0!, 0)

      m_pD3DDevice.BeginScene

      ' // Render geometry here...

      m_pD3DDevice.EndScene

      m_pD3DDevice.Present(BYVAL %NULL, BYVAL %NULL, %NULL, BYVAL %NULL)

   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

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

   ' // Create an instance of the DX9 class
   pDX9 = CLASS "CDX9"
   IF ISNOTHING(pDX9) THEN EXIT FUNCTION

   ' // Create the main window
   LOCAL hwnd AS DWORD
   hwnd = pWindow.CreateWindow(%NULL, $WindowCaption, 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Change the class style to remove flicker
   pWindow.ClassStyle = %CS_DBLCLKS
   ' // Set the client size
   pWindow.SetClientSize 600, 400
   ' // Center the window
   pWindow.CenterWindow

   ' // Initialize DX9
   IF ISFALSE pDX9.InitD3D(hwnd) THEN EXIT FUNCTION

   ' // Set the timer
   SetTimer(hwnd, 1, 0, %NULL)

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

   ' // Message loop
   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      TranslateMessage uMsg
      DispatchMessage uMsg
   WEND

   ' // Kill the timer
   KillTimer(hwnd, 1)

   FUNCTION = uMsg.wParam

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

' ========================================================================================
' Main window procedure callback
' ========================================================================================
FUNCTION WindowProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC pWindow AS IWindow        ' // Reference to the IWindow interface

   SELECT CASE wMsg

      CASE %WM_CREATE
         ' // Get a reference to the IWindow interface from the CREATESTRUCT structure
         pWindow = CWindow_GetObjectFromCreateStruct(lParam)
         EXIT FUNCTION

      CASE %WM_SYSCOMMAND
         ' // Disable the Windows screensaver
         IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION
         ' // Close the window
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_TIMER
         ' // Render the scene
         pDX9.RenderD3DScene
         EXIT FUNCTION

      CASE %WM_KEYDOWN
         SELECT CASE LO(WORD, wParam)
            CASE %VK_ESCAPE
               SendMessage hwnd, %WM_CLOSE, 0, 0
               EXIT FUNCTION
         END SELECT

      CASE %WM_DESTROY
         ' // Destroy the class
         pDX9 = NOTHING
         ' // Close the application by sending a WM_QUIT message
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

   ' // Pass unprocessed messages to Windows
   FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)

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


[José Roca]

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_GraphCtrlGdipSkeleton.pbtpl
' Contents: Template - CWindow Graphic Control GDI+ Skeleton
' 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

' // Header files for imported files
%USEGRAPHCTX = 1
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

%IDC_GRCTX = 1001

' ========================================================================================
' The following sample code draws a line.
' Change it with your own code.
' ========================================================================================
SUB GDIP_Render (BYVAL hdc AS DWORD)

'   LOCAL rx AS SINGLE   ' // If High DPI aware
'   LOCAL ry AS SINGLE   ' // If High DPI aware
   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pPen AS DWORD

   ' // If High DPI aware, retrieve the DPI scaling ratios
'   AfxGetDesktopDPIRatios(rx, ry)

   ' // Create a graphics object
   hStatus = GdipCreateFromHDC(hdc, pGraphics)

   ' // Create a Pen
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 0, 0), 1, %UnitPixel, pPen)
   ' // If High DPI aware, scale the pen
'   hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 0, 0), 1 * rx, %UnitPixel, pPen)

   ' // Draw the line
   GdipDrawLineI pGraphics, pPen, 0, 0, 200, 100
   ' // If High DPI aware, scale the pen
'   GdipDrawLine pGraphics, pPen, 0, 0, 200 * rx, 100 * ry

   ' // Cleanup
   IF pPen THEN GdipDeletePen(pPen)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)

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 Graphic Control GDI+ Skeleton", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   ' // Set the client size
   pWindow.SetClientSize 400, 250
   ' // Change the background color
   pWindow.Brush = %COLOR_WINDOW + 1
   ' // Center the window
   pWindow.CenterWindow

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

   ' // Draw the graphics
   GDIP_Render(GraphCtx_GetDc(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

   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
               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

' // Header files for imported files
%USEGRAPHCTX = 1
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class

%IDC_GRCTX = 101

' ========================================================================================
' The following sample code draws a line.
' Change it with your own code.
' ========================================================================================
SUB GDIP_Render (BYVAL hdc AS DWORD)

   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pPen AS DWORD

   hStatus = GdipCreateFromHDC(hdc, pGraphics)

   ' // Create a Pen
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 0, 0), 1, %UnitPixel, pPen)

   ' // Draw the line
   GdipDrawLineI pGraphics, pPen, 0, 0, 200, 100

   ' // Cleanup
   IF pPen THEN GdipDeletePen(pPen)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)

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

' ========================================================================================
' 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 CWindow class
   LOCAL pWindow AS IWindow
   pWindow = CLASS "CWindow"
   IF ISNOTHING(pWindow) THEN EXIT FUNCTION

   ' // Create the main window
   pWindow.CreateWindow(%NULL, "CWindow Graphic Control GDI+ Skeleton Stretchable", 0, 0, 400, 300, 0, 0, CODEPTR(WindowProc))
   ' // Center the window
   pWindow.CenterWindow

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

   ' // Set it stretchable
   GraphCtx_SetStretchable(hCtl, %TRUE)

   ' // Draw the graphics
   GDIP_Render(GraphCtx_GetDc(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

   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
               END IF
         END SELECT

      CASE %WM_SIZE
         ' // If the window isn't minimized, resize it
         LOCAL pWindow AS IWindow
         IF wParam <> %SIZE_MINIMIZED THEN
            pWindow = CWindow_GetObjectFromWindowHandle(hwnd)
            pWindow.MoveWindow GetDlgItem(hwnd, %IDC_GRCTX), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %TRUE
            pWindow = NOTHING
            GDIP_Render(GraphCtx_GetDc(GetDlgItem(hwnd, %IDC_GRCTX)))
         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_GdipSkeleton.pbtpl
' Contents: Template - CWindow GDI+ skeleton
' 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

' // Header files for imported files
#INCLUDE ONCE "CWindow.inc"   ' // CWindow class
#INCLUDE ONCE "GDIPLUS.INC"   ' // GDI+

%IDC_GRCTX = 101

' ========================================================================================
' The following sample code draws a line.
' Change it with your own code.
' ========================================================================================
SUB GDIP_Render (BYVAL hdc AS DWORD)

'   LOCAL rx AS SINGLE   ' // If High DPI Aware
'   LOCAL ry AS SINGLE   ' // If High DPI Aware
   LOCAL hStatus AS LONG
   LOCAL pGraphics AS DWORD
   LOCAL pPen AS DWORD

   ' // If High DPI aware, retrieve the DPI scaling ratios
'   AfxGetDesktopDPIRatios(rx, ry)

   ' // Create a graphics object
   hStatus = GdipCreateFromHDC(hdc, pGraphics)

   ' // Create a Pen
   hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 0, 0), 1, %UnitPixel, pPen)
   ' // If High DPI aware, scale the pen
'   hStatus = GdipCreatePen1(GDIP_ARGB(255, 255, 0, 0), 1 * rx, %UnitPixel, pPen)

   ' // Draw the line
   GdipDrawLineI pGraphics, pPen, 0, 0, 200, 100
   ' // If High DPI aware, scale the line
'   GdipDrawLine pGraphics, pPen, 0, 0, 200 * rx, 100 * ry

   ' // Cleanup
   IF pPen THEN GdipDeletePen(pPen)
   IF pGraphics THEN GdipDeleteGraphics(pGraphics)

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

   ' // Initialize GDI+
   LOCAL GdipToken AS DWORD
   GdipToken = GdiPlusInit

   ' // 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 GDI+ skeleton", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
   pWindow.SetClientSize 400, 250
   ' // Change the background color
   pWindow.Brush = %COLOR_WINDOW + 1
   ' // Center the window
   pWindow.CenterWindow

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

   

   ' // Shutdown GDI+
   GdiplusShutdown GdipToken

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 ps AS PAINTSTRUCT

   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_PAINT
         ' // Draw the graphics
         hDC = BeginPaint(hwnd, ps)
         GDIP_Render hDC
         EndPaint(hwnd, ps)

      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
' ========================================================================================