Charles Petzold's Examples

[José Roca]

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

Shows how to load a small monochrome bitmap resource. This bitmap doesn't exactly look like a brick by itself but when repeated horizontally and vertically resembles a wall of bricks.

Code Select Expand


' ========================================================================================
' BRICKS1.BAS
' This program is a translation/adaptation of BRICKS1.C -- LoadBitmap Demonstration
' © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming
' Windows, 5th Edition.
' Shows how to load a small monochrome bitmap resource. This bitmap doesn't exactly look
' like a brick by itself but when repeated horizontally and vertically resembles a wall of
' bricks.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#RESOURCE RES, "bricks1.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          = "Bricks1"
   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 = "LoadBitmap 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 hBitmap   AS DWORD
   STATIC cxClient  AS LONG
   STATIC cyClient  AS LONG
   STATIC cxSource  AS LONG
   STATIC cySource  AS LONG
   LOCAL  bmp       AS BITMAP
   LOCAL  hdc       AS DWORD
   LOCAL  hdcMem    AS DWORD
   LOCAL  lpc       AS CREATESTRUCT PTR
   LOCAL  hInstance AS DWORD
   LOCAL  x         AS LONG
   LOCAL  y         AS LONG
   LOCAL  ps        AS PAINTSTRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE
         lpc = lParam
         hInstance = @lpc.hInstance
         hBitmap = LoadBitmap(hInstance, "Bricks")
         GetObject hBitmap, SIZEOF(BITMAP), bmp
         cxSource = bmp.bmWidth
         cySource = bmp.bmHeight
         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)
         hdcMem = CreateCompatibleDC(hdc)
         SelectObject hdcMem, hBitmap
         FOR y = 0 TO cxClient - 1 STEP cySource
            FOR x = 0 TO cxClient - 1 STEP cxSource
               BitBlt hdc, x, y, cxSource, cySource, hdcMem, 0, 0, %SRCCOPY
            NEXT
         NEXT
         DeleteDC hdcMem
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         DeleteObject hBitmap
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

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

If you're working with small monochrome images, you don't have to create them as resources. Unlike color bitmap objects, the format of monochrome bits is relatively simple and can almost be derived directly from the image you want to create.

You can write down a series of bits (0 for black and 1 for white) that directly corresponds to this grid. Reading these bits from left to right, you can then assign each group of 8 bits a hexadecimal byte. If the width of the bitmap is not a multiple of 16, pad the bytes to the right with zeros to get an even number of bytes.

The BRICKS2 program uses this technique to create the bricks bitmap directly without requiring a resource.

Code Select Expand


' ========================================================================================
' BRICKS2.BAS
' This program is a translation/adaptation of BRICKS2.C -- CreateBitmap Demonstration
' © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming
' Windows, 5th Edition.
' If you're working with small monochrome images, you don't have to create them as
' resources. Unlike color bitmap objects, the format of monochrome bits is relatively
' simple and can almost be derived directly from the image you want to create.
' You can write down a series of bits (0 for black and 1 for white) that directly
' corresponds to this grid. Reading these bits from left to right, you can then assign
' each group of 8 bits a hexadecimal byte. If the width of the bitmap is not a multiple
' of 16, pad the bytes to the right with zeros to get an even number of bytes.
' The BRICKS2 program uses this technique to create the bricks bitmap directly without
' requiring a resource.
' ========================================================================================

#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          = "Bricks2"
   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 = "CreateBitmap 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 hBitmap   AS DWORD
   STATIC cxClient  AS LONG
   STATIC cyClient  AS LONG
   STATIC cxSource  AS LONG
   STATIC cySource  AS LONG
   LOCAL  hdc       AS DWORD
   LOCAL  hdcMem    AS DWORD
   LOCAL  x         AS LONG
   LOCAL  y         AS LONG
   LOCAL  ps        AS PAINTSTRUCT
   STATIC bmp       AS BITMAP
   DIM    bmpbits(0 TO 7, 0 TO 1) AS STATIC BYTE

   SELECT CASE uMsg

      CASE %WM_CREATE
         bmp.bmType = 0
         bmp.bmWidth = 8
         bmp.bmHeight = 8
         bmp.bmWidthBytes = 2
         bmp.bmPlanes = 1
         bmp.bmBitsPixel = 1
         bmpbits(0, 0) = &HFF : bmpbits(1, 0) = 0
         bmpbits(2, 0) = &H0C : bmpbits(3, 0) = 0
         bmpbits(4, 0) = &H0C : bmpbits(5, 0) = 0
         bmpbits(6, 0) = &H0C : bmpbits(7, 0) = 0
         bmpbits(0, 1) = &HFF : bmpbits(1, 1) = 0
         bmpbits(2, 1) = &HC0 : bmpbits(3, 1) = 0
         bmpbits(4, 1) = &HC0 : bmpbits(5, 1) = 0
         bmpbits(6, 1) = &HC0 : bmpbits(7, 1) = 0
         bmp.bmBits = VARPTR(bmpbits(0))
         hBitmap = CreateBitmapIndirect(bmp)
         cxSource = bmp.bmWidth
         cySource = bmp.bmHeight
         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)
         hdcMem = CreateCompatibleDC(hdc)
         SelectObject hdcMem, hBitmap
         FOR y = 0 TO cxClient - 1 STEP cySource
            FOR x = 0 TO cxClient - 1 STEP cxSource
               BitBlt hdc, x, y, cxSource, cySource, hdcMem, 0, 0, %SRCCOPY
            NEXT
         NEXT
         DeleteDC hdcMem
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         DeleteObject hBitmap
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

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

The final entry in the BRICKS series is BRICKS3. At first glance this program might provoke the reaction "Where's the code?"

As you can see, the window procedure doesn't do much of anything. BRICKS3 actually uses the bricks pattern as the window class background brush, which is defined in the hbrBackground field of the WNDCLASS structure.

Code Select Expand


' ========================================================================================
' BRICKS3.BAS
' This program is a translation/adaptation of BRICKS3.C -- CreatePatternBrush Demonstration
' © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming
' Windows, 5th Edition.
' The final entry in the BRICKS series is BRICKS3. At first glance this program might
' provoke the reaction "Where's the code?"
' As you can see, the window procedure doesn't do much of anything. BRICKS3 actually uses
' the bricks pattern as the window class background brush, which is defined in the
' hbrBackground field of the WNDCLASS structure.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#RESOURCE RES, "bricks3.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
   LOCAL hBitmap   AS DWORD
   LOCAL hBrush    AS DWORD

   hBitmap = LoadBitmap (hInstance, "Bricks")
   hBrush = CreatePatternBrush(hBitmap)
   DeleteObject hBitmap

   szAppName          = "Bricks3"
   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 = hBrush
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szAppName)

   IF ISFALSE RegisterClassEx(wcex) THEN
      FUNCTION = %TRUE
      EXIT FUNCTION
   END IF

   szCaption = "CreatePatternBrush 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

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

   SELECT CASE uMsg

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

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

   END SELECT

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

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


[José Roca]

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

Creates 10 child window button controls, one for each of the 10 standard styles of buttons.

Code Select Expand


' ========================================================================================
' BTNLOOK.BAS
' This program is a translation/adaptation of BTNLOOK.C -- Button Look Program
' © Charles Petzold, 1998, described and analysed in Chapter 9 of the book Programming
' Windows, 5th Edition.
' Creates 10 child window button controls, one for each of the 10 standard styles of
' buttons.
' ========================================================================================

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

TYPE BUTTON_STRUCT
   iStyle AS LONG
   szText AS ASCIIZ * 256
END TYPE

