Charles Petzold's Examples

[José Roca]

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

Displays the ChooseColor common dialog box. Color selection is similar to that in COLORS1 and COLORS2, but it's somewhat more interactive.

Code: [Select]

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

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

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

   LOCAL hwnd         AS DWORD
   LOCAL szAppName    AS ASCIIZ * 256
   LOCAL wcex         AS WNDCLASSEX
   LOCAL szCaption    AS ASCIIZ * 256
   LOCAL hDlgModeless AS DWORD

   szAppName          = "Colors2"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hIcon         = LoadIcon(%NULL, BYVAL %IDI_APPLICATION)
   wcex.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = CreateSolidBrush(0)
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szAppName)

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

   szCaption = "Color Scroll"
   hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _   ' extended style
                         szAppName, _              ' window class name
                         szCaption, _              ' window caption
                         %WS_OVERLAPPEDWINDOW, _   ' window style
                         %CW_USEDEFAULT, _         ' initial x position
                         %CW_USEDEFAULT, _         ' initial y position
                         %CW_USEDEFAULT, _         ' initial x size
                         %CW_USEDEFAULT, _         ' initial y size
                         %NULL, _                  ' parent window handle
                         %NULL, _                  ' window menu handle
                         hInstance, _              ' program instance handle
                         BYVAL %NULL)              ' creation parameters

   ShowWindow hwnd, iCmdShow
   UpdateWindow hwnd

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

   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      TranslateMessage uMsg
      DispatchMessage uMsg
   WEND

   FUNCTION = uMsg.wParam

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

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

   SELECT CASE uMsg

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

     CASE %WM_DESTROY
         DeleteObject SetClassLong(hwnd, %GCL_HBRBACKGROUND, GetStockObject(%WHITE_BRUSH))
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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

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

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

   SELECT CASE uMsg

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

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

         SELECT CASE LO(WORD, wParam)

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

         END SELECT

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

      CASE ELSE
         FUNCTION = %FALSE

   END SELECT

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


[José Roca]

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

Does some simple mouse processing to let you get a good feel for how Windows sends mouse messages to your program.

CONNECT processes three mouse messages:

    %WM_LBUTTONDOWN CONNECT clears the client area.
    %WM_MOUSEMOVE If the left button is down, CONNECT draws a black dot on the client area at the mouse position and saves the coordinates.
    %WM_LBUTTONUP CONNECT connects every dot shown in the client area to every other dot. Sometimes this results in a pretty design, sometimes in a dense blob.


To use CONNECT, bring the mouse cursor into the client area, press the left button, move the mouse around a little, and then release the left button. CONNECT works best for a curved pattern of a few dots, which you can draw by moving the mouse quickly while the left button is depressed.

Code: [Select]

' ========================================================================================
' CONNECT.BAS
' This program is a translation/adaptation of the CONNECT.C -- Connect-the-Dots Mouse Demo
' Program © Charles Petzold, 1998, described and analysed in Chapter 7 of the book Programming
' Windows, 5th Edition.
' Does some simple mouse processing to let you get a good feel for how Windows sends mouse
' messages to your program.
'CONNECT processes three mouse messages:
'  * %WM_LBUTTONDOWN CONNECT clears the client area.
'  * %WM_MOUSEMOVE If the left button is down, CONNECT draws a black dot on the client area
'    at the mouse position and saves the coordinates.
'  * %WM_LBUTTONUP CONNECT connects every dot shown in the client area to every other dot.
'    Sometimes this results in a pretty design, sometimes in a dense blob.
' To use CONNECT, bring the mouse cursor into the client area, press the left button, move
' the mouse around a little, and then release the left button. CONNECT works best for a
' curved pattern of a few dots, which you can draw by moving the mouse quickly while the
' left button is depressed.
' ========================================================================================

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

%MAXPOINTS = 1000

' ========================================================================================
' 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          = "Connect"
   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 = "Connect-the-Points Mouse Demo"
   hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _   ' extended style
                         szAppName, _              ' window class name
                         szCaption, _              ' window caption
                         %WS_OVERLAPPEDWINDOW, _   ' window style
                         %CW_USEDEFAULT, _         ' initial x position
                         %CW_USEDEFAULT, _         ' initial y position
                         %CW_USEDEFAULT, _         ' initial x size
                         %CW_USEDEFAULT, _         ' initial y size
                         %NULL, _                  ' parent window handle
                         %NULL, _                  ' window menu handle
                         hInstance, _              ' program instance handle
                         BYVAL %NULL)              ' creation parameters

   ShowWindow hwnd, iCmdShow
   UpdateWindow hwnd

   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      TranslateMessage uMsg
      DispatchMessage uMsg
   WEND

   FUNCTION = uMsg.wParam

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

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

   STATIC iCount AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  i AS LONG
   LOCAL  j AS LONG
   LOCAL  ps  AS PAINTSTRUCT
   DIM    pt(%MAXPOINTS) AS STATIC 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_LBUTTONDOWN
         iCount = 0
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         EXIT FUNCTION

      CASE %WM_MOUSEMOVE
         IF (wParam AND %MK_LBUTTON) AND (iCount < %MAXPOINTS) THEN
            pt(iCount).x = LO(WORD, lParam)
            pt(iCount).y = HI(WORD, lParam)
            iCount = iCount + 1
            hdc = GetDC(hwnd)
            SetPixel hdc, LOWRD(lParam), HIWRD(lParam), 0
            ReleaseDC hwnd, hdc
         END IF
         EXIT FUNCTION

      CASE %WM_LBUTTONUP
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         SetCursor LoadCursor(%NULL, BYVAL %IDC_WAIT)
         ShowCursor %TRUE
         FOR i = 0 TO iCount - 2
            FOR j = i + 1 TO iCount - 1
               MoveToEx hdc, pt(i).x, pt(i).y, BYVAL %NULL
               LineTo hdc, pt(j).x, pt(j).y
            NEXT
         NEXT
         ShowCursor %FALSE
         SetCursor LoadCursor(%NULL, BYVAL %IDC_ARROW)
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
his program is a translation of the DEVCAPS1.C-Device Capabilities Display Program No. 1 © Charles Petzold, 1998, described and analysed in Chapter 5 of the book Programming Windows, 5th Edition.

Displays some (but not all) of the information available from the GetDeviceCaps function using a device context for the video display.

Code: [Select]

' ========================================================================================
' DEVCAPS1.BAS
' This program is a translation/adaptation of the DEVCAPS1.C-Device Capabilities Display
' Program No. 1 © Charles Petzold, 1998, described and analysed in Chapter 5 of the book
' Programming Windows, 5th Edition.
' Displays some (but not all) of the information available from the GetDeviceCaps function
' using a device context for the video display.
' ========================================================================================

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

' ========================================================================================
' DEVCAPS_STRUCT
' ========================================================================================
TYPE DEVCAPS_STRUCT
   iIndex AS LONG
   szLabel AS ASCIIZ * 13
   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          = "DevCaps1"
   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 = "Device Capabilities"
   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 devcaps(19) AS STATIC DEVCAPS_STRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE

         ' Initialize array
         devcaps( 0).iIndex = %HORZSIZE    : devcaps( 0).szLabel = "HORZSIZE"    : devcaps( 0).szDesc = "Width in millimeters:"
         devcaps( 1).iIndex = %VERTSIZE    : devcaps( 1).szLabel = "VERTSIZE"    : devcaps( 1).szDesc = "Height in millimeters:"
         devcaps( 2).iIndex = %HORZRES     : devcaps( 2).szLabel = "HORZRES"     : devcaps( 2).szDesc = "Width in pixels:"
         devcaps( 3).iIndex = %VERTRES     : devcaps( 3).szLabel = "VERTRES"     : devcaps( 3).szDesc = "Height in raster lines:"
         devcaps( 4).iIndex = %BITSPIXEL   : devcaps( 4).szLabel = "BITSPIXEL"   : devcaps( 4).szDesc = "Color bits per pixel:"
         devcaps( 5).iIndex = %PLANES      : devcaps( 5).szLabel = "PLANES"      : devcaps( 5).szDesc = "Number of color planes:"
         devcaps( 6).iIndex = %NUMBRUSHES  : devcaps( 6).szLabel = "NUMBRUSHES"  : devcaps( 6).szDesc = "Number of device brushes:"
         devcaps( 7).iIndex = %NUMPENS     : devcaps( 7).szLabel = "NUMPENS"     : devcaps( 7).szDesc = "Number of device pens:"
         devcaps( 8).iIndex = %NUMMARKERS  : devcaps( 8).szLabel = "NUMMARKERS"  : devcaps( 8).szDesc = "Number of device markers:"
         devcaps( 9).iIndex = %NUMFONTS    : devcaps( 9).szLabel = "NUMFONTS"    : devcaps( 9).szDesc = "Number of device fonts:"
         devcaps(10).iIndex = %NUMCOLORS   : devcaps(10).szLabel = "NUMCOLORS"   : devcaps(10).szDesc = "Number of device colors:"
         devcaps(11).iIndex = %PDEVICESIZE : devcaps(11).szLabel = "PDEVICESIZE" : devcaps(11).szDesc = "Size of device structure:"
         devcaps(12).iIndex = %ASPECTX     : devcaps(12).szLabel = "ASPECTX"     : devcaps(12).szDesc = "Relative width of pixel:"
         devcaps(13).iIndex = %ASPECTY     : devcaps(13).szLabel = "ASPECTY"     : devcaps(13).szDesc = "Cursor width"
         devcaps(14).iIndex = %ASPECTXY    : devcaps(14).szLabel = "ASPECTXY"    : devcaps(14).szDesc = "Relative diagonal of pixel:"
         devcaps(15).iIndex = %LOGPIXELSX  : devcaps(15).szLabel = "LOGPIXELSX"  : devcaps(15).szDesc = "Horizontal dots per inch:"
         devcaps(16).iIndex = %LOGPIXELSY  : devcaps(16).szLabel = "LOGPIXELSY"  : devcaps(16).szDesc = "Vertical dots per inch:"
         devcaps(17).iIndex = %SIZEPALETTE : devcaps(17).szLabel = "SIZEPALETTE" : devcaps(17).szDesc = "Number of palette entries:"
         devcaps(18).iIndex = %NUMRESERVED : devcaps(18).szLabel = "NUMRESERVED" : devcaps(18).szDesc = "Reserved palette entries:"
         devcaps(19).iIndex = %COLORRES    : devcaps(19).szLabel = "COLORRES"    : devcaps(19).szDesc = "Actual color resolution:"

         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(devcaps) TO UBOUND(devcaps)
            TextOut hdc, 0, cyChar * i, devcaps(i).szLabel, LEN(devcaps(i).szLabel)
            TextOut hdc, 14 * cxCaps, cyChar * i, devcaps(i).szDesc, LEN(devcaps(i).szDesc)
            SetTextAlign hdc, %TA_RIGHT OR %TA_TOP
            szBuffer = FORMAT$(GetDeviceCaps(hdc, devcaps(i).iIndex))
            TextOut hdc, 14 * cxCaps + 35 * 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 DEVCAPS2.C -- Displays Device Capability Information (Version 2) © Charles Petzold, 1998, described and analysed in Chapter 13 of the book Programming Windows, 5th Edition.

The original DEVCAPS1 program in Chapter 5 displayed basic information available from the GetDeviceCaps function for the video display. The new version shows more information for both the video display and all printers attached to the system.

Code: [Select]

' ========================================================================================
' DEVCAPS2.BAS
' This program is a translation/adaptation of DEVCAPS2.C -- Displays Device Capability
' Information (Version 2) © Charles Petzold, 1998, described and analysed in Chapter 13
' of the book Programming Windows, 5th Edition.
' The original DEVCAPS1 program in Chapter 5 displayed basic information available from
' the GetDeviceCaps function for the video display. The new version shows more information
' for both the video display and all printers attached to the system.
' ========================================================================================

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

TYPE BITS_STRUCT
   iMask AS LONG
   szDesc AS ASCIIZ * 256
END TYPE

TYPE DEVCAPS2_INFO_STRUCT
   nIndex AS LONG
   szDesc AS ASCIIZ * 256
END TYPE

