Charles Petzold's Examples

[José Roca]

 
This program is a translation of the SINEWAVE.C-Sine Wave Using Polyline Program © Charles Petzold, 1998, described and analysed in Chapter 5 of the book Programming Windows, 5th Edition.

Draws a sine wave using the Polyline function, which draws a series of line segments by connecting the points in the specified array.

Code: [Select]

' ========================================================================================
' SINEWAVE.BAS
' This program is a translation/adaptation of the SINEWAVE.C-Sine Wave Using Polyline
' Program © Charles Petzold, 1998, described and analysed in Chapter 5 of the book
' Programming Windows, 5th Edition.
' Draws a sine wave using the Polyline function, which draws a series of line segments by
' connecting the points in the specified array.
' ========================================================================================

#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          = "SineWave"
   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 = "Sine Wave Using Polyline"
   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 cxClient AS LONG
   STATIC cyClient AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  i AS LONG
   LOCAL  ps  AS PAINTSTRUCT
   DIM    apt(999) AS POINT

   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)
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         MoveToEx hdc, 0, cyClient / 2, BYVAL %NULL
         LineTo hdc, cxClient, cyClient / 2
         FOR i = LBOUND(apt) TO UBOUND(apt)
            apt(i).x = i * cxClient / UBOUND(apt)
            apt(i).y = (cyClient / 2 * (1 - SIN((2 * 3.14159) * i / UBOUND(apt))))
         NEXT
         Polyline hdc, apt(0), UBOUND(apt)
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

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

The technique of drawing on a memory device context (and hence a bitmap) is the key to implementing a "shadow bitmap." This is a bitmap that contains everything displayed in the window's client area. %WM_PAINT message processing thus reduces to a simple BitBlt.  Shadow bitmaps are most useful in paint programs. The SKETCH program is not exactly the most sophisticated paint program around, but it's a start.

Code: [Select]

' ========================================================================================
' SKETCH.BAS
' This program is a translation/adaptation of SKETCH.C -- Shadow Bitmap Demonstration
' © Charles Petzold, 1998, described and analysed in Chapter 14 of the book Programming
' Windows, 5th Edition.
' The technique of drawing on a memory device context (and hence a bitmap) is the key to
' implementing a "shadow bitmap." This is a bitmap that contains everything displayed in
' the window's client area. %WM_PAINT message processing thus reduces to a simple BitBlt.
' Shadow bitmaps are most useful in paint programs. The SKETCH program is not exactly the
' most sophisticated paint program around, but it's a start.
' ========================================================================================

#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        = "Sketch"
   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 = "Sketch"
   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 GetLargestDisplayMode (BYREF pcxBitmap AS LONG, BYREF pcyBitmap AS LONG)

   LOCAL dvmode   AS DEVMODE
   LOCAL iModeNum AS LONG
   LOCAL hr       AS LONG

   pcxBitmap = 0
   pcyBitmap = 0

   dvmode.dmSize = SIZEOF(DEVMODE)

   DO
      hr = EnumDisplaySettings(BYVAL %NULL, iModeNum, dvMode)
      IF hr = 0 THEN EXIT DO
      pcxBitmap = MAX&(pcxBitmap, dvmode.dmPelsWidth)
      pcyBitmap = MAX&(pcyBitmap, dvmode.dmPelsHeight)
      iModeNum = iModeNum + 1
   LOOP

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 fLeftButtonDown  AS LONG
   STATIC fRightButtonDown AS LONG
   STATIC hBitmap          AS DWORD
   STATIC hdcMem           AS DWORD
   STATIC cxBitmap         AS LONG
   STATIC cyBitmap         AS LONG
   STATIC cxClient         AS LONG
   STATIC cyClient         AS LONG
   STATIC xMouse           AS LONG
   STATIC yMouse           AS LONG
   LOCAL  hdc              AS DWORD
   LOCAL  ps               AS PAINTSTRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE
         GetLargestDisplayMode cxBitmap, cyBitmap
         hdc = GetDC(hwnd)
         hBitmap = CreateCompatibleBitmap(hdc, cxBitmap, cyBitmap)
         hdcMem  = CreateCompatibleDC(hdc)
         ReleaseDC hwnd, hdc
         IF ISFALSE hBitmap THEN     ' No memory for bitmap
            DeleteDC hdcMem
            FUNCTION = -1
            EXIT FUNCTION
         END IF
         SelectObject hdcMem, hBitmap
         PatBlt hdcMem, 0, 0, cxBitmap, cyBitmap, %WHITENESS
         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_LBUTTONDOWN
         IF ISFALSE fRightButtonDown THEN SetCapture hwnd
         xMouse = LO(WORD, lParam)
         yMouse = HI(WORD, lParam)
         fLeftButtonDown = %TRUE
         EXIT FUNCTION

      CASE %WM_LBUTTONUP
         IF fLeftButtonDown THEN SetCapture %NULL
         fLeftButtonDown = %FALSE
         EXIT FUNCTION

      CASE %WM_RBUTTONDOWN
         IF ISFALSE fLeftButtonDown THEN SetCapture hwnd
         xMouse = LO(WORD, lParam)
         yMouse = HI(WORD, lParam)
         fRightButtonDown = %TRUE
         EXIT FUNCTION

      CASE %WM_RBUTTONUP
         IF fRightButtonDown THEN SetCapture %NULL
         fRightButtonDown = %FALSE
         EXIT FUNCTION

      CASE %WM_MOUSEMOVE
         IF ISFALSE fLeftButtonDown AND ISFALSE fRightButtonDown THEN EXIT FUNCTION
         hdc = GetDC(hwnd)
         SelectObject (hdc, GetStockObject(IIF&(fLeftButtonDown = %TRUE, %BLACK_PEN, %WHITE_PEN)))
         SelectObject (hdcMem, GetStockObject(IIF&(fLeftButtonDown = %TRUE, %BLACK_PEN, %WHITE_PEN)))
         MoveToEx hdc,    xMouse, yMouse, BYVAL %NULL
         MoveToEx hdcMem, xMouse, yMouse, BYVAL %NULL
         xMouse = LO(WORD, lParam)
         yMouse = HI(WORD, lParam)
         LineTo hdc,    xMouse, yMouse
         LineTo hdcMem, xMouse, yMouse
         ReleaseDC hwnd, hdc
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         BitBlt hdc, 0, 0, cxClient, cyClient, hdcMem, 0, 0, %SRCCOPY
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         DeleteDC hdcMem
         DeleteObject hBitmap
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of the STOKFONT.C-Stock Font Objects program © Charles Petzold, 1998, described and analysed in Chapter 6 of the book Programming Windows, 5th Edition.

Displays Windows stock fonts.

Code: [Select]

' ========================================================================================
' STOCKFONT.BAS
' This program is a translation/adaptation of the STOKFONT.C-Stock Font Objects program
' © Charles Petzold, 1998, described and analysed in Chapter 6 of the book Programming
' Windows, 5th Edition.
' Displays Windows stock fonts.
' ========================================================================================

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

TYPE STOCKFONT_STRUCT
   idStockFont AS LONG
   szStockFont 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        = "StokFont"
   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 = "Stock Fonts"
   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 iFont AS LONG
   STATIC cFonts AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  i AS LONG
   LOCAL  x AS LONG
   LOCAL  y AS LONG
   LOCAL  cxGrid AS LONG
   LOCAL  cyGrid AS LONG
   LOCAL  ps  AS PAINTSTRUCT
   LOCAL  szFaceName AS ASCIIZ * %LF_FACESIZE
   LOCAL  szBuffer AS ASCIIZ * %LF_FACESIZE + 64
   LOCAL  tm AS TEXTMETRIC
   DIM    stockFont(6) AS STATIC STOCKFONT_STRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE
         stockFont(0).idStockFont = %OEM_FIXED_FONT : stockFont(0).szStockFont = "OEM_FIXED_FONT"
         stockFont(1).idStockFont = %ANSI_FIXED_FONT : stockFont(1).szStockFont = "ANSI_FIXED_FONT"
         stockFont(2).idStockFont = %ANSI_VAR_FONT : stockFont(2).szStockFont = "ANSI_VAR_FONT"
         stockFont(3).idStockFont = %SYSTEM_FONT : stockFont(3).szStockFont = "SYSTEM_FONT"
         stockFont(4).idStockFont = %DEVICE_DEFAULT_FONT : stockFont(4).szStockFont = "DEVICE_DEFAULT_FONT"
         stockFont(5).idStockFont = %SYSTEM_FIXED_FONT : stockFont(5).szStockFont = "SYSTEM_FIXED_FONT"
         stockFont(6).idStockFont = %DEFAULT_GUI_FONT : stockFont(6).szStockFont = "DEFAULT_GUI_FONT"
         cFonts = 7
         SetScrollRange hwnd, %SB_VERT, 0, cFonts - 1, %TRUE
         EXIT FUNCTION

      CASE %WM_DISPLAYCHANGE
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         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_VSCROLL
         SELECT CASE LO(WORD, wParam)
            CASE %SB_TOP
               iFont = 0
            CASE %SB_BOTTOM
               iFont = cFonts - 1
            CASE %SB_LINEUP, %SB_PAGEUP
               iFont = iFont - 1
            CASE %SB_LINEDOWN, %SB_PAGEDOWN
               iFont = iFont + 1
            CASE %SB_THUMBPOSITION
               iFont = HI(WORD, wParam)
         END SELECT
         iFont = MAX&(0, MIN&(cFonts - 1, iFont))
         SetScrollPos hwnd, %SB_VERT, iFont, %TRUE
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         EXIT FUNCTION

      CASE %WM_KEYDOWN
         SELECT CASE wParam
            CASE %VK_HOME
               SendMessage hwnd, %WM_VSCROLL, %SB_TOP, 0
            CASE %VK_END
               SendMessage hwnd, %WM_VSCROLL, %SB_BOTTOM, 0
            CASE %VK_PRIOR, %VK_LEFT, %VK_UP
               SendMessage hwnd, %WM_VSCROLL, %SB_LINEUP, 0
            CASE %VK_NEXT, %VK_RIGHT, %VK_DOWN
               SendMessage hwnd, %WM_VSCROLL, %SB_PAGEDOWN, 0
         END SELECT
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)

         SelectObject hdc, GetStockObject(stockfont(iFont).idStockFont)
         GetTextFace hdc, %LF_FACESIZE, szFaceName
         GetTextMetrics hdc, tm
         cxGrid = MAX&(3 * tm.tmAveCharWidth, 2 * tm.tmMaxCharWidth)
         cyGrid = tm.tmHeight + 3

         szBuffer = stockFont(iFont).szStockFont & ": Face Name = " & szFaceName & ", Charset = " & FORMAT$(tm.tmCharSet)
         TextOut hdc, 0, 0, szBuffer, LEN(szBuffer)
         SetTextAlign hdc, %TA_TOP OR %TA_CENTER

         ' vertical and horizontal lines
         FOR i = 0 TO 16
            MoveToEx hdc, (i + 2) * cxGrid, 2 * cyGrid, BYVAL %NULL
            LineTo hdc, (i + 2) * cxGrid, 19 * cyGrid
            MoveToEx hdc, cxGrid, (i + 3) * cyGrid, BYVAL %NULL
            LineTo hdc, 18 * cxGrid, (i + 3) * cyGrid
         NEXT

         ' vertical and horizontal headings
         FOR i = 0 TO 15
            szBuffer = HEX$(i) & "-"
            TextOut hdc, (2 * i + 5) * cxGrid / 2, 2 *cyGrid + 2, szBuffer, LEN(szBuffer)
            szBuffer = "-" & HEX$(i)
            TextOut hdc, 3 * cxGrid / 2, (i + 3) * cyGrid + 2, szBuffer, LEN(szBuffer)
         NEXT

         ' characters
         FOR y = 0 TO 15
            FOR x = 0 TO 15
               szBuffer = CHR$(16 * x + y)
               TextOut hdc, (2 * x + 5) * cxGrid / 2, (y + 3) * cyGrid + 2, szBuffer, LEN(szBuffer)
            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/adaptation from C of SYSMETS.C -- Final System Metrics Display Program described and analysed in Chapter 7 of Charles Petzold's book, Programming Windows 98.

Adds mouse wheel logic to SYSMETS4.

Code: [Select]

' ========================================================================================
' SYSMETS.BAS
' This program is a translation/adaptation from C of SYSMETS.C -- Final System Metrics
' Display Program described and analysed in Chapter 7 of Charles Petzold's book,
' Programming Windows 98. Adds mouse wheel logic to SYSMETS4.
' ========================================================================================

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

