IT-Consultant: José Roca (PBWIN 10+/PBCC 6+) (Archive only) > Windows API Programming
Charles Petzold's Examples
José Roca:
Examples from the book Programming Windows, 5th Edition, by Charles Petzold, translated and adapted to PBWIN 10.
José Roca:
This program is a translation of ABOUT1.C -- About Box Demo Program No. 1 © Charles Petzold, 1998, described and analysed in Chapter 11 of the book Programming Windows, 5th Edition.
Even if a Windows program requires no user input, it will often have a dialog box that is invoked by an About option on the menu. This dialog box displays the name and icon of the program, a copyright notice, a push button labeled OK, and perhaps some other information.
--- Code: ---' ========================================================================================
' ABOUT1.BAS
' This program is an translation/adaptation of ABOUT1.C -- About Box Demo Program No. 1
' © Charles Petzold, 1998, described and analysed in Chapter 11 of the book Programming
' Windows, 5th Edition.
' Even if a Windows program requires no user input, it will often have a dialog box that
' is invoked by an About option on the menu. This dialog box displays the name and icon of
' the program, a copyright notice, a push button labeled OK, and perhaps some other
' information.
' ========================================================================================
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#RESOURCE RES, "about1.res"
%IDM_APP_ABOUT = 40001
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL pszCmdLine AS WSTRINGZ PTR, BYVAL iCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL szAppName AS ASCIIZ * 256
LOCAL wcex AS WNDCLASSEX
LOCAL szCaption AS ASCIIZ * 256
szAppName = "About1"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR(WndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
wcex.lpszMenuName = VARPTR(szAppName)
wcex.lpszClassName = VARPTR(szAppName)
IF ISFALSE RegisterClassEx(wcex) THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
szCaption = "About Box Demo Program"
hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _ ' extended style
szAppName, _ ' window class name
szCaption, _ ' window caption
%WS_OVERLAPPEDWINDOW, _ ' window style
%CW_USEDEFAULT, _ ' initial x position
%CW_USEDEFAULT, _ ' initial y position
%CW_USEDEFAULT, _ ' initial x size
%CW_USEDEFAULT, _ ' initial y size
%NULL, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
ShowWindow hwnd, iCmdShow
UpdateWindow hwnd
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage uMsg
DispatchMessage uMsg
WEND
FUNCTION = uMsg.wParam
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
STATIC hInstance AS DWORD
LOCAL lpc AS CREATESTRUCT PTR
SELECT CASE uMsg
CASE %WM_CREATE
lpc = lParam
hInstance = @lpc.hInstance
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_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDM_APP_ABOUT
DialogBox hInstance, "AboutBox", hwnd, CODEPTR(AboutDlgProc)
END SELECT
EXIT FUNCTION
CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION AboutDlgProc (BYVAL hDlg AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
SELECT CASE uMsg
CASE %WM_INITDIALOG
FUNCTION = %TRUE
EXIT FUNCTION
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDOK, %IDCANCEL
EndDialog hDlg, 0
FUNCTION = %TRUE
EXIT FUNCTION
END SELECT
END SELECT
END FUNCTION
' ========================================================================================
--- End code ---
José Roca:
This program is a translation of ABOUT2.C -- About Box Demo Program No. 2 © Charles Petzold, 1998, described and analysed in Chapter 11 of the book Programming Windows, 5th Edition.
Demonstrates how to manage controls (in this case, radio buttons) within a dialog box procedure and also how to paint on the client area of the dialog box.
--- Code: ---' ========================================================================================
' ABOUT2.BAS
' This program is a translation/adaptation of ABOUT2.C -- About Box Demo Program No. 2
' © Charles Petzold, 1998, described and analysed in Chapter 11 of the book Programming
' Windows, 5th Edition.
' Demonstrates how to manage controls (in this case, radio buttons) within a dialog box
' procedure and also how to paint on the client area of the dialog box.
' ========================================================================================
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#RESOURCE RES, "about2.res"
%IDC_BLACK = 1000
%IDC_BLUE = 1001
%IDC_GREEN = 1002
%IDC_CYAN = 1003
%IDC_RED = 1004
%IDC_MAGENTA = 1005
%IDC_YELLOW = 1006
%IDC_WHITE = 1007
%IDC_RECT = 1008
%IDC_ELLIPSE = 1009
%IDC_PAINT = 1010
%IDM_APP_ABOUT = 40001
GLOBAL iCurrentColor AS LONG
GLOBAL iCurrentFigure AS LONG
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL pszCmdLine AS WSTRINGZ PTR, BYVAL iCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL szAppName AS ASCIIZ * 256
LOCAL wcex AS WNDCLASSEX
LOCAL szCaption AS ASCIIZ * 256
szAppName = "About2"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR(WndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
wcex.lpszMenuName = VARPTR(szAppName)
wcex.lpszClassName = VARPTR(szAppName)
IF ISFALSE RegisterClassEx(wcex) THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
szCaption = "About Box Demo Program"
hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _ ' extended style
szAppName, _ ' window class name
szCaption, _ ' window caption
%WS_OVERLAPPEDWINDOW, _ ' window style
%CW_USEDEFAULT, _ ' initial x position
%CW_USEDEFAULT, _ ' initial y position
%CW_USEDEFAULT, _ ' initial x size
%CW_USEDEFAULT, _ ' initial y size
%NULL, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
ShowWindow hwnd, iCmdShow
UpdateWindow hwnd
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage uMsg
DispatchMessage uMsg
WEND
FUNCTION = uMsg.wParam
END FUNCTION
' ========================================================================================
' ========================================================================================
SUB PaintWindow (BYVAL hwnd AS DWORD, BYVAL iColor AS LONG, BYVAL iFigure AS LONG)
DIM crColor(0 TO 7) AS STATIC DWORD
STATIC flag AS LONG
LOCAL hBrush AS DWORD
LOCAL hdc AS DWORD
LOCAL rc AS RECT
IF ISFALSE flag THEN
flag = %TRUE
crColor(0) = RGB(0, 0, 0)
crColor(1) = RGB(0, 0, 255)
crColor(2) = RGB(0, 255, 0)
crColor(3) = RGB (0, 255, 255)
crColor(4) = RGB(255, 0, 0)
crColor(5) = RGB(255, 0, 255)
crColor(6) = RGB(255, 255, 0)
crColor(7) = RGB(255, 255, 255)
END IF
hdc = GetDC(hwnd)
GetClientRect hwnd, rc
hBrush = CreateSolidBrush(crColor(iColor - %IDC_BLACK))
hBrush = SelectObject(hdc, hBrush)
IF iFigure = %IDC_RECT THEN
Rectangle hdc, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom
ELSE
Ellipse hdc, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom
END IF
DeleteObject SelectObject(hdc, hBrush)
ReleaseDC hwnd, hdc
END SUB
' ========================================================================================
' ========================================================================================
SUB PaintTheBlock (BYVAL hCtrl AS DWORD, BYVAL iColor AS LONG, BYVAL iFigure AS LONG)
InvalidateRect hCtrl, BYVAL %NULL, %TRUE
UpdateWindow hCtrl
PaintWindow hCtrl, iColor, iFigure
END SUB
' ========================================================================================
' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
STATIC hInstance AS DWORD
LOCAL lpc AS CREATESTRUCT PTR
LOCAL ps AS PAINTSTRUCT
SELECT CASE uMsg
CASE %WM_CREATE
lpc = lParam
hInstance = @lpc.hInstance
iCurrentColor = %IDC_BLACK
iCurrentFigure = %IDC_RECT
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_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDM_APP_ABOUT
IF DialogBox(hInstance, "AboutBox", hwnd, CODEPTR(AboutDlgProc)) THEN
InvalidateRect hwnd, BYVAL %NULL, %TRUE
END IF
END SELECT
EXIT FUNCTION
CASE %WM_PAINT
BeginPaint hwnd, ps
EndPaint hwnd, ps
PaintWindow hwnd, iCurrentColor, iCurrentFigure
EXIT FUNCTION
CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION AboutDlgProc (BYVAL hDlg AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
STATIC hCtrlBlock AS DWORD
STATIC iColor AS LONG
STATIC iFigure AS LONG
SELECT CASE uMsg
CASE %WM_INITDIALOG
iColor = iCurrentColor
iFigure = iCurrentFigure
CheckRadioButton hDlg, %IDC_BLACK, %IDC_WHITE, iColor
CheckRadioButton hDlg, %IDC_RECT, %IDC_ELLIPSE, iFigure
hCtrlBlock = GetDlgItem (hDlg, %IDC_PAINT)
SetFocus GetDlgItem (hDlg, iColor)
FUNCTION = %FALSE
EXIT FUNCTION
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDOK
iCurrentColor = iColor
iCurrentFigure = iFigure
EndDialog hDlg, %TRUE
FUNCTION = %TRUE
EXIT FUNCTION
CASE %IDCANCEL
EndDialog hDlg, %FALSE
FUNCTION = %TRUE
EXIT FUNCTION
CASE %IDC_BLACK, %IDC_RED, %IDC_GREEN, %IDC_YELLOW, _
%IDC_BLUE, %IDC_MAGENTA, %IDC_CYAN, %IDC_WHITE
iColor = LO(WORD, wParam)
CheckRadioButton hDlg, %IDC_BLACK, %IDC_WHITE, LO(WORD, wParam)
PaintTheBlock hCtrlBlock, iColor, iFigure
FUNCTION = %TRUE
CASE %IDC_RECT, %IDC_ELLIPSE
iFigure = LO(WORD, wParam)
CheckRadioButton hDlg, %IDC_RECT, %IDC_ELLIPSE, LO(WORD, wParam)
PaintTheBlock hCtrlBlock, iColor, iFigure
FUNCTION = %TRUE
END SELECT
CASE %WM_PAINT
PaintTheBlock hCtrlBlock, iColor, iFigure
END SELECT
END FUNCTION
' ========================================================================================
--- End code ---
José Roca:
This program is a translation of ABOUT3.C -- About Box Demo Program No. 3 © Charles Petzold, 1998, described and analysed in Chapter 11 of the book Programming Windows, 5th Edition.
You can also define your own child window controls and use them in a dialog box. For example, suppose you don't particularly care for the normal rectangular push buttons and would prefer to create elliptical push buttons. You can do this by registering a window class and using your own window procedure to process messages for your customized child window.
--- Code: ---' ========================================================================================
' ABOUT3.BAS
' This program is a translation/adaptation of ABOUT3.C -- About Box Demo Program No. 3
' © Charles Petzold, 1998, described and analysed in Chapter 11 of the book Programming
' Windows, 5th Edition.
' You can also define your own child window controls and use them in a dialog box. For
' example, suppose you don't particularly care for the normal rectangular push buttons and
' would prefer to create elliptical push buttons. You can do this by registering a window
' class and using your own window procedure to process messages for your customized child
' window.
' ========================================================================================
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#RESOURCE RES "about3.res"
%IDM_APP_ABOUT = 40001
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL pszCmdLine AS WSTRINGZ PTR, BYVAL iCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL szAppName AS ASCIIZ * 256
LOCAL szClassName AS ASCIIZ * 256
LOCAL wcex AS WNDCLASSEX
LOCAL szCaption AS ASCIIZ * 256
szAppName = "About3"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR(WndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
wcex.lpszMenuName = VARPTR(szAppName)
wcex.lpszClassName = VARPTR(szAppName)
IF ISFALSE RegisterClassEx(wcex) THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
szClassName = "EllipPush"
wcex.style = %CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR(EllipPushwndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hIcon = %NULL
wcex.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = %COLOR_BTNFACE + 1
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szClassName)
RegisterClassEx wcex
szCaption = "About Box Demo Program"
hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _ ' extended style
szAppName, _ ' window class name
szCaption, _ ' window caption
%WS_OVERLAPPEDWINDOW, _ ' window style
%CW_USEDEFAULT, _ ' initial x position
%CW_USEDEFAULT, _ ' initial y position
%CW_USEDEFAULT, _ ' initial x size
%CW_USEDEFAULT, _ ' initial y size
%NULL, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
ShowWindow hwnd, iCmdShow
UpdateWindow hwnd
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage uMsg
DispatchMessage uMsg
WEND
FUNCTION = uMsg.wParam
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
STATIC hInstance AS DWORD
LOCAL lpc AS CREATESTRUCT PTR
LOCAL ps AS PAINTSTRUCT
SELECT CASE uMsg
CASE %WM_CREATE
lpc = lParam
hInstance = @lpc.hInstance
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_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDM_APP_ABOUT
DialogBox(hInstance, "AboutBox", hwnd, CODEPTR(AboutDlgProc))
END SELECT
EXIT FUNCTION
CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION AboutDlgProc (BYVAL hDlg AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
STATIC hCtrlBlock AS DWORD
STATIC iColor AS LONG
STATIC iFigure AS LONG
SELECT CASE uMsg
CASE %WM_INITDIALOG
FUNCTION = %TRUE
EXIT FUNCTION
CASE %WM_COMMAND
SELECT CASE LO(WORD, wParam)
CASE %IDOK
EndDialog hDlg, 0
FUNCTION = %TRUE
EXIT FUNCTION
END SELECT
END SELECT
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION EllipPushwndProc (BYVAL hwnd AS DWORD, BYVAL message AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
LOCAL szText AS ASCIIZ * 40
LOCAL hBrush AS DWORD
LOCAL hdc AS DWORD
LOCAL ps AS PAINTSTRUCT
LOCAL rc AS RECT
SELECT CASE message
CASE %WM_PAINT
GetClientRect hwnd, rc
GetWindowText hwnd, szText, SIZEOF(szText)
hdc = BeginPaint(hwnd, ps)
hBrush = CreateSolidBrush (GetSysColor(%COLOR_WINDOW))
hBrush = SelectObject(hdc, hBrush)
SetBkColor hdc, GetSysColor(%COLOR_WINDOW)
SetTextColor hdc, GetSysColor(%COLOR_WINDOWTEXT)
Ellipse hdc, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom
DrawText hdc, szText, -1, rc, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
DeleteObject SelectObject(hdc, hBrush)
EndPaint hwnd, ps
EXIT FUNCTION
CASE %WM_KEYUP
IF wParam = %VK_SPACE THEN
SendMessage GetParent(hwnd), %WM_COMMAND, GetWindowLong(hwnd, %GWL_ID), hwnd
END IF
EXIT FUNCTION
CASE %WM_LBUTTONUP
SendMessage GetParent(hwnd), %WM_COMMAND, GetWindowLong(hwnd, %GWL_ID), hwnd
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc (hwnd, message, wParam, lParam)
END FUNCTION
' ========================================================================================
--- End code ---
José Roca:
This program is a translation of the ALTWIND.C-Alternate and Winding Fill Modes Program © Charles Petzold, 1998, described and analysed in Chapter 5 of the book Programming Windows, 5th Edition.
Displays the figure twice, once using the ALTERNATE filling mode and then using WINDING.
--- Code: ---' ========================================================================================
' ALTWIND.BAS
' This program is a translation/adaptation of the ALTWIND.C-Alternate and Winding Fill
' Modes Program © Charles Petzold, 1998, described and analysed in Chapter 5 of the book
' Programming Windows, 5th Edition.
' Displays the figure twice, once using the ALTERNATE filling mode and then using WINDING.
' ========================================================================================
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
BYVAL pszCmdLine AS WSTRINGZ PTR, BYVAL iCmdShow AS LONG) AS LONG
LOCAL hwnd AS DWORD
LOCAL szAppName AS ASCIIZ * 256
LOCAL wcex AS WNDCLASSEX
LOCAL szCaption AS ASCIIZ * 256
szAppName = "AltWind"
wcex.cbSize = SIZEOF(wcex)
wcex.style = %CS_HREDRAW OR %CS_VREDRAW
wcex.lpfnWndProc = CODEPTR(WndProc)
wcex.cbClsExtra = 0
wcex.cbWndExtra = 0
wcex.hInstance = hInstance
wcex.hIcon = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
wcex.hCursor = LoadCursor(%NULL, BYVAL %IDC_ARROW)
wcex.hbrBackground = GetStockObject(%WHITE_BRUSH)
wcex.lpszMenuName = %NULL
wcex.lpszClassName = VARPTR(szAppName)
IF ISFALSE RegisterClassEx(wcex) THEN
FUNCTION = %TRUE
EXIT FUNCTION
END IF
szCaption = "Alternate and Winding Fill Modes"
hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _ ' extended style
szAppName, _ ' window class name
szCaption, _ ' window caption
%WS_OVERLAPPEDWINDOW, _ ' window style
%CW_USEDEFAULT, _ ' initial x position
%CW_USEDEFAULT, _ ' initial y position
%CW_USEDEFAULT, _ ' initial x size
%CW_USEDEFAULT, _ ' initial y size
%NULL, _ ' parent window handle
%NULL, _ ' window menu handle
hInstance, _ ' program instance handle
BYVAL %NULL) ' creation parameters
ShowWindow hwnd, iCmdShow
UpdateWindow hwnd
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
TranslateMessage uMsg
DispatchMessage uMsg
WEND
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG
STATIC cxClient AS LONG
STATIC cyClient AS LONG
LOCAL hdc AS DWORD
LOCAL i AS LONG
LOCAL ps AS PAINTSTRUCT
DIM aptFigure(9) AS STATIC POINTAPI
DIM apt(9) AS POINTAPI
SELECT CASE uMsg
CASE %WM_CREATE
aptFigure(0).x = 10 : aptFigure(0).y = 70
aptFigure(1).x = 50 : aptFigure(1).y = 70
aptFigure(2).x = 50 : aptFigure(2).y = 10
aptFigure(3).x = 90 : aptFigure(3).y = 10
aptFigure(4).x = 90 : aptFigure(4).y = 50
aptFigure(5).x = 30 : aptFigure(5).y = 50
aptFigure(6).x = 30 : aptFigure(6).y = 90
aptFigure(7).x = 70 : aptFigure(7).y = 90
aptFigure(8).x = 70 : aptFigure(8).y = 30
aptFigure(9).x = 10 : aptFigure(9).y = 30
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_SIZE
cxClient = LO(WORD, lParam)
cyClient = HI(WORD, lParam)
EXIT FUNCTION
CASE %WM_PAINT
hdc = BeginPaint(hwnd, ps)
SelectObject hdc, GetStockObject(%GRAY_BRUSH)
FOR i = 0 TO 9
apt(i).x = cxClient * aptFigure(i).x / 200
apt(i).y = cyClient * aptFigure(i).y / 100
NEXT
SetPolyFillMode hdc, %ALTERNATE
Polygon hdc, apt(0), 10
FOR i = 0 TO 9
apt(i).x = apt(i).x + cxClient / 2
NEXT
SetPolyFillMode hdc, %WINDING
Polygon hdc, apt(0), 10
EndPaint hwnd, ps
EXIT FUNCTION
CASE %WM_DESTROY
PostQuitMessage 0
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
--- End code ---
Navigation
[0] Message Index
[#] Next page
Go to full version