' ========================================================================================
' 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          = "BtnLook"
   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 = "Button Look"
   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

   DIM    tbutton(9) AS STATIC BUTTON_STRUCT
   DIM    hwndButton(9) AS STATIC DWORD
   STATIC rc AS RECT
   STATIC szTop AS ASCIIZ * 256
   STATIC szUnd AS ASCIIZ * 256
   STATIC szFormat AS ASCIIZ * 256
   STATIC szBuffer AS ASCIIZ * 256
   STATIC cxChar AS LONG
   STATIC cyChar AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  i AS LONG
   LOCAL  lpc AS CREATESTRUCT PTR
   LOCAL  hInstance AS DWORD
   LOCAL  szMsg AS ASCIIZ * 256

   SELECT CASE uMsg

      CASE %WM_CREATE

         lpc = lParam
         hInstance = @lpc.hInstance

         szTop = "message            wParam       lParam"
         szUnd = "_______            ______       ______"
         szFormat = "%-16s%04X-%04X    %04X-%04X"

         tbutton(0).iStyle = %BS_PUSHBUTTON      : tbutton(0).szText = "PUSHBUTTON"
         tbutton(1).iStyle = %BS_DEFPUSHBUTTON   : tbutton(1).szText = "DEFPUSHBUTTON"
         tbutton(2).iStyle = %BS_CHECKBOX        : tbutton(2).szText = "CHECKBOX"
         tbutton(3).iStyle = %BS_AUTOCHECKBOX    : tbutton(3).szText = "AUTOCHECKBOX"
         tbutton(4).iStyle = %BS_RADIOBUTTON     : tbutton(4).szText = "RADIOBUTTON"
         tbutton(5).iStyle = %BS_3STATE          : tbutton(5).szText = "3STATE"
         tbutton(6).iStyle = %BS_AUTO3STATE      : tbutton(6).szText = "AUTO3STATE"
         tbutton(7).iStyle = %BS_GROUPBOX        : tbutton(7).szText = "GROUPBOX"
         tbutton(8).iStyle = %BS_AUTORADIOBUTTON : tbutton(8).szText = "AUTORADIO"
         tbutton(9).iStyle = %BS_OWNERDRAW       : tbutton(9).szText = "OWNERDRAW"

         cxChar = LO(WORD, GetDialogBaseUnits())
         cyChar = HI(WORD, GetDialogBaseUnits())

         FOR i = 0 TO 9
            hwndButton(i) = CreateWindowEx (0, "button",  _
                            tbutton(i).szText, _
                            %WS_CHILD OR %WS_VISIBLE OR tbutton(i).iStyle, _
                            cxChar, cyChar * (1 + 2 * i), _
                            20 * cxChar, 7 * cyChar / 4, _
                            hwnd, i, hInstance, BYVAL %NULL)
         NEXT

         EXIT FUNCTION

      CASE %WM_SIZE
         rc.nLeft   = 24 * cxChar
         rc.nTop    =  2 * cyChar
         rc.nRight  = LO(WORD, lParam)
         rc.nBottom = HI(WORD, lParam)
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         SelectObject hdc, GetStockObject(%SYSTEM_FIXED_FONT)
         SetBkMode hdc, %TRANSPARENT
         TextOut hdc, 24 * cxChar, cyChar, szTop, LEN(szTop)
         TextOut hdc, 24 * cxChar, cyChar, szUnd, LEN(szUnd)
         EndPaint(hwnd, ps)
         EXIT FUNCTION

      CASE %WM_DRAWITEM, %WM_COMMAND
         ScrollWindow hwnd, 0, -cyChar, rc, rc
         hdc = GetDC(hwnd)
         SelectObject hdc, GetStockObject(%SYSTEM_FIXED_FONT)
         IF uMsg = %WM_DRAWITEM THEN
            szMsg = "WM_DRAWITEM"
         ELSE
            szMsg = "WM_COMMAND"
         END IF
         wsprintf szBuffer, szFormat, szMsg, BYVAL HIWRD(wParam), BYVAL LOWRD(wParam), BYVAL HIWRD(lParam), BYVAL LOWRD(lParam)
         TextOut hdc, 24 * cxChar, cyChar * (rc.nBottom / cyChar - 1), szBuffer, LEN(szBuffer)
         ReleaseDC hwnd, hdc
         ValidateRect hwnd, rc
         ' Fall through DefWindowProc

     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 CHECKER1.C -- Mouse Hit-Test Demo Program No. 1 © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming Windows, 5th Edition.

Demonstrates some simple hit-testing. The program divides the client area into a 5-by-5 array of 25 rectangles. If you click the mouse on one of the rectangles, the rectangle is filled with an X. If you click there again, the X is removed.

Code Select Expand


' ========================================================================================
' CHECKER1.BAS
' This program is a translation/adaptation of CHECKER1.C -- Mouse Hit-Test Demo Program No. 1
' © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming
' Windows, 5th Edition.
' Demonstrates some simple hit-testing. The program divides the client area into a 5-by-5
' array of 25 rectangles. If you click the mouse on one of the rectangles, the rectangle
' is filled with an X. If you click there again, the X is removed.
' ========================================================================================

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

%DIVISIONS = 5

' ========================================================================================
' 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          = "Checker1"
   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 = "Checker1 Mouse Hit-Test 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 window callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   DIM fState(0 TO %DIVISIONS, 0 TO %DIVISIONS) AS STATIC LONG
   STATIC cxBlock AS LONG
   STATIC cyBlock AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  x AS LONG
   LOCAL  y AS LONG
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  rc AS RECT

   SELECT CASE uMsg

      CASE %WM_SIZE
         cxBlock = LO(WORD, lParam) \ %DIVISIONS
         cyBlock = HI(WORD, lParam) \ %DIVISIONS
         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
         x = LO(WORD, lParam) \ cxBlock
         y = HI(WORD, lParam) \ cyBlock
         IF x < %DIVISIONS AND y < %DIVISIONS THEN
            fState(x, y) = IIF&(fState(x, y) = 1, 0, 1)
            rc.nLeft   = x * cxBlock
            rc.nTop    = y * cyBlock
            rc.nRight  = (x + 1) * cxBlock
            rc.nBottom = (y + 1) * cyBlock
            InvalidateRect hwnd, rc, %FALSE
         ELSE
            MessageBeep 0
         END IF
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         FOR x = 0 TO %DIVISIONS - 1
            FOR y = 0 TO %DIVISIONS - 1
               Rectangle hdc, x * cxBlock, y * cyBlock, _
                         (x + 1) * cxBlock, (y + 1) * cyBlock
               IF fState(x, y) THEN
                  MoveToEx hdc,  x    * cxBlock,  y    * cyBlock, BYVAL %NULL
                  LineTo   hdc, (x+1) * cxBlock, (y+1) * cyBlock
                  MoveToEx hdc,  x    * cxBlock, (y+1) * cyBlock, BYVAL %NULL
                  LineTo   hdc, (x+1) * cxBlock,  y    * cyBlock
               END IF
            NEXT
         NEXT
         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 CHECKER2.C -- Mouse Hit-Test Demo Program No. 2 © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming Windows, 5th Edition.

Same as CHECKER1, except that it includes a keyboard interface. You can use the Left, Right, Up, and Down arrow keys to move the cursor among the 25 rectangles. The Home key sends the cursor to the upper left rectangle; the End key drops it down to the lower right rectangle. Both the Spacebar and Enter keys toggle the X mark.

Code Select Expand


' ========================================================================================
' CHECKER2.BAS
' This program is a translation/adaptation of CHECKER2.C -- Mouse Hit-Test Demo Program No. 2
' © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming
' Windows, 5th Edition.
' Same as CHECKER1, except that it includes a keyboard interface. You can use the Left,
' Right, Up, and Down arrow keys to move the cursor among the 25 rectangles. The Home key
' sends the cursor to the upper left rectangle; the End key drops it down to the lower
' right rectangle. Both the Spacebar and Enter keys toggle the X mark.
' ========================================================================================

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

%DIVISIONS = 5