' ========================================================================================
' SYSMETRICS_STRUCT
' ========================================================================================
TYPE SYSMETRICS_STRUCT
   iIndex AS LONG
   szLabel AS ASCIIZ * 21
   szDesc AS ASCIIZ * 31
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        = "SysMets"
   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 = "Get System Metrics"
   hwnd = CreateWindowEx(0, 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 cxChar         AS LONG
   STATIC cxCaps         AS LONG
   STATIC cyChar         AS LONG
   STATIC cyClient       AS LONG
   STATIC cxClient       AS LONG
   STATIC iMaxWidth      AS LONG
   STATIC iDeltaPerLine  AS LONG   ' for mouse wheel logic
   STATIC iAccumDelta    AS LONG     ' for mouse wheel logic
   LOCAL  hdc            AS DWORD
   LOCAL  i              AS LONG
   LOCAL  x              AS LONG
   LOCAL  y              AS LONG
   LOCAL  iVertPos       AS LONG
   LOCAL  iHorzPos       AS LONG
   LOCAL  iPaintBeg      AS LONG
   LOCAL  iPaintEnd      AS LONG
   LOCAL  ps             AS PAINTSTRUCT
   LOCAL  si             AS SCROLLINFO
   LOCAL  szBuffer       AS ASCIIZ * 10
   LOCAL  tm             AS TEXTMETRIC
   LOCAL  ulScrollLines  AS DWORD        ' for mouse wheel logic
   DIM    sysmetrics(44) AS STATIC SYSMETRICS_STRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE

         ' Initialize array
         sysmetrics( 0).iIndex = %SM_CXSCREEN          : sysmetrics( 0).szLabel = "SM_CXSCREEN"          : sysmetrics( 0).szDesc = "Screen width in pixels"
         sysmetrics( 1).iIndex = %SM_CYSCREEN          : sysmetrics( 1).szLabel = "SM_CYSCREEN"          : sysmetrics( 1).szDesc = "Screen height in pixels"
         sysmetrics( 2).iIndex = %SM_CXVSCROLL         : sysmetrics( 2).szLabel = "SM_CXVSCROLL"         : sysmetrics( 2).szDesc = "Vertical scroll arrow width"
         sysmetrics( 3).iIndex = %SM_CYHSCROLL         : sysmetrics( 3).szLabel = "SM_CYHSCROLL"         : sysmetrics( 3).szDesc = "Horizontal scroll arrow height"
         sysmetrics( 4).iIndex = %SM_CYCAPTION         : sysmetrics( 4).szLabel = "SM_CYCAPTION"         : sysmetrics( 4).szDesc = "Caption bar height"
         sysmetrics( 5).iIndex = %SM_CXBORDER          : sysmetrics( 5).szLabel = "SM_CXBORDER"          : sysmetrics( 5).szDesc = "Window border width"
         sysmetrics( 6).iIndex = %SM_CYBORDER          : sysmetrics( 6).szLabel = "SM_CYBORDER"          : sysmetrics( 6).szDesc = "Window border height"
         sysmetrics( 7).iIndex = %SM_CXDLGFRAME        : sysmetrics( 7).szLabel = "SM_CXDLGFRAME"        : sysmetrics( 7).szDesc = "Dialog window frame width"
         sysmetrics( 8).iIndex = %SM_CYDLGFRAME        : sysmetrics( 8).szLabel = "SM_CYDLGFRAME"        : sysmetrics( 8).szDesc = "Dialog window frame height"
         sysmetrics( 9).iIndex = %SM_CYVTHUMB          : sysmetrics( 9).szLabel = "SM_CYVTHUMB"          : sysmetrics( 9).szDesc = "Vertical scroll thumb height"
         sysmetrics(10).iIndex = %SM_CXHTHUMB          : sysmetrics(10).szLabel = "SM_CXHTHUMB"          : sysmetrics(10).szDesc = "Horizontal scroll thumb width"
         sysmetrics(11).iIndex = %SM_CXICON            : sysmetrics(11).szLabel = "SM_CXICON"            : sysmetrics(11).szDesc = "Icon width"
         sysmetrics(12).iIndex = %SM_CYICON            : sysmetrics(12).szLabel = "SM_CYICON"            : sysmetrics(12).szDesc = "Icon height"
         sysmetrics(13).iIndex = %SM_CXCURSOR          : sysmetrics(13).szLabel = "SM_CXCURSOR"          : sysmetrics(13).szDesc = "Cursor width"
         sysmetrics(14).iIndex = %SM_CYCURSOR          : sysmetrics(14).szLabel = "SM_CYCURSOR"          : sysmetrics(14).szDesc = "Cursor height"
         sysmetrics(15).iIndex = %SM_CYMENU            : sysmetrics(15).szLabel = "SM_CYMENU"            : sysmetrics(15).szDesc = "Menu bar height"
         sysmetrics(16).iIndex = %SM_CXFULLSCREEN      : sysmetrics(16).szLabel = "SM_CXFULLSCREEN"      : sysmetrics(16).szDesc = "Full screen client area width"
         sysmetrics(17).iIndex = %SM_CYFULLSCREEN      : sysmetrics(17).szLabel = "SM_CYFULLSCREEN"      : sysmetrics(17).szDesc = "Full screen client area height"
         sysmetrics(18).iIndex = %SM_CYKANJIWINDOW     : sysmetrics(18).szLabel = "SM_CYKANJIWINDOW"     : sysmetrics(18).szDesc = "Kanji window height"
         sysmetrics(19).iIndex = %SM_MOUSEPRESENT      : sysmetrics(19).szLabel = "SM_MOUSEPRESENT"      : sysmetrics(19).szDesc = "Mouse present flag"
         sysmetrics(20).iIndex = %SM_CYVSCROLL         : sysmetrics(20).szLabel = "SM_CYVSCROLL"         : sysmetrics(20).szDesc = "Vertical scroll arrow height"
         sysmetrics(21).iIndex = %SM_CXHSCROLL         : sysmetrics(21).szLabel = "SM_CXHSCROLL"         : sysmetrics(21).szDesc = "Horizontal scroll arrow width"
         sysmetrics(22).iIndex = %SM_DEBUG             : sysmetrics(22).szLabel = "SM_DEBUG"             : sysmetrics(22).szDesc = "Debug version flag"
         sysmetrics(23).iIndex = %SM_SWAPBUTTON        : sysmetrics(23).szLabel = "SM_SWAPBUTTON"        : sysmetrics(23).szDesc = "Mouse buttons swapped flag"
         sysmetrics(24).iIndex = %SM_RESERVED1         : sysmetrics(24).szLabel = "SM_RESERVED1"         : sysmetrics(24).szDesc = "Reserved"
         sysmetrics(25).iIndex = %SM_RESERVED2         : sysmetrics(25).szLabel = "SM_RESERVED2"         : sysmetrics(25).szDesc = "Reserved"
         sysmetrics(26).iIndex = %SM_RESERVED3         : sysmetrics(26).szLabel = "SM_RESERVED3"         : sysmetrics(26).szDesc = "Reserved"
         sysmetrics(27).iIndex = %SM_RESERVED4         : sysmetrics(27).szLabel = "SM_RESERVED4"         : sysmetrics(27).szDesc = "Reserved"
         sysmetrics(28).iIndex = %SM_CXMIN             : sysmetrics(28).szLabel = "SM_CXMIN"             : sysmetrics(28).szDesc = "Minimum window width"
         sysmetrics(29).iIndex = %SM_CYMIN             : sysmetrics(29).szLabel = "SM_CYMIN"             : sysmetrics(29).szDesc = "Minimum window height"
         sysmetrics(30).iIndex = %SM_CXSIZE            : sysmetrics(30).szLabel = "SM_CXSIZE"            : sysmetrics(30).szDesc = "Minimize/Maximize icon width"
         sysmetrics(31).iIndex = %SM_CYSIZE            : sysmetrics(31).szLabel = "SM_CYSIZE"            : sysmetrics(31).szDesc = "Minimize/Maximize icon height"
         sysmetrics(32).iIndex = %SM_CXFRAME           : sysmetrics(32).szLabel = "SM_CXFRAME"           : sysmetrics(32).szDesc = "Window frame width"
         sysmetrics(33).iIndex = %SM_CYFRAME           : sysmetrics(33).szLabel = "SM_CYFRAME"           : sysmetrics(33).szDesc = "Window frame height"
         sysmetrics(34).iIndex = %SM_CXMINTRACK        : sysmetrics(34).szLabel = "SM_CXMINTRACK"        : sysmetrics(34).szDesc = "Minimum window tracking width"
         sysmetrics(35).iIndex = %SM_CYMINTRACK        : sysmetrics(35).szLabel = "SM_CYMINTRACK"        : sysmetrics(35).szDesc = "Minimum window tracking height"
         sysmetrics(36).iIndex = %SM_CXDOUBLECLK       : sysmetrics(36).szLabel = "SM_CXDOUBLECLK"       : sysmetrics(36).szDesc = "Double click x tolerance"
         sysmetrics(37).iIndex = %SM_CYDOUBLECLK       : sysmetrics(37).szLabel = "SM_CYDOUBLECLK"       : sysmetrics(37).szDesc = "Double click y tolerance"
         sysmetrics(38).iIndex = %SM_CXICONSPACING     : sysmetrics(38).szLabel = "SM_CXICONSPACING"     : sysmetrics(38).szDesc = "Horizontal icon spacing"
         sysmetrics(39).iIndex = %SM_CYICONSPACING     : sysmetrics(39).szLabel = "SM_CYICONSPACING"     : sysmetrics(39).szDesc = "Vertical icon spacing"
         sysmetrics(40).iIndex = %SM_MENUDROPALIGNMENT : sysmetrics(40).szLabel = "SM_MENUDROPALIGNMENT" : sysmetrics(40).szDesc = "Left or right menu drop"
         sysmetrics(41).iIndex = %SM_PENWINDOWS        : sysmetrics(41).szLabel = "SM_PENWINDOWS"        : sysmetrics(41).szDesc = "Pen extensions installed"
         sysmetrics(42).iIndex = %SM_DBCSENABLED       : sysmetrics(42).szLabel = "SM_DBCSENABLED"       : sysmetrics(42).szDesc = "Double-Byte Char Set enabled"
         sysmetrics(43).iIndex = %SM_CMOUSEBUTTONS     : sysmetrics(43).szLabel = "SM_CMOUSEBUTTONS"     : sysmetrics(43).szDesc = "Number of mouse buttons"
         sysmetrics(44).iIndex = %SM_SHOWSOUNDS        : sysmetrics(44).szLabel = "SM_SHOWSOUNDS"        : sysmetrics(44).szDesc = "Present sounds visually"

         hdc = GetDC (hwnd)
         GetTextMetrics hdc, tm
         cxChar = tm.tmAveCharWidth
         cxCaps = IIF&((tm.tmPitchAndFamily AND 1), cxChar * 3 \ 2, cxChar)
         cyChar = tm.tmHeight + tm.tmExternalLeading
         ReleaseDC hwnd, hdc

         ' Save the width of the three columns
         iMaxWidth = 40 * cxChar + 22 * cxCaps

         ' For mouse wheel information
         SendMessage hwnd, %WM_SETTINGCHANGE, 0, 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_SETTINGCHANGE
         SystemParametersInfo %SPI_GETWHEELSCROLLLINES, 0, ulScrollLines, 0
         ' ulScrollLines usually equals 3 or 0 (for no scrolling)
         ' WHEEL_DELTA equals 120, so iDeltaPerLine will be 40
         IF ulScrollLines THEN
            iDeltaPerLine = %WHEEL_DELTA \ ulScrollLines
         ELSE
            iDeltaPerLine = 0
         END IF
         EXIT FUNCTION

      CASE %WM_SIZE

         cxClient = LO(WORD, lParam)
         cyClient = HI(WORD, lParam)

         ' Set vertical scroll bar range and page size
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_RANGE OR %SIF_PAGE
         si.nMin   = 0
         si.nMax   = UBOUND(sysmetrics)
         si.nPage  = cyClient \ cyChar
         SetScrollInfo (hwnd, %SB_VERT, si, %TRUE)

         ' Set horizontal scroll bar range and page size
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_RANGE OR %SIF_PAGE
         si.nMin   = 0
         si.nMax   = 2 + iMaxWidth \ cxChar
         si.nPage  = cxClient \ cxChar
         SetScrollInfo (hwnd, %SB_HORZ, si, %TRUE)

         EXIT FUNCTION

      CASE %WM_VSCROLL

         ' Get all the vertical scroll bar information
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_ALL
         GetScrollInfo hwnd, %SB_VERT, si

         ' Save the position for comparison later on
         iVertPos = si.nPos

         SELECT CASE LO(WORD, wParam)
            CASE %SB_TOP
               si.nPos = si.nMin
            CASE %SB_BOTTOM
               si.nPos = si.nMax
            CASE %SB_LINEUP
               si.nPos = si.nPos - 1
            CASE %SB_LINEDOWN
               si.nPos = si.nPos + 1
            CASE %SB_PAGEUP
               si.nPos = si.nPos - si.nPage
            CASE %SB_PAGEDOWN
               si.nPos = si.nPos + si.nPage
            CASE %SB_THUMBPOSITION
               si.nPos = si.nTrackPos
         END SELECT

         ' Set the position and then retrieve it.  Due to adjustments
         '   by Windows it may not be the same as the value set.
         si.fMask = %SIF_POS
         SetScrollInfo hwnd, %SB_VERT, si, %TRUE
         GetScrollInfo hwnd, %SB_VERT, si

         ' If the position has changed, scroll the window and update it
         IF si.nPos <> iVertPos THEN
            ScrollWindow hwnd, 0, cyChar * (iVertPos - si.nPos), BYVAL %NULL, BYVAL %NULL
            UpdateWindow hwnd
         END IF

         EXIT FUNCTION

      CASE %WM_HSCROLL

         ' Get all the vertical scroll bar information
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_ALL

         ' Save the position for comparison later on
         GetScrollInfo hwnd, %SB_HORZ, si
         iHorzPos = si.nPos

         SELECT CASE LO(WORD, wParam)
            CASE %SB_LINELEFT
               si.nPos = si.nPos - 1
            CASE %SB_LINERIGHT
               si.nPos = si.nPos + 1
            CASE %SB_PAGELEFT
               si.nPos = si.nPos - si.nPage
            CASE %SB_PAGERIGHT
               si.nPos = si.nPos + si.nPage
            CASE %SB_THUMBPOSITION:
               si.nPos = si.nTrackPos
         END SELECT

         ' Set the position and then retrieve it.  Due to adjustments
         '   by Windows it may not be the same as the value set.
         si.fMask = %SIF_POS
         SetScrollInfo hwnd, %SB_HORZ, si, %TRUE
         GetScrollInfo hwnd, %SB_HORZ, si

         ' If the position has changed, scroll the window
         IF si.nPos <> iHorzPos THEN
            ScrollWindow hwnd, cxChar * (iHorzPos - si.nPos), 0, BYVAL %NULL, BYVAL %NULL
         END IF

         EXIT FUNCTION

      CASE %WM_KEYDOWN
         SELECT CASE wParam
            CASE %VK_HOME
               SendMessage hwnd, %WM_VSCROLL, %SB_TOP, 0
            CASE %VK_END
               SendMessage hwnd, %WM_VSCROLL, %SB_BOTTOM, 0
            CASE %VK_PRIOR
               SendMessage hwnd, %WM_VSCROLL, %SB_PAGEUP, 0
            CASE %VK_NEXT
               SendMessage hwnd, %WM_VSCROLL, %SB_PAGEDOWN, 0
            CASE %VK_UP
               SendMessage hwnd, %WM_VSCROLL, %SB_LINEUP, 0
            CASE %VK_DOWN
               SendMessage hwnd, %WM_VSCROLL, %SB_LINEDOWN, 0
            CASE %VK_LEFT
               SendMessage hwnd, %WM_HSCROLL, %SB_PAGEUP, 0
            CASE %VK_RIGHT
               SendMessage hwnd, %WM_HSCROLL, %SB_PAGEDOWN, 0
         END SELECT
         EXIT FUNCTION

      CASE %WM_MOUSEWHEEL
         IF iDeltaPerLine = 0 THEN EXIT FUNCTION
         iAccumDelta = iAccumDelta + CINT(HI(WORD, wParam))     ' 120 or -120
         WHILE iAccumDelta >= iDeltaPerLine
            SendMessage hwnd, %WM_VSCROLL, %SB_LINEUP, 0
            iAccumDelta = iAccumDelta - iDeltaPerLine
         WEND
         WHILE (iAccumDelta <= -iDeltaPerLine)
            SendMessage hwnd, %WM_VSCROLL, %SB_LINEDOWN, 0
            iAccumDelta = iAccumDelta + iDeltaPerLine
         WEND
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)

         ' Get vertical scroll bar position
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_POS
         GetScrollInfo hwnd, %SB_VERT, si
         iVertPos = si.nPos

         ' Get horizontal scroll bar position
         GetScrollInfo hwnd, %SB_HORZ, si
         iHorzPos = si.nPos

         ' Find painting limits
         iPaintBeg = MAX&(0, iVertPos + ps.rcPaint.nTop \ cyChar)
         iPaintEnd = MIN&(UBOUND(sysmetrics), iVertPos + ps.rcPaint.nBottom \ cyChar)

         FOR i = iPaintBeg TO iPaintEnd
            x = cxChar * (1 - iHorzPos)
            y = cyChar * (i - iVertPos)
            TextOut hdc, x, y, sysmetrics(i).szLabel, LEN(sysmetrics(i).szLabel)
            TextOut hdc, x + 22 * cxCaps, y, sysmetrics(i).szDesc, LEN(sysmetrics(i).szDesc)
            SetTextAlign hdc, %TA_RIGHT OR %TA_TOP
            szBuffer = FORMAT$(GetSystemMetrics(sysmetrics(i).iIndex))
            TextOut hdc, x + 22 * cxCaps + 40 * cxChar, y, szBuffer, LEN(szBuffer)
            SetTextAlign hdc, %TA_LEFT OR %TA_TOP
         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 the SYSMETS1.C-System Metrics Display Program No. 1 © Charles Petzold, 1998, described and analysed in Chapter 4 of the book Programming Windows, 5th Edition.