TYPE BITINFO_STRUCT
   iIndex  AS LONG
   szTitle AS ASCIIZ * 256
   pbits AS BITS_STRUCT PTR
   iSize  AS LONG
END TYPE

%IDM_DEVMODE = 1000

%IDM_SCREEN  = 40001
%IDM_BASIC   = 40002
%IDM_OTHER   = 40003
%IDM_CURVE   = 40004
%IDM_LINE    = 40005
%IDM_POLY    = 40006
%IDM_TEXT    = 40007

' ========================================================================================
' 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        = "DevCaps2"
   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 = "Device Capabilities"
   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 DoBasicInfo (BYVAL hdc AS DWORD, BYVAL hdcInfo AS DWORD, BYVAL cxChar AS LONG, BYVAL cyChar AS LONG)

   DIM info (23) AS DEVCAPS2_INFO_STRUCT

   info ( 0).nIndex = %HORZSIZE        : info ( 0).szDesc = "HORZSIZE        Width in millimeters:"
   info ( 1).nIndex = %VERTSIZE        : info ( 1).szDesc = "VERTSIZE        Height in millimeters:"
   info ( 2).nIndex = %HORZRES         : info ( 2).szDesc = "HORZRES         Width in pixels:"
   info ( 3).nIndex = %VERTRES         : info ( 3).szDesc = "VERTRES         Height in raster lines:"
   info ( 4).nIndex = %BITSPIXEL       : info ( 4).szDesc = "BITSPIXEL       Color bits per pixel:"
   info ( 5).nIndex = %PLANES          : info ( 5).szDesc = "PLANES          Number of color planes:"
   info ( 6).nIndex = %NUMBRUSHES      : info ( 6).szDesc = "NUMBRUSHES      Number of device brushes:"
   info ( 7).nIndex = %NUMPENS         : info ( 7).szDesc = "NUMPENS         Number of device pens:"
   info ( 8).nIndex = %NUMMARKERS      : info ( 8).szDesc = "NUMMARKERS      Number of device markers:"
   info ( 9).nIndex = %NUMFONTS        : info ( 9).szDesc = "NUMFONTS        Number of device fonts:"
   info (10).nIndex = %NUMCOLORS       : info (10).szDesc = "NUMCOLORS       Number of device colors:"
   info (11).nIndex = %PDEVICESIZE     : info (11).szDesc = "PDEVICESIZE     Size of device structure:"
   info (12).nIndex = %ASPECTX         : info (12).szDesc = "ASPECTX         Relative width of pixel:"
   info (13).nIndex = %ASPECTY         : info (13).szDesc = "ASPECTY         Relative width of pixel:"
   info (14).nIndex = %ASPECTXY        : info (14).szDesc = "ASPECTXY        Relative diagonal of pixel:"
   info (15).nIndex = %LOGPIXELSX      : info (15).szDesc = "LOGPIXELSX      Horizontal dots per inch:"
   info (16).nIndex = %LOGPIXELSY      : info (16).szDesc = "LOGPIXELSY      Veertical dots per inch:"
   info (17).nIndex = %SIZEPALETTE     : info (17).szDesc = "SIZEPALETTE     Number of palette entries:"
   info (18).nIndex = %NUMRESERVED     : info (18).szDesc = "NUMRESERVED     Reserved palette entries:"
   info (19).nIndex = %COLORRES        : info (19).szDesc = "COLORRES        Actual color resolution:"
   info (20).nIndex = %PHYSICALWIDTH   : info (20).szDesc = "PHYSICALWIDTH   Printer page pixel width:"
   info (21).nIndex = %PHYSICALHEIGHT  : info (21).szDesc = "PHYSICALHEIGHT  Printer page pixel height:"
   info (22).nIndex = %PHYSICALOFFSETX : info (22).szDesc = "PHYSICALOFFSETX Printer page x offset:"
   info (23).nIndex = %PHYSICALOFFSETY : info (23).szDesc = "PHYSICALOFFSETY Printer page y offset:"

   LOCAL i AS LONG
   LOCAL szBuffer AS ASCIIZ * 80

   FOR i = 0 TO 23
      wsprintf szBuffer, "%-45s%8d", info(i).szDesc, _
               BYVAL GetDeviceCaps(hdcInfo, info(i).nIndex)
      TextOut hdc, cxChar, (i + 1) * cyChar, szBuffer, LEN(szBuffer)
   NEXT

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

' ========================================================================================
SUB DoOtherInfo (BYVAL hdc AS DWORD, BYVAL hdcInfo AS DWORD, BYVAL cxChar AS LONG, BYVAL cyChar AS LONG)

   LOCAL clip AS BITS_STRUCT
   clip.iMask = %CP_RECTANGLE : clip.szDesc = "CP_RECTANGLE    Can Clip To Rectangle"

   DIM raster(11) AS BITS_STRUCT
   raster( 0).iMask = %RC_BITBLT       : raster( 0).szDesc = "RC_BITBLT       Capable of simple BitBlt:"
   raster( 1).iMask = %RC_BANDING      : raster( 1).szDesc = "RC_BANDING      Requires banding support:"
   raster( 2).iMask = %RC_SCALING      : raster( 2).szDesc = "RC_SCALING      Requires scaling support:"
   raster( 3).iMask = %RC_BITMAP64     : raster( 3).szDesc = "RC_BITMAP64     Supports bitmaps >64K:"
   raster( 4).iMask = %RC_GDI20_OUTPUT : raster( 4).szDesc = "RC_GDI20_OUTPUT Has 2.0 output calls:"
   raster( 5).iMask = %RC_DI_BITMAP    : raster( 5).szDesc = "RC_DI_BITMAP    Supports DIB to memory:"
   raster( 6).iMask = %RC_PALETTE      : raster( 6).szDesc = "RC_PALETTE      Supports a palette:"
   raster( 7).iMask = %RC_DIBTODEV     : raster( 7).szDesc = "RC_DIBTODEV     Supports bitmap conversion:"
   raster( 8).iMask = %RC_BIGFONT      : raster( 8).szDesc = "RC_BIGFONT      Supports fonts >64K:"
   raster( 9).iMask = %RC_STRETCHBLT   : raster( 9).szDesc = "RC_STRETCHBLT   Supports StretchBlt:"
   raster(10).iMask = %RC_FLOODFILL    : raster(10).szDesc = "RC_FLOODFILL    Supports FloodFill:"
   raster(11).iMask = %RC_STRETCHDIB   : raster(11).szDesc = "RC_STRETCHDIB   Supports StretchDIBits:"

   DIM szTech(6) AS ASCIIZ * 256
   szTech(0) = "DT_PLOTTER (Vector plotter)"
   szTech(1) = "DT_RASDISPLAY (Raster display)"
   szTech(2) = "DT_RASPRINTER (Raster printer)"
   szTech(3) = "DT_RASCAMERA (Raster camera)"
   szTech(4) = "DT_CHARSTREAM (Character stream)"
   szTech(5) = "DT_METAFILE (Metafile)"
   szTech(6) = "DT_DISPFILE (Display file)"

   LOCAL i AS LONG
   LOCAL szBuffer AS ASCIIZ * 80
   LOCAL szDesc AS ASCIIZ * 80
   LOCAL szYesNo AS ASCIIZ * 4

   szDesc = "DRIVERVERSION:"
   wsprintf szBuffer, "%-24s%04XH", szDesc, _
            BYVAL GetDeviceCaps(hdcInfo, %DRIVERVERSION)
   TextOut hdc, cxChar, cyChar, szBuffer, LEN(szBuffer)

   szDesc = "TECHNOLOGY:"
   wsprintf szBuffer, "%-24s%-40s", szDesc, _
            szTech(GetDeviceCaps(hdcInfo, %TECHNOLOGY))
   TextOut hdc, cxChar, 2 * cyChar, szBuffer, LEN(szBuffer)

   szDesc = "CLIPCAPS (Clipping capabilities)"
   wsprintf szBuffer, szDesc, BYVAL %NULL
   TextOut hdc, cxChar,  4 * cyChar, szBuffer, LEN(szBuffer)

   szYesNo = IIF$((GetDeviceCaps(hdcInfo, %CLIPCAPS) AND clip.iMask) = clip.iMask, "Yes", "No")
   wsprintf szBuffer, "%-45s %3s", clip.szDesc, szYesNo
   TextOut hdc, 9 * cxChar, (i + 6) * cyChar, szBuffer, LEN(szBuffer)

   szDesc = "RASTERCAPS (Raster capabilities)"
   wsprintf szBuffer, szDesc, BYVAL %NULL
   TextOut hdc, cxChar, 8 * cyChar, szBuffer, LEN(szBuffer)

   FOR i = LBOUND(raster) TO UBOUND(raster)
      szYesNo = IIF$((GetDeviceCaps(hdcInfo, %RASTERCAPS) AND raster(i).iMask) = raster(i).iMask, "Yes", "No")
      wsprintf szBuffer, "%-45s %3s", raster(i).szDesc, szYesNo
      TextOut hdc, 9 * cxChar, (i + 10) * cyChar, szBuffer, LEN(szBuffer)
   NEXT

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