' ========================================================================================
' 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          = "Checker2"
   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 = "Checker2 Mouse Hit-Test 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 window callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   DIM fState(0 TO %DIVISIONS, 0 TO %DIVISIONS) AS STATIC LONG
   STATIC cxBlock AS LONG
   STATIC cyBlock AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  x AS LONG
   LOCAL  y AS LONG
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  pt AS POINT
   LOCAL  rc AS RECT

   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_SIZE
         cxBlock = LO(WORD, lParam) \ %DIVISIONS
         cyBlock = HI(WORD, lParam) \ %DIVISIONS
         EXIT FUNCTION

      CASE %WM_SETFOCUS
         ShowCursor %TRUE
         EXIT FUNCTION

      CASE %WM_KILLFOCUS
         ShowCursor %FALSE
         EXIT FUNCTION

      CASE %WM_KEYDOWN
         GetCursorPos pt
         ScreenToClient hwnd, pt
         x = MAX&(0, MIN&(%DIVISIONS - 1, pt.x \ cxBlock))
         y = MAX&(0, MIN&(%DIVISIONS - 1, pt.y \ cyBlock))
         SELECT CASE wParam
            CASE %VK_UP
               DECR y
            CASE %VK_DOWN
               INCR y
            CASE %VK_LEFT
               DECR x
            CASE %VK_RIGHT
               INCR x
            CASE %VK_HOME
               x = 0
               y = 0
            CASE %VK_END
               x = %DIVISIONS - 1
               y = %DIVISIONS - 1
            CASE %VK_RETURN, %VK_SPACE
               SendMessage hwnd, %WM_LBUTTONDOWN, %MK_LBUTTON, _
                           MAKLNG(x * cxBlock, y * cyBlock)
         END SELECT
         x = (x + %DIVISIONS) MOD %DIVISIONS
         y = (y + %DIVISIONS) MOD %DIVISIONS
         pt.x = x * cxBlock + cxBlock \ 2
         pt.y = y * cyBlock + cyBlock \ 2
         ClientToScreen hwnd, pt
         SetCursorPos pt.x, pt.y
         EXIT FUNCTION

      CASE %WM_LBUTTONDOWN
         x = LO(WORD, lParam) \ cxBlock
         y = HI(WORD, lParam) \ cyBlock
         IF x < %DIVISIONS AND y < %DIVISIONS THEN
            fState(x, y) = IIF&(fState(x, y) = 1, 0, 1)
            rc.nLeft   = x * cxBlock
            rc.nTop    = y * cyBlock
            rc.nRight  = (x + 1) * cxBlock
            rc.nBottom = (y + 1) * cyBlock
            InvalidateRect hwnd, rc, %FALSE
         ELSE
            MessageBeep 0
         END IF
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         FOR x = 0 TO %DIVISIONS - 1
            FOR y = 0 TO %DIVISIONS - 1
               Rectangle hdc, x * cxBlock, y * cyBlock, _
                         (x + 1) * cxBlock, (y + 1) * cyBlock
               IF fState(x, y) THEN
                  MoveToEx hdc,  x    * cxBlock,  y    * cyBlock, BYVAL %NULL
                  LineTo   hdc, (x+1) * cxBlock, (y+1) * cyBlock
                  MoveToEx hdc,  x    * cxBlock, (y+1) * cyBlock, BYVAL %NULL
                  LineTo   hdc, (x+1) * cxBlock,  y    * cyBlock
               END IF
            NEXT
         NEXT
         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 CHECKER3.C -- Mouse Hit-Test Demo Program No. 3 © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming Windows, 5th Edition.

This version of the program creates 25 child windows to process mouse clicks.

Code Select Expand


' ========================================================================================
' CHECKER3.BAS
' This program is a translation/adaptation of CHECKER3.C -- Mouse Hit-Test Demo Program No. 3
' © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming
' Windows, 5th Edition.
' This version of the program creates 25 child windows to process mouse clicks.
' ========================================================================================

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

%DIVISIONS = 5

GLOBAL szChildClass AS ASCIIZ * 256

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

   szChildClass       = "Checker3_Child"
   wcex.lpfnWndProc   = CODEPTR(ChildWndProc)
   wcex.cbWndExtra    = 4
   wcex.hIcon         = %NULL
   wcex.lpszClassName = VARPTR(szChildClass)
   RegisterClassEx wcex

   szCaption = "Checker3 Mouse Hit-Test 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 window callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   DIM hwndChild(0 TO %DIVISIONS, 0 TO %DIVISIONS) AS STATIC DWORD
   LOCAL cxBlock AS LONG
   LOCAL cyBlock AS LONG
   LOCAL x AS LONG
   LOCAL y AS LONG
   LOCAL id AS LONG

   SELECT CASE uMsg

      CASE %WM_CREATE
         FOR x = 0 TO %DIVISIONS - 1
            FOR y = 0 TO %DIVISIONS - 1
               id = y
               SHIFT LEFT id, 8
               id = id OR x
               hwndChild(x, y) = CreateWindowEx(0, szChildClass, BYVAL %NULL, _
                                 %WS_CHILDWINDOW OR %WS_VISIBLE, _
                                 0, 0, 0, 0, _
                                 hwnd, id, _
                                 GetWindowLong(hwnd, %GWL_HINSTANCE), _
                                 BYVAL %NULL)
            NEXT
         NEXT
         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
         cxBlock = LO(WORD, lParam) \ %DIVISIONS
         cyBlock = HI(WORD, lParam) \ %DIVISIONS
         FOR x = 0 TO %DIVISIONS - 1
            FOR y = 0 TO %DIVISIONS - 1
               MoveWindow hwndChild(x, y), _
                          x * cxBlock, y * cyBlock, _
                          cxBlock, cyBlock, %TRUE
            NEXT
         NEXT
         EXIT FUNCTION

      CASE %WM_LBUTTONDOWN
         MessageBeep 0
         EXIT FUNCTION

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Child window callback
' ========================================================================================
FUNCTION ChildWndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hdc AS DWORD
   LOCAL ps AS PAINTSTRUCT
   LOCAL rc AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         SetWindowLong hwnd, 0, 0       ' on/off flag
         EXIT FUNCTION

      CASE %WM_LBUTTONDOWN
         SetWindowLong hwnd, 0, IIF&(GetWindowLong(hwnd, 0) = 1, 0, 1)
         InvalidateRect hwnd, BYVAL %NULL, %FALSE
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         GetClientRect hwnd, rc
         Rectangle hdc, 0, 0, rc.nRight, rc.nBottom
         IF GetWindowLong (hwnd, 0) THEN
            MoveToEx hdc, 0,         0, BYVAL %NULL
            LineTo   hdc, rc.nRight, rc.nBottom
            MoveToEx hdc, 0,         rc.nBottom, BYVAL %NULL
            LineTo   hdc, rc.nRight, 0
         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 CHECKER4.C -- Mouse Hit-Test Demo Program No. 4 © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming Windows, 5th Edition.

Same as CHECKER3 with added keyboard interface.

Code Select Expand


' ========================================================================================
' CHECKER4.BAS
' This program is a translation/adaptation of CHECKER4.C -- Mouse Hit-Test Demo Program No. 4
' © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming
' Windows, 5th Edition.
' Same as CHECKER3 with added keyboard interface.
' ========================================================================================

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

%DIVISIONS = 5

GLOBAL szChildClass AS ASCIIZ * 256
GLOBAL idFocus 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        = "Checker4"
   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

   szChildClass       = "Checker4_Child"
   wcex.lpfnWndProc   = CODEPTR(ChildWndProc)
   wcex.cbWndExtra    = 4
   wcex.hIcon         = %NULL
   wcex.lpszClassName = VARPTR(szChildClass)
   RegisterClassEx wcex

   szCaption = "Checker4 Mouse Hit-Test 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 window callback.
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   DIM hwndChild(0 TO %DIVISIONS, 0 TO %DIVISIONS) AS STATIC DWORD
   LOCAL cxBlock AS LONG
   LOCAL cyBlock AS LONG
   LOCAL x AS LONG
   LOCAL y AS LONG
   LOCAL id AS LONG

   SELECT CASE uMsg

      CASE %WM_CREATE
         FOR x = 0 TO %DIVISIONS - 1
            FOR y = 0 TO %DIVISIONS - 1
               id = y
               SHIFT LEFT id, 8
               id = id OR x
               hwndChild(x, y) = CreateWindowEx(0, szChildClass, BYVAL %NULL, _
                                 %WS_CHILDWINDOW OR %WS_VISIBLE, _
                                 0, 0, 0, 0, _
                                 hwnd, id, _
                                 GetWindowLong(hwnd, %GWL_HINSTANCE), _
                                 BYVAL %NULL)
            NEXT
         NEXT
         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
         cxBlock = LO(WORD, lParam) \ %DIVISIONS
         cyBlock = HI(WORD, lParam) \ %DIVISIONS
         FOR x = 0 TO %DIVISIONS - 1
            FOR y = 0 TO %DIVISIONS - 1
               MoveWindow hwndChild(x, y), _
                          x * cxBlock, y * cyBlock, _
                          cxBlock, cyBlock, %TRUE
            NEXT
         NEXT
         EXIT FUNCTION

      CASE %WM_LBUTTONDOWN
         MessageBeep 0
         EXIT FUNCTION

      ' On set-focus message, set focus to child window
      CASE %WM_SETFOCUS
         SetFocus GetDlgItem(hwnd, idFocus)
         EXIT FUNCTION

      CASE %WM_KEYDOWN
         x = idFocus AND &HFF
         y = idFocus
         SHIFT RIGHT y, 8
         SELECT CASE wParam
            CASE %VK_UP:    DECR y
            CASE %VK_DOWN:  INCR y
            CASE %VK_LEFT:  DECR x
            CASE %VK_RIGHT: INCR x
            CASE %VK_HOME:  x = 0 : y = 0
            CASE %VK_END:   x = %DIVISIONS - 1 : y = x
            CASE ELSE
               EXIT FUNCTION
         END SELECT
         x = (x + %DIVISIONS) MOD %DIVISIONS
         y = (y + %DIVISIONS) MOD %DIVISIONS
         idFocus = y
         SHIFT LEFT idFocus, 8
         idFocus = idFocus OR x
         SetFocus GetDlgItem(hwnd, idFocus)
         EXIT FUNCTION

      CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