Displays some of the information available from the GetSystemMetrics calls in a simple one-line-per-item format.

Code: [Select]

' ========================================================================================
' SYSMETS1.BAS
' This program is a translation/adaptation of the SYSMETS1.C-System Metrics Display
' Program No. 1 © Charles Petzold, 1998, described and analysed in Chapter 4 of the book
' Programming Windows, 5th Edition.
' Displays some of the information available from the GetSystemMetrics calls in a simple
' one-line-per-item format.
' ========================================================================================

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

' ========================================================================================
' SYSMETRICS_STRUCT
' ========================================================================================
TYPE SYSMETRICS_STRUCT
   iIndex AS LONG
   szLabel AS ASCIIZ * 21
   szDesc AS ASCIIZ * 31
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        = "SysMets1"
   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 = "Get System Metrics No. 1"
   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 cxChar AS LONG
   STATIC cxCaps AS LONG
   STATIC cyChar AS LONG
   LOCAL hdc AS DWORD
   LOCAL i AS LONG
   LOCAL szBuffer AS ASCIIZ * 10
   LOCAL ps  AS PAINTSTRUCT
   LOCAL tm AS TEXTMETRIC
   DIM sysmetrics(44) AS STATIC SYSMETRICS_STRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE

         ' Initialize array
         sysmetrics( 0).iIndex = %SM_CXSCREEN          : sysmetrics( 0).szLabel = "SM_CXSCREEN"          : sysmetrics( 0).szDesc = "Screen width in pixels"
         sysmetrics( 1).iIndex = %SM_CYSCREEN          : sysmetrics( 1).szLabel = "SM_CYSCREEN"          : sysmetrics( 1).szDesc = "Screen height in pixels"
         sysmetrics( 2).iIndex = %SM_CXVSCROLL         : sysmetrics( 2).szLabel = "SM_CXVSCROLL"         : sysmetrics( 2).szDesc = "Vertical scroll arrow width"
         sysmetrics( 3).iIndex = %SM_CYHSCROLL         : sysmetrics( 3).szLabel = "SM_CYHSCROLL"         : sysmetrics( 3).szDesc = "Horizontal scroll arrow height"
         sysmetrics( 4).iIndex = %SM_CYCAPTION         : sysmetrics( 4).szLabel = "SM_CYCAPTION"         : sysmetrics( 4).szDesc = "Caption bar height"
         sysmetrics( 5).iIndex = %SM_CXBORDER          : sysmetrics( 5).szLabel = "SM_CXBORDER"          : sysmetrics( 5).szDesc = "Window border width"
         sysmetrics( 6).iIndex = %SM_CYBORDER          : sysmetrics( 6).szLabel = "SM_CYBORDER"          : sysmetrics( 6).szDesc = "Window border height"
         sysmetrics( 7).iIndex = %SM_CXDLGFRAME        : sysmetrics( 7).szLabel = "SM_CXDLGFRAME"        : sysmetrics( 7).szDesc = "Dialog window frame width"
         sysmetrics( 8).iIndex = %SM_CYDLGFRAME        : sysmetrics( 8).szLabel = "SM_CYDLGFRAME"        : sysmetrics( 8).szDesc = "Dialog window frame height"
         sysmetrics( 9).iIndex = %SM_CYVTHUMB          : sysmetrics( 9).szLabel = "SM_CYVTHUMB"          : sysmetrics( 9).szDesc = "Vertical scroll thumb height"
         sysmetrics(10).iIndex = %SM_CXHTHUMB          : sysmetrics(10).szLabel = "SM_CXHTHUMB"          : sysmetrics(10).szDesc = "Horizontal scroll thumb width"
         sysmetrics(11).iIndex = %SM_CXICON            : sysmetrics(11).szLabel = "SM_CXICON"            : sysmetrics(11).szDesc = "Icon width"
         sysmetrics(12).iIndex = %SM_CYICON            : sysmetrics(12).szLabel = "SM_CYICON"            : sysmetrics(12).szDesc = "Icon height"
         sysmetrics(13).iIndex = %SM_CXCURSOR          : sysmetrics(13).szLabel = "SM_CXCURSOR"          : sysmetrics(13).szDesc = "Cursor width"
         sysmetrics(14).iIndex = %SM_CYCURSOR          : sysmetrics(14).szLabel = "SM_CYCURSOR"          : sysmetrics(14).szDesc = "Cursor height"
         sysmetrics(15).iIndex = %SM_CYMENU            : sysmetrics(15).szLabel = "SM_CYMENU"            : sysmetrics(15).szDesc = "Menu bar height"
         sysmetrics(16).iIndex = %SM_CXFULLSCREEN      : sysmetrics(16).szLabel = "SM_CXFULLSCREEN"      : sysmetrics(16).szDesc = "Full screen client area width"
         sysmetrics(17).iIndex = %SM_CYFULLSCREEN      : sysmetrics(17).szLabel = "SM_CYFULLSCREEN"      : sysmetrics(17).szDesc = "Full screen client area height"
         sysmetrics(18).iIndex = %SM_CYKANJIWINDOW     : sysmetrics(18).szLabel = "SM_CYKANJIWINDOW"     : sysmetrics(18).szDesc = "Kanji window height"
         sysmetrics(19).iIndex = %SM_MOUSEPRESENT      : sysmetrics(19).szLabel = "SM_MOUSEPRESENT"      : sysmetrics(19).szDesc = "Mouse present flag"
         sysmetrics(20).iIndex = %SM_CYVSCROLL         : sysmetrics(20).szLabel = "SM_CYVSCROLL"         : sysmetrics(20).szDesc = "Vertical scroll arrow height"
         sysmetrics(21).iIndex = %SM_CXHSCROLL         : sysmetrics(21).szLabel = "SM_CXHSCROLL"         : sysmetrics(21).szDesc = "Horizontal scroll arrow width"
         sysmetrics(22).iIndex = %SM_DEBUG             : sysmetrics(22).szLabel = "SM_DEBUG"             : sysmetrics(22).szDesc = "Debug version flag"
         sysmetrics(23).iIndex = %SM_SWAPBUTTON        : sysmetrics(23).szLabel = "SM_SWAPBUTTON"        : sysmetrics(23).szDesc = "Mouse buttons swapped flag"
         sysmetrics(24).iIndex = %SM_RESERVED1         : sysmetrics(24).szLabel = "SM_RESERVED1"         : sysmetrics(24).szDesc = "Reserved"
         sysmetrics(25).iIndex = %SM_RESERVED2         : sysmetrics(25).szLabel = "SM_RESERVED2"         : sysmetrics(25).szDesc = "Reserved"
         sysmetrics(26).iIndex = %SM_RESERVED3         : sysmetrics(26).szLabel = "SM_RESERVED3"         : sysmetrics(26).szDesc = "Reserved"
         sysmetrics(27).iIndex = %SM_RESERVED4         : sysmetrics(27).szLabel = "SM_RESERVED4"         : sysmetrics(27).szDesc = "Reserved"
         sysmetrics(28).iIndex = %SM_CXMIN             : sysmetrics(28).szLabel = "SM_CXMIN"             : sysmetrics(28).szDesc = "Minimum window width"
         sysmetrics(29).iIndex = %SM_CYMIN             : sysmetrics(29).szLabel = "SM_CYMIN"             : sysmetrics(29).szDesc = "Minimum window height"
         sysmetrics(30).iIndex = %SM_CXSIZE            : sysmetrics(30).szLabel = "SM_CXSIZE"            : sysmetrics(30).szDesc = "Minimize/Maximize icon width"
         sysmetrics(31).iIndex = %SM_CYSIZE            : sysmetrics(31).szLabel = "SM_CYSIZE"            : sysmetrics(31).szDesc = "Minimize/Maximize icon height"
         sysmetrics(32).iIndex = %SM_CXFRAME           : sysmetrics(32).szLabel = "SM_CXFRAME"           : sysmetrics(32).szDesc = "Window frame width"
         sysmetrics(33).iIndex = %SM_CYFRAME           : sysmetrics(33).szLabel = "SM_CYFRAME"           : sysmetrics(33).szDesc = "Window frame height"
         sysmetrics(34).iIndex = %SM_CXMINTRACK        : sysmetrics(34).szLabel = "SM_CXMINTRACK"        : sysmetrics(34).szDesc = "Minimum window tracking width"
         sysmetrics(35).iIndex = %SM_CYMINTRACK        : sysmetrics(35).szLabel = "SM_CYMINTRACK"        : sysmetrics(35).szDesc = "Minimum window tracking height"
         sysmetrics(36).iIndex = %SM_CXDOUBLECLK       : sysmetrics(36).szLabel = "SM_CXDOUBLECLK"       : sysmetrics(36).szDesc = "Double click x tolerance"
         sysmetrics(37).iIndex = %SM_CYDOUBLECLK       : sysmetrics(37).szLabel = "SM_CYDOUBLECLK"       : sysmetrics(37).szDesc = "Double click y tolerance"
         sysmetrics(38).iIndex = %SM_CXICONSPACING     : sysmetrics(38).szLabel = "SM_CXICONSPACING"     : sysmetrics(38).szDesc = "Horizontal icon spacing"
         sysmetrics(39).iIndex = %SM_CYICONSPACING     : sysmetrics(39).szLabel = "SM_CYICONSPACING"     : sysmetrics(39).szDesc = "Vertical icon spacing"
         sysmetrics(40).iIndex = %SM_MENUDROPALIGNMENT : sysmetrics(40).szLabel = "SM_MENUDROPALIGNMENT" : sysmetrics(40).szDesc = "Left or right menu drop"
         sysmetrics(41).iIndex = %SM_PENWINDOWS        : sysmetrics(41).szLabel = "SM_PENWINDOWS"        : sysmetrics(41).szDesc = "Pen extensions installed"
         sysmetrics(42).iIndex = %SM_DBCSENABLED       : sysmetrics(42).szLabel = "SM_DBCSENABLED"       : sysmetrics(42).szDesc = "Double-Byte Char Set enabled"
         sysmetrics(43).iIndex = %SM_CMOUSEBUTTONS     : sysmetrics(43).szLabel = "SM_CMOUSEBUTTONS"     : sysmetrics(43).szDesc = "Number of mouse buttons"
         sysmetrics(44).iIndex = %SM_SHOWSOUNDS        : sysmetrics(44).szLabel = "SM_SHOWSOUNDS"        : sysmetrics(44).szDesc = "Present sounds visually"

         hdc = GetDC (hwnd)
         GetTextMetrics hdc, tm
         cxChar = tm.tmAveCharWidth
         cxCaps = IIF&((tm.tmPitchAndFamily AND 1), cxChar * 3 / 2, cxChar)
         cyChar = tm.tmHeight + tm.tmExternalLeading
         ReleaseDC hwnd, hdc

         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_PAINT
         hdc = BeginPaint(hwnd, ps)
         FOR i = LBOUND(sysmetrics) TO UBOUND(sysmetrics)
            TextOut hdc, 0, cyChar * i, sysmetrics(i).szLabel, LEN(sysmetrics(i).szLabel)
            TextOut hdc, 22 * cxCaps, cyChar * i, sysmetrics(i).szDesc, LEN(sysmetrics(i).szDesc)
            SetTextAlign hdc, %TA_RIGHT OR %TA_TOP
            szBuffer = FORMAT$(GetSystemMetrics(sysmetrics(i).iIndex))
            TextOut hdc, 22 * cxCaps + 40 * cxChar, cyChar * i, szBuffer, LEN(szBuffer)
            SetTextAlign hdc, %TA_LEFT OR %TA_TOP
         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 the SYSMETS2.C-System Metrics Display Program No. 2 © Charles Petzold, 1998, described and analysed in Chapter 4 of the book Programming Windows, 5th Edition.