SUB DoBitCodedCaps (BYVAL hdc AS DWORD, BYVAL hdcInfo AS DWORD, BYVAL cxChar AS LONG, BYVAL cyChar AS LONG, BYVAL iType AS LONG)

   DIM curves(7) AS BITS_STRUCT

   curves(0).iMask = %CC_CIRCLES    : curves(0).szDesc = "CC_CIRCLES    Can do circles:"
   curves(1).iMask = %CC_PIE        : curves(1).szDesc = "CC_PIE        Can do pie wedges:"
   curves(2).iMask = %CC_CHORD      : curves(2).szDesc = "CC_CHORD      Can do chord arcs:"
   curves(3).iMask = %CC_ELLIPSES   : curves(3).szDesc = "CC_ELLIPSES   Can do ellipses:"
   curves(4).iMask = %CC_WIDE       : curves(4).szDesc = "CC_WIDE       Can do wide borders:"
   curves(5).iMask = %CC_STYLED     : curves(5).szDesc = "CC_STYLED     Can do styled borders:"
   curves(6).iMask = %CC_WIDESTYLED : curves(6).szDesc = "CC_WIDESTYLED Can do wide and styled borders:"
   curves(7).iMask = %CC_INTERIORS  : curves(7).szDesc = "CC_INTERIORS  Can do interiors:"

   DIM lines(6) AS BITS_STRUCT

   lines(0).iMask = %LC_POLYLINE    : lines(0).szDesc = "LC_POLYLINE   Can do polyline:"
   lines(1).iMask = %LC_MARKER      : lines(1).szDesc = "LC_MARKER     Can do markers:"
   lines(2).iMask = %LC_POLYMARKER  : lines(2).szDesc = "LC_POLYMARKER Can do polymarkers:"
   lines(3).iMask = %LC_WIDE        : lines(3).szDesc = "LC_WIDE       Can do wide lines:"
   lines(4).iMask = %LC_STYLED      : lines(4).szDesc = "LC_STYLED     Can do styled lines:"
   lines(5).iMask = %LC_WIDESTYLED  : lines(5).szDesc = "LC_WIDESTYLED Can do wide and styled lines:"
   lines(6).iMask = %LC_INTERIORS   : lines(6).szDesc = "LC_INTERIORS  Can do interiors:"

   DIM poly(7) AS BITS_STRUCT

   poly(0).iMask = %PC_POLYGON      : poly(0).szDesc = "PC_POLYGON     Can do alternate fill polygon:"
   poly(1).iMask = %PC_RECTANGLE    : poly(1).szDesc = "PC_RECTANGLE   Can do rectangle:"
   poly(2).iMask = %PC_WINDPOLYGON  : poly(2).szDesc = "PC_WINDPOLYGON Can do winding number fill polygon:"
   poly(3).iMask = %PC_SCANLINE     : poly(3).szDesc = "PC_SCANLINE    Can do scanlines:"
   poly(4).iMask = %PC_WIDE         : poly(4).szDesc = "PC_WIDE        Can do wide borders:"
   poly(5).iMask = %PC_STYLED       : poly(5).szDesc = "PC_STYLED      Can do styled borders:"
   poly(6).iMask = %PC_WIDESTYLED   : poly(6).szDesc = "PC_WIDESTYLED  Can do wide and styled borders:"
   poly(7).iMask = %PC_INTERIORS    : poly(7).szDesc = "PC_INTERIORS   Can do interiors:"

   DIM text(14) AS BITS_STRUCT

   text( 0).iMask = %TC_OP_CHARACTER : text( 0).szDesc = "TC_OP_CHARACTER Can do character output precision:"
   text( 1).iMask = %TC_OP_STROKE    : text( 1).szDesc = "TC_OP_STROKE    Can do stroke output precision:"
   text( 2).iMask = %TC_CP_STROKE    : text( 2).szDesc = "TC_CP_STROKE    Can do stroke clip precision:"
   text( 3).iMask = %TC_CR_90        : text( 3).szDesc = "TC_CP_90        Can do 90 degree character rotation:"
   text( 4).iMask = %TC_CR_ANY       : text( 4).szDesc = "TC_CR_ANY       Can do any character rotation:"
   text( 5).iMask = %TC_SF_X_YINDEP  : text( 5).szDesc = "TC_SF_X_YINDEP  Can do scaling independent of X and Y:"
   text( 6).iMask = %TC_SA_DOUBLE    : text( 6).szDesc = "TC_SA_DOUBLE    Can do doubled character for scaling:"
   text( 7).iMask = %TC_SA_INTEGER   : text( 7).szDesc = "TC_SA_INTEGER   Can do integer multiples for scaling:"
   text( 8).iMask = %TC_SA_CONTIN    : text( 8).szDesc = "TC_SA_CONTIN    Can do any multiples for exact scaling:"
   text( 9).iMask = %TC_EA_DOUBLE    : text( 9).szDesc = "TC_EA_DOUBLE    Can do double weight characters:"
   text(10).iMask = %TC_IA_ABLE      : text(10).szDesc = "TC_IA_ABLE      Can do italicizing:"
   text(11).iMask = %TC_UA_ABLE      : text(11).szDesc = "TC_UA_ABLE      Can do underlining:"
   text(12).iMask = %TC_SO_ABLE      : text(12).szDesc = "TC_SO_ABLE      Can do strikeouts::"
   text(13).iMask = %TC_RA_ABLE      : text(13).szDesc = "TC_RA_ABLE      Can do raster fonts:"
   text(14).iMask = %TC_VA_ABLE      : text(14).szDesc = "TC_VA_ABLE      Can do vector fonts:"

   DIM bitinfo(3) AS BITINFO_STRUCT

   bitinfo(0).iIndex  = %CURVECAPS
   bitinfo(0).szTitle = "CURVCAPS (Curve Capabilities)"
   bitinfo(0).pbits   = VARPTR(curves(0))
   bitinfo(0).iSize   = UBOUND(curves) - LBOUND(curves) + 1

   bitinfo(1).iIndex  = %LINECAPS
   bitinfo(1).szTitle = "LINECAPS (Line Capabilities)"
   bitinfo(1).pbits   = VARPTR(lines(0))
   bitinfo(1).iSize   = UBOUND(lines) - LBOUND(lines) + 1

   bitinfo(2).iIndex  = %POLYGONALCAPS
   bitinfo(2).szTitle = "POLYGONALCAPS (Polygonal Capabilities)"
   bitinfo(2).pbits   = VARPTR(poly(0))
   bitinfo(2).iSize   = UBOUND(poly) - LBOUND(poly) + 1

   bitinfo(3).iIndex  = %TEXTCAPS
   bitinfo(3).szTitle = "TEXTCAPS (Text Capabilities)"
   bitinfo(3).pbits   = VARPTR(text(0))
   bitinfo(3).iSize   = UBOUND(text) - LBOUND(text) + 1

   LOCAL szBuffer AS ASCIIZ * 80
   LOCAL pbits AS BITS_STRUCT PTR
   LOCAL i AS LONG
   LOCAL iDevCaps AS LONG

   pbits = bitinfo(iType).pbits
   iDevCaps = GetDeviceCaps(hdcInfo, bitinfo(iType).iIndex)

   TextOut hdc, cxChar, cyChar, bitinfo(iType).szTitle, LEN(bitinfo(iType).szTitle)

   LOCAL szYesNo AS ASCIIZ * 80
   FOR i = 0 TO bitinfo(iType).iSize - 1
      szYesNo = IIF$((iDevCaps AND @pbits[i].iMask) = @pbits[i].iMask, "Yes", "No")
      wsprintf szBuffer, "%-55s %3s", @pbits[i].szDesc, szYesNo
      TextOut hdc, cxChar, (i + 3) * cyChar, szBuffer, LEN(szBuffer)
   NEXT

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 szDevice AS ASCIIZ * 32
   STATIC szWindowText AS ASCIIZ * 64
   STATIC cxChar AS LONG
   STATIC cyChar AS LONG
   STATIC nCurrentDevice AS LONG
   STATIC nCurrentInfo AS LONG
   STATIC dwNeeded AS DWORD
   STATIC dwReturned AS DWORD
   STATIC pinfo4 AS PRINTER_INFO_4 PTR
   STATIC pinfo5 AS PRINTER_INFO_5 PTR
   LOCAL  i AS DWORD
   LOCAL  hdc AS DWORD
   LOCAL  hdcInfo AS DWORD
   LOCAL  hMenu AS DWORD
   LOCAL  hPrint AS DWORD
   LOCAL  ps AS PAINTSTRUCT
   LOCAL  tm AS TEXTMETRIC

   SELECT CASE uMsg

      CASE %WM_CREATE
         nCurrentDevice = %IDM_SCREEN
         nCurrentInfo = %IDM_BASIC
         hdc = GetDC(hwnd)
         SelectObject hdc, GetStockObject(%SYSTEM_FIXED_FONT)
         GetTextMetrics hdc, tm
         cxChar = tm.tmAveCharWidth
         cyChar = tm.tmHeight + tm.tmExternalLeading
         ReleaseDC hwnd, hdc
         SendMessage hwnd, %WM_SETTINGCHANGE, 0, 0
         EXIT FUNCTION

      CASE %WM_SETTINGCHANGE
         hMenu = GetSubMenu(GetMenu(hwnd), 0)
         WHILE GetMenuItemCount (hMenu) > 1
            DeleteMenu hMenu, 1, %MF_BYPOSITION
         WEND
         ' Get a list of all local and remote printers
         '
         ' First, find out how large an array we need; this
         '   call will fail, leaving the required size in dwNeeded
         '
         ' Next, allocate space for the info array and fill it
         '
         ' Put the printer names on the menu
         IF (GetVersion () AND &H80000000) THEN     ' // Windows 98
            EnumPrinters %PRINTER_ENUM_LOCAL, BYVAL %NULL, 5, BYVAL %NULL, _
                         0, dwNeeded, dwReturned
            pinfo5 = CoTaskMemAlloc(dwNeeded)
            EnumPrinters %PRINTER_ENUM_LOCAL, BYVAL %NULL, 5, BYVAL pinfo5, _
                         dwNeeded, dwNeeded, dwReturned
            FOR i = 0 TO dwReturned - 1
               AppendMenu hMenu, IIF&((i+1) MOD 16 <> 0, 0, %MF_MENUBARBREAK), i + 1, _
                          @pinfo5[i].@pPrinterName
            NEXT
            CoTaskMemFree pinfo5
         ELSE                                      ' // Windows NT
            EnumPrinters %PRINTER_ENUM_LOCAL, BYVAL %NULL, 4, BYVAL %NULL, _
                         0, dwNeeded, dwReturned
            pinfo4 = CoTaskMemAlloc(dwNeeded)
            EnumPrinters %PRINTER_ENUM_LOCAL, BYVAL %NULL, 4, BYVAL pinfo4, _
                         dwNeeded, dwNeeded, dwReturned
            FOR i = 0 TO dwReturned - 1
               AppendMenu hMenu, IIF&((i+1) MOD 16 <> 0, 0, %MF_MENUBARBREAK), i + 1, _
                          @pinfo4[i].@pPrinterName
            NEXT
            CoTaskMemFree pInfo4
         END IF

         AppendMenu hMenu, %MF_SEPARATOR, 0, BYVAL %NULL
         AppendMenu hMenu, 0, %IDM_DEVMODE, "Properties"

         wParam = %IDM_SCREEN
         SendMessage hwnd, %WM_COMMAND, wParam, 0
         EXIT FUNCTION

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

      CASE %WM_COMMAND
         hMenu = GetMenu(hwnd)
         IF LO(WORD, wParam) = %IDM_SCREEN OR _         ' IDM_SCREEN & Printers
            LO(WORD, wParam) < %IDM_DEVMODE THEN
            CheckMenuItem hMenu, nCurrentDevice, %MF_UNCHECKED
            nCurrentDevice = LO(WORD, wParam)
            CheckMenuItem hMenu, nCurrentDevice, %MF_CHECKED
         ELSEIF LO(WORD, wParam) = %IDM_DEVMODE THEN   ' Properties selection
            GetMenuString hMenu, nCurrentDevice, szDevice, _
                          SIZEOF(szDevice), %MF_BYCOMMAND
            IF OpenPrinter(szDevice, hPrint, BYVAL %NULL) THEN
               PrinterProperties hwnd, hPrint
               ClosePrinter hPrint
            END IF
         ELSE                                       ' info menu items
            CheckMenuItem hMenu, nCurrentInfo, %MF_UNCHECKED
            nCurrentInfo = LO(WORD, wParam)
            CheckMenuItem hMenu, nCurrentInfo, %MF_CHECKED
         END IF
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         EXIT FUNCTION

      CASE %WM_INITMENUPOPUP
         IF lParam = 0 THEN
            EnableMenuItem GetMenu(hwnd), %IDM_DEVMODE, _
                 IIF&(nCurrentDevice = %IDM_SCREEN, %MF_GRAYED, %MF_ENABLED)
         END IF
         EXIT FUNCTION

      CASE %WM_PAINT
         szWindowText = "Device Capabilities: "
         IF nCurrentDevice = %IDM_SCREEN THEN
            szDevice = "DISPLAY"
            hdcInfo = CreateIC(szDevice, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
         ELSE
            hMenu = GetMenu(hwnd)
            GetMenuString hMenu, nCurrentDevice, szDevice, SIZEOF(szDevice), %MF_BYCOMMAND
            hdcInfo = CreateIC(BYVAL %NULL, szDevice, BYVAL %NULL, BYVAL %NULL)
         END IF
         szWindowText = szWindowText & szDevice
         SetWindowText hwnd, szWindowText
         hdc = BeginPaint(hwnd, ps)
         SelectObject hdc, GetStockObject(%SYSTEM_FIXED_FONT)
         IF hdcInfo THEN
            SELECT CASE nCurrentInfo
               CASE %IDM_BASIC
                  DoBasicInfo hdc, hdcInfo, cxChar, cyChar
               CASE %IDM_OTHER
                  DoOtherInfo hdc, hdcInfo, cxChar, cyChar
               CASE %IDM_CURVE, %IDM_LINE, %IDM_POLY, %IDM_TEXT
                  DoBitCodedCaps hdc, hdcInfo, cxChar, cyChar, nCurrentInfo - %IDM_CURVE
            END SELECT
            DeleteDC hdcInfo
         END IF
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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

DEVCAPS2.RC

Code: [Select]

#define IDM_SCREEN                      40001
#define IDM_BASIC                       40002
#define IDM_OTHER                       40003
#define IDM_CURVE                       40004
#define IDM_LINE                        40005
#define IDM_POLY                        40006
#define IDM_TEXT                        40007

/////////////////////////////////////////////////////////////////////////////
// Menu
DEVCAPS2 MENU DISCARDABLE
BEGIN
    POPUP "&Device"
    BEGIN
        MENUITEM "&Screen",                     IDM_SCREEN, CHECKED
    END
    POPUP "&Capabilities"
    BEGIN
        MENUITEM "&Basic Information",          IDM_BASIC
        MENUITEM "&Other Information",          IDM_OTHER
        MENUITEM "&Curve Capabilities",         IDM_CURVE
        MENUITEM "&Line Capabilities",          IDM_LINE
        MENUITEM "&Polygonal Capabilities",     IDM_POLY
        MENUITEM "&Text Capabilities",          IDM_TEXT
    END
END


[José Roca]

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

Displays the current time using a simulated LED-like 7-segment display.

Code: [Select]

' ========================================================================================
' DIGCLOCK.BAS
' This program is a translation/adaptation of DIGCLOCK.C -- Digital Clock © Charles
' Petzold, 1998, described and analysed in Chapter 5 of the book Programming Windows,
' 5th Edition.
' Displays the current time using a simulated LED-like 7-segment display.
' ========================================================================================

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

%ID_TIMER = 1

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

   LOCAL hwnd      AS DWORD
   LOCAL szAppName AS ASCIIZ * 256
   LOCAL wcex      AS WNDCLASSEX
   LOCAL szCaption AS ASCIIZ * 256

   szAppName        = "DigClock"
   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 = "Digital Clock"
   hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _   ' extended style
                         szAppName, _              ' window class name
                         szCaption, _              ' window caption
                         %WS_OVERLAPPEDWINDOW, _   ' window style
                         %CW_USEDEFAULT, _         ' initial x position
                         %CW_USEDEFAULT, _         ' initial y position
                         %CW_USEDEFAULT, _         ' initial x size
                         %CW_USEDEFAULT, _         ' initial y size
                         %NULL, _                  ' parent window handle
                         %NULL, _                  ' window menu handle
                         hInstance, _              ' program instance handle
                         BYVAL %NULL)              ' creation parameters

   ShowWindow hwnd, iCmdShow
   UpdateWindow hwnd

   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      TranslateMessage uMsg
      DispatchMessage uMsg
   WEND

   FUNCTION = uMsg.wParam

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