' Child window callback
' ========================================================================================
FUNCTION ChildWndProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL hdc AS DWORD
   LOCAL ps AS PAINTSTRUCT
   LOCAL rc AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         SetWindowLong hwnd, 0, 0       ' on/off flag
         EXIT FUNCTION

      CASE %WM_KEYDOWN
         ' Send most key presses to the parent window
         IF wParam <> %VK_RETURN AND wParam <> %VK_SPACE THEN
            SendMessage GetParent(hwnd), uMsg, wParam, lParam
            EXIT FUNCTION
         END IF
         ' For Return and Space, fall through to toggle the square
         SendMessage hwnd, %WM_LBUTTONDOWN, %MK_LBUTTON, 0
         EXIT FUNCTION

      CASE %WM_LBUTTONDOWN
         SetWindowLong hwnd, 0, IIF&(GetWindowLong(hwnd, 0) = 1, 0, 1)
         SetFocus hwnd
         InvalidateRect hwnd, BYVAL %NULL, %FALSE
         EXIT FUNCTION

      ' For focus messages, invalidate the window for repaint
      CASE %WM_SETFOCUS
         idFocus = GetWindowLong(hwnd, %GWL_ID)
         InvalidateRect hwnd, BYVAL %NULL, %FALSE
         EXIT FUNCTION

      CASE %WM_KILLFOCUS
         InvalidateRect hwnd, BYVAL %NULL, %FALSE
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         GetClientRect hwnd, rc
         Rectangle hdc, 0, 0, rc.nRight, rc.nBottom
         IF GetWindowLong (hwnd, 0) THEN
            MoveToEx hdc, 0,         0, BYVAL %NULL
            LineTo   hdc, rc.nRight, rc.nBottom
            MoveToEx hdc, 0,         rc.nBottom, BYVAL %NULL
            LineTo   hdc, rc.nRight, 0
         END IF
         ' Draw the "focus" rectangle
         IF hwnd = GetFocus() THEN
            rc.nLeft   = rc.nLeft + rc.nRight \ 10
            rc.nRight  = rc.nRight - rc.nLeft
            rc.nTop    = rc.nTop + rc.nBottom \ 10
            rc.nBottom = rc.nBottom - rc.nTop
            SelectObject hdc, GetStockObject(%NULL_BRUSH)
            SelectObject hdc, CreatePen(%PS_DASH, 0, 0)
            Rectangle hdc, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom
            DeleteObject SelectObject(hdc, GetStockObject(%BLACK_PEN))
         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 CHOSFONT.C -- ChooseFont Demo © Charles Petzold, 1998, described and analysed in Chapter 17 of the book Programming Windows, 5th Edition.

The CHOSFONT program demonstrates using the ChooseFont function and displays the fields of the LOGFONT structure that the function defines. The program also displays the same string of text as PICKFONT.

Code Select Expand


' ========================================================================================
' CHOSFONT.BAS
' This program is a translation/adaptation of CHOSFONT.C -- ChooseFont Demo
' © Charles Petzold, 1998, described and analysed in Chapter 17 of the book Programming
' Windows, 5th Edition.
' The CHOSFONT program demonstrates using the ChooseFont function and displays the fields
' of the LOGFONT structure that the function defines. The program also displays the same
' string of text as PICKFONT.
' ========================================================================================

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

%IDM_FONT = 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          = "ChosFont"
   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 = "ChooseFont"
   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 cf AS CHOOSEFONTAPI
   STATIC cyChar AS LONG
   STATIC lf AS LOGFONT
   STATIC szText AS ASCIIZ * 256
   LOCAL  hdc AS DWORD
   LOCAL  y AS LONG
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  szBuffer AS ASCIIZ * 64
   LOCAL  tm AS TEXTMETRIC

   SELECT CASE uMsg

      CASE %WM_CREATE
         szText = CHR$(&H41, &H42, &H43, &H44, &H45) & " " & _
                  CHR$(&H61, &H62, &H63, &H64, &H65) & " " & _
                  CHR$(&HC0, &HC1, &HC2, &HC3, &HC4, &HC5) & " " & _
                  CHR$(&HE0, &HE1, &HE2, &HE3, &HE4, &HE5)
         ' Get text height
         cyChar = HIWRD(GetDialogBaseUnits())
         ' Initialize the LOGFONT structure
         GetObject (GetStockObject(%SYSTEM_FONT), SIZEOF(lf), lf)
         ' Inialize the CHOOSEFONT structure
         cf.lStructSize    = SIZEOF(CHOOSEFONTAPI)
         cf.hwndOwner      = hwnd
         cf.hDC            = %NULL
         cf.lpLogFont      = VARPTR(lf)
         cf.iPointSize     = 0
         cf.Flags          = %CF_INITTOLOGFONTSTRUCT OR _
                             %CF_SCREENFONTS OR %CF_EFFECTS
         cf.rgbColors      = 0
         cf.lCustData      = 0
         cf.lpfnHook       = %NULL
         cf.lpTemplateName = %NULL
         cf.hInstance      = %NULL
         cf.lpszStyle      = %NULL
         cf.nFontType      = 0
         cf.nSizeMin       = 0
         cf.nSizeMax       = 0
         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_FONT
               IF ChooseFont(cf) THEN
                  InvalidateRect hwnd, BYVAL %NULL, %TRUE
               END IF
         END SELECT
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         ' Display sample text using selected font
         SelectObject hdc, CreateFontIndirect(lf)
         GetTextMetrics hdc, tm
         SetTextColor hdc, cf.rgbColors
         y = tm.tmExternalLeading
         TextOut hdc, 0, y, szText, LEN(szText)
         ' Display LOGFONT structure fields using system font
         DeleteObject SelectObject(hdc, GetStockObject(%SYSTEM_FONT))
         SetTextColor hdc, 0
         wsprintf szBuffer, "lfHeight = %i", BYVAL lf.lfHeight
         y = y + tm.tmHeight
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfWidth = %i", BYVAL lf.lfWidth
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfEscapement = %i", BYVAL lf.lfEscapement
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfOrientation = %i", BYVAL lf.lfOrientation
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfWeight = %i", BYVAL lf.lfWeight
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfItalic = %i", BYVAL lf.lfItalic
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfUnderline = %i", BYVAL lf.lfUnderline
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfStrikeOut = %i", BYVAL lf.lfStrikeOut
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfCharSet = %i", BYVAL lf.lfCharSet
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfOutPrecision = %i", BYVAL lf.lfOutPrecision
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfClipPrecision = %i", BYVAL lf.lfClipPrecision
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfQuality = %i", BYVAL lf.lfQuality
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfPitchAndFamily = 0x%02X", BYVAL lf.lfPitchAndFamily
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         wsprintf szBuffer, "lfFaceName = %s", lf.lfFaceName
         y = y + cyChar
         TextOut hdc, 0, y, szBuffer, LEN(szBuffer)
         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 CLIPTEXT.C -- The Clipboard and Text © Charles Petzold, 1998, described and analysed in Chapter 12 of the book Programming Windows, 5th Edition.

Clipboard text transfers.

ANSI version

Code Select Expand


' ========================================================================================
' CLIPTEXT.BAS
' This program is a translation/adaptation of CLIPTEXT.C -- The Clipboard and Text
' © Charles Petzold, 1998, described and analysed in Chapter 12 of the book Programming
' Windows, 5th Edition.
' Clipboard text transfers.
' ========================================================================================

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

%IDM_EDIT_CUT   = 40001
%IDM_EDIT_COPY  = 40002
%IDM_EDIT_PASTE = 40003
%IDM_EDIT_CLEAR = 40004
%IDM_EDIT_RESET = 40005