Displays some of the information available from the GetSystemMetrics calls in a simple one-line-per-item format. Like SysMets1 but with vertical scrolling.

Code: [Select]

' ========================================================================================
' SYSMETS2.BAS
' This program is a translation/adaptation from C of the program SYSMETS2.C described and
' analysed in Chapter 4 of Charles Petzold's book, Programming Windows 98.
' Displays some of the information available from the GetSystemMetrics calls in a simple
' one-line-per-item format. Like SysMets1 but with vertical scrolling.
' ========================================================================================

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

' ========================================================================================
' SYSMETRICS_STRUCT
' ========================================================================================
TYPE SYSMETRICS_STRUCT
   iIndex AS LONG
   szLabel AS ASCIIZ * 21
   szDesc AS ASCIIZ * 31
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        = "SysMets2"
   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 = "Get System Metrics No. 2"
   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 cxChar AS LONG
   STATIC cxCaps AS LONG
   STATIC cyChar AS LONG
   STATIC cyClient AS LONG
   STATIC iVScrollPos AS LONG
   LOCAL hdc AS DWORD
   LOCAL i AS LONG
   LOCAL y AS LONG
   LOCAL szBuffer AS ASCIIZ * 10
   LOCAL ps  AS PAINTSTRUCT
   LOCAL tm AS TEXTMETRIC
   DIM sysmetrics(44) AS STATIC SYSMETRICS_STRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE

         ' Initialize array
         sysmetrics( 0).iIndex = %SM_CXSCREEN          : sysmetrics( 0).szLabel = "SM_CXSCREEN"          : sysmetrics( 0).szDesc = "Screen width in pixels"
         sysmetrics( 1).iIndex = %SM_CYSCREEN          : sysmetrics( 1).szLabel = "SM_CYSCREEN"          : sysmetrics( 1).szDesc = "Screen height in pixels"
         sysmetrics( 2).iIndex = %SM_CXVSCROLL         : sysmetrics( 2).szLabel = "SM_CXVSCROLL"         : sysmetrics( 2).szDesc = "Vertical scroll arrow width"
         sysmetrics( 3).iIndex = %SM_CYHSCROLL         : sysmetrics( 3).szLabel = "SM_CYHSCROLL"         : sysmetrics( 3).szDesc = "Horizontal scroll arrow height"
         sysmetrics( 4).iIndex = %SM_CYCAPTION         : sysmetrics( 4).szLabel = "SM_CYCAPTION"         : sysmetrics( 4).szDesc = "Caption bar height"
         sysmetrics( 5).iIndex = %SM_CXBORDER          : sysmetrics( 5).szLabel = "SM_CXBORDER"          : sysmetrics( 5).szDesc = "Window border width"
         sysmetrics( 6).iIndex = %SM_CYBORDER          : sysmetrics( 6).szLabel = "SM_CYBORDER"          : sysmetrics( 6).szDesc = "Window border height"
         sysmetrics( 7).iIndex = %SM_CXDLGFRAME        : sysmetrics( 7).szLabel = "SM_CXDLGFRAME"        : sysmetrics( 7).szDesc = "Dialog window frame width"
         sysmetrics( 8).iIndex = %SM_CYDLGFRAME        : sysmetrics( 8).szLabel = "SM_CYDLGFRAME"        : sysmetrics( 8).szDesc = "Dialog window frame height"
         sysmetrics( 9).iIndex = %SM_CYVTHUMB          : sysmetrics( 9).szLabel = "SM_CYVTHUMB"          : sysmetrics( 9).szDesc = "Vertical scroll thumb height"
         sysmetrics(10).iIndex = %SM_CXHTHUMB          : sysmetrics(10).szLabel = "SM_CXHTHUMB"          : sysmetrics(10).szDesc = "Horizontal scroll thumb width"
         sysmetrics(11).iIndex = %SM_CXICON            : sysmetrics(11).szLabel = "SM_CXICON"            : sysmetrics(11).szDesc = "Icon width"
         sysmetrics(12).iIndex = %SM_CYICON            : sysmetrics(12).szLabel = "SM_CYICON"            : sysmetrics(12).szDesc = "Icon height"
         sysmetrics(13).iIndex = %SM_CXCURSOR          : sysmetrics(13).szLabel = "SM_CXCURSOR"          : sysmetrics(13).szDesc = "Cursor width"
         sysmetrics(14).iIndex = %SM_CYCURSOR          : sysmetrics(14).szLabel = "SM_CYCURSOR"          : sysmetrics(14).szDesc = "Cursor height"
         sysmetrics(15).iIndex = %SM_CYMENU            : sysmetrics(15).szLabel = "SM_CYMENU"            : sysmetrics(15).szDesc = "Menu bar height"
         sysmetrics(16).iIndex = %SM_CXFULLSCREEN      : sysmetrics(16).szLabel = "SM_CXFULLSCREEN"      : sysmetrics(16).szDesc = "Full screen client area width"
         sysmetrics(17).iIndex = %SM_CYFULLSCREEN      : sysmetrics(17).szLabel = "SM_CYFULLSCREEN"      : sysmetrics(17).szDesc = "Full screen client area height"
         sysmetrics(18).iIndex = %SM_CYKANJIWINDOW     : sysmetrics(18).szLabel = "SM_CYKANJIWINDOW"     : sysmetrics(18).szDesc = "Kanji window height"
         sysmetrics(19).iIndex = %SM_MOUSEPRESENT      : sysmetrics(19).szLabel = "SM_MOUSEPRESENT"      : sysmetrics(19).szDesc = "Mouse present flag"
         sysmetrics(20).iIndex = %SM_CYVSCROLL         : sysmetrics(20).szLabel = "SM_CYVSCROLL"         : sysmetrics(20).szDesc = "Vertical scroll arrow height"
         sysmetrics(21).iIndex = %SM_CXHSCROLL         : sysmetrics(21).szLabel = "SM_CXHSCROLL"         : sysmetrics(21).szDesc = "Horizontal scroll arrow width"
         sysmetrics(22).iIndex = %SM_DEBUG             : sysmetrics(22).szLabel = "SM_DEBUG"             : sysmetrics(22).szDesc = "Debug version flag"
         sysmetrics(23).iIndex = %SM_SWAPBUTTON        : sysmetrics(23).szLabel = "SM_SWAPBUTTON"        : sysmetrics(23).szDesc = "Mouse buttons swapped flag"
         sysmetrics(24).iIndex = %SM_RESERVED1         : sysmetrics(24).szLabel = "SM_RESERVED1"         : sysmetrics(24).szDesc = "Reserved"
         sysmetrics(25).iIndex = %SM_RESERVED2         : sysmetrics(25).szLabel = "SM_RESERVED2"         : sysmetrics(25).szDesc = "Reserved"
         sysmetrics(26).iIndex = %SM_RESERVED3         : sysmetrics(26).szLabel = "SM_RESERVED3"         : sysmetrics(26).szDesc = "Reserved"
         sysmetrics(27).iIndex = %SM_RESERVED4         : sysmetrics(27).szLabel = "SM_RESERVED4"         : sysmetrics(27).szDesc = "Reserved"
         sysmetrics(28).iIndex = %SM_CXMIN             : sysmetrics(28).szLabel = "SM_CXMIN"             : sysmetrics(28).szDesc = "Minimum window width"
         sysmetrics(29).iIndex = %SM_CYMIN             : sysmetrics(29).szLabel = "SM_CYMIN"             : sysmetrics(29).szDesc = "Minimum window height"
         sysmetrics(30).iIndex = %SM_CXSIZE            : sysmetrics(30).szLabel = "SM_CXSIZE"            : sysmetrics(30).szDesc = "Minimize/Maximize icon width"
         sysmetrics(31).iIndex = %SM_CYSIZE            : sysmetrics(31).szLabel = "SM_CYSIZE"            : sysmetrics(31).szDesc = "Minimize/Maximize icon height"
         sysmetrics(32).iIndex = %SM_CXFRAME           : sysmetrics(32).szLabel = "SM_CXFRAME"           : sysmetrics(32).szDesc = "Window frame width"
         sysmetrics(33).iIndex = %SM_CYFRAME           : sysmetrics(33).szLabel = "SM_CYFRAME"           : sysmetrics(33).szDesc = "Window frame height"
         sysmetrics(34).iIndex = %SM_CXMINTRACK        : sysmetrics(34).szLabel = "SM_CXMINTRACK"        : sysmetrics(34).szDesc = "Minimum window tracking width"
         sysmetrics(35).iIndex = %SM_CYMINTRACK        : sysmetrics(35).szLabel = "SM_CYMINTRACK"        : sysmetrics(35).szDesc = "Minimum window tracking height"
         sysmetrics(36).iIndex = %SM_CXDOUBLECLK       : sysmetrics(36).szLabel = "SM_CXDOUBLECLK"       : sysmetrics(36).szDesc = "Double click x tolerance"
         sysmetrics(37).iIndex = %SM_CYDOUBLECLK       : sysmetrics(37).szLabel = "SM_CYDOUBLECLK"       : sysmetrics(37).szDesc = "Double click y tolerance"
         sysmetrics(38).iIndex = %SM_CXICONSPACING     : sysmetrics(38).szLabel = "SM_CXICONSPACING"     : sysmetrics(38).szDesc = "Horizontal icon spacing"
         sysmetrics(39).iIndex = %SM_CYICONSPACING     : sysmetrics(39).szLabel = "SM_CYICONSPACING"     : sysmetrics(39).szDesc = "Vertical icon spacing"
         sysmetrics(40).iIndex = %SM_MENUDROPALIGNMENT : sysmetrics(40).szLabel = "SM_MENUDROPALIGNMENT" : sysmetrics(40).szDesc = "Left or right menu drop"
         sysmetrics(41).iIndex = %SM_PENWINDOWS        : sysmetrics(41).szLabel = "SM_PENWINDOWS"        : sysmetrics(41).szDesc = "Pen extensions installed"
         sysmetrics(42).iIndex = %SM_DBCSENABLED       : sysmetrics(42).szLabel = "SM_DBCSENABLED"       : sysmetrics(42).szDesc = "Double-Byte Char Set enabled"
         sysmetrics(43).iIndex = %SM_CMOUSEBUTTONS     : sysmetrics(43).szLabel = "SM_CMOUSEBUTTONS"     : sysmetrics(43).szDesc = "Number of mouse buttons"
         sysmetrics(44).iIndex = %SM_SHOWSOUNDS        : sysmetrics(44).szLabel = "SM_SHOWSOUNDS"        : sysmetrics(44).szDesc = "Present sounds visually"

         hdc = GetDC (hwnd)
         GetTextMetrics hdc, tm
         cxChar = tm.tmAveCharWidth
         cxCaps = IIF&((tm.tmPitchAndFamily AND 1), cxChar * 3 / 2, cxChar)
         cyChar = tm.tmHeight + tm.tmExternalLeading
         ReleaseDC hwnd, hdc

         SetScrollRange hwnd, %SB_VERT, 0, UBOUND(sysmetrics), %FALSE
         SetScrollPos hwnd, %SB_VERT, iVscrollPos, %TRUE

         EXIT FUNCTION

      CASE %WM_SIZE
         cyClient = HI(WORD, lParam)
         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_VSCROLL
         SELECT CASE LO(WORD, wParam)
            CASE %SB_LINEUP
               iVscrollPos = iVscrollPos - 1
            CASE %SB_LINEDOWN
               iVscrollPos = iVscrollPos + 1
            CASE %SB_PAGEUP
               iVscrollPos = iVscrollPos - cyClient / cyChar
            CASE %SB_PAGEDOWN
               iVscrollPos = iVscrollPos + cyClient / cyChar
            CASE %SB_THUMBPOSITION
               iVscrollPos = HI(WORD, wParam)
         END SELECT
         iVscrollPos = MAX&(0, MIN&(iVscrollPos, UBOUND(sysmetrics)))
         IF iVscrollPos <> GetScrollPos(hwnd, %SB_VERT) THEN
            SetScrollPos hwnd, %SB_VERT, iVscrollPos, %TRUE
            InvalidateRect hwnd, BYVAL %NULL, %TRUE
         END IF
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         FOR i = LBOUND(sysmetrics) TO UBOUND(sysmetrics)
            y = cyChar * (i - iVScrollPos)
            TextOut hdc, 0, y, sysmetrics(i).szLabel, LEN(sysmetrics(i).szLabel)
            TextOut hdc, 22 * cxCaps, y, sysmetrics(i).szDesc, LEN(sysmetrics(i).szDesc)
            SetTextAlign hdc, %TA_RIGHT OR %TA_TOP
            szBuffer = FORMAT$(GetSystemMetrics(sysmetrics(i).iIndex))
            TextOut hdc, 22 * cxCaps + 40 * cxChar, y, szBuffer, LEN(szBuffer)
            SetTextAlign hdc, %TA_LEFT OR %TA_TOP
         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 the SYSMETS3.C-System Metrics Display Program No. 3 © Charles Petzold, 1998, described and analysed in Chapter 4 of the book Programming Windows, 5th Edition.

Displays some of the information available from the GetSystemMetrics calls in a simple one-line-per-item format. This version uses the SetScrollInfo and GetScrollInfo functions, adds a horizontal scroll bar for left and right scrolling, and repaints the client area more efficiently.