' ========================================================================================
SUB DisplayDigit (BYVAL hdc AS DWORD, BYVAL iNumber AS LONG)

   DIM fSevenSegment(0 TO 9, 0 TO 6) AS STATIC LONG
   DIM ptSegment(0 TO 5, 0 TO 6) AS STATIC POINTAPI
   STATIC flag AS LONG
   LOCAL iSeg AS LONG

   IF ISFALSE flag THEN

      fSevenSegment(0, 0) = 1
      fSevenSegment(0, 1) = 1
      fSevenSegment(0, 2) = 1
      fSevenSegment(0, 3) = 0
      fSevenSegment(0, 4) = 1
      fSevenSegment(0, 5) = 1
      fSevenSegment(0, 6) = 1

      fSevenSegment(1, 0) = 0
      fSevenSegment(1, 1) = 0
      fSevenSegment(1, 2) = 1
      fSevenSegment(1, 3) = 0
      fSevenSegment(1, 4) = 0
      fSevenSegment(1, 5) = 1
      fSevenSegment(1, 6) = 0

      fSevenSegment(2, 0) = 1
      fSevenSegment(2, 1) = 0
      fSevenSegment(2, 2) = 1
      fSevenSegment(2, 3) = 1
      fSevenSegment(2, 4) = 1
      fSevenSegment(2, 5) = 0
      fSevenSegment(2, 6) = 1

      fSevenSegment(3, 0) = 1
      fSevenSegment(3, 1) = 0
      fSevenSegment(3, 2) = 1
      fSevenSegment(3, 3) = 1
      fSevenSegment(3, 4) = 0
      fSevenSegment(3, 5) = 1
      fSevenSegment(3, 6) = 1

      fSevenSegment(4, 0) = 0
      fSevenSegment(4, 1) = 1
      fSevenSegment(4, 2) = 1
      fSevenSegment(4, 3) = 1
      fSevenSegment(4, 4) = 0
      fSevenSegment(4, 5) = 1
      fSevenSegment(4, 6) = 0

      fSevenSegment(5, 0) = 1
      fSevenSegment(5, 1) = 1
      fSevenSegment(5, 2) = 0
      fSevenSegment(5, 3) = 1
      fSevenSegment(5, 4) = 0
      fSevenSegment(5, 5) = 1
      fSevenSegment(5, 6) = 1

      fSevenSegment(6, 0) = 1
      fSevenSegment(6, 1) = 1
      fSevenSegment(6, 2) = 0
      fSevenSegment(6, 3) = 1
      fSevenSegment(6, 4) = 1
      fSevenSegment(6, 5) = 1
      fSevenSegment(6, 6) = 1

      fSevenSegment(7, 0) = 1
      fSevenSegment(7, 1) = 0
      fSevenSegment(7, 2) = 1
      fSevenSegment(7, 3) = 0
      fSevenSegment(7, 4) = 0
      fSevenSegment(7, 5) = 1
      fSevenSegment(7, 6) = 0

      fSevenSegment(8, 0) = 1
      fSevenSegment(8, 1) = 1
      fSevenSegment(8, 2) = 1
      fSevenSegment(8, 3) = 1
      fSevenSegment(8, 4) = 1
      fSevenSegment(8, 5) = 1
      fSevenSegment(8, 6) = 1

      fSevenSegment(9, 0) = 1
      fSevenSegment(9, 1) = 1
      fSevenSegment(9, 2) = 1
      fSevenSegment(9, 3) = 1
      fSevenSegment(9, 4) = 0
      fSevenSegment(9, 5) = 1
      fSevenSegment(9, 6) = 1

      ptSegment(0, 0).x = 7  : ptSegment(0, 0).y = 6
      ptSegment(1, 0).x = 11 : ptSegment(1, 0).y = 2
      ptSegment(2, 0).x = 31 : ptSegment(2, 0).y = 2
      ptSegment(3, 0).x = 35 : ptSegment(3, 0).y = 6
      ptSegment(4, 0).x = 31 : ptSegment(4, 0).y = 10
      ptSegment(5, 0).x = 11 : ptSegment(5, 0).y = 10

      ptSegment(0, 1).x = 6  : ptSegment(0, 1).y = 7
      ptSegment(1, 1).x = 10 : ptSegment(1, 1).y = 11
      ptSegment(2, 1).x = 10 : ptSegment(2, 1).y = 31
      ptSegment(3, 1).x = 6  : ptSegment(3, 1).y = 35
      ptSegment(4, 1).x = 2  : ptSegment(4, 1).y = 31
      ptSegment(5, 1).x = 2  : ptSegment(5, 1).y = 11

      ptSegment(0, 2).x = 36 : ptSegment(0, 2).y = 7
      ptSegment(1, 2).x = 40 : ptSegment(1, 2).y = 11
      ptSegment(2, 2).x = 40 : ptSegment(2, 2).y = 31
      ptSegment(3, 2).x = 36 : ptSegment(3, 2).y = 35
      ptSegment(4, 2).x = 32 : ptSegment(4, 2).y = 31
      ptSegment(5, 2).x = 32 : ptSegment(5, 2).y = 11

      ptSegment(0, 3).x = 7  : ptSegment(0, 3).y = 36
      ptSegment(1, 3).x = 11 : ptSegment(1, 3).y = 32
      ptSegment(2, 3).x = 31 : ptSegment(2, 3).y = 32
      ptSegment(3, 3).x = 35 : ptSegment(3, 3).y = 36
      ptSegment(4, 3).x = 31 : ptSegment(4, 3).y = 40
      ptSegment(5, 3).x = 11 : ptSegment(5, 3).y = 40

      ptSegment(0, 4).x = 6  : ptSegment(0, 4).y = 37
      ptSegment(1, 4).x = 10 : ptSegment(1, 4).y = 41
      ptSegment(2, 4).x = 10 : ptSegment(2, 4).y = 61
      ptSegment(3, 4).x = 6  : ptSegment(3, 4).y = 65
      ptSegment(4, 4).x = 2  : ptSegment(4, 4).y = 61
      ptSegment(5, 4).x = 2  : ptSegment(5, 4).y = 41

      ptSegment(0, 5).x = 36 : ptSegment(0, 5).y = 37
      ptSegment(1, 5).x = 40 : ptSegment(1, 5).y = 41
      ptSegment(2, 5).x = 40 : ptSegment(2, 5).y = 61
      ptSegment(3, 5).x = 36 : ptSegment(3, 5).y = 65
      ptSegment(4, 5).x = 32 : ptSegment(4, 5).y = 61
      ptSegment(5, 5).x = 32 : ptSegment(5, 5).y = 41

      ptSegment(0, 6).x = 7  : ptSegment(0, 6).y = 66
      ptSegment(1, 6).x = 11 : ptSegment(1, 6).y = 62
      ptSegment(2, 6).x = 31 : ptSegment(2, 6).y = 62
      ptSegment(3, 6).x = 35 : ptSegment(3, 6).y = 66
      ptSegment(4, 6).x = 31 : ptSegment(4, 6).y = 70
      ptSegment(5, 6).x = 11 : ptSegment(5, 6).y = 70

      flag = %TRUE

   END IF

   FOR iSeg = 0 TO 6
      IF fSevenSegment(iNumber, iSeg) THEN
         Polygon hdc, ptSegment(0, iSeg), 6
      END IF
   NEXT

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

' ========================================================================================
SUB DisplayTwoDigits (BYVAL hdc AS DWORD, BYVAL iNumber AS LONG, BYVAL fSuppress AS LONG)

   IF ISFALSE fSuppress OR iNumber \ 10 <> 0 THEN
      DisplayDigit hdc, iNumber \ 10
   END IF
   OffsetWindowOrgEx hdc, -42, 0, BYVAL %NULL
   DisplayDigit hdc, iNumber MOD 10
   OffsetWindowOrgEx hdc, -42, 0, BYVAL %NULL

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

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

   DIM ptColon(0 TO 1, 0 TO 3) AS STATIC POINTAPI
   STATIC flag AS LONG

   IF ISFALSE flag THEN
      ptColon(0, 0).x = 2  : ptColon(0, 0).y = 21
      ptColon(0, 1).x = 6  : ptColon(0, 1).y = 17
      ptColon(0, 2).x = 10 : ptColon(0, 2).y = 21
      ptColon(0, 3).x = 6  : ptColon(0, 3).y = 25
      flag = %TRUE
   END IF

   Polygon hdc, ptColon(0), 4
   Polygon hdc, ptColon(1), 4

   OffsetWindowOrgEx hdc, -12, 0, BYVAL %NULL

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

' ========================================================================================
SUB DisplayTime (BYVAL hdc AS DWORD, BYVAL f24Hour AS LONG, BYVAL fSuppress AS LONG)

   LOCAL st AS SYSTEMTIME

   GetLocalTime st

   IF f24Hour THEN
      DisplayTwoDigits hdc, st.wHour, fSuppress
   ELSE
      IF st.wHour MOD 12 = 0 THEN
         DisplayTwoDigits hdc, 12, fSuppress
      ELSE
         DisplayTwoDigits hdc, st.wHour MOD 12, fSuppress
      END IF
   END IF

   DisplayColon hdc
   DisplayTwoDigits hdc, st.wMinute, %FALSE
   DisplayColon hdc
   DisplayTwoDigits hdc, st.wSecond, %FALSE

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 f24Hour AS LONG
   STATIC fSuppress AS LONG
   STATIC hBrushRed AS DWORD
   STATIC cxClient AS LONG
   STATIC cyClient AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  ps  AS PAINTSTRUCT
   LOCAL  szBuffer AS ASCIIZ * 3

   SELECT CASE uMsg

      CASE %WM_CREATE
         hBrushRed = CreateSolidBrush(RGB (255, 0, 0))
         SetTimer hwnd, %ID_TIMER, 1000, %NULL
         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
         GetLocaleInfo %LOCALE_USER_DEFAULT, %LOCALE_ITIME, szBuffer, 2
         IF LEFT$(szBuffer, 1) = "1" THEN f24Hour = %TRUE
         GetLocaleInfo %LOCALE_USER_DEFAULT, %LOCALE_ITLZERO, szBuffer, 2
         IF LEFT$(szBuffer, 1) = "0" THEN fSuppress = %TRUE
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         EXIT FUNCTION

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

      CASE %WM_TIMER
         InvalidateRect hwnd, BYVAL %NULL, %TRUE
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         SetMapMode hdc, %MM_ISOTROPIC
         SetWindowExtEx hdc, 276, 72, BYVAL %NULL
         SetViewportExtEx hdc, cxClient, cyClient, BYVAL %NULL
         SetWindowOrgEx hdc, 138, 36, BYVAL %NULL
         SetViewportOrgEx hdc, cxClient \ 2, cyClient \ 2, BYVAL %NULL
         SelectObject hdc, GetStockObject(%NULL_PEN)
         SelectObject hdc, hBrushRed
         DisplayTime hdc, f24Hour, fSuppress
         EndPaint hwnd, ps
         EXIT FUNCTION

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

   END SELECT

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

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


