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
Adding controls has not any mystery. You just call the approprite AddXXX method. Most of them have the same parameters.
Some examples:
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
#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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
#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
' ========================================================================================
#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
#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
#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
' ========================================================================================
#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
' ========================================================================================
' ########################################################################################
' 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
' ========================================================================================
#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
' ========================================================================================
#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
' // 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", 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)
' // 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
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
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
' ========================================================================================
#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
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 (High DPI)", 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)
' // 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
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
' ========================================================================================
#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 Stretchable", 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_SetStretchable 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
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
' ========================================================================================
#COMPILE EXE
#DIM ALL
%UNICODE = 1
#INCLUDE ONCE "CWindow.inc"
#INCLUDE ONCE "glu.inc"
$WindowCaption = "OpenGL Template"
%GL_WINDOWWIDTH = 640 ' Window width
%GL_WINDOWHEIGHT = 480 ' Window height
%GL_BITSPERPEL = 16 ' Color resolution in bits per pixel
%GL_DEPTHBITS = 16 ' Depth of the depth (z-axis) buffer
GLOBAL hDC AS LONG ' Device context handle
' =======================================================================================
' 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
' ------------------------------------------------------------------------------------
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
END SUB
' =======================================================================================
' =======================================================================================
' Cleanup
' =======================================================================================
SUB Cleanup (BYVAL hwnd AS DWORD)
' ------------------------------------------------------------------------------------
' Insert your code here
' ------------------------------------------------------------------------------------
END SUB
' =======================================================================================
' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB 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 SUB
' =======================================================================================
' =======================================================================================
' Processes mouse clicks and movement
' Parameters:
' * hwnd = Window hande
' * wMsg = Windows message
' * wKeyState = Indicates whether various virtual keys are down.
' MK_CONTROL The CTRL key is down.
' MK_LBUTTON The left mouse button is down.
' MK_MBUTTON The middle mouse button is down.
' MK_RBUTTON The right mouse button is down.
' MK_SHIFT The SHIFT key is down.
' MK_XBUTTON1 Windows 2000/XP: The first X button is down.
' MK_XBUTTON2 Windows 2000/XP: The second X button is down.
' * x = x-coordinate of the cursor
' * y = y-coordinate of the cursor
' =======================================================================================
SUB ProcessMouse (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wKeyState AS DWORD, BYVAL x AS LONG, BYVAL y AS LONG)
SELECT CASE wMsg
CASE %WM_LBUTTONDOWN
CASE %WM_LBUTTONUP
CASE %WM_MOUSEMOVE
END SELECT
END SUB
' =======================================================================================
' =======================================================================================
' Main
' =======================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS WSTRINGZ PTR, BYVAL nCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL wcex AS WNDCLASSEX
LOCAL msg AS tagMSG
LOCAL rc AS RECT
LOCAL bDone AS LONG
LOCAL nLeft AS LONG
LOCAL nTop AS LONG
LOCAL nWidth AS LONG
LOCAL nHeight AS LONG
LOCAL dwStyle AS DWORD
LOCAL dwStyleEx AS DWORD
STATIC vKeyCode AS LONG
STATIC bKeyDown AS LONG
LOCAL t AS DOUBLE
LOCAL t0 AS DOUBLE
LOCAL fps AS DOUBLE
LOCAL nFrames AS LONG
LOCAL dm AS DEVMODE
LOCAL bFullScreen AS LONG
LOCAL lResult 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
' // Ask the user which screen mode he prefers
lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _
"Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION)
SELECT CASE lResult
CASE %IDCANCEL : EXIT FUNCTION
CASE %IDYES : bFullScreen = %TRUE
CASE %IDNO : bFullScreen = %FALSE
END SELECT
' // Window size
nWidth = %GL_WINDOWWIDTH
nHeight = %GL_WINDOWHEIGHT
IF bFullScreen THEN
' // Change display settings
dm.dmSize = SIZEOF(dm)
dm.dmPelsWidth = nWidth
dm.dmPelsHeight = nHeight
dm.dmBitsPerPel = %GL_BITSPERPEL
dm.dmFields = %DM_BITSPERPEL OR %DM_PELSWIDTH OR %DM_PELSHEIGHT
IF ChangeDisplaySettings(dm, %CDS_FULLSCREEN) = 0 THEN ShowCursor %FALSE
END IF
' // Window styles
IF ISFALSE bFullScreen THEN
dwStyle = %WS_OVERLAPPEDWINDOW
dwStyleEx = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
ELSE
dwStyle = %WS_POPUP
dwStyleEx = %WS_EX_APPWINDOW
END IF
' // Create the window
hwnd = pWindow.CreateWindow(%NULL, $WindowCaption, nLeft, nTop, nWidth, nHeight, dwStyle, dwStyleEx, CODEPTR(WndProc))
' // Don't erase nackground
pWindow.ClassStyle = %CS_DBLCLKS
'// Black brush
pWindow.Brush = %BLACK
' // Retrieve the coordinates of the window's client area
GetClientRect hwnd, rc
' // Initialize the new OpenGl window
SetupScene hwnd, rc.Right - rc.Left, rc.Bottom - rc.Top
' // Show the window
ShowWindow hwnd, nCmdShow
UpdateWindow hwnd
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
#IF %DEF(%UNICODE)
LOCAL szCaption AS WSTRINGZ * 256
#ELSE
LOCAL szCaption AS ASCIIZ * 256
#ENDIF
IF ISFALSE bFullScreen THEN
' // Get time and mouse position
t = INT(TIMER)
' // Calculate and display FPS (frames per second)
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
END IF
' // Draw the scene
DrawScene hwnd, nWidth, nHeight
' // Exchange the front and back buffers
SwapBuffers hDC
' // Process the keystrokes
IF vKeyCode THEN
ProcessKeystrokes hwnd, vKeyCode, bKeyDown
vKeyCode = 0
END IF
LOOP
' // Retore defaults
IF bFullScreen THEN
ChangeDisplaySettings BYVAL %NULL, 0
ShowCursor %TRUE
END IF
FUNCTION = msg.wParam
END FUNCTION
' =======================================================================================
' =======================================================================================
' Main window procedure
' =======================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL pf AS LONG
LOCAL pfd AS PIXELFORMATDESCRIPTOR
STATIC hRC 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_CREATE
' // Retrieve the device context handle
hDC = GetDC(hwnd)
' // Fill the PIXELFORMATDESCRIPTOR structure
pfd.nSize = SIZEOF(PIXELFORMATDESCRIPTOR) ' Size of the structure
pfd.nVersion = 1 ' Version number
pfd.dwFlags = %PFD_DRAW_TO_WINDOW _ ' Format must support window
OR %PFD_SUPPORT_OPENGL _ ' Format must support OpenGL
OR %PFD_DOUBLEBUFFER ' Format must support double buffering
pfd.iPixelType = %PFD_TYPE_RGBA ' Request an RGBA format
pfd.cColorBits = %GL_BITSPERPEL ' Number of color bitplanes in each color buffer
pfd.cRedBits = 0 ' Number of red bitplanes in each RGBA color buffer.
pfd.cRedShift = 0 ' Shift count for red bitplanes in each RGBA color buffer.
pfd.cGreenBits = 0 ' Number of green bitplanes in each RGBA color buffer.
pfd.cGreenShift = 0 ' Shift count for green bitplanes in each RGBA color buffer.
pfd.cBlueBits = 0 ' Number of blue bitplanes in each RGBA color buffer.
pfd.cBlueShift = 0 ' Shift count for blue bitplanes in each RGBA color buffer.
pfd.cAlphaBits = 0 ' Number of alpha bitplanes in each RGBA color buffer
pfd.cAlphaShift = 0 ' Shift count for alpha bitplanes in each RGBA color buffer.
pfd.cAccumBits = 0 ' Total number of bitplanes in the accumulation buffer.
pfd.cAccumRedBits = 0 ' Number of red bitplanes in the accumulation buffer.
pfd.cAccumGreenBits = 0 ' Number of gree bitplanes in the accumulation buffer.
pfd.cAccumBlueBits = 0 ' Number of blue bitplanes in the accumulation buffer.
pfd.cAccumAlphaBits = 0 ' Number of alpha bitplanes in the accumulation buffer.
pfd.cDepthBits = %GL_DEPTHBITS ' Depth of the depth (z-axis) buffer.
pfd.cStencilBits = 0 ' Depth of the stencil buffer.
pfd.cAuxBuffers = 0 ' Number of auxiliary buffers.
pfd.iLayerType = %PFD_MAIN_PLANE ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
pfd.bReserved = 0 ' Number of overlay and underlay planes.
pfd.dwLayerMask = 0 ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
pfd.dwVisibleMask = 0 ' Transparent color or index of an underlay plane.
pfd.dwDamageMask = 0 ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
' // Find a matching pixel format
pf = ChoosePixelFormat(hDC, pfd)
IF ISFALSE pf THEN
MessageBox hwnd, "Can't find a suitable pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' // Set the pixel format
IF ISFALSE SetPixelFormat(hDC, pf, pfd) THEN
MessageBox hwnd, "Can't set the pixel format", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' // Create a new OpenGL rendering context
hRC = wglCreateContext(hDC)
IF ISFALSE hRC THEN
MessageBox hwnd, "Can't create an OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
' // Make it current
IF ISFALSE wglMakeCurrent(hDC,hRC) THEN
MessageBox hwnd, "Can't activate the OpenGL rendering context", _
"Error", %MB_OK OR %MB_ICONEXCLAMATION
SendMessage hwnd, %WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
EXIT FUNCTION
CASE %WM_DESTROY
' // Clear resources
Cleanup hwnd
' // Release the device and rendering contexts
wglMakeCurrent hDC, 0
' // Make the rendering context no longer current
wglDeleteContext hRC
' // Release the device context
ReleaseDC hwnd, hDC
' // Post an WM_QUIT message
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_SIZE
ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
EXIT FUNCTION
CASE %WM_LBUTTONDOWN, %WM_LBUTTONUP, %WM_MOUSEMOVE
ProcessMouse hwnd, wMsg, wParam, LO(WORD, lParam), HI(WORD, lParam)
EXIT FUNCTION
END SELECT
' // Call the default window procedure to process unhandled messages
FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)
END FUNCTION
' =======================================================================================
#COMPILE EXE
#DIM ALL
%UNICODE = 1
' // Include files for external files
%USERICHEDIT = 1
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
%IDC_RICHEDIT = 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 a resizable RichEdit control", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 500, 320
' // Center the window
pWindow.CenterWindow
' // Add a rich edit control without coordinates (it will be resized in WM_SIZE, below)
pWindow.AddRichEdit(pWindow.hwnd, %IDC_RICHEDIT, "RichEdit box", 0, 0, 0, 0)
' // Add a button without coordinates (it will be resized in WM_SIZE, below)
pWindow.AddButton(pWindow.hwnd, %IDCANCEL, "&Close", 0, 0, 75, 23)
' // Force reizing
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 controls
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_RICHEDIT), 100, 50, pWindow.ClientWidth - 200, pWindow.ClientHeight - 150, %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
' ========================================================================================
#COMPILE EXE
#DIM ALL
%UNICODE = 1
' // Include files for external files
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
#INCLUDE ONCE "comdlg32.inc" ' // Common dialogs
' ========================================================================================
' 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 Run 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
AfxRunFileDialog hwnd, 0, "", "Run File Dialog", "", 0' %RFF_NOSEPARATEMEM
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
' // Process the RFN_VALIDATE notification message
CASE %WM_NOTIFY
LOCAL hr AS LONG
LOCAL ptnmhdr AS NMHDR PTR
LOCAL ptnmrfd AS NM_RUNFILEDLG PTR
ptnmhdr = lParam
SELECT CASE @ptnmhdr.code
CASE %RFN_VALIDATE
ptnmrfd = lParam
LOCAL wszPath AS WSTRINGZ * %MAX_PATH
wszPath = @ptnmrfd.@lpDirectory & @ptnmrfd.@lpFile
hr = MessageBox(BYVAL hwnd, "Run the file " & wszPath, "", _
%MB_YESNOCANCEL OR %MB_ICONQUESTION OR %MB_APPLMODAL)
SELECT CASE hr
CASE %IDYES : FUNCTION = %RF_OK
CASE %IDNO : FUNCTION = %RF_RETRY
CASE ELSE : FUNCTION = %RF_CANCEL
END SELECT
EXIT FUNCTION
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
' ========================================================================================
#COMPILE EXE
#DIM ALL
%UNICODE = 1
' // Include files for external files
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
#INCLUDE ONCE "comdlg32.inc" ' // Common dialogs
' ========================================================================================
' SDK open file dialog.
' ========================================================================================
SUB SdkSaveFileDialog (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 += "All Files (*.*)|*.*"
dwStyle = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_ALLOWMULTISELECT
IF AfxSaveFileDialog(hwnd, "", bstrFileSpec, bstrInitialDir, bstrFilter, bstrDefExtension, dwStyle) THEN
bstrPath = bstrInitialDir & bstrFileSpec
MSGBOX bstrPath
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 Save 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
SdkSaveFileDialog(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
' ========================================================================================
#COMPILE EXE
#DIM ALL
%UNICODE = 1
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
#INCLUDE ONCE "ProgressBarCtrl.inc" ' // Progress bar wrappers
%IDC_START = 1001
%IDC_STATUSBAR = 1002
%IDC_PROGRESSBAR = 1003
' ========================================================================================
' 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, "Status bar with progress bar", 0, 0, 400, 200, 0, 0, CODEPTR(WindowProc))
' // Center the window
pWindow.CenterWindow
' // Add a button
pWindow.AddButton(pWindow.hwnd, %IDC_START, "&Start", 20, 20, 75, 23)
' // Add a status bar
LOCAL hStatusbar AS DWORD
hStatusbar = pWindow.AddStatusBar(pWindow.hwnd, %IDC_STATUSBAR, "", 0, 0, 0, 0)
pWindow.SetStatusbarPartsBySize(hStatusbar, "160, -1")
' // Add a progress bar to the status bar
LOCAL hProgressBar AS DWORD
hProgressBar = pWindow.AddProgressBar(hStatusbar, %IDC_PROGRESSBAR, "", 0, 2, 160, 18)
' // Set the range
ProgressBar_SetRange32(hProgressBar, 0, 100)
' // Set the initial position
ProgressBar_SetPos(hProgressBar, 0)
' // 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
CASE %IDC_START
' // Retrieve the handle to the progress bar.
LOCAL hProgressBar AS DWORD
hProgressBar = GetDlgItem(GetDlgItem(hwnd, %IDC_STATUSBAR), %IDC_PROGRESSBAR)
' *** Test code ***
' // Sets the step increment.
ProgressBar_SetStep(hProgressBar, 1)
' // Draws the bar.
LOCAL i AS LONG
FOR i = 1 TO 100
' // Advances the current position for a progress bar by the step
' // increment and redraws the bar to reflect the new position.
ProgressBar_StepIt(hProgressBar)
SLEEP 10
NEXT
' // Clears the bar by reseting its position to 0.
ProgressBar_SetPos(hProgressBar, 0)
END SELECT
CASE %WM_SIZE
' // Gets the handle of the status bar
LOCAL hStatusBar AS DWORD
hStatusBar = GetDlgItem(hwnd, %IDC_STATUSBAR)
' // Resizes it
SendMessage hStatusBar, %WM_SIZE, wParam, lParam
' // Redraws it
InvalidateRect hStatusBar, BYVAL %NULL, %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
' ========================================================================================
' ########################################################################################
' Microsoft Windows
' File: CW_TabCtrl.pbtpl
' Contents: Template - CWindow with a tab control
' 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 "TabCtrl.inc" ' // Tab control wrappers
#INCLUDE ONCE "ComboBoxCtrl.inc" ' // Combo box control wrappers
#INCLUDE ONCE "ListBoxCtrl.inc" ' // List box control wrappers
' // Control identifiers
%IDC_TAB = 1001
%IDC_EDIT1 = 1002
%IDC_EDIT2 = 1003
%IDC_BTNSUBMIT = 1004
%IDC_COMBO = 1005
%IDC_LISTBOX = 1006
' ========================================================================================
' 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 Tab control", 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 470, 280
' // Center the window
pWindow.CenterWindow
' // Add a Tab control
LOCAL hTab AS DWORD
hTab = pWindow.AddTab(pWindow.hwnd, %IDC_TAB, "", 10, 10, pWindow.ClientWidth - 20, pWindow.ClientHeight - 20)
' // Add tab pages
LOCAL pTabPage1, pTabPage2, pTabPage3 AS IWindow
pTabPage1 = pWindow.InsertTabPage(hTab, 0, "Tab 1", -1, 0, 0, CODEPTR(TabPage1_WndProc))
pTabPage2 = pWindow.InsertTabPage(hTab, 1, "Tab 2", -1, 0, 0, CODEPTR(TabPage2_WndProc))
pTabPage3 = pWindow.InsertTabPage(hTab, 2, "Tab 3", -1, 0, 0, CODEPTR(TabPage3_WndProc))
' // Add controls to the first page
pWindow.AddLabel(pTabPage1.hwnd, -1, "First name", 15, 15, 121, 21)
pWindow.AddLabel(pTabPage1.hwnd, -1, "Last name", 15, 50, 121, 21)
pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT1, "", 165, 15, 186, 21)
pWindow.AddTextBox(pTabPage1.hwnd, %IDC_EDIT2, "", 165, 50, 186, 21)
pWindow.AddButton(pTabPage1.hwnd, %IDC_BTNSUBMIT, "Submit", 340, 185, 76, 26, %BS_DEFPUSHBUTTON)
' // Add controls to the 2nd page
LOCAL hComboBox AS DWORD
hComboBox = pTabPage2.AddComboBox(pTabPage2.hwnd, %IDC_COMBO, "", 20, 20, 191, 105)
' // Add controls to the 3rd page
LOCAL hListBox AS DWORD
hListBox = pTabPage3.AddListBox(pTabPage3.hwnd, %IDC_LISTBOX, "", 15, 20, 161, 120)
' // Fill the controls with some data
LOCAL i AS LONG
FOR i = 1 TO 9
Combobox_AddString hComboBox, "Item" & STR$(i)
ListBox_AddString hListBox, "Item" & STR$(i)
NEXT
ComboBox_SetCurSel hComboBox, 0
ListBox_SetCurSel hListBox, 0
' // Display the first tab page
ShowWindow pTabPage1.hwnd, %SW_SHOW
' // Set the focus to the first tab
TabCtrl_SetCurFocus hTab, 0
' // 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
' // Process window mesages
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_DESTROY
' // End the application
PostQuitMessage 0
EXIT FUNCTION
CASE %WM_NOTIFY
LOCAL nPage AS DWORD ' // Page number
LOCAL pTabPage AS IWindow ' // Tab page object reference
LOCAL tci AS TCITEM ' // TCITEM structure
LOCAL ptnmhdr AS NMHDR PTR ' // Information about a notification message
ptnmhdr = lParam
SELECT CASE @ptnmhdr.idFrom
CASE %IDC_TAB
SELECT CASE @ptnmhdr.code
CASE %TCN_SELCHANGE
' // Show the selected page
nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
tci.mask = %TCIF_PARAM
TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
IF tci.lParam THEN
pTabPage = Ptr2Obj(tci.lParam)
IF ISOBJECT(pTabPage) THEN
ShowWindow pTabPage.hwnd, %SW_SHOW
pTabPage = NOTHING
END IF
END IF
CASE %TCN_SELCHANGING
' // Hide the current page
nPage = TabCtrl_GetCurSel(@ptnmhdr.hwndFrom)
tci.mask = %TCIF_PARAM
TabCtrl_GetItem(@ptnmhdr.hwndFrom, nPage, tci)
IF tci.lParam THEN
pTabPage = Ptr2Obj(tci.lParam)
IF ISOBJECT(pTabPage) THEN
ShowWindow pTabPage.hwnd, %SW_HIDE
pTabPage = NOTHING
END IF
END IF
END SELECT
END SELECT
END SELECT
' // Pass unprocessed messages to Windows
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 1 window procedure
' ========================================================================================
FUNCTION TabPage1_WndProc (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 %IDC_BTNSUBMIT
IF HI(WORD, wParam) = %BN_CLICKED THEN
MSGBOX "Submit"
EXIT FUNCTION
END IF
END SELECT
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 2 window procedure
' ========================================================================================
FUNCTION TabPage2_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL hBrush AS DWORD
LOCAL rc AS RECT
LOCAL tlb AS LOGBRUSH
SELECT CASE uMsg
CASE %WM_ERASEBKGND
GetClientRect hWnd, rc
' Create custom brush
tlb.lbStyle = %BS_SOLID
tlb.lbColor = &H00CB8734???
tlb.lbHatch = 0
hBrush = CreateBrushIndirect(tlb)
' Erase background
FillRect wParam, rc, hBrush
DeleteObject hBrush
FUNCTION = %TRUE
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Tab page 3 window procedure
' ========================================================================================
FUNCTION TabPage3_WndProc (BYVAL hWnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL hBrush AS DWORD
LOCAL rc AS RECT
LOCAL tlb AS LOGBRUSH
SELECT CASE uMsg
CASE %WM_ERASEBKGND
GetClientRect hWnd, rc
' Create custom brush
tlb.lbStyle = %BS_SOLID
tlb.lbColor = %GREEN
tlb.lbHatch = 0
hBrush = CreateBrushIndirect(tlb)
' Erase background
FillRect wParam, rc, hBrush
DeleteObject hBrush
FUNCTION = %TRUE
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
#COMPILE EXE
#DIM ALL
%UNICODE = 1
' // Include files for external files
#INCLUDE ONCE "CWindow.inc" ' // CWindow class
#INCLUDE ONCE "ToolBarCtrl.inc" ' // ToolBar wrappers
%IDC_TOOLBAR = 1001
%IDM_CUT = 28000
%IDM_COPY = 28001
%IDM_PASTE = 28002
%IDM_UNDO = 28003
%IDM_REDOW = 28004
%IDM_DELETE = 28005
%IDM_FILENEW = 28006
%IDM_FILEOPEN = 28007
%IDM_FILESAVE = 28008
%IDM_PRINTPRE = 28009
%IDM_PROPERTIES = 28010
%IDM_HELP = 28011
%IDM_FIND = 28012
%IDM_REPLACE = 28013
%IDM_PRINT = 28014
' ========================================================================================
' Create the toolbar
' ========================================================================================
FUNCTION CreateToolBar (BYVAL pWindow AS IWindow) AS DWORD
' // Add a toolbar
LOCAL hToolBar AS DWORD
hToolBar = pWindow.AddToolBar(pWindow.hwnd, %IDC_TOOLBAR, "", 0, 0, 0, 0, _
%WS_VISIBLE OR %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS OR %CCS_TOP OR %WS_BORDER OR %TBSTYLE_FLAT)
' // Add a bitmap with the button images
LOCAL ttbab AS TBADDBITMAP
ttbab.hInst = %HINST_COMMCTRL
IF pWindow.IsProcessDPIAware THEN
ttbab.nId = %IDB_STD_LARGE_COLOR
ELSE
ttbab.nId = %IDB_STD_SMALL_COLOR
END IF
ToolBar_AddBitmap hToolBar, 15, ttbab
' // Add buttons to the toolbar
Toolbar_AddButton hToolBar, %STD_CUT, %IDM_CUT
Toolbar_AddButton hToolBar, %STD_COPY, %IDM_COPY
Toolbar_AddButton hToolBar, %STD_PASTE, %IDM_PASTE
Toolbar_AddButton hToolBar, %STD_DELETE, %IDM_DELETE
ToolBar_AddSeparator hToolBar
Toolbar_AddButton hToolBar, %STD_UNDO, %IDM_UNDO
Toolbar_AddButton hToolBar, %STD_REDOW, %IDM_REDOW
ToolBar_AddSeparator hToolBar
Toolbar_AddButton hToolBar, %STD_FILENEW, %IDM_FILENEW
Toolbar_AddButton hToolBar, %STD_FILEOPEN, %IDM_FILEOPEN
Toolbar_AddButton hToolBar, %STD_FILESAVE, %IDM_FILESAVE
Toolbar_AddButton hToolBar, %STD_PRINTPRE, %IDM_PRINTPRE
ToolBar_AddSeparator hToolBar
Toolbar_AddButton hToolBar, %STD_FIND, %IDM_FIND
Toolbar_AddButton hToolBar, %STD_REPLACE, %IDM_REPLACE
ToolBar_AddSeparator hToolBar
Toolbar_AddButton hToolBar, %STD_PROPERTIES, %IDM_PROPERTIES
Toolbar_AddButton hToolBar, %STD_PRINT, %IDM_PRINT
ToolBar_AddSeparator hToolBar
Toolbar_AddButton hToolBar, %STD_HELP, %IDM_HELP
' // Size the toolbar
ToolBar_AutoSize hToolBar
END FUNCTION
' ========================================================================================
' ========================================================================================
' 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 a toolbar", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Disable background erasing
pWindow.ClassStyle = %CS_DBLCLKS
' // Set the client siz
pWindow.SetClientSize 600, 350
' // 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)
' // Add the toolbar
CreateToolBar pWindow
' // 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
CASE %IDM_CUT
MSGBOX "Cut button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_COPY
MSGBOX "Copy button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_PASTE
MSGBOX "Paste button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_UNDO
MSGBOX "Undo button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_REDOW
MSGBOX "Redo button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_DELETE
MSGBOX "Delete button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_FILENEW
MSGBOX "File New button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_FILEOPEN
MSGBOX "File Open button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_FILESAVE
MSGBOX "File Save button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_PRINTPRE
MSGBOX "Print Preview button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_PROPERTIES
MSGBOX "Properties button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_HELP
MSGBOX "Help button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_FIND
MSGBOX "Find button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_REPLACE
MSGBOX "Replace button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
CASE %IDM_PRINT
MSGBOX "Print button clicked"
FUNCTION = %FALSE
EXIT FUNCTION
END SELECT
CASE %WM_SYSCOLORCHANGE
' // Forward this message to common controls so that they will
' // be properly updated when the user changes the color settings.
SendMessage GetDlgItem(hWnd, %IDC_TOOLBAR), %WM_SYSCOLORCHANGE, wParam, lParam
CASE %WM_SIZE
' // If the window isn't minimized, resize it
IF wParam <> %SIZE_MINIMIZED THEN
' // Update the size and position of the Toolbar control
ToolBar_AutoSize GetDlgItem(hWnd, %IDC_TOOLBAR)
' // Resize the sample button
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
' ========================================================================================
#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
' // 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, "AddWebBrowser Template", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client siz
pWindow.SetClientSize 600, 350
' // Center the window
pWindow.CenterWindow
' // Add a WebBrowser control
LOCAL hCtl AS DWORD
LOCAL bstrURL AS WSTRING
' // You can pass a URL
bstrURL = "http://www.jose.it-berater.org/smfforum/index.php"
' // or a path to an Active document file (Excel, Word or PDF)
' bstrURL = EXE.Path$ & "Test.xls" ' <-- change me!
' bstrURL = EXE.Path$ & "JetSQL.doc" ' <-- change me!
' bstrURL = EXE.Path$ & "COMCollections.pdf" ' <-- change me!
' // or a fragment of HTML code (remember to always start with "MSHTML:")
' bstrURL = "MSHTML:<HTML><BODY>This is a line of text</BODY></HTML>"
' // or a web page (remember to always start with "MSHTML:")
' LOCAL s AS WSTRING
' LOCAL bstrName AS WSTRING
' S = "MSHTML:<?xml version=""1.0""?>"
' s += "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">" & $CRLF
' s += "<html xmlns=""http://www.w3.org/1999/xhtml"">" & $CRLF
' s += "<head>" & $CRLF
' s += "<title>Image Test</title>" & $CRLF
' s += "</head>" & $CRLF
' s += "<body scroll=" & $DQ & "auto" & $DQ & " style=" & $DQ & "MARGIN: 0px 0px 0px 0px" & $DQ & " >" & $CRLF
' bstrName = EXE.Path$ & "Ciutat_de_les_Arts_i_de_les_Ciencies_02.jpg"
' s += "<img src=" & $DQ & bstrName & $DQ & " alt=" & $DQ & bstrName & $DQ & " title=" & $DQ & bstrName & $DQ & " "
' s += "/>" & $CRLF
' s += "</body>" & $CRLF
' s += "</html>" & $CRLF
' bstrURL = s
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrURL, 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
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
' // 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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
#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
' // 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, "AddWebBrowser Template", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 600, 350
' // Center the window
pWindow.CenterWindow
' // Add a WebBrowser control
LOCAL hCtl AS DWORD
LOCAL bstrHTML AS WSTRING
' // Script to display the picture
bstrHTML = "MSHTML:" & $CRLF
bstrHTML += "<body scroll='auto' style='margin: 0px 0px 0px 0px'>" & $CRLF
bstrHTML += "<img src='http://celeb-world.net/d/4134-2/nicolekidman3.jpg' border='0' width='100%'></img>"
bstrHTML += "</body>"
' // Script to display the picture centered
' bstrHTML = "MSHTML:" & $CRLF
' bstrHTML += "<body scroll='auto' style='margin: 0px 0px 0px 0px'>" & $CRLF
' bstrHTML += "<center>" & $CRLF
' bstrHTML += "<img src='http://celeb-world.net/d/4134-2/nicolekidman3.jpg' border='0' height='100%'></img>"
' bstrHTML += "</center>" & $CRLF
' bstrHTML += "</body>"
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrHTML, NOTHING, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
' // Note: Right click with the mouse to activate the options menu
' // 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_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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
#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
' // 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, "AddWebBrowser Template: Image hyperlink", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 400, 260
' // Center the window
pWindow.CenterWindow
' // Add a WebBrowser control
LOCAL hCtl AS DWORD
LOCAL bstrHTML AS WSTRING
' // Script to display the hyperlink
bstrHTML = "MSHTML:" & $CRLF
bstrHTML += "<body scroll='no' style='margin: 0px 0px 0px 0px'>" & $CRLF
bstrHTML += "<a href='http://www.jose.it-berater.org/smfforum/index.php' target='_blank'>" & _
"<img src='http://www.jose.it-berater.org/webpages_images/h_2.jpg' width='100%' height='100%' alt='Jose Roca Software'></a>"
bstrHTML += "</body>"
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, bstrHTML, NOTHING, 45, 45, 311, 170)
' // Note: Right click with the mouse to activate the options menu
' // 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_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_DESTROY
' // End the application
PostQuitMessage 0
EXIT FUNCTION
END SELECT
' // Pass unprocessed messages to Windows
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
#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 = 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
pWindow.CreateWindow(%NULL, "AddWebBrowser Template: Google Map", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 700, 500
' // Center the window
pWindow.CenterWindow
' Web Browser zoom
IF pWindow.IsProcessDPIAware THEN pWindow.WBZoom = 100 * pWindow.rxRatio
' // Build the html script
LOCAL s AS WSTRING
LOCAL cx, cy AS DOUBLE
LOCAL zoom AS LONG
cx = 39.47#
cy = 0.28#
zoom = 7
s = "<!DOCTYPE html>"
s += "<html>"
s += "<head>"
s += "<meta name='viewport' content='initial-scale=1.0, user-scalable=no' />"
s += "<style type='text/css'>" & $CRLF
s += "html { height: 100% }" & $CRLF
s += " body { height: 100%; margin: 0px; padding: 0px }" & $CRLF
s += " #map_canvas { height: 100% }" & $CRLF
s += "</style>" & $CRLF
s += "<script type='text/javascript'" & $CRLF
s += " src='http://maps.google.com/maps/api/js?sensor=false'>" & $CRLF
s += "</script>" & $CRLF
s += "<script type='text/javascript'>" & $CRLF
s += " function initialize() {" & $CRLF
s += " var latlng = new google.maps.LatLng(" & FORMAT$(cx) & "," & FORMAT$(cy) & ");" & $CRLF
s += " var myOptions = {" & $CRLF
s += " zoom: " & FORMAT$(zoom) & "," & $CRLF
s += " center: latlng," & $CRLF
s += " mapTypeId: google.maps.MapTypeId.ROADMAP" & $CRLF
s += " };" & $CRLF
s += " var map = new google.maps.Map(document.getElementById('map_canvas')," & $CRLF
s += " myOptions);" & $CRLF
s += " }" & $CRLF
s += "</script>" & $CRLF
s += "</head>" & $CRLF
s += "<body scroll='no' onload='initialize()'>" & $CRLF
s += " <div id='map_canvas' style='width:100%; height:100%'></div>" & $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
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
' // 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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
#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
' // 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, "AddWebBrowser Template: Virtual Earth Map", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 700, 500
' // Center the window
pWindow.CenterWindow
' // Set the web browser zoom
IF pWindow.IsProcessDPIAware THEN pWindow.WBZoom = 100 * pWindow.rxRatio
' // Build the html script
LOCAL s AS WSTRING
LOCAL cx, cy AS DOUBLE
LOCAL zoom AS LONG
cx = -6.89186#
cy = 107.59987#
zoom = 8
s = "<!DOCTYPE html>" & $CRLF
s += "<html>" & $CRLF
s += "<head>" & $CRLF
s += " <title>Virtual Earth Map</title>" & $CRLF
s += " <meta http-equiv='Content-Type' content='text/html; charset=utf-8'>" & $CRLF
s += " <script type='text/javascript' src='http://dev.virtualearth.net/mapcontrol/mapcontrol.ashx?v=6'>" & $CRLF
s += " </script>" & $CRLF
s += " <script type='text/javascript'>" & $CRLF
s += " var map = null;" & $CRLF
s += " var dyCodeCoord = new VELatLong(" & FORMAT$(cx) & ", " & FORMAT$(cy) & ");" & $CRLF
s += " function GetMap()" & $CRLF
s += " {" & $CRLF
s += " map = new VEMap('myMap');" & $CRLF
s += " map.LoadMap(dyCodeCoord," & FORMAT$(zoom) & ");" & $CRLF
s += " }" & $CRLF
s += " </script>" & $CRLF
s += " <style type='text/css'>" & $CRLF
s += " .map" & $CRLF
s += " {" & $CRLF
s += " position: absolute;" & $CRLF
s += " top: 0;" & $CRLF
s += " left: 0;" & $CRLF
s += " width: 100%;" & $CRLF
s += " height: 100%;" & $CRLF
s += " }" & $CRLF
s += " </style>" & $CRLF
s += "</head>" & $CRLF
s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px' onload='GetMap();'>" & $CRLF
s += "<body>" & $CRLF
s += " <div id='myMap' class='map'>" & $CRLF
s += " </div>" & $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
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
' // 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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
#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
' // 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, "AddWebBrowser Template: Windows Media Player", 0, 0, 0, 0, -1, -1, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 450, 400
' // Center the window
pWindow.CenterWindow
' // Add a WebBrowser control and display a YouTube video
LOCAL hCtl AS DWORD
LOCAL s AS WSTRING
LOCAL bstrURL AS WSTRING
bstrURL = "MyVideo.wmv" ' --> change me
' // Build the web page. Remember to always start it with "MSHTML:".
s = "MSHTML:<!DOCTYPE html>" & $CRLF
s += "<html>" & $CRLF
s += "<head>" & $CRLF
s += "<meta http-equiv='MSThemeCompatible' content='Yes'>" & $CRLF
s += "<title>Windows Media Player</title>" & $CRLF
s += "" & $CRLF
s += "</head>" & $CRLF
s += "<body scroll='no' style='margin: 0px 0px 0px 0px'>"
s += "<object id='video' classid='clsid:6BF52A52-394A-11d3-B153-00C04F79FAA6' type='application/x-oleobject' width='100%' height='100%'>" & $CRLF
s += "<param name='URL' value=" & bstrURL & ">" & $CRLF
s += "<param name='Enabled' value='true'>" & $CRLF
s += "<param name='AutoStart' value='true'>" & $CRLF
s += "<param name='StretchToFit' value='true'>" & $CRLF
s += "<param name='PlayCount' value='1'>" & $CRLF
s += "<param name='Volume' value='50'>" & $CRLF
s += "<param name='Balance'value='0'>" & $CRLF
s += "<param name='Rate' value='1.0'>" & $CRLF
s += "<param name='Mute' value='false'>" & $CRLF
s += "<param name='FullScreen' value='false'>" & $CRLF
s += "<param name='uiMode' value='full'>" & $CRLF
s += "</object>" & $CRLF
s += "" & $CRLF
s += "</body>" & $CRLF
s += "" & $CRLF
s += "</html>" & $CRLF
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, s, NOTHING, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, -1, -1)
' // 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 wParam <> %SIZE_MINIMIZED THEN
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
#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
' // 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, "AddWebBrowser Template: YouTube", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 450, 400
' // Center the window
pWindow.CenterWindow
' // Add a WebBrowser control and display a YouTube video
LOCAL hCtl AS DWORD
LOCAL s AS WSTRING
' // Build the web page. Remember to always start it with "MSHTML:".
s = "MSHTML:<!DOCTYPE html>" & $CRLF
s += "<html>" & $CRLF
s += "<head>" & $CRLF
s += "<meta http-equiv='MSThemeCompatible' content='Yes'>" & $CRLF
s += "<title>YouTube video</title>" & $CRLF
s += "" & $CRLF
s += "</head>" & $CRLF
s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px'>"
s += "<object width='100%' height='100%'>" & _
"<param name='movie' value='http://www.youtube.com/v/t6Lp4w8wyy0&hl=es&fs=1'></param>" & _
"<param name='wmode' value='transparent'>" & _
"</param><embed src='http://www.youtube.com/v/t6Lp4w8wyy0&hl=es&fs=1'" & _
" type='application/x-shockwave-flash' wmode='transparent' width='100%' height='100%'>" & _
"</embed></object>"
s += "" & $CRLF
s += "</body>" & $CRLF
s += "" & $CRLF
s += "</html>" & $CRLF
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, s, 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
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
' // 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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
#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
' // 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, "AddWebBrowser Template: YouTube", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 450, 400
' // Center the window
pWindow.CenterWindow
' // Add a WebBrowser control and display a YouTube video
LOCAL hCtl AS DWORD
LOCAL s AS WSTRING
' // Build the web page. Remember to always start it with "MSHTML:".
s = "MSHTML:<!DOCTYPE html>" & $CRLF
s += "<html>" & $CRLF
s += "<head>" & $CRLF
s += "<meta http-equiv='MSThemeCompatible' content='Yes'>" & $CRLF
s += "<title>YouTube video</title>" & $CRLF
s += "" & $CRLF
s += "</head>" & $CRLF
s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px'>"
s += "<object width='100%' height='100%'>" & _
"<param name='movie' value='http://www.youtube.com/v/MWzshE1FQX4&h1=en_US&feature=player_embedded&version=3'></param>" & _
"<param name='wmode' value='transparent'>" & _
"</param><embed src='http://www.youtube.com/v/MWzshE1FQX4&h1=en_US&feature=player_embedded&version=3'" & _
" type='application/x-shockwave-flash' wmode='transparent' width='100%' height='100%'>" & _
"</embed></object>"
s += "" & $CRLF
s += "</body>" & $CRLF
s += "" & $CRLF
s += "</html>" & $CRLF
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, s, 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
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
' // 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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
#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
' // 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, "AddWebBrowser Template: Web GUI", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 550, 350
' // Center the window
pWindow.CenterWindow
' // Add a WebBrowser control
LOCAL hCtl AS DWORD
LOCAL s AS WSTRING
' // Build the web page
s = "MSHTML:<!DOCTYPE html>" & $CRLF
s += "<html>" & $CRLF
s += "<head>" & $CRLF
s += "<meta http-equiv='MSThemeCompatible' content='yes'>" & $CRLF
s += " <title>WebGui</title>" & $CRLF
s += "" & $CRLF
s += " <style type='text/css'>" & $CRLF
s += " <!--" & $CRLF
s += "" & $CRLF
s += " #output" & $CRLF
s += " {" & $CRLF
s += " background: #FFFFCC;" & $CRLF
s += " border: thin solid black;" & $CRLF
s += " text-align: center;" & $CRLF
s += " width: 300px;" & $CRLF
s += " }" & $CRLF
s += " -->" & $CRLF
s += " </style>" & $CRLF
s += "" & $CRLF
s += "</head>" & $CRLF
s += "<body scroll='no'>" & $CRLF
s += " <input type ='Button' id='Button_1' name='Button_1' value='Button 1'><br />" & $CRLF
s += " <input type ='Button' id='Button_2' name='Button_2' value='Button 2'><br />" & $CRLF
s += " <input type ='Button' id='Button_3' name='Button_3' value='Button 3'><br />" & $CRLF
s += " <input type ='Button' id='Button_4' name='Button_4' value='Button 4'><br />" & $CRLF
s += " <br />" & $CRLF
s += " <div id='output'>" & $CRLF
s += " Click a button" & $CRLF
s += " </div>" & $CRLF
s += " <br />" & $CRLF
s += " <br />" & $CRLF
s += " <input type='Text' id='Input_Text' name='Input_Text' value='' size=40><br />" & $CRLF
s += " <br />" & $CRLF
s += " <input type ='Button' id='Button_GetText' name='Button_GetTex' value='Get text'><br />" & $CRLF
s += "</body>" & $CRLF
s += "</html>" & $CRLF
' // Create an instance of the event class
LOCAL pWBEvents AS DWebBrowserEvents2Impl
pWBEvents = CLASS "CDWebBrowserEvents2"
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, s, pWBEvents, 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
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
' // 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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
' ########################################################################################
' Class CDWebBrowserEvents2
' Interface name = DWebBrowserEvents2
' IID = {34A715A0-6587-11D0-924A-0020AFC7AC4D}
' Web Browser Control events interface
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' ########################################################################################
CLASS CDWebBrowserEvents2 GUID$("{700B73A2-CCFC-4FE0-B9AC-D5853D71B7B9}") AS EVENT
INSTANCE pIWebBrowser2 AS IWebBrowser2
INSTANCE pHTMLDocumentEvents2 AS HTMLDocumentEvents2Impl
' =====================================================================================
CLASS METHOD Destroy
' // Disconnect events
IF ISOBJECT(pHTMLDocumentEvents2) THEN EVENTS END pHTMLDocumentEvents2
END METHOD
' =====================================================================================
' ========================================================================================
' Implementation of the interface
' ========================================================================================
INTERFACE DWebBrowserEvents2Impl GUID$("{34A715A0-6587-11D0-924A-0020AFC7AC4D}") AS EVENT
INHERIT IDispatch
' =====================================================================================
' Note It would be more appropriate to use the DocumentComplete event, but this
' event isn't fired. See: BUG: DocumentComplete Does Not Fire When WebBrowser Is Not Visible
' http://support.microsoft.com/kb/q259935/
' =====================================================================================
METHOD DownloadComplete <104>
' // Get a reference to the IHTMLDocument2 interface
LOCAL pHTMLDocument2 AS IHTMLDocument2
pHTMLDocument2 = pIWebBrowser2.Document
IF ISNOTHING(pHTMLDocument2) THEN EXIT METHOD
' // Connect to the events fired by the page
IF ISOBJECT(pHTMLDocumentEvents2) THEN EXIT METHOD
pHTMLDocumentEvents2 = CLASS "CHTMLDocumentEvents2"
IF ISNOTHING(pHTMLDocumentEvents2) THEN EXIT METHOD
EVENTS FROM pHTMLDocument2 CALL pHTMLDocumentEvents2
END METHOD
' =====================================================================================
' =====================================================================================
METHOD BeforeNavigate2 <250> ( _
BYVAL pDisp AS IDispatch _ ' __in IDispatch* pDisp
, BYREF vURL AS VARIANT _ ' __in VARIANT* URL
, BYREF vFlags AS VARIANT _ ' __in VARIANT* Flags
, BYREF vTargetFrameName AS VARIANT _ ' __in VARIANT* TargetFrameName
, BYREF vPostData AS VARIANT _ ' __in VARIANT* PostData
, BYREF vHeaders AS VARIANT _ ' __in VARIANT* Headers
, BYREF bCancel AS INTEGER _ ' __in_out VARIANT_BOOL* Cancel
) ' void
' Get a reference to the WebBrowser control
IF ISNOTHING(pIWebBrowser2) THEN pIWebBrowser2 = pDisp
IF ISNOTHING(pIWebBrowser2) THEN EXIT METHOD
' If there was a previous loaded page, disconnect from the events
IF ISOBJECT(pHTMLDocumentEvents2) THEN
EVENTS END pHTMLDocumentEvents2
pHTMLDocumentEvents2 = NOTHING
END IF
END METHOD
' =====================================================================================
END INTERFACE
END CLASS
' ########################################################################################
' ########################################################################################
' Class CHTMLDocumentEvents2
' Interface name = HTMLDocumentEvents2
' IID = {3050F613-98B5-11CF-BB82-00AA00BDCE0B}
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' ########################################################################################
CLASS CHTMLDocumentEvents2 GUID$("{1FFB0071-8BCC-4BBD-BC29-A662FAE87C82}") AS EVENT
INTERFACE HTMLDocumentEvents2Impl GUID$("{3050F613-98B5-11CF-BB82-00AA00BDCE0B}") AS EVENT
INHERIT IDispatch
' =====================================================================================
METHOD onclick <-600> ( _
BYVAL pEvtObj AS IHTMLEventObj _ ' __in IHTMLEventObj* pEvtObj
) ' void
LOCAL pElement AS IHTMLElement ' // Element that has fired the event
LOCAL pHTMLDocument2 AS IHTMLDocument2 ' // Document object
LOCAL bstrId AS WSTRING ' // Identifier of the element that has fired the event
LOCAL bstrValue AS WSTRING ' // Value of the property
' // Get a reference to the element that has fired the event
IF ISOBJECT(pEvtObj) THEN pElement = pEvtObj.srcElement
IF ISNOTHING(pElement) THEN EXIT METHOD
' // Get a reference to the IHTMLDocument2 interface
pHTMLDocument2 = pElement.document
IF ISNOTHING(pHTMLDocument2) THEN EXIT METHOD
' // Get the identifier of the element that has fired the event
bstrId = pElement.id
SELECT CASE bstrId
CASE "Button_1", "Button_2", "Button_3", "Button_4"
IHTMLDocument_setElementInnerHtmlById pHTMLDocument2, "output", "You have clicked " & bstrId
CASE "Button_GetText"
bstrValue = IHTMLDocument_getElementValueById(pHTMLDocument2, "Input_Text")
MSGBOX bstrValue
END SELECT
END METHOD
' =====================================================================================
END INTERFACE
END CLASS
' ########################################################################################
#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
' // 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, "AddWindowsMediaPlayer Template", 0, 0, 0, 0, -1, -1, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 450, 400
' // Center the window
pWindow.CenterWindow
' // Display a Windows Media Player video
LOCAL bstrURL AS WSTRING
bstrURL = "MyVideo.wmv" ' --> change me
pWindow.AddWindowsMediaPlayer(pWindow.hwnd, %IDC_WEBBROWSER, bstrURL, 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
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
' // 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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
#COMPILE EXE
#DIM ALL
%UNICODE = 1
' // Include files for external files
%USEXPBUTTON = 1
#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 an XPButton", 0, 0, 500, 350, 0, 0, CODEPTR(WindowProc))
' // Center the window
pWindow.CenterWindow
' // Add a button
pWindow.AddXPButton(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
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_DESTROY
' // End the application
PostQuitMessage 0
EXIT FUNCTION
END SELECT
' // Pass unprocessed messages to Windows
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
#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
' // 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, "AddYouTubeVideo Template", 0, 0, 478, 428, 0, 0, CODEPTR(WindowProc))
' // Center the window
pWindow.CenterWindow
' // Display a YouTube video
LOCAL bstrCode AS WSTRING
bstrCode = "MWzshE1FQX4" ' --> Change me: 11 character video code
pWindow.AddYouTubeVideo(pWindow.hwnd, %IDC_WEBBROWSER, bstrCode, 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
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
' // 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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
#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
' // 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, "AddWebBrowser Template: YouTube", 0, 0, 0, 0, 0, 0, CODEPTR(WindowProc))
' // Set the client size
pWindow.SetClientSize 500, 400
' // Center the window
pWindow.CenterWindow
' // Add a WebBrowser control and display a YouTube video
LOCAL hCtl AS DWORD
LOCAL s AS WSTRING
' // Build the web page. Remember to always start it with "MSHTML:".
s = "MSHTML:<!DOCTYPE html>" & $CRLF
s += "<html>" & $CRLF
s += "<head>" & $CRLF
s += "<meta http-equiv='MSThemeCompatible' content='Yes'>" & $CRLF
s += "<title>YouTube video</title>" & $CRLF
s += "" & $CRLF
s += "</head>" & $CRLF
s += "<body scroll='no' style='MARGIN: 0px 0px 0px 0px'>"
s += "<object width='100%' height='100%'>" & _
"<param name='movie' value='http://www.youtube.com/v/MWzshE1FQX4&h1=en_US&feature=player_embedded&version=3'></param>" & _
"<param name='wmode' value='transparent'>" & _
"</param><embed src='http://www.youtube.com/v/MWzshE1FQX4&h1=en_US&feature=player_embedded&version=3'" & _
" type='application/x-shockwave-flash' wmode='transparent' width='100%' height='100%'>" & _
"</embed></object>"
s += "" & $CRLF
s += "</body>" & $CRLF
s += "" & $CRLF
s += "</html>" & $CRLF 'http://www.youtube.com/watch?v=YtcJ7gvJP0Q
' // Create the control
hCtl = pWindow.AddWebBrowserControl(pWindow.hwnd, %IDC_WEBBROWSER, s, 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
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
' // 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
' // Resize the control
pWindow.MoveWindow GetDlgItem(hwnd, %IDC_WEBBROWSER), 0, 0, pWindow.ClientWidth, pWindow.ClientHeight, %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
' ========================================================================================
They come as templates with the CSED editor.
Then this is should be the link:
http://www.jose.it-berater.org/smfforum/index.php?topic=4153.0