Code: [Select]

' ========================================================================================
' SYSMETS3.BAS
' This program is a translation/adaptation from C of the program SYSMETS3.C described and
' analysed in Chapter 4 of Charles Petzold's book, Programming Windows 98.
' Displays some of the information available from the GetSystemMetrics calls in a simple
' one-line-per-item format. This version uses the SetScrollInfo and GetScrollInfo
' functions, adds a horizontal scroll bar for left and right scrolling, and repaints the
' client area more efficiently.
' ========================================================================================

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

' ========================================================================================
' SYSMETRICS_STRUCT
' ========================================================================================
TYPE SYSMETRICS_STRUCT
   iIndex AS LONG
   szLabel AS ASCIIZ * 21
   szDesc AS ASCIIZ * 31
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          = "SysMets3"
   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 = "Get System Metrics No. 3"
   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 cxChar AS LONG
   STATIC cxCaps AS LONG
   STATIC cyChar AS LONG
   STATIC cyClient AS LONG
   STATIC cxClient AS LONG
   STATIC iMaxWidth AS LONG
   LOCAL hdc AS DWORD
   LOCAL i AS LONG
   LOCAL x AS LONG
   LOCAL y AS LONG
   LOCAL iVertPos AS LONG
   LOCAL iHorzPos AS LONG
   LOCAL iPaintBeg AS LONG
   LOCAL iPaintEnd AS LONG
   LOCAL si AS SCROLLINFO
   LOCAL szBuffer AS ASCIIZ * 10
   LOCAL ps  AS PAINTSTRUCT
   LOCAL tm AS TEXTMETRIC
   DIM sysmetrics(44) AS STATIC SYSMETRICS_STRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE

         ' Initialize array
         sysmetrics( 0).iIndex = %SM_CXSCREEN          : sysmetrics( 0).szLabel = "SM_CXSCREEN"          : sysmetrics( 0).szDesc = "Screen width in pixels"
         sysmetrics( 1).iIndex = %SM_CYSCREEN          : sysmetrics( 1).szLabel = "SM_CYSCREEN"          : sysmetrics( 1).szDesc = "Screen height in pixels"
         sysmetrics( 2).iIndex = %SM_CXVSCROLL         : sysmetrics( 2).szLabel = "SM_CXVSCROLL"         : sysmetrics( 2).szDesc = "Vertical scroll arrow width"
         sysmetrics( 3).iIndex = %SM_CYHSCROLL         : sysmetrics( 3).szLabel = "SM_CYHSCROLL"         : sysmetrics( 3).szDesc = "Horizontal scroll arrow height"
         sysmetrics( 4).iIndex = %SM_CYCAPTION         : sysmetrics( 4).szLabel = "SM_CYCAPTION"         : sysmetrics( 4).szDesc = "Caption bar height"
         sysmetrics( 5).iIndex = %SM_CXBORDER          : sysmetrics( 5).szLabel = "SM_CXBORDER"          : sysmetrics( 5).szDesc = "Window border width"
         sysmetrics( 6).iIndex = %SM_CYBORDER          : sysmetrics( 6).szLabel = "SM_CYBORDER"          : sysmetrics( 6).szDesc = "Window border height"
         sysmetrics( 7).iIndex = %SM_CXDLGFRAME        : sysmetrics( 7).szLabel = "SM_CXDLGFRAME"        : sysmetrics( 7).szDesc = "Dialog window frame width"
         sysmetrics( 8).iIndex = %SM_CYDLGFRAME        : sysmetrics( 8).szLabel = "SM_CYDLGFRAME"        : sysmetrics( 8).szDesc = "Dialog window frame height"
         sysmetrics( 9).iIndex = %SM_CYVTHUMB          : sysmetrics( 9).szLabel = "SM_CYVTHUMB"          : sysmetrics( 9).szDesc = "Vertical scroll thumb height"
         sysmetrics(10).iIndex = %SM_CXHTHUMB          : sysmetrics(10).szLabel = "SM_CXHTHUMB"          : sysmetrics(10).szDesc = "Horizontal scroll thumb width"
         sysmetrics(11).iIndex = %SM_CXICON            : sysmetrics(11).szLabel = "SM_CXICON"            : sysmetrics(11).szDesc = "Icon width"
         sysmetrics(12).iIndex = %SM_CYICON            : sysmetrics(12).szLabel = "SM_CYICON"            : sysmetrics(12).szDesc = "Icon height"
         sysmetrics(13).iIndex = %SM_CXCURSOR          : sysmetrics(13).szLabel = "SM_CXCURSOR"          : sysmetrics(13).szDesc = "Cursor width"
         sysmetrics(14).iIndex = %SM_CYCURSOR          : sysmetrics(14).szLabel = "SM_CYCURSOR"          : sysmetrics(14).szDesc = "Cursor height"
         sysmetrics(15).iIndex = %SM_CYMENU            : sysmetrics(15).szLabel = "SM_CYMENU"            : sysmetrics(15).szDesc = "Menu bar height"
         sysmetrics(16).iIndex = %SM_CXFULLSCREEN      : sysmetrics(16).szLabel = "SM_CXFULLSCREEN"      : sysmetrics(16).szDesc = "Full screen client area width"
         sysmetrics(17).iIndex = %SM_CYFULLSCREEN      : sysmetrics(17).szLabel = "SM_CYFULLSCREEN"      : sysmetrics(17).szDesc = "Full screen client area height"
         sysmetrics(18).iIndex = %SM_CYKANJIWINDOW     : sysmetrics(18).szLabel = "SM_CYKANJIWINDOW"     : sysmetrics(18).szDesc = "Kanji window height"
         sysmetrics(19).iIndex = %SM_MOUSEPRESENT      : sysmetrics(19).szLabel = "SM_MOUSEPRESENT"      : sysmetrics(19).szDesc = "Mouse present flag"
         sysmetrics(20).iIndex = %SM_CYVSCROLL         : sysmetrics(20).szLabel = "SM_CYVSCROLL"         : sysmetrics(20).szDesc = "Vertical scroll arrow height"
         sysmetrics(21).iIndex = %SM_CXHSCROLL         : sysmetrics(21).szLabel = "SM_CXHSCROLL"         : sysmetrics(21).szDesc = "Horizontal scroll arrow width"
         sysmetrics(22).iIndex = %SM_DEBUG             : sysmetrics(22).szLabel = "SM_DEBUG"             : sysmetrics(22).szDesc = "Debug version flag"
         sysmetrics(23).iIndex = %SM_SWAPBUTTON        : sysmetrics(23).szLabel = "SM_SWAPBUTTON"        : sysmetrics(23).szDesc = "Mouse buttons swapped flag"
         sysmetrics(24).iIndex = %SM_RESERVED1         : sysmetrics(24).szLabel = "SM_RESERVED1"         : sysmetrics(24).szDesc = "Reserved"
         sysmetrics(25).iIndex = %SM_RESERVED2         : sysmetrics(25).szLabel = "SM_RESERVED2"         : sysmetrics(25).szDesc = "Reserved"
         sysmetrics(26).iIndex = %SM_RESERVED3         : sysmetrics(26).szLabel = "SM_RESERVED3"         : sysmetrics(26).szDesc = "Reserved"
         sysmetrics(27).iIndex = %SM_RESERVED4         : sysmetrics(27).szLabel = "SM_RESERVED4"         : sysmetrics(27).szDesc = "Reserved"
         sysmetrics(28).iIndex = %SM_CXMIN             : sysmetrics(28).szLabel = "SM_CXMIN"             : sysmetrics(28).szDesc = "Minimum window width"
         sysmetrics(29).iIndex = %SM_CYMIN             : sysmetrics(29).szLabel = "SM_CYMIN"             : sysmetrics(29).szDesc = "Minimum window height"
         sysmetrics(30).iIndex = %SM_CXSIZE            : sysmetrics(30).szLabel = "SM_CXSIZE"            : sysmetrics(30).szDesc = "Minimize/Maximize icon width"
         sysmetrics(31).iIndex = %SM_CYSIZE            : sysmetrics(31).szLabel = "SM_CYSIZE"            : sysmetrics(31).szDesc = "Minimize/Maximize icon height"
         sysmetrics(32).iIndex = %SM_CXFRAME           : sysmetrics(32).szLabel = "SM_CXFRAME"           : sysmetrics(32).szDesc = "Window frame width"
         sysmetrics(33).iIndex = %SM_CYFRAME           : sysmetrics(33).szLabel = "SM_CYFRAME"           : sysmetrics(33).szDesc = "Window frame height"
         sysmetrics(34).iIndex = %SM_CXMINTRACK        : sysmetrics(34).szLabel = "SM_CXMINTRACK"        : sysmetrics(34).szDesc = "Minimum window tracking width"
         sysmetrics(35).iIndex = %SM_CYMINTRACK        : sysmetrics(35).szLabel = "SM_CYMINTRACK"        : sysmetrics(35).szDesc = "Minimum window tracking height"
         sysmetrics(36).iIndex = %SM_CXDOUBLECLK       : sysmetrics(36).szLabel = "SM_CXDOUBLECLK"       : sysmetrics(36).szDesc = "Double click x tolerance"
         sysmetrics(37).iIndex = %SM_CYDOUBLECLK       : sysmetrics(37).szLabel = "SM_CYDOUBLECLK"       : sysmetrics(37).szDesc = "Double click y tolerance"
         sysmetrics(38).iIndex = %SM_CXICONSPACING     : sysmetrics(38).szLabel = "SM_CXICONSPACING"     : sysmetrics(38).szDesc = "Horizontal icon spacing"
         sysmetrics(39).iIndex = %SM_CYICONSPACING     : sysmetrics(39).szLabel = "SM_CYICONSPACING"     : sysmetrics(39).szDesc = "Vertical icon spacing"
         sysmetrics(40).iIndex = %SM_MENUDROPALIGNMENT : sysmetrics(40).szLabel = "SM_MENUDROPALIGNMENT" : sysmetrics(40).szDesc = "Left or right menu drop"
         sysmetrics(41).iIndex = %SM_PENWINDOWS        : sysmetrics(41).szLabel = "SM_PENWINDOWS"        : sysmetrics(41).szDesc = "Pen extensions installed"
         sysmetrics(42).iIndex = %SM_DBCSENABLED       : sysmetrics(42).szLabel = "SM_DBCSENABLED"       : sysmetrics(42).szDesc = "Double-Byte Char Set enabled"
         sysmetrics(43).iIndex = %SM_CMOUSEBUTTONS     : sysmetrics(43).szLabel = "SM_CMOUSEBUTTONS"     : sysmetrics(43).szDesc = "Number of mouse buttons"
         sysmetrics(44).iIndex = %SM_SHOWSOUNDS        : sysmetrics(44).szLabel = "SM_SHOWSOUNDS"        : sysmetrics(44).szDesc = "Present sounds visually"

         hdc = GetDC (hwnd)
         GetTextMetrics hdc, tm
         cxChar = tm.tmAveCharWidth
         cxCaps = IIF&((tm.tmPitchAndFamily AND 1), cxChar * 3 / 2, cxChar)
         cyChar = tm.tmHeight + tm.tmExternalLeading
         ReleaseDC hwnd, hdc

         ' Save the width of the three columns
         iMaxWidth = 40 * cxChar + 22 * cxCaps

         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)

         ' Set vertical scroll bar range and page size
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_RANGE OR %SIF_PAGE
         si.nMin   = 0
         si.nMax   = UBOUND(sysmetrics)
         si.nPage  = cyClient / cyChar
         SetScrollInfo (hwnd, %SB_VERT, si, %TRUE)

         ' Set horizontal scroll bar range and page size
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_RANGE OR %SIF_PAGE
         si.nMin   = 0
         si.nMax   = 2 + iMaxWidth / cxChar
         si.nPage  = cxClient / cxChar
         SetScrollInfo (hwnd, %SB_HORZ, si, %TRUE)

         EXIT FUNCTION

      CASE %WM_VSCROLL

         ' Get all the vertical scroll bar information
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_ALL
         GetScrollInfo hwnd, %SB_VERT, si

         ' Save the position for comparison later on
         iVertPos = si.nPos

         SELECT CASE LO(WORD, wParam)
            CASE %SB_TOP
               si.nPos = si.nMin
            CASE %SB_BOTTOM
               si.nPos = si.nMax
            CASE %SB_LINEUP
               si.nPos = si.nPos - 1
            CASE %SB_LINEDOWN
               si.nPos = si.nPos + 1
            CASE %SB_PAGEUP
               si.nPos = si.nPos - si.nPage
            CASE %SB_PAGEDOWN
               si.nPos = si.nPos + si.nPage
            CASE %SB_THUMBPOSITION
               si.nPos = si.nTrackPos
         END SELECT

         ' Set the position and then retrieve it.  Due to adjustments
         '   by Windows it may not be the same as the value set.
         si.fMask = %SIF_POS
         SetScrollInfo hwnd, %SB_VERT, si, %TRUE
         GetScrollInfo hwnd, %SB_VERT, si

         ' If the position has changed, scroll the window and update it
         IF si.nPos <> iVertPos THEN
            ScrollWindow hwnd, 0, cyChar * (iVertPos - si.nPos), BYVAL %NULL, BYVAL %NULL
            UpdateWindow hwnd
         END IF

         EXIT FUNCTION

      CASE %WM_HSCROLL

         ' Get all the vertical scroll bar information
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_ALL

         ' Save the position for comparison later on
         GetScrollInfo hwnd, %SB_HORZ, si
         iHorzPos = si.nPos

         SELECT CASE LO(WORD, wParam)
            CASE %SB_LINELEFT
               si.nPos = si.nPos - 1
            CASE %SB_LINERIGHT
               si.nPos = si.nPos + 1
            CASE %SB_PAGELEFT
               si.nPos = si.nPos - si.nPage
            CASE %SB_PAGERIGHT
               si.nPos = si.nPos + si.nPage
            CASE %SB_THUMBPOSITION:
               si.nPos = si.nTrackPos
         END SELECT

         ' Set the position and then retrieve it.  Due to adjustments
         '   by Windows it may not be the same as the value set.
         si.fMask = %SIF_POS
         SetScrollInfo hwnd, %SB_HORZ, si, %TRUE
         GetScrollInfo hwnd, %SB_HORZ, si

         ' If the position has changed, scroll the window
         IF si.nPos <> iHorzPos THEN
            ScrollWindow hwnd, cxChar * (iHorzPos - si.nPos), 0, BYVAL %NULL, BYVAL %NULL
         END IF

         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)

         ' Get vertical scroll bar position
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_POS
         GetScrollInfo hwnd, %SB_VERT, si
         iVertPos = si.nPos

         ' Get horizontal scroll bar position
         GetScrollInfo hwnd, %SB_HORZ, si
         iHorzPos = si.nPos

         ' Find painting limits
         iPaintBeg = MAX&(0, iVertPos + ps.rcPaint.nTop / cyChar)
         iPaintEnd = MIN&(UBOUND(sysmetrics), iVertPos + ps.rcPaint.nBottom / cyChar)

         FOR i = iPaintBeg TO iPaintEnd
            x = cxChar * (1 - iHorzPos)
            y = cyChar * (i - iVertPos)
            TextOut hdc, x, y, sysmetrics(i).szLabel, LEN(sysmetrics(i).szLabel)
            TextOut hdc, x + 22 * cxCaps, y, sysmetrics(i).szDesc, LEN(sysmetrics(i).szDesc)
            SetTextAlign hdc, %TA_RIGHT OR %TA_TOP
            szBuffer = FORMAT$(GetSystemMetrics(sysmetrics(i).iIndex))
            TextOut hdc, x + 22 * cxCaps + 40 * cxChar, y, szBuffer, LEN(szBuffer)
            SetTextAlign hdc, %TA_LEFT OR %TA_TOP
         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 from C of the program SYSMETS4.C described and analysed in Chapter 6 of Charles Petzold's book, Programming Windows 98.