[José Roca]

 
This program is a translation of EMF1.C -- Enhanced Metafile Demo #1 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

Creates and displays an enhanced metafile with a fairly minimal amount of distraction.

Code: [Select]

' ========================================================================================
' EMF1.BAS
' This program is a translation/adaptation of EMF1.C -- Enhanced Metafile Demo #1
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' Creates and displays an enhanced metafile with a fairly minimal amount of distraction.
' ========================================================================================

#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          = "EMF1"
   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 = "Enhanced Metafile Demo #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 hemf   AS DWORD
   LOCAL  hdc    AS DWORD
   LOCAL  hdcEMF AS DWORD
   LOCAL  ps     AS PAINTSTRUCT
   LOCAL  rc     AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         hdcEMF = CreateEnhMetaFile(%NULL, BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
         Rectangle hdcEMF, 100, 100, 200, 200
         MoveToEx  hdcEMF, 100, 100, BYVAL %NULL
         LineTo    hdcEMF, 200, 200
         MoveToEx  hdcEMF, 200, 100, BYVAL %NULL
         LineTo    hdcEMF, 100, 200
         hemf = CloseEnhMetaFile(hdcEMF)
         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)
         GetClientRect hwnd, rc
         rc.nLeft   =     rc.nRight  / 4
         rc.nRight  = 3 * rc.nRight  / 4
         rc.nTop    =     rc.nBottom / 4
         rc.nBottom = 3 * rc.nBottom / 4
         PlayEnhMetaFile hdc, hemf, rc
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         DeleteEnhMetaFile hemf
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of EMF2.C -- Enhanced Metafile Demo #2 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

You can get a good feel for how metafiles work by looking at the contents of the metafile. This is easiest if you have a disk-based metafile to look at, so the EMF2 program creates one for you.

Code: [Select]

' ========================================================================================
' EMF2.BAS
' This program is a translation/adaptation of EMF2.C -- Enhanced Metafile Demo #2
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' You can get a good feel for how metafiles work by looking at the contents of the
' metafile. This is easiest if you have a disk-based metafile to look at, so the EMF2
' program creates one for you.
' ========================================================================================

#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          = "EMF2"
   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 = "Enhanced Metafile Demo #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

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

   SELECT CASE uMsg

      CASE %WM_CREATE
         hdcEMF = CreateEnhMetaFile(%NULL, "emf2.emf", BYVAL %NULL, "EMF2" & $NUL & "EMF Demo #2" & $NUL)
         Rectangle hdcEMF, 100, 100, 201, 201
         MoveToEx  hdcEMF, 100, 100, BYVAL %NULL
         LineTo    hdcEMF, 200, 200
         MoveToEx  hdcEMF, 200, 100, BYVAL %NULL
         LineTo    hdcEMF, 100, 200
         hemf = CloseEnhMetaFile(hdcEMF)
         DeleteEnhMetaFile hemf
         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)
         GetClientRect hwnd, rc
         rc.nLeft   =     rc.nRight  / 4
         rc.nRight  = 3 * rc.nRight  / 4
         rc.nTop    =     rc.nBottom / 4
         rc.nBottom = 3 * rc.nBottom / 4
         hemf = GetEnhMetaFile("emf2.emf")
         IF hemf THEN
            PlayEnhMetaFile hdc, hemf, rc
            DeleteEnhMetaFile hemf
         END IF
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of EMF3.C -- Enhanced Metafile Demo #3 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

We've now seen how GDI drawing commands are stored in metafiles. Now let's examine how GDI objects are stored. The EMF3 program is similar to the EMF2 program shown earlier, except that it creates a nondefault pen and brush for drawing the rectangle and lines.

Code: [Select]

' ========================================================================================
' EMF3.BAS
' This program is a translation/adaptation of EMF3.C -- Enhanced Metafile Demo #3
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' We've now seen how GDI drawing commands are stored in metafiles. Now let's examine how
' GDI objects are stored. The EMF3 program is similar to the EMF2 program shown earlier,
' except that it creates a nondefault pen and brush for drawing the rectangle and lines.
' ========================================================================================

#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          = "EMF3"
   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 = "Enhanced Metafile Demo #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

   LOCAL lb     AS LOGBRUSH
   LOCAL hdc    AS DWORD
   LOCAL hdcEMF AS DWORD
   LOCAL hemf   AS DWORD
   LOCAL ps     AS PAINTSTRUCT
   LOCAL rc     AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         hdcEMF = CreateEnhMetaFile(%NULL, "emf3.emf", BYVAL %NULL, "EMF3" & $NUL & "EMF Demo #3" & $NUL)
         SelectObject hdcEMF, CreateSolidBrush(RGB(0, 0, 255))
         lb.lbStyle = %BS_SOLID
         lb.lbColor = RGB(255, 0, 0)
         lb.lbHatch = 0
         SelectObject hdcEMF, ExtCreatePen(%PS_SOLID OR %PS_GEOMETRIC, 5, lb, 0, BYVAL %NULL)
         Rectangle hdcEMF, 100, 100, 201, 201
         MoveToEx  hdcEMF, 100, 100, BYVAL %NULL
         LineTo    hdcEMF, 200, 200
         MoveToEx  hdcEMF, 200, 100, BYVAL %NULL
         LineTo    hdcEMF, 100, 200
         DeleteObject SelectObject (hdcEMF, GetStockObject(%BLACK_PEN))
         DeleteObject SelectObject (hdcEMF, GetStockObject(%WHITE_BRUSH))
         hemf = CloseEnhMetaFile(hdcEMF)
         DeleteEnhMetaFile hemf
         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)
         GetClientRect hwnd, rc
         rc.nLeft   =     rc.nRight  / 4
         rc.nRight  = 3 * rc.nRight  / 4
         rc.nTop    =     rc.nBottom / 4
         rc.nBottom = 3 * rc.nBottom / 4
         hemf = GetEnhMetaFile("emf3.emf")
         IF hemf THEN
            PlayEnhMetaFile hdc, hemf, rc
            DeleteEnhMetaFile hemf
         END IF
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of EMF4.C -- Enhanced Metafile Demo #4 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

Let's try something a little more complex now, in particular drawing a bitmap in a metafile device context.

Code: [Select]

' ========================================================================================
' EMF4.BAS
' This program is a translation/adaptation of EMF4.C -- Enhanced Metafile Demo #4
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' Let's try something a little more complex now, in particular drawing a bitmap in a
' metafile device context.
' ========================================================================================

#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          = "EMF4"
   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 = "Enhanced Metafile Demo #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

   LOCAL bm     AS BITMAP
   LOCAL hbm    AS DWORD
   LOCAL hdc    AS DWORD
   LOCAL hdcEMF AS DWORD
   LOCAL hdcMem AS DWORD
   LOCAL hemf   AS DWORD
   LOCAL ps     AS PAINTSTRUCT
   LOCAL rc     AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE
         hdcEMF = CreateEnhMetaFile(%NULL, "emf4.emf", BYVAL %NULL, "EMF4" & $NUL & "EMF Demo #4" & $NUL)
         hbm = LoadBitmap(%NULL, BYVAL %OBM_CLOSE)
         GetObject hbm, SIZEOF(BITMAP), bm
         hdcMem = CreateCompatibleDC(hdcEMF)
         SelectObject hdcMem, hbm
         StretchBlt hdcEMF, 100, 100, 100, 100, _
                    hdcMem,   0,   0, bm.bmWidth, bm.bmHeight, %SRCCOPY
         DeleteDC hdcMem
         DeleteObject hbm
         hemf = CloseEnhMetaFile(hdcEMF)
         DeleteEnhMetaFile hemf
         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)
         GetClientRect hwnd, rc
         rc.nLeft   =     rc.nRight  / 4
         rc.nRight  = 3 * rc.nRight  / 4
         rc.nTop    =     rc.nBottom / 4
         rc.nBottom = 3 * rc.nBottom / 4
         hemf = GetEnhMetaFile("emf4.emf")
         IF hemf THEN
            PlayEnhMetaFile hdc, hemf, rc
            DeleteEnhMetaFile hemf
         END IF
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of EMF5.C -- Enhanced Metafile Demo #5 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

This program uses a metafile to display the same image as EMF3 but works by using  metafile enumeration.

Note: This program uses the EMF3.EMF file created by the EMF3 program, so make sure you run that one before this one.

Code: [Select]

' ========================================================================================
' EMF5.BAS
' This program is a translation/adaptation of EMF5.C -- Enhanced Metafile Demo #5
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' This program uses a metafile to display the same image as EMF3 but works by using
' metafile enumeration.
' Note: This program uses the EMF3.EMF file created by the EMF3 program, so make sure you
' run that one before this one.
' ========================================================================================

#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          = "EMF5"
   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 = "Enhanced Metafile Demo #5"
   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
' ========================================================================================

' ========================================================================================
' Enhanced metafile enumeration callback
' ========================================================================================
FUNCTION EnhMetaFileProc (BYVAL hdc AS DWORD, pHandleTable AS HANDLETABLE, _
                          pEmfRecord AS ENHMETARECORD, BYVAL iHandles AS DWORD, _
                          BYVAL pData AS LONG) AS LONG

   PlayEnhMetaFileRecord hdc, pHandleTable, pEmfRecord, iHandles
   FUNCTION = %TRUE

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

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

   SELECT CASE uMsg

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

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         GetClientRect hwnd, rc
         rc.nLeft   =     rc.nRight  / 4
         rc.nRight  = 3 * rc.nRight  / 4
         rc.nTop    =     rc.nBottom / 4
         rc.nBottom = 3 * rc.nBottom / 4
         hemf = GetEnhMetaFile("emf3.emf")
         IF hemf THEN
            EnumEnhMetaFile hdc, hemf, CODEPTR(EnhMetaFileProc), BYVAL %NULL, rc
            DeleteEnhMetaFile hemf
         END IF
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of EMF6.C -- Enhanced Metafile Demo #6 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

EMF6 demonstrates that if you want to modify metafile records before rendering them, the solution is fairly simple: you make a copy and modify that.

Note: This program uses the EMF3.EMF file created by the EMF3 program, so make sure you run that one before this one.

Code: [Select]

' ========================================================================================
' EMF6.BAS
' This program is a translation/adaptation of EMF6.C -- Enhanced Metafile Demo #6
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' EMF6 demonstrates that if you want to modify metafile records before rendering them,
' the solution is fairly simple: you make a copy and modify that.
' Note: This program uses the EMF3.EMF file created by the EMF3 program, so make sure you
' run that one before this one.
' ========================================================================================

#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "windows.inc"
#INCLUDE ONCE "objbase.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          = "EMF6"
   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 = "Enhanced Metafile Demo #6"
   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
' ========================================================================================

' ========================================================================================
' Enhanced metafile enumeration callback
' ========================================================================================
FUNCTION EnhMetaFileProc (BYVAL hdc AS DWORD, pHandleTable AS HANDLETABLE, _
                          pEmfRecord AS ENHMETARECORD, BYVAL iHandles AS DWORD, _
                          BYVAL pData AS LONG) AS LONG

   LOCAL pEmfr AS ENHMETARECORD PTR

   pEmfr = CoTaskMemALloc(pEmfRecord.nSize)
   CopyMemory pEmfr, VARPTR(pEmfRecord), pEmfRecord.nSize
   IF @pEmfr.iType = %EMR_RECTANGLE THEN @pEmfr.iType = %EMR_ELLIPSE
   PlayEnhMetaFileRecord hdc, pHandleTable, BYVAL pEmfr, iHandles
   FUNCTION = %TRUE
   CoTaskMemFree pEmfr

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

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

   SELECT CASE uMsg

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

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         GetClientRect hwnd, rc
         rc.nLeft   =     rc.nRight  / 4
         rc.nRight  = 3 * rc.nRight  / 4
         rc.nTop    =     rc.nBottom / 4
         rc.nBottom = 3 * rc.nBottom / 4
         hemf = GetEnhMetaFile("emf3.emf")
         IF hemf THEN
            EnumEnhMetaFile hdc, hemf, CODEPTR(EnhMetaFileProc), BYVAL %NULL, rc
            DeleteEnhMetaFile hemf
         END IF
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of EMF7.C -- Enhanced Metafile Demo #7 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

