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: [Select]

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


[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: [Select]

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


[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: [Select]

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


[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: [Select]

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


[José Roca]

 
This program is a translation of APOLLO11.C -- Program for screen captures © Charles Petzold, 1998, described and analysed in Chapter 15 of the book Programming Windows, 5th Edition.

The program loads two DIBS, named APOLLO11.BMP (the bottom-up version) and APOLLOTD.BMP (the top-down version). Both are 220 pixels wide and 240 pixels high. Note that when the program determines the DIB width and height from the header information structure, it uses the abs function to take the absolute value of the biHeight field. When displaying the DIBs in full size or in the partial views, the xSrc, ySrc, cxSrc, and cySrc coordinates are identical regardless of which bitmap is being displayed.

Code: [Select]

' ========================================================================================
' APOLLO11.BAS
' This program is a translation/adaptation of APOLLO11.C -- Program for screen captures
' © Charles Petzold, 1998, described and analysed in Chapter 15 of the book Programming
' Windows, 5th Edition.
' The program loads two DIBS, named APOLLO11.BMP (the bottom-up version) and APOLLOTD.BMP
' (the top-down version). Both are 220 pixels wide and 240 pixels high. Note that when the
' program determines the DIB width and height from the header information structure, it
' uses the abs function to take the absolute value of the biHeight field. When displaying
' the DIBs in full size or in the partial views, the xSrc, ySrc, cxSrc, and cySrc
' coordinates are identical regardless of which bitmap is being displayed.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "objbase.inc"

FUNCTION DibLoadImage (BYVAL strFileName AS STRING) AS DWORD

   LOCAL bSuccess AS LONG
   LOCAL dwFileSize AS DWORD
   LOCAL dwHighSize AS DWORD
   LOCAL dwBytesRead AS DWORD
   LOCAL hFile AS DWORD
   LOCAL pbmfh AS BITMAPFILEHEADER PTR

   hFile = CreateFile(BYCOPY strFileName, %GENERIC_READ, %FILE_SHARE_READ, _
           BYVAL %NULL, %OPEN_EXISTING, %FILE_FLAG_SEQUENTIAL_SCAN, %NULL)
   IF hFile = %INVALID_HANDLE_VALUE THEN EXIT FUNCTION

   dwFileSize = GetFileSize(hFile, dwHighSize)
   IF dwHighSize THEN
      CloseHandle hFile
      EXIT FUNCTION
   END IF

   ' Read the contents of the file. Notice that pmfh has been cast as
   ' BITMAPFILEHEADER PTR to be able to read the header.
   pbmfh = CoTaskMemAlloc(dwFileSize)
   bSuccess = ReadFile (hFile, BYVAL pbmfh, dwFileSize, dwBytesRead, BYVAL %NULL)
   ' Check for "BM" (&H4D42, i.e. &H42 = "B", &H4D = "M", they are in reverse order)
   IF ISFALSE bSuccess OR dwBytesRead <> dwFileSize OR @pbmfh.bfType <> &H4D42 THEN
      CoTaskMemFree pbmfh
      CloseHandle hFile
      EXIT FUNCTION
   END IF

   ' Close the file handle and return a pointer to the data read
   CloseHandle hFile
   FUNCTION = pbmfh

END FUNCTION

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

   DIM    pbmfh(1) AS STATIC BITMAPFILEHEADER PTR
   DIM    pbmi(1)  AS STATIC BITMAPINFO PTR
   DIM    pbits(1) AS STATIC BYTE PTR
   DIM    cxDib(1) AS STATIC LONG
   DIM    cyDib(1) AS STATIC LONG

   LOCAL  hdc AS DWORD
   LOCAL  ps  AS PAINTSTRUCT
   LOCAL  bSuccess AS LONG

   SELECT CASE uMsg

      CASE %WM_CREATE
         ' Load the images
         pbmfh(0) = DibLoadImage("Apollo11.bmp")
         pbmfh(1) = DibLoadImage("ApolloTD.bmp")
         IF pbmfh(0) = %NULL OR pbmfh(1) = %NULL THEN
            MessageBox hwnd, "Cannot load DIB file", "Apollo11", %MB_OK OR %MB_ICONERROR OR %MB_TASKMODAL
            EXIT FUNCTION
         END IF
         ' Get pointers to the info structure & the bits
         pbmi(0) = pbmfh(0) + SIZEOF(@pbmfh(0))  ' same as SIZEOF(BITMAPFILEHEADER)
         pbmi(1) = pbmfh(1) + SIZEOF(@pbmfh(1))  ' same as SIZEOF(BITMAPFILEHEADER)
         pbits(0) = pbmfh(0) + @pbmfh(0).bfOffBits
         pbits(1) = pbmfh(1) + @pbmfh(1).bfOffBits
         ' Get the DIB width and height (assume BITMAPINFOHEADER)
         ' Note that cyDib is the absolute value of the header value!!!
         cxDib(0) = @pbmi(0).bmiHeader.biWidth
         cxDib(1) = @pbmi(1).bmiHeader.biWidth
         cyDib(0) = ABS(@pbmi(0).bmiHeader.biHeight)
         cyDib(1) = ABS(@pbmi(1).bmiHeader.biHeight)
         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
         ' Store the width and height of the client area
         cxClient = LO(WORD, lParam)
         cyClient = HI(WORD, lParam)
         EXIT FUNCTION

      CASE %WM_PAINT
         ' Draw the bitmaps
         hdc = BeginPaint(hwnd, ps)
         bSuccess = SetDIBitsToDevice(hdc, 0, cyCLient / 4, cxDib(0), cyDib(0), 0, 0, 0, _
                    cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
         bSuccess = SetDIBitsToDevice(hdc, 240, cyCLient / 4, 80, 166, 80, 60, 0, _
                    cyDib(0), BYVAL pbits(0), BYVAL pbmi(0), %DIB_RGB_COLORS)
         bSuccess = SetDIBitsToDevice(hdc, 340, cyCLient / 4, cxDib(1), cyDib(1), 0, 0, 0, _
                    cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
         bSuccess = SetDIBitsToDevice(hdc, 580, cyCLient / 4, 80, 166, 80, 60, 0, _
                    cyDib(1), BYVAL pbits(1), BYVAL pbmi(1), %DIB_RGB_COLORS)
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         ' Free the allocated memory
         IF pbmfh(0) THEN CoTaskMemFree pbmfh(0)
         IF pbmfh(1) THEN CoTaskMemFree pbmfh(1)
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of BACHTOCC.C -- Bach Toccata in D Minor (First Bar) © Charles Petzold, 1998, described and analysed in Chapter 22 of the book Programming Windows, 5th Edition.

Plays the first measure of the toccata section of J. S. Bach's famous Toccata and Fugue in D Minor for organ.

Code: [Select]

' ========================================================================================
' BACHTOCC.BAS
' This program is a translation/adaptation of BACHTOCC.C -- Bach Toccata in D Minor
' (First Bar) © Charles Petzold, 1998, described and analysed in Chapter 22 of the book
' Programming Windows, 5th Edition.
' Plays the first measure of the toccata section of J. S. Bach's famous Toccata and Fugue
' in D Minor for organ.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"

TYPE NOTESEQ_STRUCT
   iDur AS LONG
   iNote(0 TO 1) AS LONG
END TYPE

%ID_TIMER = 1

' ========================================================================================
' 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          = "BachTocc"
   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 = "Bach Toccata in D Minor (First Bar)"
   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
' ========================================================================================

' ========================================================================================
FUNCTION MidiOutMessage_ (BYVAL hMidi AS DWORD, BYVAL iStatus AS LONG, BYVAL iChannel AS LONG, _
                                BYVAL iData1 AS LONG, BYVAL iData2 AS LONG) AS DWORD

   LOCAL dwMessage AS DWORD

   SHIFT LEFT iData1, 8
   SHIFT LEFT iData2, 16
   dwMessage = iStatus OR iChannel OR iData1 OR iData2

   FUNCTION = midiOutShortMsg(hMidi, dwMessage)

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

   DIM noteseq(19) AS STATIC NOTESEQ_STRUCT
   STATIC hMidiOut AS DWORD
   STATIC iIndex   AS LONG
   LOCAL  i        AS LONG

   SELECT CASE uMsg

      CASE %WM_CREATE
         noteseq( 0).iDur =  110 : noteseq( 0).iNote(0) = 69 : noteseq( 0).iNote(1) = 81
         noteseq( 1).iDur =  110 : noteseq( 1).iNote(0) = 67 : noteseq( 1).iNote(1) = 79
         noteseq( 2).iDur =  990 : noteseq( 2).iNote(0) = 69 : noteseq( 2).iNote(1) = 81
         noteseq( 3).iDur =  220 : noteseq( 3).iNote(0) = -1 : noteseq( 3).iNote(1) = -1

         noteseq( 4).iDur =  110 : noteseq( 4).iNote(0) = 67 : noteseq( 4).iNote(1) = 79
         noteseq( 5).iDur =  110 : noteseq( 5).iNote(0) = 65 : noteseq( 5).iNote(1) = 77
         noteseq( 6).iDur =  110 : noteseq( 6).iNote(0) = 64 : noteseq( 6).iNote(1) = 76
         noteseq( 7).iDur =  110 : noteseq( 7).iNote(0) = 62 : noteseq( 7).iNote(1) = 74

         noteseq( 8).iDur =  220 : noteseq( 8).iNote(0) = 61 : noteseq( 8).iNote(1) = 73
         noteseq( 9).iDur =  440 : noteseq( 9).iNote(0) = 62 : noteseq( 9).iNote(1) = 74
         noteseq(10).iDur = 1980 : noteseq(10).iNote(0) = -1 : noteseq(10).iNote(1) = -1
         noteseq(11).iDur =  110 : noteseq(11).iNote(0) = 57 : noteseq(11).iNote(1) = 69

         noteseq(12).iDur =  110 : noteseq(12).iNote(0) = 55 : noteseq(12).iNote(1) = 67
         noteseq(13).iDur =  990 : noteseq(13).iNote(0) = 57 : noteseq(13).iNote(1) = 69
         noteseq(14).iDur =  220 : noteseq(14).iNote(0) = -1 : noteseq(14).iNote(1) = -1
         noteseq(15).iDur =  220 : noteseq(15).iNote(0) = 52 : noteseq(15).iNote(1) = 64

         noteseq(16).iDur =  220 : noteseq(16).iNote(0) = 53 : noteseq(16).iNote(1) = 65
         noteseq(17).iDur =  220 : noteseq(17).iNote(0) = 49 : noteseq(17).iNote(1) = 61
         noteseq(18).iDur =  440 : noteseq(18).iNote(0) = 50 : noteseq(18).iNote(1) = 62
         noteseq(19).iDur = 1980 : noteseq(19).iNote(0) = -1 : noteseq(19).iNote(1) = -1

         ' Open MIDIMAPPER device
         IF midiOutOpen(hMidiOut, %MIDIMAPPER, 0, 0, 0) <> %MMSYSERR_NOERROR THEN
            MessageBeep %MB_ICONEXCLAMATION
            MessageBox hwnd, "Cannot open MIDI output device!", _
                       "BachTocc", %MB_ICONEXCLAMATION OR %MB_OK
            FUNCTION = -1
            EXIT FUNCTION
         END IF
         ' Send Program Change messages for "Church Organ"
         MidiOutMessage_ hMidiOut, &HC0,  0, 19, 0
         MidiOutMessage_ hMidiOut, &HC0, 12, 19, 0
         SetTimer hwnd, %ID_TIMER, 1000, %NULL
         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_TIMER
         ' Loop for 2-note polyphony
         FOR i = 0 TO 1
            ' Note Off messages for previous note
            IF iIndex <> 0 THEN
               IF noteseq(iIndex - 1).iNote(i) <> -1 THEN
                  MidiOutMessage_ hMidiOut, &H80,  0, _
                                  noteseq(iIndex - 1).iNote(i), 0
                  MidiOutMessage_ hMidiOut, &H80, 12, _
                                  noteseq(iIndex - 1).iNote(i), 0
               END IF
            END IF
            ' Note On messages for new note
            IF iIndex < 19 THEN
               IF noteseq(iIndex).iNote(i) <> -1 THEN
                  MidiOutMessage_ hMidiOut, &H90,  0, _
                                  noteseq(iIndex).iNote(i), 127
                  MidiOutMessage_ hMidiOut, &H90, 12, _
                                  noteseq(iIndex).iNote(i), 127
               END IF
            END IF
         NEXT
         IF iIndex < 19 THEN
            SetTimer hwnd, %ID_TIMER, noteseq(iIndex).iDur - 1, %NULL
            iIndex = iIndex + 1
         ELSE
            KillTimer hwnd, %ID_TIMER
            DestroyWindow hwnd
         END IF
         EXIT FUNCTION

      CASE %WM_DESTROY
         midiOutReset hMidiOut
         midiOutClose hMidiOut
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of BEEPER1.C  -- Timer Demo Program No. 1 © Charles Petzold, 1998, described and analysed in Chapter 8 of the book Programming Windows, 5th Edition.

Sets a timer for 1-second intervals. When it receives a WM_TIMER message, it alternates coloring the client area blue and red and it beeps by calling the function MessageBeep. (Although MessageBeep is often used as a companion to MessageBox, it's really an all-purpose beep function. In PCs equipped with sound boards, you can use the various MB_ICON parameters normally used with MessageBox as parameters to MessageBeep to make different sounds as selected by the user in the Control Panel Sounds applet.)

Code: [Select]

' ========================================================================================
' BEEPER1.BAS
' This program is a translation/adaptation of BEEPER1.C  -- Timer Demo Program No. 1
' © Charles Petzold, 1998, described and analysed in Chapter 8 of the book Programming
' Windows, 5th Edition.
' Sets a timer for 1-second intervals. When it receives a WM_TIMER message, it alternates
' coloring the client area blue and red and it beeps by calling the function MessageBeep.
' (Although MessageBeep is often used as a companion to MessageBox, it's really an
' all-purpose beep function. In PCs equipped with sound boards, you can use the various
' MB_ICON parameters normally used with MessageBox as parameters to MessageBeep to make
' different sounds as selected by the user in the Control Panel Sounds applet.)
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"

%ID_TIMER = 1

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

   szAppName          = "Beeper1"
   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

   hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _   ' extended style
                         szAppName, _              ' window class name
                         "Beeper1 Timer Demo", _   ' 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 fFlipFlop AS LONG
   LOCAL  hBrush AS DWORD
   LOCAL  hdc AS DWORD
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  rc AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         SetTimer hwnd, %ID_TIMER, 1000, %NULL
         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_TIMER
         MessageBeep -1
         fFlipFlop = NOT fFlipFlop
         InvalidateRect hwnd, BYVAL %NULL, %FALSE
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         GetClientRect hwnd, rc
         hBrush = CreateSolidBrush (IIF&(fFlipFlop <> 0, RGB(255,0,0), RGB(0,0,255)))
         FillRect hdc, rc, hBrush
         EndPaint(hwnd, ps)
         DeleteObject hBrush
         EXIT FUNCTION

     CASE %WM_DESTROY
         KillTimer hwnd, %ID_TIMER
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of BEEPER2.C  -- Timer Demo Program No. 2 © Charles Petzold, 1998, described and analysed in Chapter 8 of the book Programming Windows, 5th Edition.

The BEEPER2 program is functionally the same as BEEPER1, except that Windows sends the timer messages to TimerProc rather than to WndProc.

Code: [Select]

' ========================================================================================
' BEEPER2.BAS
' This program is a translation/adaptation of BEEPER2.C  -- Timer Demo Program No. 2
' © Charles Petzold, 1998, described and analysed in Chapter 8 of the book Programming
' Windows, 5th Edition.
' The BEEPER2 program is functionally the same as BEEPER1, except that Windows sends the
' timer messages to TimerProc rather than to WndProc.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"

%ID_TIMER = 1

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

   szAppName          = "Beeper2"
   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

   hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _   ' extended style
                         szAppName, _              ' window class name
                         "Beeper2 Timer Demo", _   ' 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 fFlipFlop AS LONG
   LOCAL  hBrush AS DWORD
   LOCAL  hdc AS DWORD
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  rc AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         SetTimer hwnd, %ID_TIMER, 1000, CODEPTR(TimerProc)
         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
         KillTimer hwnd, %ID_TIMER
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Timer callback procedure
' ========================================================================================
SUB TimerProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL iTimerID AS DWORD, BYVAL dwTime AS DWORD)

   STATIC fFlipFlop AS LONG
   LOCAL  hBrush    AS DWORD
   LOCAL  hdc       AS DWORD
   LOCAL  rc        AS RECT

   MessageBeep -1
   fFlipFlop = NOT fFlipFlop

   GetClientRect hwnd, rc

   hdc = GetDC(hwnd)
   hBrush = CreateSolidBrush(IIF&(fFlipFlop <> 0, RGB(255,0,0), RGB(0,0,255)))

   FillRect hdc, rc, hBrush
   ReleaseDC hwnd, hdc
   DeleteObject hBrush

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


[José Roca]

 
This program is a translation of the BEZIER.C-Bezier Splines Demo © Charles Petzold, 1998, described and analysed in Chapter 5 of the book Programming Windows, 5th Edition.

Interactively draws Bézier splines. The two control points are manipulable, the first by pressing the left mouse button and moving the mouse, the second by pressing the right mouse button and moving the mouse.

Code: [Select]

' ========================================================================================
' BEZIER.BAS
' This program is a translation/adaptation of the BEZIER.C-Bezier Splines Demo
' © Charles Petzold, 1998, described and analysed in Chapter 5 of the book Programming
' Windows, 5th Edition.
' Interactively draws Bézier splines. The two control points are manipulable, the first by
' pressing the left mouse button and moving the mouse, the second by pressing the right
' mouse button and moving the mouse.
' ========================================================================================

#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          = "Bezier"
   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 = "Bezier Splines"
   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
' ========================================================================================

' ========================================================================================
' Draws the Bézier splines.
' ========================================================================================
SUB DrawBezier (BYVAL hdc AS DWORD, BYREF apt() AS POINTAPI)

   PolyBezier hdc, apt(0), 4
   MoveToEx hdc, apt(0).x, apt(0).y, BYVAL %NULL
   LineTo hdc, apt(1).x, apt(1).y
   MoveToEx hdc, apt(2).x, apt(2).y, BYVAL %NULL
   LineTo hdc, apt(3).x, apt(3).y

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 cxClient AS LONG
   STATIC cyClient AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  ps  AS PAINTSTRUCT
   DIM    apt(3) AS STATIC POINT

   SELECT CASE uMsg

      CASE %WM_SIZE
         cxClient = LO(WORD, lParam)
         cyClient = HI(WORD, lParam)

         apt(0).x = cxClient / 4
         apt(0).y = cyClient / 2

         apt(1).x = cxClient / 2
         apt(1).y = cyClient / 4

         apt(2).x =     cxClient / 2
         apt(2).y = 3 * cyClient / 4

         apt(3).x = 3 * cxClient / 4
         apt(3).y =     cyClient / 2

         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_LBUTTONDOWN, %WM_RBUTTONDOWN, %WM_MOUSEMOVE
         IF (wParam AND %MK_LBUTTON) OR (wParam AND %MK_RBUTTON) THEN
            hdc = GetDC(hwnd)
            SelectObject hdc, GetStockObject(%WHITE_PEN)
            DrawBezier hdc, apt()
            IF (wParam AND %MK_LBUTTON) THEN
               apt(1).x = LO(WORD, lParam)
               apt(1).y = HI(WORD, lParam)
            END IF
            IF (wParam AND %MK_RBUTTON) THEN
               apt(2).x = LO(WORD, lParam)
               apt(2).y = HI(WORD, lParam)
            END IF
            SelectObject hdc, GetStockObject(%BLACK_PEN)
            DrawBezier hdc, apt()
            ReleaseDC hwnd, hdc
         END IF

      CASE %WM_PAINT
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         hdc = BeginPaint(hwnd, ps)
         DrawBezier hdc, apt()
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of BITBLT.C -- BitBlt Demonstration © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming Windows, 5th Edition.

The BITBLT program uses the BitBlt function to copy the program's system menu icon (located in the upper left corner of the program's window) to its client area.

Code: [Select]

' ========================================================================================
' BITBLT.BAS
' This program is a translation/adaptation of BITBLT.C -- BitBlt Demonstration
' © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming
' Windows, 5th Edition.
' The BITBLT program uses the BitBlt function to copy the program's system menu icon
' (located in the upper left corner of the program's window) to its client area.
' ========================================================================================

#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          = "BitBlt"
   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 = "BitBlt Demo"
   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
   STATIC cxSource  AS LONG
   STATIC cySource  AS LONG
   LOCAL  hdcClient AS DWORD
   LOCAL  hdcWindow AS DWORD
   LOCAL  x         AS LONG
   LOCAL  y         AS LONG
   LOCAL  ps        AS PAINTSTRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE
         cxSource = GetSystemMetrics(%SM_CXSIZEFRAME) + GetSystemMetrics(%SM_CXSIZE)
         cySource = GetSystemMetrics(%SM_CYSIZEFRAME) + GetSystemMetrics(%SM_CYCAPTION)
         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

      ' // Note: The following code only works with Windows classic theme, not with Aero.
      CASE %WM_PAINT
         hdcClient = BeginPaint(hwnd, ps)
         hdcWindow = GetWindowDC(hwnd)
         FOR y = 0 TO cyClient - 1 STEP cySource
            FOR x = 0 TO cxClient - 1 STEP cxSource
               BitBlt hdcClient, x, y, cxSource, cySource, hdcWindow, 0, 0, %SRCCOPY
            NEXT
         NEXT
         ReleaseDC hwnd, hdcWindow
         EndPaint hwnd, ps
         EXIT FUNCTION

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of BITMASK.C -- Bitmap Masking Demonstration © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming Windows, 5th Edition.

A mask is a monochrome bitmap of the same dimensions as the rectangular bitmap image you want to display. Each mask pixel corresponds with a pixel of the bitmap image. The mask pixels are 1 (white) wherever the original bitmap pixel is to be displayed, and 0 (black) wherever you want to preserve the destination background. (Or the mask bitmap can be opposite this, with some corresponding changes to the raster operations you use.)

Code: [Select]

' ========================================================================================
' BITMASK.BAS
' This program is a translation/adaptation of BITMASK.C -- Bitmap Masking Demonstration
' © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming
' Windows, 5th Edition.
' A mask is a monochrome bitmap of the same dimensions as the rectangular bitmap image you
' want to display. Each mask pixel corresponds with a pixel of the bitmap image. The mask
' pixels are 1 (white) wherever the original bitmap pixel is to be displayed, and 0 (black)
' wherever you want to preserve the destination background. (Or the mask bitmap can be
' opposite this, with some corresponding changes to the raster operations you use.)
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#RESOURCE RES, "bitmask.res"

' ========================================================================================
' 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          = "BitMask"
   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 = "Bitmap Masking Demo"
   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 hBitmapImag AS DWORD
   STATIC hBitmapMask AS DWORD
   STATIC hInstance   AS DWORD
   STATIC cxClient    AS LONG
   STATIC cyClient    AS LONG
   STATIC cxBitmap    AS LONG
   STATIC cyBitmap    AS LONG
   LOCAL  bmp         AS BITMAP
   LOCAL  hdc         AS DWORD
   LOCAL  hdcMemImag  AS DWORD
   LOCAL  hdcMemMask  AS DWORD
   LOCAL  x           AS LONG
   LOCAL  y           AS LONG
   LOCAL  ps          AS PAINTSTRUCT
   LOCAL  lpc         AS CREATESTRUCT PTR

   SELECT CASE uMsg

     CASE %WM_CREATE
         lpc = lParam
         hInstance = @lpc.hInstance
         ' Load the original image and get its size
         hBitmapImag = LoadBitmap (hInstance, "Matthew")
         GetObject hBitmapImag, SIZEOF(BITMAP), bmp
         cxBitmap = bmp.bmWidth
         cyBitmap = bmp.bmHeight
         ' Select the original image into a memory DC
         hdcMemImag = CreateCompatibleDC(%NULL)
         SelectObject hdcMemImag, hBitmapImag
         ' Create the monochrome mask bitmap and memory DC
         hBitmapMask = CreateBitmap(cxBitmap, cyBitmap, 1, 1, BYVAL %NULL)
         hdcMemMask = CreateCompatibleDC(%NULL)
         SelectObject hdcMemMask, hBitmapMask
         ' Color the mask bitmap black with a white ellipse
         SelectObject hdcMemMask, GetStockObject(%BLACK_BRUSH)
         Rectangle hdcMemMask, 0, 0, cxBitmap, cyBitmap
         SelectObject hdcMemMask, GetStockObject(%WHITE_BRUSH)
         Ellipse hdcMemMask, 0, 0, cxBitmap, cyBitmap
         ' Mask the original image
         BitBlt hdcMemImag, 0, 0, cxBitmap, cyBitmap, hdcMemMask, 0, 0, %SRCAND
         DeleteDC hdcMemImag
         DeleteDC hdcMemMask
         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)
         ' Select bitmaps into memory DCs
         hdcMemImag = CreateCompatibleDC(hdc)
         SelectObject hdcMemImag, hBitmapImag
         hdcMemMask = CreateCompatibleDC(hdc)
         SelectObject hdcMemMask, hBitmapMask
         ' Center image
         x = (cxClient - cxBitmap) / 2
         y = (cyClient - cyBitmap) / 2
         ' Do the bitblts
         BitBlt hdc, x, y, cxBitmap, cyBitmap, hdcMemMask, 0, 0, &H220326
         BitBlt hdc, x, y, cxBitmap, cyBitmap, hdcMemImag, 0, 0, %SRCPAINT
         DeleteDC hdcMemImag
         DeleteDC hdcMemMask
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         DeleteObject hBitmapImag
         DeleteObject hBitmapMask
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of BLOKOUT1.C -- Mouse Button Demo Program © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming Windows, 5th Edition.

This program demonstrates a little something that might be implemented in a Windows drawing program. You begin by depressing the left mouse button to indicate one corner of a rectangle. You then drag the mouse. The program draws an outlined rectangle with the opposite corner at the current mouse position. When you release the mouse, the program fills in the rectangle.

Code: [Select]

' ========================================================================================
' BLOKOUT1.BAS
' This program is a translation/adaptation of BLOKOUT1.C -- Mouse Button Demo Program
' © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming
' Windows, 5th Edition.
' This program demonstrates a little something that might be implemented in a Windows
' drawing program. You begin by depressing the left mouse button to indicate one corner of
' a rectangle. You then drag the mouse. The program draws an outlined rectangle with the
' opposite corner at the current mouse position. When you release the mouse, the program
' fills in the rectangle.
' ========================================================================================

#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          = "BlokOut1"
   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 = "Mouse Button Demo"
   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 DrawBoxOutline (BYVAL hwnd AS DWORD, ptBeg AS POINTAPI, ptEnd AS POINTAPI)

   LOCAL hdc AS DWORD

   hdc = GetDC(hwnd)

   SetROP2 hdc, %R2_NOT
   SelectObject hdc, GetStockObject(%NULL_BRUSH)
   Rectangle hdc, ptBeg.x, ptBeg.y, ptEnd.x, ptEnd.y

   ReleaseDC hwnd, hdc

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 fBlocking AS LONG
   STATIC fValidBox AS LONG
   STATIC ptBeg     AS POINT
   STATIC ptEnd     AS POINT
   STATIC ptBoxBeg  AS POINT
   STATIC ptBoxEnd  AS POINT
   LOCAL  hdc       AS DWORD
   LOCAL  ps        AS PAINTSTRUCT

   SELECT CASE uMsg

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

      CASE %WM_LBUTTONDOWN
         ptBeg.x = LOWRD(lParam)
         ptBeg.y = HIWRD(lParam)
         ptEnd.x = ptBeg.x
         ptEnd.y = ptBeg.y
         DrawBoxOutline hwnd, ptBeg, ptEnd
         SetCursor LoadCursor(%NULL, BYVAL %IDC_CROSS)
         fBlocking = %TRUE
         EXIT FUNCTION

      CASE %WM_MOUSEMOVE
         IF fBlocking THEN
            SetCursor LoadCursor(%NULL, BYVAL %IDC_CROSS)
            DrawBoxOutline hwnd, ptBeg, ptEnd
            ptEnd.x = LOWRD(lParam)
            ptEnd.y = HIWRD(lParam)
            DrawBoxOutline hwnd, ptBeg, ptEnd
         END IF
         EXIT FUNCTION

      CASE %WM_LBUTTONUP
         IF fBlocking THEN
            DrawBoxOutline hwnd, ptBeg, ptEnd
            ptBoxBeg   = ptBeg
            ptBoxEnd.x = LOWRD(lParam)
            ptBoxEnd.y = HIWRD(lParam)
            SetCursor LoadCursor(%NULL, BYVAL %IDC_ARROW)
            fBlocking = %FALSE
            fValidBox  = %TRUE
            InvalidateRect hwnd, BYVAL %NULL, %TRUE
         END IF
         EXIT FUNCTION

      CASE %WM_CHAR
         IF ISTRUE fBlocking AND wParam = %VK_ESCAPE THEN
            DrawBoxOutline hwnd, ptBeg, ptEnd
            SetCursor LoadCursor(%NULL, BYVAL %IDC_ARROW)
            fBlocking = %FALSE
         END IF
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         IF fValidBox THEN
            SelectObject hdc, GetStockObject(%BLACK_BRUSH)
            Rectangle hdc, ptBoxBeg.x, ptBoxBeg.y, ptBoxEnd.x, ptBoxEnd.y
         END IF
         IF fBlocking THEN
            SetROP2 hdc, %R2_NOT
            SelectObject hdc, GetStockObject(%NULL_BRUSH)
            Rectangle hdc, ptBeg.x, ptBeg.y, ptEnd.x, ptEnd.y
         END IF
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of BLOKOUT2.C -- Mouse Button & Capture Demo Program © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming Windows, 5th Edition.

BLOKOUT2 is the same as BLOKOUT1, except with three new lines of code: a call to SetCapture during the WM_LBUTTONDOWN message and calls to ReleaseCapture during the WM_LBUTTONDOWN and WM_CHAR messages. And check this out: Make the window smaller than the screen size, begin blocking out a rectangle within the client area, and then move the mouse cursor outside the client and to the right or bottom, and finally release the mouse button. The program will have the coordinates of the entire rectangle. Just enlarge the window to see it.

Code: [Select]

' ========================================================================================
' BLOKOUT2.BAS
' This program is a translation/adaptation of BLOKOUT2.C -- Mouse Button & Capture Demo
' Program © Charles Petzold, 1998, described and analysed in Chapter 7 of the book
' Programming Windows, 5th Edition.
' BLOKOUT2 is the same as BLOKOUT1, except with three new lines of code: a call to
' SetCapture during the WM_LBUTTONDOWN message and calls to ReleaseCapture during the
' WM_LBUTTONDOWN and WM_CHAR messages. And check this out: Make the window smaller than
' the screen size, begin blocking out a rectangle within the client area, and then move
' the mouse cursor outside the client and to the right or bottom, and finally release the
' mouse button. The program will have the coordinates of the entire rectangle. Just
' enlarge the window to see it.
' ========================================================================================

#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          = "BlokOut2"
   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 = "Mouse Button & Capture Demo"
   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 DrawBoxOutline (BYVAL hwnd AS DWORD, ptBeg AS POINTAPI, ptEnd AS POINTAPI)

   LOCAL hdc AS DWORD

   hdc = GetDC(hwnd)

   SetROP2 hdc, %R2_NOT
   SelectObject hdc, GetStockObject(%NULL_BRUSH)
   Rectangle hdc, ptBeg.x, ptBeg.y, ptEnd.x, ptEnd.y

   ReleaseDC hwnd, hdc

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 fBlocking AS LONG
   STATIC fValidBox AS LONG
   STATIC ptBeg     AS POINT
   STATIC ptEnd     AS POINT
   STATIC ptBoxBeg  AS POINT
   STATIC ptBoxEnd  AS POINT
   LOCAL  hdc       AS DWORD
   LOCAL  ps        AS PAINTSTRUCT

   SELECT CASE uMsg

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

      CASE %WM_LBUTTONDOWN
         ptBeg.x = LOWRD(lParam)
         ptBeg.y = HIWRD(lParam)
         ptEnd.x = ptBeg.x
         ptEnd.y = ptBeg.y
         DrawBoxOutline hwnd, ptBeg, ptEnd
         SetCapture hwnd
         SetCursor LoadCursor(%NULL, BYVAL %IDC_CROSS)
         fBlocking = %TRUE
         EXIT FUNCTION

      CASE %WM_MOUSEMOVE
         IF fBlocking THEN
            SetCursor LoadCursor(%NULL, BYVAL %IDC_CROSS)
            DrawBoxOutline hwnd, ptBeg, ptEnd
            ptEnd.x = LOWRD(lParam)
            ptEnd.y = HIWRD(lParam)
            DrawBoxOutline hwnd, ptBeg, ptEnd
         END IF
         EXIT FUNCTION

      CASE %WM_LBUTTONUP
         IF fBlocking THEN
            DrawBoxOutline hwnd, ptBeg, ptEnd
            ptBoxBeg   = ptBeg
            ptBoxEnd.x = LOWRD(lParam)
            ptBoxEnd.y = HIWRD(lParam)
            ReleaseCapture()
            SetCursor LoadCursor(%NULL, BYVAL %IDC_ARROW)
            fBlocking = %FALSE
            fValidBox  = %TRUE
            InvalidateRect hwnd, BYVAL %NULL, %TRUE
         END IF
         EXIT FUNCTION

      CASE %WM_CHAR
         IF ISTRUE fBlocking AND wParam = %VK_ESCAPE THEN
            DrawBoxOutline hwnd, ptBeg, ptEnd
            ReleaseCapture()
            SetCursor LoadCursor(%NULL, BYVAL %IDC_ARROW)
            fBlocking = %FALSE
         END IF
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         IF fValidBox THEN
            SelectObject hdc, GetStockObject(%BLACK_BRUSH)
            Rectangle hdc, ptBoxBeg.x, ptBoxBeg.y, ptBoxEnd.x, ptBoxEnd.y
         END IF
         IF fBlocking THEN
            SetROP2 hdc, %R2_NOT
            SelectObject hdc, GetStockObject(%NULL_BRUSH)
            Rectangle hdc, ptBeg.x, ptBeg.y, ptEnd.x, ptEnd.y
         END IF
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of BOUNCE.C -- Bouncing Ball Program © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming Windows, 5th Edition.

The BOUNCE program constructs a ball that bounces around in the window's client area. The program uses the timer to pace the ball. The ball itself is a bitmap. The program first creates the ball by creating the bitmap, selecting it into a memory device context, and then making simple GDI function calls. The program draws the bitmapped ball on the display using a BitBlt from a memory device context.

Code: [Select]

' ========================================================================================
' BOUNCE.BAS
' This program is a translation/adaptation of BOUNCE.C -- Bouncing Ball Program
' © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming
' Windows, 5th Edition.
' The BOUNCE program constructs a ball that bounces around in the window's client area.
' The program uses the timer to pace the ball. The ball itself is a bitmap. The program
' first creates the ball by creating the bitmap, selecting it into a memory device
' context, and then making simple GDI function calls. The program draws the bitmapped ball
' on the display using a BitBlt from a memory device context.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"

%ID_TIMER = 1

' ========================================================================================
' 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          = "Bounce"
   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 = "Bouncing Ball"
   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 hBitmap  AS DWORD
   STATIC cxClient AS LONG
   STATIC cyClient AS LONG
   STATIC xCenter  AS LONG
   STATIC yCenter  AS LONG
   STATIC cxTotal  AS LONG
   STATIC cyTotal  AS LONG
   STATIC cxRadius AS LONG
   STATIC cyRadius AS LONG
   STATIC cxMove   AS LONG
   STATIC cyMove   AS LONG
   STATIC xPixel   AS LONG
   STATIC yPixel   AS LONG
   LOCAL  hBrush   AS DWORD
   LOCAL  hdc      AS DWORD
   LOCAL  hdcMem   AS DWORD
   LOCAL  iScale   AS LONG

   SELECT CASE uMsg

     CASE %WM_CREATE
         hdc = GetDC(hwnd)
         xPixel = GetDeviceCaps(hdc, %ASPECTX)
         yPixel = GetDeviceCaps(hdc, %ASPECTY)
         ReleaseDC hwnd, hdc
         SetTimer hwnd, %ID_TIMER, 50, %NULL
         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 = LOWRD(lParam)
         cyClient = HIWRD(lParam)
         xCenter = cxClient  \ 2
         yCenter = cyClient  \ 2
         iScale = MIN&(cxClient * xPixel, cyClient * yPixel) \ 16
         cxRadius = iScale \ xPixel
         cyRadius = iScale \ yPixel
         cxMove = MAX&(1, cxRadius \ 2)
         cyMove = MAX&(1, cyRadius \ 2)
         cxTotal = 2 * (cxRadius + cxMove)
         cyTotal = 2 * (cyRadius + cyMove)
         IF hBitmap THEN DeleteObject hBitmap
         hdc = GetDC(hwnd)
         hdcMem = CreateCompatibleDC(hdc)
         hBitmap = CreateCompatibleBitmap(hdc, cxTotal, cyTotal)
         ReleaseDC hwnd, hdc
         SelectObject hdcMem, hBitmap
         Rectangle hdcMem, -1, -1, cxTotal + 1, cyTotal + 1
         hBrush = CreateHatchBrush(%HS_DIAGCROSS, 0)
         SelectObject hdcMem, hBrush
         SetBkColor hdcMem, RGB(255, 0, 255)
         Ellipse hdcMem, cxMove, cyMove, cxTotal - cxMove, cyTotal - cyMove
         DeleteDC hdcMem
         DeleteObject hBrush
         EXIT FUNCTION

      CASE %WM_TIMER
         IF ISFALSE hBitmap THEN EXIT FUNCTION
         hdc = GetDC(hwnd)
         hdcMem = CreateCompatibleDC(hdc)
         SelectObject hdcMem, hBitmap
         BitBlt hdc, xCenter - cxTotal \ 2, _
                     yCenter - cyTotal \ 2, cxTotal, cyTotal, _
                hdcMem, 0, 0, %SRCCOPY
         ReleaseDC hwnd, hdc
         DeleteDC hdcMem
         xCenter = xCenter + cxMove
         yCenter = yCenter + cyMove
         IF (xCenter + cxRadius) >= cxClient OR (xCenter - cxRadius <= 0) THEN cxMove = -cxMove
         IF (yCenter + cyRadius) >= cyClient OR (yCenter - cyRadius) <= 0 THEN cyMove = -cyMove
         EXIT FUNCTION

     CASE %WM_DESTROY
         IF hBitmap THEN DeleteObject hBitmap
         KillTimer hwnd, %ID_TIMER
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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