Displays some of the information available from the GetSystemMetrics calls in a simple one-line-per-item format. This version adds a keyboard interface to the scrollbars.

Code: [Select]

' ========================================================================================
' SYSMETS4.BAS
' This program is a translation/adaptation from C of the program SYSMETS4.C described and
' analysed in Chapter 6 of Charles Petzold's book, Programming Windows 98.
' Displays some of the information available from the GetSystemMetrics calls in a simple
' one-line-per-item format. This version adds a keyboard interface to the scrollbars.
' ========================================================================================

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

' ========================================================================================
' SYSMETRICS_STRUCT
' ========================================================================================
TYPE SYSMETRICS_STRUCT
   iIndex AS LONG
   szLabel AS ASCIIZ * 21
   szDesc AS ASCIIZ * 31
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        = "SysMets4"
   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 = "Get System Metrics No. 4"
   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 cxChar AS LONG
   STATIC cxCaps AS LONG
   STATIC cyChar AS LONG
   STATIC cyClient AS LONG
   STATIC cxClient AS LONG
   STATIC iMaxWidth AS LONG
   LOCAL hdc AS DWORD
   LOCAL i AS LONG
   LOCAL x AS LONG
   LOCAL y AS LONG
   LOCAL iVertPos AS LONG
   LOCAL iHorzPos AS LONG
   LOCAL iPaintBeg AS LONG
   LOCAL iPaintEnd AS LONG
   LOCAL si AS SCROLLINFO
   LOCAL szBuffer AS ASCIIZ * 10
   LOCAL ps  AS PAINTSTRUCT
   LOCAL tm AS TEXTMETRIC
   DIM sysmetrics(44) AS STATIC SYSMETRICS_STRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE

         ' Initialize array
         sysmetrics( 0).iIndex = %SM_CXSCREEN          : sysmetrics( 0).szLabel = "SM_CXSCREEN"          : sysmetrics( 0).szDesc = "Screen width in pixels"
         sysmetrics( 1).iIndex = %SM_CYSCREEN          : sysmetrics( 1).szLabel = "SM_CYSCREEN"          : sysmetrics( 1).szDesc = "Screen height in pixels"
         sysmetrics( 2).iIndex = %SM_CXVSCROLL         : sysmetrics( 2).szLabel = "SM_CXVSCROLL"         : sysmetrics( 2).szDesc = "Vertical scroll arrow width"
         sysmetrics( 3).iIndex = %SM_CYHSCROLL         : sysmetrics( 3).szLabel = "SM_CYHSCROLL"         : sysmetrics( 3).szDesc = "Horizontal scroll arrow height"
         sysmetrics( 4).iIndex = %SM_CYCAPTION         : sysmetrics( 4).szLabel = "SM_CYCAPTION"         : sysmetrics( 4).szDesc = "Caption bar height"
         sysmetrics( 5).iIndex = %SM_CXBORDER          : sysmetrics( 5).szLabel = "SM_CXBORDER"          : sysmetrics( 5).szDesc = "Window border width"
         sysmetrics( 6).iIndex = %SM_CYBORDER          : sysmetrics( 6).szLabel = "SM_CYBORDER"          : sysmetrics( 6).szDesc = "Window border height"
         sysmetrics( 7).iIndex = %SM_CXDLGFRAME        : sysmetrics( 7).szLabel = "SM_CXDLGFRAME"        : sysmetrics( 7).szDesc = "Dialog window frame width"
         sysmetrics( 8).iIndex = %SM_CYDLGFRAME        : sysmetrics( 8).szLabel = "SM_CYDLGFRAME"        : sysmetrics( 8).szDesc = "Dialog window frame height"
         sysmetrics( 9).iIndex = %SM_CYVTHUMB          : sysmetrics( 9).szLabel = "SM_CYVTHUMB"          : sysmetrics( 9).szDesc = "Vertical scroll thumb height"
         sysmetrics(10).iIndex = %SM_CXHTHUMB          : sysmetrics(10).szLabel = "SM_CXHTHUMB"          : sysmetrics(10).szDesc = "Horizontal scroll thumb width"
         sysmetrics(11).iIndex = %SM_CXICON            : sysmetrics(11).szLabel = "SM_CXICON"            : sysmetrics(11).szDesc = "Icon width"
         sysmetrics(12).iIndex = %SM_CYICON            : sysmetrics(12).szLabel = "SM_CYICON"            : sysmetrics(12).szDesc = "Icon height"
         sysmetrics(13).iIndex = %SM_CXCURSOR          : sysmetrics(13).szLabel = "SM_CXCURSOR"          : sysmetrics(13).szDesc = "Cursor width"
         sysmetrics(14).iIndex = %SM_CYCURSOR          : sysmetrics(14).szLabel = "SM_CYCURSOR"          : sysmetrics(14).szDesc = "Cursor height"
         sysmetrics(15).iIndex = %SM_CYMENU            : sysmetrics(15).szLabel = "SM_CYMENU"            : sysmetrics(15).szDesc = "Menu bar height"
         sysmetrics(16).iIndex = %SM_CXFULLSCREEN      : sysmetrics(16).szLabel = "SM_CXFULLSCREEN"      : sysmetrics(16).szDesc = "Full screen client area width"
         sysmetrics(17).iIndex = %SM_CYFULLSCREEN      : sysmetrics(17).szLabel = "SM_CYFULLSCREEN"      : sysmetrics(17).szDesc = "Full screen client area height"
         sysmetrics(18).iIndex = %SM_CYKANJIWINDOW     : sysmetrics(18).szLabel = "SM_CYKANJIWINDOW"     : sysmetrics(18).szDesc = "Kanji window height"
         sysmetrics(19).iIndex = %SM_MOUSEPRESENT      : sysmetrics(19).szLabel = "SM_MOUSEPRESENT"      : sysmetrics(19).szDesc = "Mouse present flag"
         sysmetrics(20).iIndex = %SM_CYVSCROLL         : sysmetrics(20).szLabel = "SM_CYVSCROLL"         : sysmetrics(20).szDesc = "Vertical scroll arrow height"
         sysmetrics(21).iIndex = %SM_CXHSCROLL         : sysmetrics(21).szLabel = "SM_CXHSCROLL"         : sysmetrics(21).szDesc = "Horizontal scroll arrow width"
         sysmetrics(22).iIndex = %SM_DEBUG             : sysmetrics(22).szLabel = "SM_DEBUG"             : sysmetrics(22).szDesc = "Debug version flag"
         sysmetrics(23).iIndex = %SM_SWAPBUTTON        : sysmetrics(23).szLabel = "SM_SWAPBUTTON"        : sysmetrics(23).szDesc = "Mouse buttons swapped flag"
         sysmetrics(24).iIndex = %SM_RESERVED1         : sysmetrics(24).szLabel = "SM_RESERVED1"         : sysmetrics(24).szDesc = "Reserved"
         sysmetrics(25).iIndex = %SM_RESERVED2         : sysmetrics(25).szLabel = "SM_RESERVED2"         : sysmetrics(25).szDesc = "Reserved"
         sysmetrics(26).iIndex = %SM_RESERVED3         : sysmetrics(26).szLabel = "SM_RESERVED3"         : sysmetrics(26).szDesc = "Reserved"
         sysmetrics(27).iIndex = %SM_RESERVED4         : sysmetrics(27).szLabel = "SM_RESERVED4"         : sysmetrics(27).szDesc = "Reserved"
         sysmetrics(28).iIndex = %SM_CXMIN             : sysmetrics(28).szLabel = "SM_CXMIN"             : sysmetrics(28).szDesc = "Minimum window width"
         sysmetrics(29).iIndex = %SM_CYMIN             : sysmetrics(29).szLabel = "SM_CYMIN"             : sysmetrics(29).szDesc = "Minimum window height"
         sysmetrics(30).iIndex = %SM_CXSIZE            : sysmetrics(30).szLabel = "SM_CXSIZE"            : sysmetrics(30).szDesc = "Minimize/Maximize icon width"
         sysmetrics(31).iIndex = %SM_CYSIZE            : sysmetrics(31).szLabel = "SM_CYSIZE"            : sysmetrics(31).szDesc = "Minimize/Maximize icon height"
         sysmetrics(32).iIndex = %SM_CXFRAME           : sysmetrics(32).szLabel = "SM_CXFRAME"           : sysmetrics(32).szDesc = "Window frame width"
         sysmetrics(33).iIndex = %SM_CYFRAME           : sysmetrics(33).szLabel = "SM_CYFRAME"           : sysmetrics(33).szDesc = "Window frame height"
         sysmetrics(34).iIndex = %SM_CXMINTRACK        : sysmetrics(34).szLabel = "SM_CXMINTRACK"        : sysmetrics(34).szDesc = "Minimum window tracking width"
         sysmetrics(35).iIndex = %SM_CYMINTRACK        : sysmetrics(35).szLabel = "SM_CYMINTRACK"        : sysmetrics(35).szDesc = "Minimum window tracking height"
         sysmetrics(36).iIndex = %SM_CXDOUBLECLK       : sysmetrics(36).szLabel = "SM_CXDOUBLECLK"       : sysmetrics(36).szDesc = "Double click x tolerance"
         sysmetrics(37).iIndex = %SM_CYDOUBLECLK       : sysmetrics(37).szLabel = "SM_CYDOUBLECLK"       : sysmetrics(37).szDesc = "Double click y tolerance"
         sysmetrics(38).iIndex = %SM_CXICONSPACING     : sysmetrics(38).szLabel = "SM_CXICONSPACING"     : sysmetrics(38).szDesc = "Horizontal icon spacing"
         sysmetrics(39).iIndex = %SM_CYICONSPACING     : sysmetrics(39).szLabel = "SM_CYICONSPACING"     : sysmetrics(39).szDesc = "Vertical icon spacing"
         sysmetrics(40).iIndex = %SM_MENUDROPALIGNMENT : sysmetrics(40).szLabel = "SM_MENUDROPALIGNMENT" : sysmetrics(40).szDesc = "Left or right menu drop"
         sysmetrics(41).iIndex = %SM_PENWINDOWS        : sysmetrics(41).szLabel = "SM_PENWINDOWS"        : sysmetrics(41).szDesc = "Pen extensions installed"
         sysmetrics(42).iIndex = %SM_DBCSENABLED       : sysmetrics(42).szLabel = "SM_DBCSENABLED"       : sysmetrics(42).szDesc = "Double-Byte Char Set enabled"
         sysmetrics(43).iIndex = %SM_CMOUSEBUTTONS     : sysmetrics(43).szLabel = "SM_CMOUSEBUTTONS"     : sysmetrics(43).szDesc = "Number of mouse buttons"
         sysmetrics(44).iIndex = %SM_SHOWSOUNDS        : sysmetrics(44).szLabel = "SM_SHOWSOUNDS"        : sysmetrics(44).szDesc = "Present sounds visually"

         hdc = GetDC (hwnd)
         GetTextMetrics hdc, tm
         cxChar = tm.tmAveCharWidth
         cxCaps = IIF&((tm.tmPitchAndFamily AND 1), cxChar * 3 / 2, cxChar)
         cyChar = tm.tmHeight + tm.tmExternalLeading
         ReleaseDC hwnd, hdc

         ' Save the width of the three columns
         iMaxWidth = 40 * cxChar + 22 * cxCaps

         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)

         ' Set vertical scroll bar range and page size
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_RANGE OR %SIF_PAGE
         si.nMin   = 0
         si.nMax   = UBOUND(sysmetrics)
         si.nPage  = cyClient / cyChar
         SetScrollInfo (hwnd, %SB_VERT, si, %TRUE)

         ' Set horizontal scroll bar range and page size
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_RANGE OR %SIF_PAGE
         si.nMin   = 0
         si.nMax   = 2 + iMaxWidth / cxChar
         si.nPage  = cxClient / cxChar
         SetScrollInfo (hwnd, %SB_HORZ, si, %TRUE)

         EXIT FUNCTION

      CASE %WM_VSCROLL

         ' Get all the vertical scroll bar information
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_ALL
         GetScrollInfo hwnd, %SB_VERT, si

         ' Save the position for comparison later on
         iVertPos = si.nPos

         SELECT CASE LO(WORD, wParam)
            CASE %SB_TOP
               si.nPos = si.nMin
            CASE %SB_BOTTOM
               si.nPos = si.nMax
            CASE %SB_LINEUP
               si.nPos = si.nPos - 1
            CASE %SB_LINEDOWN
               si.nPos = si.nPos + 1
            CASE %SB_PAGEUP
               si.nPos = si.nPos - si.nPage
            CASE %SB_PAGEDOWN
               si.nPos = si.nPos + si.nPage
            CASE %SB_THUMBPOSITION
               si.nPos = si.nTrackPos
         END SELECT

         ' Set the position and then retrieve it.  Due to adjustments
         '   by Windows it may not be the same as the value set.
         si.fMask = %SIF_POS
         SetScrollInfo hwnd, %SB_VERT, si, %TRUE
         GetScrollInfo hwnd, %SB_VERT, si

         ' If the position has changed, scroll the window and update it
         IF si.nPos <> iVertPos THEN
            ScrollWindow hwnd, 0, cyChar * (iVertPos - si.nPos), BYVAL %NULL, BYVAL %NULL
            UpdateWindow hwnd
         END IF

         EXIT FUNCTION

      CASE %WM_HSCROLL

         ' Get all the vertical scroll bar information
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_ALL

         ' Save the position for comparison later on
         GetScrollInfo hwnd, %SB_HORZ, si
         iHorzPos = si.nPos

         SELECT CASE LO(WORD, wParam)
            CASE %SB_LINELEFT
               si.nPos = si.nPos - 1
            CASE %SB_LINERIGHT
               si.nPos = si.nPos + 1
            CASE %SB_PAGELEFT
               si.nPos = si.nPos - si.nPage
            CASE %SB_PAGERIGHT
               si.nPos = si.nPos + si.nPage
            CASE %SB_THUMBPOSITION:
               si.nPos = si.nTrackPos
         END SELECT

         ' Set the position and then retrieve it.  Due to adjustments
         '   by Windows it may not be the same as the value set.
         si.fMask = %SIF_POS
         SetScrollInfo hwnd, %SB_HORZ, si, %TRUE
         GetScrollInfo hwnd, %SB_HORZ, si

         ' If the position has changed, scroll the window
         IF si.nPos <> iHorzPos THEN
            ScrollWindow hwnd, cxChar * (iHorzPos - si.nPos), 0, BYVAL %NULL, BYVAL %NULL
         END IF

         EXIT FUNCTION

      CASE %WM_KEYDOWN
         SELECT CASE wParam
            CASE %VK_HOME
               SendMessage hwnd, %WM_VSCROLL, %SB_TOP, 0
            CASE %VK_END
               SendMessage hwnd, %WM_VSCROLL, %SB_BOTTOM, 0
            CASE %VK_PRIOR
               SendMessage hwnd, %WM_VSCROLL, %SB_PAGEUP, 0
            CASE %VK_NEXT
               SendMessage hwnd, %WM_VSCROLL, %SB_PAGEDOWN, 0
            CASE %VK_UP
               SendMessage hwnd, %WM_VSCROLL, %SB_LINEUP, 0
            CASE %VK_DOWN
               SendMessage hwnd, %WM_VSCROLL, %SB_LINEDOWN, 0
            CASE %VK_LEFT
               SendMessage hwnd, %WM_HSCROLL, %SB_PAGEUP, 0
            CASE %VK_RIGHT
               SendMessage hwnd, %WM_HSCROLL, %SB_PAGEDOWN, 0
         END SELECT
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)

         ' Get vertical scroll bar position
         si.cbSize = SIZEOF(si)
         si.fMask  = %SIF_POS
         GetScrollInfo hwnd, %SB_VERT, si
         iVertPos = si.nPos

         ' Get horizontal scroll bar position
         GetScrollInfo hwnd, %SB_HORZ, si
         iHorzPos = si.nPos

         ' Find painting limits
         iPaintBeg = MAX&(0, iVertPos + ps.rcPaint.nTop / cyChar)
         iPaintEnd = MIN&(UBOUND(sysmetrics), iVertPos + ps.rcPaint.nBottom / cyChar)

         FOR i = iPaintBeg TO iPaintEnd
            x = cxChar * (1 - iHorzPos)
            y = cyChar * (i - iVertPos)
            TextOut hdc, x, y, sysmetrics(i).szLabel, LEN(sysmetrics(i).szLabel)
            TextOut hdc, x + 22 * cxCaps, y, sysmetrics(i).szDesc, LEN(sysmetrics(i).szDesc)
            SetTextAlign hdc, %TA_RIGHT OR %TA_TOP
            szBuffer = FORMAT$(GetSystemMetrics(sysmetrics(i).iIndex))
            TextOut hdc, x + 22 * cxCaps + 40 * cxChar, y, szBuffer, LEN(szBuffer)
            SetTextAlign hdc, %TA_LEFT OR %TA_TOP
         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 TESTMCI.C -- MCI Command String Tester © Charles Petzold, 1998, described and analysed in Chapter 22 of the book Programming Windows, 5th Edition.