Perhaps the most important use of metafile enumeration is to embed other images (or even entire metafiles) in an existing metafile. Actually, the existing metafile remains unchanged; what you really do is create a new metafile that combines the existing metafile and the new embedded images. The basic trick is to pass a metafile device context handle as the first argument to EnumEnhMetaFile. That allows you to render both metafile records and GDI function calls on the metafile device context.

Note: This program uses the EMF3.EMF file created by the EMF3 program, so make sure you run that one before this one.

Code: [Select]

' ========================================================================================
' EMF7.BAS
' This program is a translation/adaptation of EMF7.C -- Enhanced Metafile Demo #7
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' Perhaps the most important use of metafile enumeration is to embed other images (or even
' entire metafiles) in an existing metafile. Actually, the existing metafile remains
' unchanged; what you really do is create a new metafile that combines the existing
' metafile and the new embedded images. The basic trick is to pass a metafile device
' context handle as the first argument to EnumEnhMetaFile. That allows you to render both
' metafile records and GDI function calls on the metafile device context.
' ========================================================================================

#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          = "EMF7"
   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 = "Enhanced Metafile Demo #7"
   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
' ========================================================================================

' ========================================================================================
' Enhanced metafile enumeration callback
' ========================================================================================
FUNCTION EnhMetaFileProc (BYVAL hdc AS DWORD, pHandleTable AS HANDLETABLE, _
                          pEmfRecord AS ENHMETARECORD, BYVAL iHandles AS DWORD, _
                          BYVAL pData AS LONG) AS LONG

   LOCAL hBrush AS DWORD
   LOCAL hPen AS DWORD
   LOCAL lb AS LOGBRUSH

   IF pEmfRecord.iType <> %EMR_HEADER AND pEmfRecord.iType <> %EMR_EOF THEN
      PlayEnhMetaFileRecord hdc, pHandleTable, pEmfRecord, iHandles
   END IF

   IF pEmfRecord.iType <> %EMR_RECTANGLE THEN
      hBrush = SelectObject(hdc, GetStockObject(%NULL_BRUSH))
      lb.lbStyle = %BS_SOLID
      lb.lbColor = RGB(0, 255, 0)
      lb.lbHatch = 0
      hPen = SelectObject(hdc, ExtCreatePen(%PS_SOLID OR %PS_GEOMETRIC, 5, lb, 0, BYVAL %NULL))
      Ellipse hdc, 100, 100, 200, 200
      DeleteObject SelectObject(hdc, hPen)
      SelectObject hdc, hBrush
   END IF

   FUNCTION = %TRUE

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

   LOCAL emh     AS ENHMETAHEADER
   LOCAL hdc     AS DWORD
   LOCAL hdcEMF  AS DWORD
   LOCAL hemfOld AS DWORD
   LOCAL hemf    AS DWORD
   LOCAL ps      AS PAINTSTRUCT
   LOCAL rc      AS RECT

   SELECT CASE uMsg

      CASE %WM_CREATE

         ' Retrieve existing metafile and header
         hemfOld = GetEnhMetaFile("emf3.emf")
         GetEnhMetaFileHeader hemfOld, SIZEOF(ENHMETAHEADER), emh
         ' Create a new metafile DC
         hdcEMF = CreateEnhMetaFile(%NULL, "emf7.emf", BYVAL %NULL, _
                                   "EMF7" & $NUL & "EMF Demo #7" & $NUL)
         ' Enumerate the existing metafile
         EnumEnhMetaFile hdcEMF, hemfOld, CODEPTR(EnhMetaFileProc), BYVAL %NULL, emh.rclBounds
         ' Clean up
         hemf = CloseEnhMetaFile(hdcEMF)
         DeleteEnhMetaFile hemfOld
         DeleteEnhMetaFile hemf
         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)
         GetClientRect hwnd, rc
         rc.nLeft   =     rc.nRight  / 4
         rc.nRight  = 3 * rc.nRight  / 4
         rc.nTop    =     rc.nBottom / 4
         rc.nBottom = 3 * rc.nBottom / 4
         hemf = GetEnhMetaFile("emf7.emf")
         IF hemf THEN
            EnumEnhMetaFile hdc, hemf, CODEPTR(EnhMetaFileProc), BYVAL %NULL, rc
            DeleteEnhMetaFile hemf
         END IF
         EndPaint hwnd, ps
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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


[José Roca]

 
This program is a translation of EMF8.C -- Enhanced Metafile Demo #8 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

In the sample programs shown previously, we've based the bounding rectangle in the PlayEnhMetaFile call on the size of the client area. Thus, as you resize the program's window, you effectively resize the image. This is conceptually similar to resizing a metafile image within a word-processing document.

Accurately displaying a metafile image-either in specific metrical sizes or with a proper aspect ratio-requires using size information in the metafile header and setting the rectangle structure accordingly.

Note: When printing the ruler you will notice that it is rendered very small. If you have a 300-dpi laser printer, the ruler will be about 11/3 inches wide. That's because we've used a pixel dimension based on the video display. Although you may think the little printed ruler looks kind of cute, it's not what we want. Let's try again in the next example.

Code: [Select]

' ========================================================================================
' EMF8.BAS
' This program is a translation/adaptation of EMF8.C -- Enhanced Metafile Demo #8
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' In the sample programs shown previously, we've based the bounding rectangle in the
' PlayEnhMetaFile call on the size of the client area. Thus, as you resize the program's
' window, you effectively resize the image. This is conceptually similar to resizing a
' metafile image within a word-processing document.
' Accurately displaying a metafile image-either in specific metrical sizes or with a
' proper aspect ratio-requires using size information in the metafile header and setting
' the rectangle structure accordingly.
' ========================================================================================

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

%IDM_PRINT = 40001
%IDM_EXIT  = 40002
%IDM_ABOUT = 40003

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

   LOCAL hwnd      AS DWORD
   LOCAL hAccel    AS DWORD
   LOCAL szAppName AS ASCIIZ * 256
   LOCAL szCaption AS ASCIIZ * 256
   LOCAL wcex      AS WNDCLASSEX

   szAppName          = "EMF8"
   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 = "EMF8: Enhanced Metafile Demo #8"
   hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _   ' extended style
                         szAppName, _              ' window class name
                         szCaption, _              ' window caption
                         %WS_OVERLAPPEDWINDOW, _   ' window style
                         %CW_USEDEFAULT, _         ' initial x position
                         %CW_USEDEFAULT, _         ' initial y position
                         %CW_USEDEFAULT, _         ' initial x size
                         %CW_USEDEFAULT, _         ' initial y size
                         %NULL, _                  ' parent window handle
                         %NULL, _                  ' window menu handle
                         hInstance, _              ' program instance handle
                         BYVAL %NULL)              ' creation parameters

   ShowWindow hwnd, iCmdShow
   UpdateWindow hwnd

   hAccel = LoadAccelerators(hInstance, szAppName)

   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      TranslateMessage uMsg
      DispatchMessage uMsg
   WEND

   FUNCTION = uMsg.wParam

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

' ========================================================================================
' Draws a ruler
' ========================================================================================
SUB DrawRuler (BYVAL hdc AS DWORD, BYVAL cx AS LONG, BYVAL cy AS LONG)

   LOCAL i AS LONG
   LOCAL iHeight AS LONG
   LOCAL lf AS LOGFONT
   LOCAL ch AS ASCIIZ * 2

   ' Black pen with 1-point width
   SelectObject hdc, CreatePen (%PS_SOLID, cx / 72 / 6, 0)

   ' Rectangle surrounding entire pen (with adjustment)
   Rectangle (hdc, 0, 0, cx + 1, cy + 1)

   ' Tick marks
   FOR i = 1 TO 95
      IF i MOD 16 = 0 THEN
         iHeight = cy /  2    ' inches
      ELSEIF i MOD 8 = 0 THEN
         iHeight = cy /  3    ' half inches
      ELSEIF i MOD 4 = 0 THEN
         iHeight = cy /  5    ' quarter inches
      ELSEIF i MOD 2 = 0 THEN
         iHeight = cy /  8    ' eighths
      ELSE
         iHeight = cy / 12    ' sixteenths
      END IF
      MoveToEx hdc, i * cx / 96, cy, BYVAL %NULL
      LineTo   hdc, i * cx / 96, cy - iHeight
   NEXT

   ' Create logical font
   lf.lfHeight = cy / 2
   lf.lfFaceName = "Times New Roman"
   SelectObject hdc, CreateFontIndirect(lf)
   SetTextAlign hdc, %TA_BOTTOM OR %TA_CENTER
   SetBkMode    hdc, %TRANSPARENT

   ' Display numbers
   FOR i = 1 TO 5
      ch = FORMAT$(i)
      TextOut hdc, i * cx / 6, cy / 2, ch, 1
   NEXT

   ' Clean up
   DeleteObject SelectObject(hdc, GetStockObject(%SYSTEM_FONT))
   DeleteObject SelectObject(hdc, GetStockObject(%BLACK_PEN))

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

' ========================================================================================
' Create enhanced metafile
' ========================================================================================
SUB CreateRoutine (BYVAL hwnd AS DWORD)

   LOCAL hdcEMF AS DWORD
   LOCAL hemf   AS DWORD
   LOCAL cxMms  AS LONG
   LOCAL cyMms  AS LONG
   LOCAL cxPix  AS LONG
   LOCAL cyPix  AS LONG
   LOCAL xDpi   AS LONG
   LOCAL yDpi   AS LONG

   hdcEMF = CreateEnhMetaFile(%NULL, "emf8.emf", BYVAL %NULL, "EMF8" & $NUL & "EMF Demo #8" & $NUL)
   IF hdcEMF = %NULL THEN EXIT SUB

   cxMms = GetDeviceCaps(hdcEMF, %HORZSIZE)
   cyMms = GetDeviceCaps(hdcEMF, %VERTSIZE)
   cxPix = GetDeviceCaps(hdcEMF, %HORZRES)
   cyPix = GetDeviceCaps(hdcEMF, %VERTRES)

   xDpi = cxPix * 254 / cxMms / 10
   yDpi = cyPix * 254 / cyMms / 10

   DrawRuler (hdcEMF, 6 * xDpi, yDpi)

   hemf = CloseEnhMetaFile(hdcEMF)

   DeleteEnhMetaFile hemf

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

' ========================================================================================
' Displays the enhanced metafile
' ========================================================================================
SUB PaintRoutine (BYVAL hwnd AS DWORD, BYVAL hdc AS DWORD, BYVAL cxArea AS LONG, BYVAL cyArea AS LONG)

   LOCAL emh     AS ENHMETAHEADER
   LOCAL hemf    AS DWORD
   LOCAL cxImage AS LONG
   LOCAL cyImage AS LONG
   LOCAL rc      AS RECT

   hemf = GetEnhMetaFile("emf8.emf")

   GetEnhMetaFileHeader hemf, SIZEOF(emh), emh

   cxImage = emh.rclBounds.nRight - emh.rclBounds.nLeft
   cyImage = emh.rclBounds.nBottom - emh.rclBounds.nTop

   rc.nLeft   = (cxArea - cxImage) / 2
   rc.nRight  = (cxArea + cxImage) / 2
   rc.nTop    = (cyArea - cyImage) / 2
   rc.nBottom = (cyArea + cyImage) / 2

   PlayEnhMetaFile hdc, hemf, rc

   DeleteEnhMetaFile hemf

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

