IT-Consultant: José Roca (PBWIN 10+/PBCC 6+) (Archive only) > Windows API Programming

Charles Petzold's Examples

(1/21) > >>

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