Last updated: 17. 1.1998, 20:26
<* +M2EXTENSIONS *>
MODULE DevCaps1;
(*---------------------------------------------------------
DEVCAPS1.C --- Device Capabilities Display Program No. 1
(c) Charles Petzold, 1996
DevCaps1.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
---------------------------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
CONST szAppName = "DevCaps1";
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
cxChar: INTEGER;
cyChar: INTEGER;
cxCaps: INTEGER;
CONST NUMLINES = 20;
TYPE
Dev = RECORD
iIndex : INTEGER;
szLabel : ARRAY [0..20] OF CHAR;
szDesc : ARRAY [0..50] OF CHAR;
END;
DevCaps= ARRAY[0..NUMLINES-1] OF Dev;
CONST
devcaps = DevCaps
{
{Windows.HORZSIZE, "HORZSIZE", "Width in millimeters:"},
{Windows.VERTSIZE, "VERTSIZE", "Height in millimeters:"},
{Windows.HORZRES, "HORZRES", "Width in pixels:"},
{Windows.VERTRES, "VERTRES", "Height in raster lines:"},
{Windows.BITSPIXEL, "BITSPIXEL", "Color bits per pixel:"},
{Windows.PLANES, "PLANES", "Number of color planes:"},
{Windows.NUMBRUSHES, "NUMBRUSHES", "Number of device brushes:"},
{Windows.NUMPENS, "NUMPENS", "Number of device pens:"},
{Windows.NUMMARKERS, "NUMMARKERS", "Number of device markers:"},
{Windows.NUMFONTS, "NUMFONTS", "Number of device fonts:"},
{Windows.NUMCOLORS, "NUMCOLORS", "Number of device colors:"},
{Windows.PDEVICESIZE, "PDEVICESIZE", "Size of device structure:"},
{Windows.ASPECTX, "ASPECTX", "Relative width of pixel:"},
{Windows.ASPECTY, "ASPECTY", "Relative height of pixel:"},
{Windows.ASPECTXY, "ASPECTXY", "Relative diagonal of pixel:"},
{Windows.LOGPIXELSX, "LOGPIXELSX", "Horizontal dots per inch:"},
{Windows.LOGPIXELSY, "LOGPIXELSY", "Vertical dots per inch:"},
{Windows.SIZEPALETTE, "SIZEPALETTE", "Number of palette entries:"},
{Windows.NUMRESERVED, "NUMRESERVED", "Reserved palette entries:"},
{Windows.COLORRES, "COLORRES", "Actual color resolution:"}
};
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc(hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
VAR
szBuffer : ARRAY[0..9] OF CHAR;
i : INTEGER;
hdc : Windows.HDC;
ps : Windows.PAINTSTRUCT;
tm : Windows.TEXTMETRIC;
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE:
hdc := Windows.GetDC (hwnd);
Windows.GetTextMetrics (hdc, tm);
cxChar := tm.tmAveCharWidth;
IF(tm.tmPitchAndFamily=SYSTEM.CAST(Windows.PITCH_AND_FAMILY_SET,1)) THEN
cxCaps := 3*cxChar/2;
ELSE
cxCaps := 2*cxChar/2;
END;
cyChar := tm.tmHeight + tm.tmExternalLeading;
Windows.ReleaseDC (hwnd, hdc);
RETURN 0;
| Windows.WM_PAINT:
hdc := Windows.BeginPaint (hwnd, ps);
FOR i := 0 TO NUMLINES-1 DO
Windows.TextOut (hdc, cxChar, cyChar * (1 + i),
devcaps[i].szLabel,
LENGTH(devcaps[i].szLabel));
Windows.TextOut (hdc, cxChar + 22 * cxCaps, cyChar * (1 + i),
devcaps[i].szDesc,
LENGTH(devcaps[i].szDesc));
Windows.SetTextAlign (hdc, Windows.TA_RIGHT + Windows.TA_TOP);
Windows.TextOut (hdc, cxChar + 22 * cxCaps + 40 * cxChar,
cyChar * (1 + i), szBuffer,
Windows.wsprintf (szBuffer, "%5d",
Windows.GetDeviceCaps (hdc, devcaps[i].iIndex)));
Windows.SetTextAlign (hdc, Windows.TA_LEFT + Windows.TA_TOP);
END;
Windows.EndPaint (hwnd, ps);
RETURN 0;
| Windows.WM_DESTROY:
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
BEGIN
wc.cbSize := SIZE(Windows.WNDCLASSEX);
wc.style := Windows.CS_HREDRAW + Windows.CS_VREDRAW;
wc.lpfnWndProc := WndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := Windows.MyInstance();
wc.hIcon := Windows.LoadIcon (NIL, Windows.IDI_APPLICATION);
wc.hCursor := Windows.LoadCursor (NIL, Windows.IDC_ARROW);
wc.hbrBackground := SYSTEM.CAST(Windows.HBRUSH, Windows.GetStockObject (Windows.WHITE_BRUSH));
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := Windows.LoadIcon (NIL, Windows.IDI_APPLICATION);
RETURN Windows.RegisterClassEx (wc)#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := Windows.CreateWindow
(szAppName, (* window class name *)
"Device Capabilities, Translation to XDS Modula-2",
(* window caption *)
Windows.WS_OVERLAPPEDWINDOW, (* window style *)
Windows.CW_USEDEFAULT, (* initial x position *)
Windows.CW_USEDEFAULT, (* initial y position *)
Windows.CW_USEDEFAULT, (* initial x size *)
Windows.CW_USEDEFAULT, (* initial y size *)
NIL, (* parent window handle *)
NIL, (* window menu handle *)
Windows.MyInstance(), (* program instance handle *)
NIL); (* creation parameters *)
IF hwnd = NIL THEN
RETURN FALSE;
END;
Windows.ShowWindow (hwnd, Windows.SW_SHOWDEFAULT);
Windows.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
(*++++*****************************************************************)
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END DevCaps1.