' ========================================================================================
' 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 hAccel    AS DWORD
   LOCAL szAppName AS ASCIIZ * 256
   LOCAL szCaption AS ASCIIZ * 256
   LOCAL wcex      AS WNDCLASSEX

   szAppName          = "ClipText"
   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 = "Clipboard Text Transfers - ANSI Version"
   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

   hAccel = LoadAccelerators(hInstance, szAppName)

   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 szDefaultText AS ASCIIZ * 256
   STATIC pText         AS ASCIIZ PTR
   LOCAL  bEnable       AS LONG
   LOCAL  hGlobal       AS DWORD
   LOCAL  hdc           AS DWORD
   LOCAL  pGlobal       AS ASCIIZ PTR
   LOCAL  ps            AS PAINTSTRUCT
   LOCAL  rc            AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         szDefaultText = "Default Text - ANSI Version"
         SendMessage hwnd, %WM_COMMAND, %IDM_EDIT_RESET, 0
         EXIT FUNCTION

      CASE %WM_INITMENUPOPUP
         EnableMenuItem (wParam, %IDM_EDIT_PASTE, _
              IIF&(IsClipboardFormatAvailable(%CF_TEXT), %MF_ENABLED, %MF_GRAYED))
         bEnable = IIF&(pText, %MF_ENABLED, %MF_GRAYED)
         EnableMenuItem wParam, %IDM_EDIT_CUT,   bEnable
         EnableMenuItem wParam, %IDM_EDIT_COPY,  bEnable
         EnableMenuItem wParam, %IDM_EDIT_CLEAR, bEnable
         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_EDIT_PASTE
               OpenClipboard hwnd
               hGlobal = GetClipboardData(%CF_TEXT)
               IF hGlobal THEN
                  pGlobal = GlobalLock (hGlobal)
                  IF pText THEN
                     CoTaskMemFree pText
                     pText = %NULL
                  END IF
                  pText = CoTaskMemAlloc(GlobalSize(hGlobal))
                  lstrcpy (BYVAL pText, BYVAL pGlobal)
                  GlobalUnlock hGlobal
                  InvalidateRect hwnd, BYVAL %NULL, %TRUE
               END IF
               CloseClipboard

            CASE %IDM_EDIT_CUT, %IDM_EDIT_COPY
               IF ISFALSE pText THEN EXIT FUNCTION
               hGlobal = GlobalAlloc(%GHND OR %GMEM_SHARE, lstrlen(BYVAL pText) + 1)
               pGlobal = GlobalLock(hGlobal)
               lstrcpy BYVAL pGlobal, BYVAL pText
               GlobalUnlock hGlobal
               OpenClipboard hwnd
               EmptyClipboard
               SetClipboardData %CF_TEXT, hGlobal
               CloseClipboard
               IF LO(WORD, wParam) = %IDM_EDIT_CUT THEN
                  SendMessage hwnd, %WM_COMMAND, %IDM_EDIT_CLEAR, 0
               END IF

            CASE %IDM_EDIT_CLEAR
               IF pText THEN
                  CoTaskMemFree pText
                  pText = %NULL
               END IF
               InvalidateRect hwnd, BYVAL %NULL, %TRUE

            CASE %IDM_EDIT_RESET
               IF pText THEN
                  CoTaskMemFree pText
                  pText = %NULL
               END IF
               pText = CoTaskMemAlloc(lstrlen(szDefaultText) + 1)
               lstrcpy BYVAL pText, szDefaultText
               InvalidateRect hwnd, BYVAL %NULL, %TRUE

         END SELECT
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         GetClientRect hwnd, rc
         IF pText THEN DrawText hdc, BYVAL pText, -1, rc, %DT_EXPANDTABS OR %DT_WORDBREAK
         EndPaint(hwnd, ps)
         EXIT FUNCTION

     CASE %WM_DESTROY
        ' Free the allocated memory and end the program
         IF pText THEN CoTaskMemFree pText
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


UNICODE version

Code Select Expand


' ========================================================================================
' CLIPTEXTW.BAS
' This program is a translation/adaptation of CLIPTEXT.C -- The Clipboard and Text
' © Charles Petzold, 1998, described and analysed in Chapter 12 of the book Programming
' Windows, 5th Edition.
' Clipboard text transfers (Unicode version).
' ========================================================================================

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

%IDM_EDIT_CUT   = 40001
%IDM_EDIT_COPY  = 40002
%IDM_EDIT_PASTE = 40003
%IDM_EDIT_CLEAR = 40004
%IDM_EDIT_RESET = 40005

' ========================================================================================
' 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 hAccel    AS DWORD
   LOCAL szAppName AS ASCIIZ * 256
   LOCAL szCaption AS ASCIIZ * 256
   LOCAL wcex      AS WNDCLASSEX

   szAppName          = "ClipText"
   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 = "Clipboard Text Transfers - UNICODE Version"
   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

   hAccel = LoadAccelerators(hInstance, szAppName)

   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      IF IsDialogMessage(hwnd, uMsg) = 0 THEN
         TranslateMessage uMsg
         DispatchMessage uMsg
      END IF
   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 wszDefaultText AS WSTRINGZ * 260
   STATIC pText          AS DWORD
   LOCAL  bEnable        AS LONG
   LOCAL  hGlobal        AS DWORD
   LOCAL  hdc            AS DWORD
   LOCAL  pGlobal        AS DWORD
   LOCAL  ps             AS PAINTSTRUCT
   LOCAL  rc             AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         wszDefaultText = "Default Text - UNICODE Version"
         SendMessage hwnd, %WM_COMMAND, %IDM_EDIT_RESET, 0
         EXIT FUNCTION

      CASE %WM_INITMENUPOPUP
         EnableMenuItem (wParam, %IDM_EDIT_PASTE, _
              IIF&(IsClipboardFormatAvailable(%CF_TEXT), %MF_ENABLED, %MF_GRAYED))
         bEnable = IIF&(pText, %MF_ENABLED, %MF_GRAYED)
         EnableMenuItem wParam, %IDM_EDIT_CUT,   bEnable
         EnableMenuItem wParam, %IDM_EDIT_COPY,  bEnable
         EnableMenuItem wParam, %IDM_EDIT_CLEAR, bEnable
         EXIT FUNCTION

      CASE %WM_COMMAND

         SELECT CASE LO(WORD, wParam)

            CASE %IDCANCEL
               IF HI(WORD, wParam) = %BN_CLICKED THEN
                  SendMessage hwnd, %WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF

            CASE %IDM_EDIT_PASTE
               OpenClipboard hwnd
               hGlobal = GetClipboardData(%CF_UNICODETEXT)
               IF hGlobal THEN
                  pGlobal = GlobalLock (hGlobal)
                  IF pText THEN
                     CoTaskMemFree pText
                     pText = %NULL
                  END IF
                  pText = CoTaskMemAlloc(GlobalSize(hGlobal))
                  lstrcpyW (BYVAL pText, BYVAL pGlobal)
                  GlobalUnlock hGlobal
                  InvalidateRect hwnd, BYVAL %NULL, %TRUE
               END IF
               CloseClipboard

            CASE %IDM_EDIT_CUT, %IDM_EDIT_COPY
               IF ISFALSE pText THEN EXIT FUNCTION
               hGlobal = GlobalAlloc(%GHND OR %GMEM_SHARE, (lstrlenW(BYVAL pText) + 1) * 2)
               pGlobal = GlobalLock(hGlobal)
               lstrcpyW BYVAL pGlobal, BYVAL pText
               GlobalUnlock hGlobal
               OpenClipboard hwnd
               EmptyClipboard
               SetClipboardData %CF_UNICODETEXT, hGlobal
               CloseClipboard
               IF LO(WORD, wParam) = %IDM_EDIT_CUT THEN
                  SendMessage hwnd, %WM_COMMAND, %IDM_EDIT_CLEAR, 0
               END IF

            CASE %IDM_EDIT_CLEAR
               IF pText THEN
                  CoTaskMemFree pText
                  pText = %NULL
               END IF
               InvalidateRect hwnd, BYVAL %NULL, %TRUE

            CASE %IDM_EDIT_RESET
               IF pText THEN
                  CoTaskMemFree pText
                  pText = %NULL
               END IF
               pText = CoTaskMemAlloc((LEN(wszDefaultText) + 1) * 2)
               lstrcpyW BYVAL pText, wszDefaultText
               InvalidateRect hwnd, BYVAL %NULL, %TRUE

         END SELECT
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         GetClientRect hwnd, rc
         IF pText THEN DrawTextW hdc, BYVAL pText, -1, rc, %DT_EXPANDTABS OR %DT_WORDBREAK
         EndPaint(hwnd, ps)
         EXIT FUNCTION

     CASE %WM_DESTROY
        ' Free the allocated memory and end the program
         IF pText THEN CoTaskMemFree pText
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of CLIPVIEW.C -- Simple Clipboard Viewer © Charles Petzold, 1998, described and analysed in Chapter 12 of the book Programming Windows, 5th Edition.

Clipboard viewers don't have to be as sophisticated as the one supplied with Windows. A clipboard viewer can, for instance, display a single clipboard format. The CLIPVIEW program is a clipboard viewer that displays only the %CF_TEXT format.