Back in the early days of Windows multimedia, the software development kit included a C program called MCITEST that allowed programmers to interactively type in MCI commands and learn how they worked. This program, at least in its C version, has apparently disappeared. So, I've recreated it as the TESTMCI. The user interface is based on the old MCITEST program but not the actual code, although I can't believe it was much different. (Petzold).

Code: [Select]

' ========================================================================================
' TESTMCI.BAS
' This program is a translation/adaptation of TESTMCI.C -- MCI Command String Tester
' © Charles Petzold, 1998, described and analysed in Chapter 22 of the book Programming
' Windows, 5th Edition.
' Back in the early days of Windows multimedia, the software development kit included a C
' program called MCITEST that allowed programmers to interactively type in MCI commands
' and learn how they worked. This program, at least in its C version, has apparently
' disappeared. So, I've recreated it as the TESTMCI. The user interface is based on the
' old MCITEST program but not the actual code, although I can't believe it was much
' different. (Petzold).
' ========================================================================================

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

%ID_TIMER = 1

%IDC_MAIN_EDIT         = 1000
%IDC_NOTIFY_MESSAGE    = 1005
%IDC_NOTIFY_ID         = 1006
%IDC_NOTIFY_SUCCESSFUL = 1007
%IDC_NOTIFY_SUPERSEDED = 1008
%IDC_NOTIFY_ABORTED    = 1009
%IDC_NOTIFY_FAILURE    = 1010
%IDC_SIGNAL_MESSAGE    = 1011
%IDC_SIGNAL_ID         = 1012
%IDC_SIGNAL_PARAM      = 1013
%IDC_RETURN_STRING     = 1014
%IDC_ERROR_STRING      = 1015
%IDC_DEVICES           = 1016

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, _
                  BYVAL pszCmdLine AS WSTRINGZ PTR, BYVAL iCmdShow AS LONG) AS LONG

   LOCAL szAppName AS ASCIIZ * 256

   szAppName = "TestMci"
   IF DialogBox(hInstance, szAppName, %NULL, CODEPTR(DlgProc)) = -1 THEN
      MessageBox %NULL, "DialogBox failed", szAppName, %MB_ICONERROR
   END IF

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

' ========================================================================================
' Main dialog callback.
' ========================================================================================
FUNCTION DlgProc (BYVAL hwnd AS DWORD, BYVAL uMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   STATIC hwndEdit  AS DWORD
   LOCAL  iCharBeg  AS LONG
   LOCAL  iCharEnd  AS LONG
   LOCAL  iLineBeg  AS LONG
   LOCAL  iLineEnd  AS LONG
   LOCAL  iChar     AS LONG
   LOCAL  iLine     AS LONG
   LOCAL  iLength   AS LONG
   LOCAL  mcierror  AS LONG
   LOCAL  rc        AS RECT
   LOCAL  szCommand AS ASCIIZ * 1024
   LOCAL  szReturn  AS ASCIIZ * 1024
   LOCAL  szError   AS ASCIIZ * 1024
   LOCAL  szBuffer  AS ASCIIZ * 32

   SELECT CASE uMsg

      CASE %WM_INITDIALOG
         ' Center the window on screen
         GetWindowRect hwnd, rc
         SetWindowPos hwnd, %NULL, _
               (GetSystemMetrics(%SM_CXSCREEN) - rc.nRight + rc.nLeft) / 2, _
               (GetSystemMetrics(%SM_CYSCREEN) - rc.nBottom + rc.nTop) / 2, _
               0, 0, %SWP_NOZORDER OR %SWP_NOSIZE
         hwndEdit = GetDlgItem(hwnd, %IDC_MAIN_EDIT)
         SetFocus hwndEdit
         FUNCTION = %FALSE
         EXIT FUNCTION

      CASE %WM_COMMAND

         SELECT CASE LO(WORD, wParam)

            CASE %IDOK
               ' Find the line numbers corresponding to the selection
               SendMessage hwndEdit, %EM_GETSEL, VARPTR(iCharBeg), VARPTR(iCharEnd)
               iLineBeg = SendMessage(hwndEdit, %EM_LINEFROMCHAR, iCharBeg, 0)
               iLineEnd = SendMessage(hwndEdit, %EM_LINEFROMCHAR, iCharEnd, 0)
               ' Loop through all the lines
               FOR iLine = iLineBeg TO iLineEnd
                  ' Get the line and terminate it; ignore if blank
                  szCommand = SPACE$(SIZEOF(szCommand))
                  iLength = SendMessage(hwndEdit, %EM_GETLINE, iLine, VARPTR(szCommand))
                  IF iLength = 0 THEN ITERATE FOR
                  szCommand = LEFT$(szCommand, iLength)
                  ' Send the MCI command
                  mcierror = mciSendString (szCommand, szReturn, SIZEOF(szReturn), hwnd)
                  ' Set the Return String field
                  SetDlgItemText hwnd, %IDC_RETURN_STRING, szReturn
                  ' Set the Error String field (even if no error)
                  mciGetErrorString mcierror, szError, SIZEOF(szError)
                  SetDlgItemText hwnd, %IDC_ERROR_STRING, szError
               NEXT
               ' Send the caret to the end of the last selected line
               iChar = SendMessage(hwndEdit, %EM_LINEINDEX, iLineEnd, 0)
               iChar = iChar + SendMessage(hwndEdit, %EM_LINELENGTH, iCharEnd, 0)
               SendMessage hwndEdit, %EM_SETSEL, iChar, iChar
               ' Insert a carriage return/line feed combination
               szBuffer = $CRLF
               SendMessage hwndEdit, %EM_REPLACESEL, %FALSE, VARPTR(szBuffer)
               SetFocus hwndEdit
               FUNCTION = %TRUE
               EXIT FUNCTION

            CASE %IDCANCEL
               EndDialog hwnd, 0
               FUNCTION = %TRUE
               EXIT FUNCTION

            CASE %IDC_MAIN_EDIT
               IF HI(WORD, wParam) = %EN_ERRSPACE THEN
                  MessageBox hwnd, "Error control out of space.", _
                             "TestMci", %MB_OK OR %MB_ICONINFORMATION
                  FUNCTION = %TRUE
                  EXIT FUNCTION
               END IF

         END SELECT

      CASE %MM_MCINOTIFY
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_MESSAGE), %TRUE
         wsprintf szBuffer, "Device ID = %i", BYVAL lParam
         SetDlgItemText hwnd, %IDC_NOTIFY_ID, szBuffer
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_ID), %TRUE
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_SUCCESSFUL), wParam AND %MCI_NOTIFY_SUCCESSFUL
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_SUPERSEDED), wParam AND %MCI_NOTIFY_SUPERSEDED
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_ABORTED), wParam AND %MCI_NOTIFY_ABORTED
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_FAILURE), wParam AND %MCI_NOTIFY_FAILURE
         SetTimer hwnd, %ID_TIMER, 5000, %NULL
         FUNCTION = %TRUE
         EXIT FUNCTION

      CASE %WM_TIMER
         KillTimer hwnd, %ID_TIMER
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_MESSAGE), %FALSE
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_ID), %FALSE
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_SUCCESSFUL), %FALSE
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_SUPERSEDED), %FALSE
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_ABORTED), %FALSE
         EnableWindow GetDlgItem(hwnd, %IDC_NOTIFY_FAILURE), %FALSE
         FUNCTION = %TRUE
         EXIT FUNCTION

      CASE %WM_SYSCOMMAND
         SELECT CASE LO(WORD, wParam)
            CASE %SC_CLOSE
               EndDialog hWnd, 0
               FUNCTION = %TRUE
               EXIT FUNCTION
         END SELECT

   END SELECT

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


TESTMCI.RC

Code: [Select]

#define WS_MINIMIZEBOX      0x00020000L
#define WS_VISIBLE          0x10000000L
#define WS_CAPTION          0x00C00000L     /* WS_BORDER | WS_DLGFRAME  */
#define WS_SYSMENU          0x00080000L
#define ES_MULTILINE        0x0004L
#define ES_AUTOHSCROLL      0x0080L
#define WS_VSCROLL          0x00200000L
#define ES_AUTOVSCROLL      0x0040L
#define ES_READONLY         0x0800L
#define WS_TABSTOP          0x00010000L
#define WS_GROUP            0x00020000L
#define WS_DISABLED         0x08000000L
#define IDOK                1
#define IDCANCEL            2


#define IDC_MAIN_EDIT                   1000
#define IDC_NOTIFY_MESSAGE              1005
#define IDC_NOTIFY_ID                   1006
#define IDC_NOTIFY_SUCCESSFUL           1007
#define IDC_NOTIFY_SUPERSEDED           1008
#define IDC_NOTIFY_ABORTED              1009
#define IDC_NOTIFY_FAILURE              1010
#define IDC_SIGNAL_MESSAGE              1011
#define IDC_SIGNAL_ID                   1012
#define IDC_SIGNAL_PARAM                1013
#define IDC_RETURN_STRING               1014
#define IDC_ERROR_STRING                1015
#define IDC_DEVICES                     1016
#define IDC_STATIC                      -1