' ========================================================================================
' Prints the enhanced metafile
' ========================================================================================
FUNCTION PrintRoutine (BYVAL hwnd AS DWORD) AS LONG

   STATIC szMessage AS ASCIIZ * 32
   LOCAL  bSuccess AS LONG
   LOCAL  hdcPrn AS DWORD
   LOCAL  cxPage AS LONG
   LOCAL  cyPage AS LONG

   STATIC dinfo AS DOCINFO
   LOCAL  szDocName AS ASCIIZ * 256
   LOCAL  Flags AS DWORD
   LOCAL  nCopies AS WORD
   LOCAL  nFromPage AS WORD
   LOCAL  nToPage AS WORD

   Flags = %PD_RETURNDC OR %PD_NOPAGENUMS OR %PD_NOSELECTION
   nCopies = 1 : nFromPage = 1 : nToPage = 1
   IF ISFALSE PrinterDialog(hwnd, Flags, hdcPrn, nCopies, nFromPage, nToPage, 1, 1) THEN EXIT FUNCTION
   IF hdcPrn = %NULL THEN EXIT FUNCTION

   cxPage = GetDeviceCaps(hdcPrn, %HORZRES)
   cyPage = GetDeviceCaps(hdcPrn, %VERTRES)

   szMessage = "EMF8: Printing"
   dinfo.cbSize = SIZEOF(DOCINFO)
   dinfo.lpszDocName = VARPTR(szMessage)

   IF StartDoc(hdcPrn, dinfo) > 0 THEN
      IF StartPage(hdcPrn) > 0 THEN
         PaintRoutine hwnd, hdcPrn, cxPage, cyPage
         IF EndPage(hdcPrn) > 0 THEN
            bSuccess = %TRUE
            EndDoc hdcPrn
         END IF
      END IF
   END IF

   DeleteDC hdcPrn

   FUNCTION = bSuccess

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  bSuccess AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  ps AS PAINTSTRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE
         CreateRoutine hwnd
         EXIT FUNCTION

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

      CASE %WM_COMMAND

         SELECT CASE LO(WORD, wParam)

            CASE %IDM_PRINT
               SetCursor LoadCursor(%NULL, BYVAL %IDC_WAIT)
               ShowCursor %TRUE
               bSuccess = PrintRoutine(hwnd)
               ShowCursor %FALSE
               SetCursor LoadCursor (%NULL, BYVAL %IDC_ARROW)
               IF ISFALSE bSuccess THEN
                  MessageBox hwnd, "Error encountered during printing", "EMF8", %MB_OK OR %MB_TASKMODAL
               END IF

            CASE %IDM_EXIT
               SendMessage hwnd, %WM_CLOSE, 0, 0

            CASE %IDM_ABOUT
               MessageBox hwnd, "Enhanced Metafile Demo Program" & $LF & _
                          "(c) Charles Petzold, 1998", "EMF8", %MB_OK OR %MB_ICONINFORMATION OR %MB_TASKMODAL

         END SELECT
         EXIT FUNCTION

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

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         PaintRoutine hwnd, hdc, cxClient, cyClient
         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 EMF9.C -- Enhanced Metafile Demo #9 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

The ENHMETAHEADER structure contains two rectangle structures that describe the size of the image. The first, which EMF8 uses, is the rclBounds field. This gives the size of the image in pixels. The second is the rclFrame field, which gives the size of the image in units of 0.01 millimeters. The relationship between these two fields is governed by the reference device context originally used when creating the metafile, in this case the video display. (The metafile header also contains two fields named szlDevice and szlMillimeters, which are SIZEL structures that indicate the size of the reference device in pixels and millimeters, the same information available from GetDeviceCaps.)

The information about the millimeter dimensions of the image is put to use by EMF9.

Code: [Select]

' ========================================================================================
' EMF9.BAS
' This program is a translation/adaptation of EMF9.C -- Enhanced Metafile Demo #9
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' The ENHMETAHEADER structure contains two rectangle structures that describe the size of
' the image. The first, which EMF8 uses, is the rclBounds field. This gives the size of
' the image in pixels. The second is the rclFrame field, which gives the size of the image
' in units of 0.01 millimeters. The relationship between these two fields is governed by
' the reference device context originally used when creating the metafile, in this case
' the video display. (The metafile header also contains two fields named szlDevice and
' szlMillimeters, which are SIZEL structures that indicate the size of the reference
' device in pixels and millimeters, the same information available from GetDeviceCaps.)
' The information about the millimeter dimensions of the image is put to use by EMF9.
' ========================================================================================

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

%IDM_PRINT = 40001
%IDM_EXIT  = 40002
%IDM_ABOUT = 40003

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

   LOCAL hwnd      AS DWORD
   LOCAL hAccel    AS DWORD
   LOCAL szAppName AS ASCIIZ * 256
   LOCAL szCaption AS ASCIIZ * 256
   LOCAL wcex      AS WNDCLASSEX

   szAppName          = "EMF9"
   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 = "EMF9: Enhanced Metafile Demo #9"
   hwnd = CreateWindowEx(%WS_EX_CONTROLPARENT, _   ' extended style
                         szAppName, _              ' window class name
                         szCaption, _              ' window caption
                         %WS_OVERLAPPEDWINDOW, _   ' window style
                         %CW_USEDEFAULT, _         ' initial x position
                         %CW_USEDEFAULT, _         ' initial y position
                         %CW_USEDEFAULT, _         ' initial x size
                         %CW_USEDEFAULT, _         ' initial y size
                         %NULL, _                  ' parent window handle
                         %NULL, _                  ' window menu handle
                         hInstance, _              ' program instance handle
                         BYVAL %NULL)              ' creation parameters

   ShowWindow hwnd, iCmdShow
   UpdateWindow hwnd

   hAccel = LoadAccelerators(hInstance, szAppName)

   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      TranslateMessage uMsg
      DispatchMessage uMsg
   WEND

   FUNCTION = uMsg.wParam

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

' ========================================================================================
' Draws a ruler
' ========================================================================================
SUB DrawRuler (BYVAL hdc AS DWORD, BYVAL cx AS LONG, BYVAL cy AS LONG)

   LOCAL i AS LONG
   LOCAL iHeight AS LONG
   LOCAL lf AS LOGFONT
   LOCAL ch AS ASCIIZ * 2

   ' Black pen with 1-point width
   SelectObject hdc, CreatePen (%PS_SOLID, cx / 72 / 6, 0)

   ' Rectangle surrounding entire pen (with adjustment)
   Rectangle (hdc, 0, 0, cx + 1, cy + 1)

   ' Tick marks
   FOR i = 1 TO 95
      IF i MOD 16 = 0 THEN
         iHeight = cy /  2    ' inches
      ELSEIF i MOD 8 = 0 THEN
         iHeight = cy /  3    ' half inches
      ELSEIF i MOD 4 = 0 THEN
         iHeight = cy /  5    ' quarter inches
      ELSEIF i MOD 2 = 0 THEN
         iHeight = cy /  8    ' eighths
      ELSE
         iHeight = cy / 12    ' sixteenths
      END IF
      MoveToEx hdc, i * cx / 96, cy, BYVAL %NULL
      LineTo   hdc, i * cx / 96, cy - iHeight
   NEXT

   ' Create logical font
   lf.lfHeight = cy / 2
   lf.lfFaceName = "Times New Roman"
   SelectObject hdc, CreateFontIndirect(lf)
   SetTextAlign hdc, %TA_BOTTOM OR %TA_CENTER
   SetBkMode    hdc, %TRANSPARENT

   ' Display numbers
   FOR i = 1 TO 5
      ch = FORMAT$(i)
      TextOut hdc, i * cx / 6, cy / 2, ch, 1
   NEXT

   ' Clean up
   DeleteObject SelectObject(hdc, GetStockObject(%SYSTEM_FONT))
   DeleteObject SelectObject(hdc, GetStockObject(%BLACK_PEN))

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

' ========================================================================================
' Create enhanced metafile
' ========================================================================================
SUB CreateRoutine (BYVAL hwnd AS DWORD)

   LOCAL hdcEMF AS DWORD
   LOCAL hemf   AS DWORD
   LOCAL cxMms  AS LONG
   LOCAL cyMms  AS LONG
   LOCAL cxPix  AS LONG
   LOCAL cyPix  AS LONG
   LOCAL xDpi   AS LONG
   LOCAL yDpi   AS LONG

   hdcEMF = CreateEnhMetaFile(%NULL, "emf9.emf", BYVAL %NULL, "EMF9" & $NUL & "EMF Demo #9" & $NUL)
   IF hdcEMF = %NULL THEN EXIT SUB

   cxMms = GetDeviceCaps(hdcEMF, %HORZSIZE)
   cyMms = GetDeviceCaps(hdcEMF, %VERTSIZE)
   cxPix = GetDeviceCaps(hdcEMF, %HORZRES)
   cyPix = GetDeviceCaps(hdcEMF, %VERTRES)

   xDpi = cxPix * 254 / cxMms / 10
   yDpi = cyPix * 254 / cyMms / 10

   DrawRuler (hdcEMF, 6 * xDpi, yDpi)

   hemf = CloseEnhMetaFile(hdcEMF)

   DeleteEnhMetaFile hemf

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

' ========================================================================================
' Displays the enhanced metafile
' ========================================================================================
SUB PaintRoutine (BYVAL hwnd AS DWORD, BYVAL hdc AS DWORD, BYVAL cxArea AS LONG, BYVAL cyArea AS LONG)

   LOCAL emh     AS ENHMETAHEADER
   LOCAL hemf    AS DWORD
   LOCAL cxMms   AS LONG
   LOCAL cyMms   AS LONG
   LOCAL cxPix   AS LONG
   LOCAL cyPix   AS LONG
   LOCAL cxImage AS LONG
   LOCAL cyImage AS LONG
   LOCAL rc      AS RECT

   cxMms = GetDeviceCaps(hdc, %HORZSIZE)
   cyMms = GetDeviceCaps(hdc, %VERTSIZE)
   cxPix = GetDeviceCaps(hdc, %HORZRES)
   cyPix = GetDeviceCaps(hdc, %VERTRES)


   hemf = GetEnhMetaFile("emf9.emf")

   GetEnhMetaFileHeader hemf, SIZEOF(emh), emh

   cxImage = emh.rclFrame.nRight - emh.rclFrame.nLeft
   cyImage = emh.rclFrame.nBottom - emh.rclFrame.nTop

   cxImage = cxImage * cxPix / cxMms / 100
   cyImage = cyImage * cyPix / cyMms / 100

   rc.nLeft   = (cxArea - cxImage) / 2
   rc.nRight  = (cxArea + cxImage) / 2
   rc.nTop    = (cyArea - cyImage) / 2
   rc.nBottom = (cyArea + cyImage) / 2

   PlayEnhMetaFile hdc, hemf, rc

   DeleteEnhMetaFile hemf

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

' ========================================================================================
' Prints the enhanced metafile
' ========================================================================================
FUNCTION PrintRoutine (BYVAL hwnd AS DWORD) AS LONG

   STATIC szMessage AS ASCIIZ * 32
   LOCAL  bSuccess AS LONG
   LOCAL  hdcPrn AS DWORD
   LOCAL  cxPage AS LONG
   LOCAL  cyPage AS LONG

   STATIC dinfo AS DOCINFO
   LOCAL  szDocName AS ASCIIZ * 256
   LOCAL  Flags AS DWORD
   LOCAL  nCopies AS WORD
   LOCAL  nFromPage AS WORD
   LOCAL  nToPage AS WORD

   Flags = %PD_RETURNDC OR %PD_NOPAGENUMS OR %PD_NOSELECTION
   nCopies = 1 : nFromPage = 1 : nToPage = 1
   IF ISFALSE PrinterDialog(hwnd, Flags, hdcPrn, nCopies, nFromPage, nToPage, 1, 1) THEN EXIT FUNCTION
   IF hdcPrn = %NULL THEN EXIT FUNCTION

   cxPage = GetDeviceCaps(hdcPrn, %HORZRES)
   cyPage = GetDeviceCaps(hdcPrn, %VERTRES)

   szMessage = "EMF9: Printing"
   dinfo.cbSize = SIZEOF(DOCINFO)
   dinfo.lpszDocName = VARPTR(szMessage)

   IF StartDoc(hdcPrn, dinfo) > 0 THEN
      IF StartPage(hdcPrn) > 0 THEN
         PaintRoutine hwnd, hdcPrn, cxPage, cyPage
         IF EndPage(hdcPrn) > 0 THEN
            bSuccess = %TRUE
            EndDoc hdcPrn
         END IF
      END IF
   END IF

   DeleteDC hdcPrn

   FUNCTION = bSuccess

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  bSuccess AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  ps AS PAINTSTRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE
         CreateRoutine hwnd
         EXIT FUNCTION

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

      CASE %WM_COMMAND

         SELECT CASE LOWRD(wParam)

            CASE %IDM_PRINT
               SetCursor LoadCursor(%NULL, BYVAL %IDC_WAIT)
               ShowCursor %TRUE
               bSuccess = PrintRoutine(hwnd)
               ShowCursor %FALSE
               SetCursor LoadCursor (%NULL, BYVAL %IDC_ARROW)
               IF ISFALSE bSuccess THEN
                  MessageBox hwnd, "Error encountered during printing", "EMF9", %MB_OK OR %MB_TASKMODAL
               END IF

            CASE %IDM_EXIT
               SendMessage hwnd, %WM_CLOSE, 0, 0

            CASE %IDM_ABOUT
               MessageBox hwnd, "Enhanced Metafile Demo Program" & $LF & _
                          "(c) Charles Petzold, 1998", "EMF9", %MB_OK OR %MB_ICONINFORMATION OR %MB_TASKMODAL

         END SELECT
         EXIT FUNCTION

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

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         PaintRoutine hwnd, hdc, cxClient, cyClient
         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 EMF10.C -- Enhanced Metafile Demo #10 © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming Windows, 5th Edition.