Code Select Expand


' ========================================================================================
' CLIPVIEW.BAS
' This program is a translation/adaptation of CLIPVIEW.C -- Simple Clipboard Viewer
' © Charles Petzold, 1998, described and analysed in Chapter 12 of the book Programming
' Windows, 5th Edition.
' Clipboard viewers don't have to be as sophisticated as the one supplied with Windows. A
' clipboard viewer can, for instance, display a single clipboard format. The CLIPVIEW
' program is a clipboard viewer that displays only the %CF_TEXT format.
' ========================================================================================

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

'%UNICODE = 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 szCaption AS ASCIIZ * 256
   LOCAL wcex      AS WNDCLASSEX

   szAppName          = "ClipView"
   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 = "Simple Clipboard Viewer (Text Only)"
   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 hwndNextViewer AS DWORD
   LOCAL  hGlobal        AS DWORD
   LOCAL  hdc            AS DWORD
   LOCAL  pGlobal        AS DWORD
   LOCAL  ps             AS PAINTSTRUCT
   LOCAL  rc             AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         hwndNextViewer = SetClipboardViewer(hwnd)
         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_CHANGECBCHAIN
         IF wParam = hwndNextViewer THEN
            hwndNextViewer = lParam
         ELSEIF hwndNextViewer THEN
            SendMessage hwndNextViewer, uMsg, wParam, lParam
         END IF
         EXIT FUNCTION

      CASE %WM_DRAWCLIPBOARD
         IF hwndNextViewer THEN
            SendMessage hwndNextViewer, uMsg, wParam, lParam
         END IF
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         GetClientRect hwnd, rc
         OpenClipboard hwnd
         #IF %DEF(%UNICODE)
            hGlobal = GetClipboardData(%CF_UNICODETEXT)
         #ELSE
            hGlobal = GetClipboardData(%CF_TEXT)
         #ENDIF
         IF hGlobal THEN
            pGlobal = GlobalLock(hGlobal)
            DrawText hdc, BYVAL pGlobal, -1, rc, %DT_EXPANDTABS
            GlobalUnlock hGlobal
         END IF
         CloseClipboard
         EndPaint(hwnd, ps)
         EXIT FUNCTION

     CASE %WM_DESTROY
         ChangeClipboardChain hwnd, hwndNextViewer
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of CLOCK.C -- Analog Clock Program © Charles Petzold, 1998, described and analysed in Chapter 5 of the book Programming Windows, 5th Edition.

An analog clock program needn't concern itself with internationalization, but the complexity of the graphics more than make up for that simplification. To get it right, you'll need to know some trigonometry.

Code Select Expand


' ========================================================================================
' CLOCK.BAS
' This program is a translation/adaptation of CLOCK.C -- Analog Clock Program © Charles Petzold,
' 1998, described and analysed in Chapter 5 of the book Programming Windows, 5th Edition.
' An analog clock program needn't concern itself with internationalization, but the
' complexity of the graphics more than make up for that simplification. To get it right,
' you'll need to know some trigonometry.
' ========================================================================================

#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          = "Clock"
   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 = "Analog Clock"
   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 SetIsotropic (BYVAL hdc AS DWORD, BYVAL cxClient AS LONG, BYVAL cyClient AS LONG)

   SetMapMode hdc, %MM_ISOTROPIC
   SetWindowExtEx hdc, 1000, 1000, BYVAL %NULL
   SetViewportExtEx hdc, cxClient / 2, -cyClient / 2, BYVAL %NULL
   SetViewportOrgEx hdc, cxClient / 2,  cyClient / 2, BYVAL %NULL

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

' ========================================================================================
SUB RotatePoint (pt() AS POINT, BYVAL iNum AS LONG, BYVAL iAngle AS LONG)

   LOCAL i AS LONG
   LOCAL ptTemp AS POINT
   LOCAL TWOPI AS DOUBLE

   TWOPI = 2 * 3.14159#

   FOR i = 0 TO iNum - 1
      ptTemp.x = (pt(i).x * COS(TWOPI * iAngle / 360) + _
                 pt(i).y * SIN(TWOPI * iAngle / 360))

      ptTemp.y = (pt(i).y * COS(TWOPI * iAngle / 360) - _
                 pt(i).x * SIN(TWOPI * iAngle / 360))
      pt(i) = ptTemp
   NEXT

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

' ========================================================================================
SUB DrawClock (BYVAL hdc AS DWORD)

   LOCAL iAngle AS LONG
   DIM   pt(0 TO 3) AS POINT

   FOR iAngle = 0 TO 359 STEP 6
      pt(0).x = 0
      pt(0).y = 900

      RotatePoint (pt(), 1, iAngle)

      IF iAngle MOD 5 <> 0 THEN
         pt(2).x = 33
      ELSE
         pt(2).x = 100
      END IF
      pt(2).y = pt(2).x

      pt(0).x = pt(0).x - pt(2).x / 2
      pt(0).y = pt(0).y - pt(2).y / 2

      pt(1).x  = pt(0).x + pt(2).x
      pt(1).y  = pt(0).y + pt(2).y

      SelectObject hdc, GetStockObject(%BLACK_BRUSH)

      Ellipse hdc, pt(0).x, pt(0).y, pt(1).x, pt(1).y
   NEXT

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

' ========================================================================================
SUB DrawHands (BYVAL hdc AS DWORD, pst AS SYSTEMTIME, BYVAL fChange AS LONG)

   DIM    pt(0 TO 2, 0 TO 4) AS STATIC POINT
   STATIC flag AS LONG
   LOCAL  i AS LONG
   LOCAL  x AS LONG
   LOCAL  start AS LONG
   DIM    iAngle(0 TO 2) AS LONG
   DIM    ptTemp(0 TO 2, 0 TO 4) AS POINT
   DIM    ptVector(0 TO 4) AS POINT

   IF ISFALSE flag THEN

      pt(0, 0).x = 0    : pt(0, 0).y = -150
      pt(0, 1).x = 100  : pt(0, 1).y = 0
      pt(0, 2).x = 0    : pt(0, 2).y = 600
      pt(0, 3).x = -100 : pt(0, 3).y = 0
      pt(0, 4).x = 0    : pt(0, 4).y = -150

      pt(1, 0).x = 0    : pt(1, 0).y = -200
      pt(1, 1).x = 50   : pt(1, 1).y = 0
      pt(1, 2).x = 0    : pt(1, 2).y = 800
      pt(1, 3).x = -50  : pt(1, 3).y = 0
      pt(1, 4).x = 0    : pt(1, 4).y = -200

      pt(2, 0).x = 0    : pt(2, 0).y = 0
      pt(2, 1).x = 0    : pt(2, 1).y = 0
      pt(2, 2).x = 0    : pt(2, 2).y = 0
      pt(2, 3).x = 0    : pt(2, 3).y = 0
      pt(2, 4).x = 0    : pt(2, 4).y = 800

      flag = %TRUE

   END IF

   iAngle(0) = (pst.wHour * 30) MOD 360 + pst.wMinute / 2
   iAngle(1) = pst.wMinute * 6
   iAngle(2) = pst.wSecond * 6

   CopyMemory VARPTR(ptTemp(0)), VARPTR(pt(0)), ARRAYATTR(pt(), 4) * SIZEOF(POINT)

   IF ISFALSE fChange THEN start = 2
   FOR i = start TO 2
      FOR x = 0 TO 4
         ptVector(x) = ptTemp(i, x)
      NEXT
      RotatePoint ptVector(), 5, iAngle(i)
      Polyline hdc, ptVector(0), 5
   NEXT

   SelectObject hdc, GetStockObject(%WHITE_BRUSH)
   Ellipse hdc, -30, -30, 30, 30

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
   STATIC stPrevious AS SYSTEMTIME
   LOCAL  fChange AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  st AS SYSTEMTIME

   SELECT CASE uMsg

      CASE %WM_CREATE
         SetTimer hwnd, %ID_TIMER, 1000, %NULL
         GetLocalTime st
         stPrevious = st
         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_TIMER
         GetLocalTime st
         IF st.wHour <> stPrevious.wHour OR st.wMinute <> stPrevious.wMinute THEN fChange = %TRUE
         hdc = GetDC(hwnd)
         SetIsotropic hdc, cxClient, cyClient
         SelectObject hdc, GetStockObject(%WHITE_PEN)
         DrawHands hdc, stPrevious, fChange
         SelectObject hdc, GetStockObject(%BLACK_PEN)
         DrawHands hdc, st, %TRUE
         ReleaseDC hwnd, hdc
         stPrevious = st
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         SetIsotropic hdc, cxClient, cyClient
         DrawClock hdc
         DrawHands hdc, stPrevious, %TRUE
         EndPaint hwnd, ps
         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 the CLOVER.C-Clover Drawing Program Using Regions © Charles Petzold, 1998, described and analysed in Chapter 5 of the book Programming Windows, 5th Edition.