/////////////////////////////////////////////////////////////////////////////
// Dialog

TESTMCI DIALOG DISCARDABLE  0, 0, 270, 276
STYLE WS_MINIMIZEBOX | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "MCI Tester"
FONT 8, "MS Sans Serif"
BEGIN
    EDITTEXT        IDC_MAIN_EDIT,8,8,254,100,ES_MULTILINE | ES_AUTOHSCROLL |
                    WS_VSCROLL
    LTEXT           "Return String:",IDC_STATIC,8,114,60,8
    EDITTEXT        IDC_RETURN_STRING,8,126,120,50,ES_MULTILINE |
                    ES_AUTOVSCROLL | ES_READONLY | WS_GROUP | NOT WS_TABSTOP
    LTEXT           "Error String:",IDC_STATIC,142,114,60,8
    EDITTEXT        IDC_ERROR_STRING,142,126,120,50,ES_MULTILINE |
                    ES_AUTOVSCROLL | ES_READONLY | NOT WS_TABSTOP
    GROUPBOX        "MM_MCINOTIFY Message",IDC_STATIC,9,186,254,58
    LTEXT           "",IDC_NOTIFY_ID,26,198,100,8
    LTEXT           "MCI_NOTIFY_SUCCESSFUL",IDC_NOTIFY_SUCCESSFUL,26,212,100,
                    8,WS_DISABLED
    LTEXT           "MCI_NOTIFY_SUPERSEDED",IDC_NOTIFY_SUPERSEDED,26,226,100,
                    8,WS_DISABLED
    LTEXT           "MCI_NOTIFY_ABORTED",IDC_NOTIFY_ABORTED,144,212,100,8,
                    WS_DISABLED
    LTEXT           "MCI_NOTIFY_FAILURE",IDC_NOTIFY_FAILURE,144,226,100,8,
                    WS_DISABLED
    DEFPUSHBUTTON   "OK",IDOK,57,255,50,14
    PUSHBUTTON      "Close",IDCANCEL,162,255,50,14
END


[José Roca]

 
This program is a translation of UNICHARS.C -- Displays 16-bit character codes © Charles Petzold, 1998, described and analysed in Chapter 17 of the book Programming Windows, 5th Edition.

This program lets you view all the characters of a font and is particularly useful for studying the Lucida Sans Unicode font, which it uses by default for display, or the Bitstream CyberBit font. UNICHARS always uses the TextOutW function for displaying the font characters, so you can run it under Windows NT or Windows 98.

Code: [Select]

' ========================================================================================
' UNICHARS.BAS
' This program is a translation/adaptation of UNICHARS.C -- Displays 16-bit character codes
' © Charles Petzold, 1998, described and analysed in Chapter 17 of the book Programming
' Windows, 5th Edition.
' This program lets you view all the characters of a font and is particularly useful for
' studying the Lucida Sans Unicode font, which it uses by default for display, or the
' Bitstream CyberBit font. UNICHARS always uses the TextOutW function for displaying the
' font characters, so you can run it under Windows NT or Windows 98.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "comdlg32.inc"
#RESOURCE RES, "unichars.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          = "UniChars"
   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 = "Unicode Characters"
   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 iPage AS LONG
   STATIC lf AS LOGFONT
   LOCAL  hdc AS DWORD
   LOCAL  cxChar AS LONG
   LOCAL  cyChar AS LONG
   LOCAL  x AS LONG
   LOCAL  y AS LONG
   LOCAL  i AS LONG
   LOCAL  cxLabels AS LONG
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  tsize AS APISIZE
   LOCAL  szBuffer AS ASCIIZ * 8
   LOCAL  tm AS TEXTMETRIC
   LOCAL  dwch AS DWORD

   SELECT CASE uMsg

      CASE %WM_CREATE
         hdc = GetDC(hwnd)
         lf.lfHeight = - GetDeviceCaps(hdc, %LOGPIXELSY) \ 6  ' 12 points
         lf.lfFaceName = "Lucida Sans Unicode"
         ReleaseDC hwnd, hdc
         cf.lStructSize = SIZEOF(CHOOSEFONTAPI)
         cf.hwndOwner   = hwnd
         cf.lpLogFont   = VARPTR(lf)
         cf.Flags       = %CF_INITTOLOGFONTSTRUCT OR %CF_SCREENFONTS
         SetScrollRange hwnd, %SB_VERT, 0, 255, %FALSE
         SetScrollPos   hwnd, %SB_VERT, iPage,  %TRUE
         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_VSCROLL
         SELECT CASE LO(WORD, wParam)
            CASE %SB_LINEUP:         iPage = iPage - 1
            CASE %SB_LINEDOWN:       iPage = iPage + 1
            CASE %SB_PAGEUP:         iPage = iPage - 16
            CASE %SB_PAGEDOWN:       iPage = iPage + 16
            CASE %SB_THUMBPOSITION:  iPage = HI(WORD, wParam)
            CASE ELSE
               EXIT FUNCTION
         END SELECT
         iPage = MAX&(0, MIN&(iPage, 255))
         SetScrollPos hwnd, %SB_VERT, iPage, %TRUE
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         SelectObject hdc, CreateFontIndirect(lf)
         GetTextMetrics hdc, tm
         cxChar = tm.tmMaxCharWidth
         cyChar = tm.tmHeight + tm.tmExternalLeading
         cxLabels = 0
         FOR i = 0 TO 15
            wsprintf szBuffer, " 000%1X: ", BYVAL i
            GetTextExtentPoint hdc, szBuffer, 7, tsize
            cxLabels = MAX&(cxLabels, tsize.cx)
         NEXT
         FOR y = 0 TO 15
            wsprintf szBuffer, " %03X_: ", BYVAL 16 * iPage + y
            TextOut hdc, 0, y * cyChar, szBuffer, 7
            FOR x = 0 TO 15
               dwch = 256 * iPage + 16 * y + x
               TextOutW hdc, x * cxChar + cxLabels,  y * cyChar, BYVAL VARPTR(dwch), 1
            NEXT
         NEXT
         DeleteObject SelectObject(hdc, GetStockObject(%SYSTEM_FONT))
         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 WHATCLR.C -- Displays Color Under Cursor © Charles Petzold, 1998, described and analysed in Chapter 8 of the book Programming Windows, 5th Edition.

WHATCLR displays the RGB color of the pixel currently under the hot point of the mouse cursor.

Code: [Select]

' ========================================================================================
' WHATCLR.BAS
' This program is a translation/adaptation of WHATCLR.C -- Displays Color Under Cursor
' © Charles Petzold, 1998, described and analysed in Chapter 8 of the book Programming
' Windows, 5th Edition.
' WHATCLR displays the RGB color of the pixel currently under the hot point of the mouse
' cursor.
' ========================================================================================

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

%ID_TIMER = 1

' ========================================================================================
SUB FindWindowSize (BYREF pcxWindow AS LONG, BYREF pcyWindow AS LONG)

   LOCAL hdcScreen AS DWORD
   LOCAL tm        AS TEXTMETRIC

   hdcScreen = CreateIC("DISPLAY", BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
   GetTextMetrics hdcScreen, tm
   DeleteDC hdcScreen

   pcxWindow = 2 * GetSystemMetrics (%SM_CXBORDER) + 12 * tm.tmAveCharWidth
   pcyWindow = 2 * GetSystemMetrics(%SM_CYBORDER) + GetSystemMetrics(%SM_CYCAPTION) + 2 * tm.tmHeight

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

' ========================================================================================
' 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 cxWindow  AS LONG
   LOCAL cyWindow  AS LONG
   LOCAL szAppName AS ASCIIZ * 256
   LOCAL wcex      AS WNDCLASSEX

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

   FindWindowSize cxWindow, cyWindow

   hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _   ' extended style
                         szAppName, _              ' window class name
                         "What Color", _           ' window caption
                         %WS_OVERLAPPED OR _
                         %WS_CAPTION OR _
                         %WS_SYSMENU OR _
                         %WS_BORDER, _             ' window style
                         %CW_USEDEFAULT, _         ' initial x position
                         %CW_USEDEFAULT, _         ' initial y position
                         cxWindow, _               ' initial x size
                         cyWindow, _               ' 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 cr        AS DWORD
   STATIC crLast    AS DWORD
   STATIC hdcScreen AS DWORD
   LOCAL  hdc       AS DWORD
   LOCAL  ps        AS PAINTSTRUCT
   LOCAL  pt        AS POINTAPI
   LOCAL  rc        AS RECT
   LOCAL  szBuffer  AS ASCIIZ * 14

   SELECT CASE uMsg

      CASE %WM_CREATE
         hdcScreen = CreateDC("DISPLAY", BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
         SetTimer hwnd, %ID_TIMER, 100, %NULL
         EXIT FUNCTION

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

      CASE %WM_DISPLAYCHANGE
         DeleteDC hdcScreen
         hdcScreen = CreateDC ("DISPLAY", BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
         EXIT FUNCTION

      CASE %WM_TIMER
         GetCursorPos pt
         cr = GetPixel(hdcScreen, pt.x, pt.y)
         IF cr <> crLast THEN
            crLast = cr
            InvalidateRect hwnd, BYVAL %NULL, %FALSE
         END IF
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         GetClientRect hwnd, rc
         wsprintf szBuffer, "  %02X %02X %02X  ", _
                  BYVAL GetRValue(cr), BYVAL GetGValue (cr), BYVAL GetBValue (cr)
         DrawText hdc, szBuffer, -1, rc, %DT_SINGLELINE OR %DT_CENTER OR %DT_VCENTER
         EndPaint(hwnd, ps)
         EXIT FUNCTION

     CASE %WM_DESTROY
         DeleteDC hdcScreen
         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 WHATSIZE.C-What Size is the Window? program © Charles Petzold, 1998, described and analysed in Chapter 5 of the book Programming Windows, 5th Edition.

Shows the dimensions of the window's client area in terms of the five metric mapping modes.

Code: [Select]

' ========================================================================================
' WHATSIZE.BAS
' This program is a translation/adaptation of the WHATSIZE.C-What Size is the Window?
' program © Charles Petzold, 1998, described and analysed in Chapter 5 of the book
' Programming Windows, 5th Edition.
' Shows the dimensions of the window's client area in terms of the five metric mapping modes.
' ========================================================================================

#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          = "WhatSize"
   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 = "What Size is the Window?"
   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
' ========================================================================================

' ========================================================================================
' Shows the data
' ========================================================================================
SUB ShowData (BYVAL hwnd AS DWORD, BYVAL hdc AS DWORD, BYVAL xText AS LONG, _
              BYVAL yText AS LONG, BYVAL iMapMode AS LONG, BYREF szMapMode AS ASCIIZ)

   LOCAL rc AS RECT
   LOCAL strMapping AS STRING * 21
   LOCAL strLeft AS STRING * 7
   LOCAL strRight AS STRING * 8
   LOCAL strTop AS STRING * 8
   LOCAL strBottom AS STRING * 8
   LOCAL szBuffer AS ASCIIZ * 256

   SaveDC hdc
   SetMapMode hdc, iMapMode
   GetClientRect hwnd, rc
   DPToLP hdc, BYVAL VARPTR(rc), 2
   RestoreDC (hdc, -1)

   strMapping = szMapMode
   RSET strLeft = FORMAT$(rc.nLeft)
   RSET strRight = FORMAT$(rc.nRight)
   RSET strTop = FORMAT$(rc.nTop)
   RSET strBottom = FORMAT$(rc.nBottom)

   szBuffer = strMapping & strLeft & strRight & strTop & strBottom

   TextOut hdc, xText, yText, szBuffer, LEN(szBuffer)

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 szHeading AS ASCIIZ * 256
   STATIC szUndLine AS ASCIIZ * 256
   STATIC cxChar AS LONG
   STATIC cyChar AS LONG
   LOCAL  hdc AS LONG
   LOCAL  ps  AS PAINTSTRUCT
   LOCAL tm AS TEXTMETRIC

   SELECT CASE uMsg

      CASE %WM_CREATE
         szHeading = "Mapping Mode            Left   Right     Top  Bottom"
         szUndLine = "------------            ----   -----     ---  ------"
         hdc = GetDC(hwnd)
         SelectObject hdc, GetStockObject(%SYSTEM_FIXED_FONT)
         GetTextMetrics hdc, tm
         cxChar = tm.tmAveCharWidth
         cyChar = tm.tmHeight + tm.tmExternalLeading
         ReleaseDC hwnd, hdc
         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_PAINT
         hdc = BeginPaint(hwnd, ps)
         SelectObject hdc, GetStockObject(%SYSTEM_FIXED_FONT)
         SetMapMode hdc, %MM_ANISOTROPIC
         SetWindowExtEx hdc, 1, 1, BYVAL %NULL
         SetViewportExtEx hdc, cxChar, cyChar, BYVAL %NULL
         TextOut hdc, 1, 1, szHeading, LEN(szHeading)
         TextOut hdc, 1, 2, szUndLine, LEN(szUndLine)
         ShowData hwnd, hdc, 1, 3, %MM_TEXT,      "TEXT (pixels)"
         ShowData hwnd, hdc, 1, 4, %MM_LOMETRIC,  "LOMETRIC (.1 mm)"
         ShowData hwnd, hdc, 1, 5, %MM_HIMETRIC,  "HIMETRIC (.01 mm)"
         ShowData hwnd, hdc, 1, 6, %MM_LOENGLISH, "LOENGLISH (.01 in)"
         ShowData hwnd, hdc, 1, 7, %MM_HIENGLISH, "HIENGLISH (.001 in)"
         ShowData hwnd, hdc, 1, 8, %MM_TWIPS,     "TWIPS (1/1440 in)"
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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