The ENHMETAHEADER structure contains two rectangle structures that describe the size of the image. The first, which EMF8 uses, is the rclBounds field. This gives the size of the image in pixels. The second is the rclFrame field, which gives the size of the image in units of 0.01 millimeters. The relationship between these two fields is governed by the reference device context originally used when creating the metafile, in this case the video display. (The metafile header also contains two fields named szlDevice and szlMillimeters, which are SIZEL structures that indicate the size of the reference device in pixels and millimeters, the same information available from GetDeviceCaps.)

The information about the millimeter dimensions of the image is put to use by EMF10.

Code: [Select]

' ========================================================================================
' EMF10.BAS
' This program is a translation/adaptation of EMF10.C -- Enhanced Metafile Demo #10
' © Charles Petzold, 1998, described and analysed in Chapter 18 of the book Programming
' Windows, 5th Edition.
' The ENHMETAHEADER structure contains two rectangle structures that describe the size of
' the image. The first, which EMF8 uses, is the rclBounds field. This gives the size of
' the image in pixels. The second is the rclFrame field, which gives the size of the image
' in units of 0.01 millimeters. The relationship between these two fields is governed by
' the reference device context originally used when creating the metafile, in this case
' the video display. (The metafile header also contains two fields named szlDevice and
' szlMillimeters, which are SIZEL structures that indicate the size of the reference
' device in pixels and millimeters, the same information available from GetDeviceCaps.)
' The information about the millimeter dimensions of the image is put to use by EMF10.
' ========================================================================================

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

%IDM_PRINT = 40001
%IDM_EXIT  = 40002
%IDM_ABOUT = 40003

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

   LOCAL hwnd      AS DWORD
   LOCAL hAccel    AS DWORD
   LOCAL szAppName AS ASCIIZ * 256
   LOCAL szCaption AS ASCIIZ * 256
   LOCAL wcex      AS WNDCLASSEX

   szAppName          = "EMF10"
   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 = "EMF10: Enhanced Metafile Demo #10"
   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

   hAccel = LoadAccelerators(hInstance, szAppName)

   ShowWindow hwnd, iCmdShow
   UpdateWindow hwnd

   LOCAL uMsg AS tagMsg
   WHILE GetMessage(uMsg, %NULL, 0, 0)
      TranslateMessage uMsg
      DispatchMessage uMsg
   WEND

   FUNCTION = uMsg.wParam

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

' ========================================================================================
' Draws a ruler
' ========================================================================================
SUB DrawRuler (BYVAL hdc AS DWORD, BYVAL cx AS LONG, BYVAL cy AS LONG)

   LOCAL i AS LONG
   LOCAL iHeight AS LONG
   LOCAL lf AS LOGFONT
   LOCAL ch AS ASCIIZ * 2

   ' Black pen with 1-point width
   SelectObject hdc, CreatePen (%PS_SOLID, cx / 72 / 6, 0)

   ' Rectangle surrounding entire pen (with adjustment)
   Rectangle (hdc, 0, 0, cx + 1, cy + 1)

   ' Tick marks
   FOR i = 1 TO 95
      IF i MOD 16 = 0 THEN
         iHeight = cy /  2    ' inches
      ELSEIF i MOD 8 = 0 THEN
         iHeight = cy /  3    ' half inches
      ELSEIF i MOD 4 = 0 THEN
         iHeight = cy /  5    ' quarter inches
      ELSEIF i MOD 2 = 0 THEN
         iHeight = cy /  8    ' eighths
      ELSE
         iHeight = cy / 12    ' sixteenths
      END IF
      MoveToEx hdc, i * cx / 96, cy, BYVAL %NULL
      LineTo   hdc, i * cx / 96, cy - iHeight
   NEXT

   ' Create logical font
   lf.lfHeight = cy / 2
   lf.lfFaceName = "Times New Roman"
   SelectObject hdc, CreateFontIndirect(lf)
   SetTextAlign hdc, %TA_BOTTOM OR %TA_CENTER
   SetBkMode    hdc, %TRANSPARENT

   ' Display numbers
   FOR i = 1 TO 5
      ch = FORMAT$(i)
      TextOut hdc, i * cx / 6, cy / 2, ch, 1
   NEXT

   ' Clean up
   DeleteObject SelectObject(hdc, GetStockObject(%SYSTEM_FONT))
   DeleteObject SelectObject(hdc, GetStockObject(%BLACK_PEN))

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

' ========================================================================================
' Create enhanced metafile
' ========================================================================================
SUB CreateRoutine (BYVAL hwnd AS DWORD)

   LOCAL hdcEMF AS DWORD
   LOCAL hemf   AS DWORD
   LOCAL cxMms  AS LONG
   LOCAL cyMms  AS LONG
   LOCAL cxPix  AS LONG
   LOCAL cyPix  AS LONG
   LOCAL xDpi   AS LONG
   LOCAL yDpi   AS LONG

   hdcEMF = CreateEnhMetaFile(%NULL, "EMF10.emf", BYVAL %NULL, "EMF10" & $NUL & "EMF Demo #10" & $NUL)
   IF hdcEMF = %NULL THEN EXIT SUB

   cxMms = GetDeviceCaps(hdcEMF, %HORZSIZE)
   cyMms = GetDeviceCaps(hdcEMF, %VERTSIZE)
   cxPix = GetDeviceCaps(hdcEMF, %HORZRES)
   cyPix = GetDeviceCaps(hdcEMF, %VERTRES)

   xDpi = cxPix * 254 / cxMms / 10
   yDpi = cyPix * 254 / cyMms / 10

   DrawRuler (hdcEMF, 6 * xDpi, yDpi)

   hemf = CloseEnhMetaFile(hdcEMF)

   DeleteEnhMetaFile hemf

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

' ========================================================================================
' Displays the enhanced metafile
' ========================================================================================
SUB PaintRoutine (BYVAL hwnd AS DWORD, BYVAL hdc AS DWORD, BYVAL cxArea AS LONG, BYVAL cyArea AS LONG)

   LOCAL emh     AS ENHMETAHEADER
   LOCAL fScale  AS SINGLE
   LOCAL hemf    AS DWORD
   LOCAL cxMms   AS LONG
   LOCAL cyMms   AS LONG
   LOCAL cxPix   AS LONG
   LOCAL cyPix   AS LONG
   LOCAL cxImage AS LONG
   LOCAL cyImage AS LONG
   LOCAL rc      AS RECT

   cxMms = GetDeviceCaps(hdc, %HORZSIZE)
   cyMms = GetDeviceCaps(hdc, %VERTSIZE)
   cxPix = GetDeviceCaps(hdc, %HORZRES)
   cyPix = GetDeviceCaps(hdc, %VERTRES)


   hemf = GetEnhMetaFile("EMF10.emf")

   GetEnhMetaFileHeader hemf, SIZEOF(emh), emh

   cxImage = emh.rclFrame.nRight - emh.rclFrame.nLeft
   cyImage = emh.rclFrame.nBottom - emh.rclFrame.nTop

   fScale = MIN(cxArea / cxImage, cyArea / cyImage)

   cxImage = fScale * cxImage
   cyImage = fScale * cyImage

   rc.nLeft   = (cxArea - cxImage) / 2
   rc.nRight  = (cxArea + cxImage) / 2
   rc.nTop    = (cyArea - cyImage) / 2
   rc.nBottom = (cyArea + cyImage) / 2

   PlayEnhMetaFile hdc, hemf, rc

   DeleteEnhMetaFile hemf

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

' ========================================================================================
' Prints the enhanced metafile
' ========================================================================================
FUNCTION PrintRoutine (BYVAL hwnd AS DWORD) AS LONG

   STATIC szMessage AS ASCIIZ * 32
   LOCAL  bSuccess AS LONG
   LOCAL  hdcPrn AS DWORD
   LOCAL  cxPage AS LONG
   LOCAL  cyPage AS LONG

   STATIC dinfo AS DOCINFO
   LOCAL  szDocName AS ASCIIZ * 256
   LOCAL  Flags AS DWORD
   LOCAL  nCopies AS WORD
   LOCAL  nFromPage AS WORD
   LOCAL  nToPage AS WORD

   Flags = %PD_RETURNDC OR %PD_NOPAGENUMS OR %PD_NOSELECTION
   nCopies = 1 : nFromPage = 1 : nToPage = 1
   IF ISFALSE PrinterDialog(hwnd, Flags, hdcPrn, nCopies, nFromPage, nToPage, 1, 1) THEN EXIT FUNCTION
   IF hdcPrn = %NULL THEN EXIT FUNCTION

   cxPage = GetDeviceCaps(hdcPrn, %HORZRES)
   cyPage = GetDeviceCaps(hdcPrn, %VERTRES)

   szMessage = "EMF10: Printing"
   dinfo.cbSize = SIZEOF(DOCINFO)
   dinfo.lpszDocName = VARPTR(szMessage)

   IF StartDoc(hdcPrn, dinfo) > 0 THEN
      IF StartPage(hdcPrn) > 0 THEN
         PaintRoutine hwnd, hdcPrn, cxPage, cyPage
         IF EndPage(hdcPrn) > 0 THEN
            bSuccess = %TRUE
            EndDoc hdcPrn
         END IF
      END IF
   END IF

   DeleteDC hdcPrn

   FUNCTION = bSuccess

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  bSuccess AS LONG
   LOCAL  hdc AS DWORD
   LOCAL  ps AS PAINTSTRUCT

   SELECT CASE uMsg

      CASE %WM_CREATE
         CreateRoutine hwnd
         EXIT FUNCTION

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

      CASE %WM_COMMAND

         SELECT CASE LO(WORD, wParam)

            CASE %IDM_PRINT
               SetCursor LoadCursor(%NULL, BYVAL %IDC_WAIT)
               ShowCursor %TRUE
               bSuccess = PrintRoutine(hwnd)
               ShowCursor %FALSE
               SetCursor LoadCursor (%NULL, BYVAL %IDC_ARROW)
               IF ISFALSE bSuccess THEN
                  MessageBox hwnd, "Error encountered during printing", "EMF10", %MB_OK OR %MB_TASKMODAL
               END IF

            CASE %IDM_EXIT
               SendMessage hwnd, %WM_CLOSE, 0, 0

            CASE %IDM_ABOUT
               MessageBox hwnd, "Enhanced Metafile Demo Program" & $LF & _
                          "(c) Charles Petzold, 1998", "EMF10", %MB_OK OR %MB_ICONINFORMATION OR %MB_TASKMODAL

         END SELECT
         EXIT FUNCTION

      CASE %WM_SIZE
         cxClient = LOWRD(lParam)
         cyClient = HIWRD(lParam)
         EXIT FUNCTION

      CASE %WM_PAINT
         hdc = BeginPaint(hwnd, ps)
         PaintRoutine hwnd, hdc, cxClient, cyClient
         EndPaint(hwnd, ps)
         EXIT FUNCTION

     CASE %WM_DESTROY
         PostQuitMessage 0
         EXIT FUNCTION

   END SELECT

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

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