Forms a region out of four ellipses, selects this region into the device context, and then draws a series of lines emanating from the center of the window's client area. The lines appear only in the area defined by the region.

Code Select Expand


' ========================================================================================
' CLOVER.BAS
' This program is a translation/adaptation of the CLOVER.C-Clover Drawing Program Using Regions
' © Charles Petzold, 1998, described and analysed in Chapter 5 of the book Programming
' Windows, 5th Edition.
' Forms a region out of four ellipses, selects this region into the device context, and
' then draws a series of lines emanating from the center of the window's client area. The
' lines appear only in the area defined by the region.
' ========================================================================================

#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          = "Clover"
   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 = "Draw a Clover"
   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 hRgnClip AS DWORD
   STATIC cxClient AS LONG
   STATIC cyClient AS LONG
   LOCAL  fAngle AS DOUBLE
   LOCAL  fRadius AS DOUBLE
   LOCAL  hCursor AS DWORD
   LOCAL  hdc AS DWORD
   LOCAL  i AS LONG
   LOCAL  ps  AS PAINTSTRUCT
   DIM    hRgnTemp(5) AS DWORD

   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_SIZE
         cxClient = LO(WORD, lParam)
         cyClient = HI(WORD, lParam)

         hCursor = SetCursor(LoadCursor(%NULL, BYVAL %IDC_WAIT))
         ShowCursor %TRUE

         IF hRgnClip THEN DeleteObject hRgnClip

         hRgnTemp(0) = CreateEllipticRgn (0, cyClient / 3, cxClient / 2, 2 * cyClient / 3)
         hRgnTemp(1) = CreateEllipticRgn (cxClient / 2, cyClient / 3, cxClient, 2 * cyClient / 3)
         hRgnTemp(2) = CreateEllipticRgn (cxClient / 3, 0, 2 * cxClient / 3, cyClient / 2)
         hRgnTemp(3) = CreateEllipticRgn (cxClient / 3, cyClient / 2, 2 * cxClient / 3, cyClient)
         hRgnTemp(4) = CreateRectRgn (0, 0, 1, 1)
         hRgnTemp(5) = CreateRectRgn (0, 0, 1, 1)
         hRgnClip    = CreateRectRgn (0, 0, 1, 1)

         CombineRgn (hRgnTemp(4), hRgnTemp(0), hRgnTemp(1), %RGN_OR)
         CombineRgn (hRgnTemp(5), hRgnTemp(2), hRgnTemp(3), %RGN_OR)
         CombineRgn (hRgnClip,    hRgnTemp(4), hRgnTemp(5), %RGN_XOR)

         FOR i = 0 TO 5
            DeleteObject hRgnTemp(i)
         NEXT

         SetCursor hCursor
         ShowCursor %FALSE

         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         SetViewportOrgEx hdc, cxClient / 2, cyClient / 2, BYVAL %NULL
         SelectClipRgn hdc, hRgnClip
         fRadius = SQR((CEXT(cxClient)/2.0)^2 + (CEXT(cyClient)/2.0)^2)
         FOR i = 0 TO 359
            fAngle = CEXT(i) * (2.0 * 3.14159) / 360
            MoveToEx hdc, 0, 0, BYVAL %NULL
            LineTo hdc, INT(fRadius * COS(fAngle) + 0.5), INT(-fRadius * SIN(fAngle) + 0.5)
         NEXT
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         DeleteObject hRgnClip
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of COLORS1.C -- Colors Using Scroll Bars © Charles Petzold, 1998, described and analysed in Chapter 9 of the book Programming Windows, 5th Edition.

COLORS1 puts its children to work. The program uses 10 child window controls: 3 scroll bars, 6 windows of static text, and 1 static rectangle. COLORS1 traps %WM_CTLCOLORSCROLLBAR messages to color the interior sections of the three scroll bars red, green, and blue and traps WM_CTLCOLORSTATIC messages to color the static text.

You can scroll the scroll bars using either the mouse or the keyboard. You can use COLORS1 as a development tool in experimenting with color and choosing attractive (or, if you prefer, ugly) colors for your own Windows programs.

Code Select Expand


' ========================================================================================
' COLORS1.BAS
' This program is a translation/adaptation of COLORS1.C -- Colors Using Scroll Bars
' © Charles Petzold, 1998, described and analysed in Chapter 9 of the book Programming
' Windows, 5th Edition.
' COLORS1 puts its children to work. The program uses 10 child window controls: 3 scroll
' bars, 6 windows of static text, and 1 static rectangle. COLORS1 traps
' %WM_CTLCOLORSCROLLBAR messages to color the interior sections of the three scroll bars
' red, green, and blue and traps WM_CTLCOLORSTATIC messages to color the static text.
' You can scroll the scroll bars using either the mouse or the keyboard. You can use
' COLORS1 as a development tool in experimenting with color and choosing attractive (or,
' if you prefer, ugly) colors for your own Windows programs.
' ========================================================================================

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

GLOBAL idFocus AS LONG
GLOBAL OldScroll() AS DWORD

' ========================================================================================
' 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          = "Colors1"
   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 = "Color Scroll"
   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

   DIM    crPrim(0 TO 2)       AS STATIC DWORD
   DIM    hBrush(0 TO 2)       AS STATIC DWORD
   STATIC hBrushStatic         AS DWORD
   DIM    hwndScroll(0 TO 2)   AS STATIC DWORD
   DIM    hwndLabel(0 TO 2)    AS STATIC DWORD
   DIM    hwndValue(0 TO 2)    AS STATIC DWORD
   STATIC hwndRect             AS DWORD
   DIM    iColor(0 TO 2)       AS STATIC LONG
   STATIC cyChar               AS LONG
   STATIC rcColor              AS RECT
   DIM    szColorLabel(0 TO 2) AS STATIC ASCIIZ * 6
   LOCAL  hInstance            AS DWORD
   LOCAL  i                    AS LONG
   LOCAL  cxClient             AS LONG
   LOCAL  cyClient             AS LONG
   LOCAL  szBuffer             AS ASCIIZ * 10

   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_CREATE

         ' Initialize variables
         hInstance = GetWindowLong(hwnd, %GWL_HINSTANCE)
         REDIM OldScroll(2)
         crPrim(0) = RGB(255, 0, 0)
         crPrim(1) = RGB(0, 255, 0)
         crPrim(2) = RGB(0, 0, 255)
         szColorLabel(0) = "Red"
         szColorLabel(1) = "Green"
         szColorLabel(2) = "Blue"

         ' Create the white-rectangle window against which the
         ' scroll bars will be positioned. The child window ID is 9.
         hwndRect = CreateWindowEx(0, "static", BYVAL %NULL, _
                                   %WS_CHILD OR %WS_VISIBLE OR %SS_WHITERECT, _
                                   0, 0, 0, 0, _
                                   hwnd, 9, hInstance, BYVAL %NULL)
         FOR i = 0 TO 2
            ' The three scroll bars have IDs 0, 1, and 2, with
            ' scroll bar ranges from 0 through 255.
            hwndScroll(i) = CreateWindowEx(0, "scrollbar", BYVAL %NULL, _
                            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %SBS_VERT, _
                            0, 0, 0, 0, hwnd, i, hInstance, BYVAL %NULL)
            SetScrollRange hwndScroll(i), %SB_CTL, 0, 255, %FALSE
            SetScrollPos   hwndScroll(i), %SB_CTL, 0, %FALSE
            ' The three color-name labels have IDs 3, 4, and 5,
            ' and text strings "Red", "Green", and "Blue".
            hwndLabel(i)  = CreateWindowEx(0, "static", szColorLabel(i), _
                            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, _
                            0, 0, 0, 0, hwnd, i + 3, hInstance, BYVAL %NULL)
            ' The three color-value text fields have IDs 6, 7,
            ' and 8, and initial text strings of "0".
            hwndValue(i) = CreateWindowEx(0, "static", "0", _
                           %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, _
                           0, 0, 0, 0, hwnd, i + 6, hInstance, BYVAL %NULL)
            OldScroll(i) = SetWindowLong (hwndScroll(i), _
                           %GWL_WNDPROC, CODEPTR(ScrollProc))
            hBrush(i) = CreateSolidBrush (crPrim(i))
         NEXT
         hBrushStatic = CreateSolidBrush (GetSysColor(%COLOR_BTNHIGHLIGHT))
         cyChar = HI(WORD, GetDialogBaseUnits())
         EXIT FUNCTION

      CASE %WM_SIZE
         cxClient = LO(WORD, lParam)
         cyClient = HI(WORD, lParam)
         SetRect rcColor, cxClient / 2, 0, cxClient, cyClient
         MoveWindow hwndRect, 0, 0, cxClient / 2, cyClient, %TRUE
         FOR i = 0 TO 2
            MoveWindow (hwndScroll(i), _
                        (2 * i + 1) * cxClient / 14, 2 * cyChar, _
                        cxClient / 14, cyClient - 4 * cyChar, %TRUE)
            MoveWindow (hwndLabel(i), _
                        (4 * i + 1) * cxClient / 28, cyChar / 2, _
                        cxClient / 7, cyChar, %TRUE)
            MoveWindow (hwndValue(i), _
                        (4 * i + 1) * cxClient / 28, _
                        cyClient - 3 * cyChar / 2, _
                        cxClient / 7, cyChar, %TRUE)
         NEXT
         SetFocus hwnd
         EXIT FUNCTION

      CASE %WM_SETFOCUS
         SetFocus(hwndScroll(idFocus))
         EXIT FUNCTION

      CASE %WM_VSCROLL

         i = GetWindowLong(lParam, %GWL_ID)

         SELECT CASE LOWRD(wParam)
            CASE %SB_PAGEDOWN
               iColor(i) = iColor(i) + 15
               iColor(i) = MIN&(255, iColor(i) + 1)
            CASE %SB_LINEDOWN
               iColor(i) = MIN&(255, iColor(i) + 1)
            CASE %SB_PAGEUP
               iColor(i) = iColor(i) - 15
               iColor(i) = MAX&(0, iColor(i) - 1)
            CASE %SB_LINEUP
               iColor(i) = MAX&(0, iColor(i) - 1)
            CASE %SB_TOP
               iColor(i) = 0
            CASE %SB_BOTTOM
               iColor(i) = 255
            CASE %SB_THUMBPOSITION, %SB_THUMBTRACK
               iColor(i) = HIWRD(wParam)
         END SELECT

         SetScrollPos hwndScroll(i), %SB_CTL, iColor(i), %TRUE
         wsprintf szBuffer, "%i", BYVAL iColor(i)
         SetWindowText hwndValue(i), szBuffer

         DeleteObject SetClassLong(hwnd, %GCL_HBRBACKGROUND, CreateSolidBrush(RGB(iColor(0), iColor(1), iColor(2))))

         InvalidateRect hwnd, rcColor, %TRUE
         EXIT FUNCTION

      CASE %WM_CTLCOLORSCROLLBAR
         i = GetWindowLong(lParam, %GWL_ID)
         FUNCTION = hBrush(i)
         EXIT FUNCTION

      CASE %WM_CTLCOLORSTATIC
         i = GetWindowLong(lParam, %GWL_ID)
         IF i >= 3 AND i <= 8 THEN   ' static text controls
            SetTextColor wParam, crPrim(i MOD 3)
            SetBkColor wParam, GetSysColor(%COLOR_BTNHIGHLIGHT)
            FUNCTION = hBrushStatic
            EXIT FUNCTION
         END IF

      CASE %WM_SYSCOLORCHANGE
         DeleteObject hBrushStatic
         hBrushStatic = CreateSolidBrush(GetSysColor(%COLOR_BTNHIGHLIGHT))
         EXIT FUNCTION

     CASE %WM_DESTROY
         DeleteObject SetClassLong(hwnd, %GCL_HBRBACKGROUND, GetStockObject(%WHITE_BRUSH))
         FOR i = 0 TO 2
            DeleteObject hBrush(i)
         NEXT
         DeleteObject hBrushStatic
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
FUNCTION ScrollProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL id AS LONG

   id = GetWindowLong(hwnd, %GWL_ID)

   SELECT CASE uMsg

      CASE %WM_KEYDOWN
         IF wParam = %VK_TAB THEN
            SetFocus (GetDlgItem(GetParent(hwnd), (id + IIF&(GetKeyState(%VK_SHIFT) < 0, 2, 1)) MOD 3))
         END IF
      CASE %WM_SETFOCUS
         idFocus = id
   END SELECT

   FUNCTION = CallWindowProc(OldScroll(id), hwnd, uMsg, wParam, lParam)

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


[José Roca]

 
This program is a translation of COLORS2.C -- Version using Modeless Dialog Box © Charles Petzold, 1998, described and analysed in Chapter 11 of the book Programming Windows, 5th Edition.

Converting COLORS1 to use a modeless dialog box makes the program-and particularly its WndProc function-almost ridiculously simple.

Although the original COLORS1 program displayed scroll bars that were based on the size of the window, the new version keeps them at a constant size within the modeless dialog box.

Code Select Expand


' ========================================================================================
' COLORS2.BAS
' This program is a translation/adaptation of COLORS2.C -- Version using Modeless Dialog Box
' © Charles Petzold, 1998, described and analysed in Chapter 11 of the book Programming
' Windows, 5th Edition.
' Converting COLORS1 to use a modeless dialog box makes the program-and particularly its
' WndProc function-almost ridiculously simple.
' Although the original COLORS1 program displayed scroll bars that were based on the size
' of the window, the new version keeps them at a constant size within the modeless dialog
' box.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#RESOURCE RES, "colors2.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
   LOCAL hDlgModeless AS DWORD

   szAppName          = "Colors2"
   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 = CreateSolidBrush(0)
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szAppName)

   IF ISFALSE RegisterClassEx(wcex) THEN
      FUNCTION = %TRUE
      EXIT FUNCTION
   END IF

   szCaption = "Color Scroll"
   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

   hDlgModeless = CreateDialog(hInstance, "ColorScrDlg", hwnd, CODEPTR(ColorScrDlg))

   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

   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_DESTROY
         DeleteObject SetClassLong(hwnd, %GCL_HBRBACKGROUND, GetStockObject(%WHITE_BRUSH))
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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

' ========================================================================================
FUNCTION ColorScrDlg (BYVAL hDlg AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   DIM iColor(0 TO 2) AS STATIC LONG
   LOCAL hwndParent AS DWORD
   LOCAL hCtrl AS DWORD
   LOCAL iCtrlID AS LONG
   LOCAL iIndex AS LONG

   SELECT CASE uMsg

      CASE %WM_INITDIALOG
         FOR iCtrlID = 10 TO 12
            hCtrl = GetDlgItem(hDlg, iCtrlID)
            SetScrollRange hCtrl, %SB_CTL, 0, 255, %FALSE
            SetScrollPos   hCtrl, %SB_CTL, 0, %FALSE
         NEXT
         FUNCTION = %TRUE

      CASE %WM_VSCROLL
         hCtrl = lParam
         iCtrlID = GetWindowLong(hCtrl, %GWL_ID)
         iIndex = iCtrlID - 10
         hwndParent = GetParent(hDlg)

         SELECT CASE LO(WORD, wParam)

            CASE %SB_PAGEDOWN
               iColor(iIndex) = iColor(iIndex) + 15
               iColor(iIndex) = MIN&(255, iColor(iIndex) + 1)
            CASE %SB_LINEDOWN
               iColor(iIndex) = MIN&(255, iColor(iIndex) + 1)
            CASE %SB_PAGEUP
               iColor(iIndex) = iColor(iIndex) - 15
               iColor(iIndex) = MAX&(0, iColor(iIndex) - 1)
            CASE %SB_LINEUP
               iColor(iIndex) = MAX&(0, iColor(iIndex) - 1)
            CASE %SB_TOP
               iColor(iIndex) = 0
            CASE %SB_BOTTOM
               iColor(iIndex) = 255
            CASE %SB_THUMBPOSITION, %SB_THUMBTRACK
               iColor(iIndex) = HIWRD(wParam)
            CASE ELSE
               FUNCTION = %FALSE

         END SELECT

         SetScrollPos  hCtrl, %SB_CTL,     iColor(iIndex), %TRUE
         SetDlgItemInt hDlg,  iCtrlID + 3, iColor(iIndex), %FALSE
         DeleteObject SetClassLong(hwndParent, %GCL_HBRBACKGROUND, CreateSolidBrush(RGB(iColor(0), iColor(1), iColor(2))))
         InvalidateRect hwndParent, BYVAL %NULL, %TRUE
         FUNCTION = %TRUE

      CASE ELSE
         FUNCTION = %FALSE

   END SELECT

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