Last updated: 18. 1.1998, 10:54
<* +M2EXTENSIONS *>
MODULE SysMets;
(*----------------------------------------------------
SYSMETS.C --- System Metrics Display Program, Final
(c) Charles Petzold, 1996
SysMets.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
----------------------------------------------------*)
IMPORT SYSTEM;
IMPORT Windows;
IMPORT SystemDef;
IMPORT Strings;
CONST
szAppName = "SysMets";
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
cxChar, cxCaps, cyChar, cxClient, cyClient, iMaxWidth,
iVscrollPos, iVscrollMax, iHscrollPos, iHscrollMax : INTEGER;
(*++++*****************************************************************)
PROCEDURE MaxInt (a,b : INTEGER) : INTEGER;
(**********************************************************************)
BEGIN
IF(a>b) THEN
RETURN a;
ELSE
RETURN b;
END;
END MaxInt;
(*++++*****************************************************************)
PROCEDURE MinInt (a,b : INTEGER) : INTEGER;
(**********************************************************************)
BEGIN
IF(a>b) THEN
RETURN b;
ELSE
RETURN a;
END;
END MinInt;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc (hwnd : Windows.HWND;
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
(**********************************************************************)
VAR
szBuffer : ARRAY[0..10] OF CHAR;
hdc : Windows.HDC;
i, x, y, iPaintBeg, iPaintEnd, iVscrollInc, iHscrollInc : INTEGER;
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);
iMaxWidth := 50 * cxChar + 30 * cxCaps;
RETURN 0;
| Windows.WM_SIZE :
cxClient := Windows.LOWORD (lParam);
cyClient := Windows.HIWORD (lParam);
iVscrollMax := MaxInt (0, SystemDef.NUMLINES + 2 - cyClient DIV cyChar);
iVscrollPos := MinInt (iVscrollPos, iVscrollMax);
Windows.SetScrollRange (hwnd, Windows.SB_VERT, 0, iVscrollMax, FALSE);
Windows.SetScrollPos (hwnd, Windows.SB_VERT, iVscrollPos, TRUE);
iHscrollMax := MaxInt (0, 2 + (iMaxWidth - cxClient) DIV cxChar);
iHscrollPos := MinInt (iHscrollPos, iHscrollMax);
Windows.SetScrollRange (hwnd, Windows.SB_HORZ, 0, iHscrollMax, FALSE);
Windows.SetScrollPos (hwnd, Windows.SB_HORZ, iHscrollPos, TRUE);
RETURN 0;
| Windows.WM_VSCROLL :
CASE (Windows.LOWORD (wParam)) OF
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_TOP) :
iVscrollInc := -iVscrollPos;
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_BOTTOM) :
iVscrollInc := iVscrollMax - iVscrollPos;
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_LINEUP) :
iVscrollInc := -1;
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_LINEDOWN) :
iVscrollInc := 1;
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_PAGEUP) :
iVscrollInc := MinInt (-1, -cyClient DIV cyChar);
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_PAGEDOWN) :
iVscrollInc := MaxInt (1, cyClient DIV cyChar);
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_THUMBTRACK) :
iVscrollInc := VAL(INTEGER,Windows.HIWORD (wParam)) - iVscrollPos;
ELSE
iVscrollInc := 0;
END;
iVscrollInc := MaxInt (-iVscrollPos,
MinInt (iVscrollInc, iVscrollMax - iVscrollPos));
IF (iVscrollInc # 0) THEN
iVscrollPos := iVscrollPos+iVscrollInc;
Windows.ScrollWindow (hwnd, 0, -cyChar * iVscrollInc, NIL, NIL);
Windows.SetScrollPos (hwnd, Windows.SB_VERT, iVscrollPos, TRUE);
Windows.UpdateWindow (hwnd);
END;
RETURN 0;
| Windows.WM_HSCROLL :
CASE (Windows.LOWORD (wParam)) OF
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_LINEUP) :
iHscrollInc := -1;
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_LINEDOWN) :
iHscrollInc := 1;
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_PAGEUP) :
iHscrollInc := -8;
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_PAGEDOWN) :
iHscrollInc := 8;
| SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_THUMBPOSITION) :
iHscrollInc := VAL(INTEGER,Windows.HIWORD (wParam)) - iHscrollPos;
ELSE
iHscrollInc := 0;
END;
iHscrollInc := MaxInt (-iHscrollPos,
MinInt (iHscrollInc, iHscrollMax - iHscrollPos));
IF (iHscrollInc # 0) THEN
iHscrollPos := iHscrollInc+ iHscrollInc;
Windows.ScrollWindow (hwnd, -cxChar * iHscrollInc, 0, NIL, NIL);
Windows.SetScrollPos (hwnd, Windows.SB_HORZ, iHscrollPos, TRUE);
END;
RETURN 0;
| Windows.WM_KEYDOWN :
CASE (wParam) OF
| Windows.VK_HOME :
Windows.SendMessage (hwnd, Windows.WM_VSCROLL, SYSTEM.CAST(CARDINAL,Windows.SB_TOP), 0h);
| Windows.VK_END :
Windows.SendMessage (hwnd, Windows.WM_VSCROLL, SYSTEM.CAST(CARDINAL,Windows.SB_BOTTOM), 0h);
| Windows.VK_PRIOR :
Windows.SendMessage (hwnd, Windows.WM_VSCROLL, SYSTEM.CAST(CARDINAL,Windows.SB_PAGEUP), 0h);
| Windows.VK_NEXT :
Windows.SendMessage (hwnd, Windows.WM_VSCROLL, SYSTEM.CAST(CARDINAL,Windows.SB_PAGEDOWN), 0h);
| Windows.VK_UP :
Windows.SendMessage (hwnd, Windows.WM_VSCROLL, SYSTEM.CAST(CARDINAL,Windows.SB_LINEUP), 0h);
| Windows.VK_DOWN :
Windows.SendMessage (hwnd, Windows.WM_VSCROLL, SYSTEM.CAST(CARDINAL,Windows.SB_LINEDOWN), 0h);
| Windows.VK_LEFT :
Windows.SendMessage (hwnd, Windows.WM_HSCROLL, SYSTEM.CAST(CARDINAL,Windows.SB_PAGEUP), 0h);
| Windows.VK_RIGHT :
Windows.SendMessage (hwnd, Windows.WM_HSCROLL, SYSTEM.CAST(CARDINAL,Windows.SB_PAGEDOWN), 0h);
ELSE
RETURN 0;
END;
| Windows.WM_PAINT :
hdc := Windows.BeginPaint (hwnd, ps);
iPaintBeg := MaxInt (0, iVscrollPos + ps.rcPaint.top DIV cyChar - 1);
iPaintEnd := MinInt (SystemDef.NUMLINES,
iVscrollPos + ps.rcPaint.bottom DIV cyChar);
FOR i := iPaintBeg TO iPaintEnd-1 DO
x := cxChar * (1 - iHscrollPos);
y := cyChar * (1 - iVscrollPos + i);
Windows.TextOut (hdc, x, y,
SystemDef.sysmetrics[i].szLabel,
LENGTH (SystemDef.sysmetrics[i].szLabel));
Windows.TextOut (hdc, x + 30 * cxCaps, y,
SystemDef.sysmetrics[i].szDesc,
LENGTH (SystemDef.sysmetrics[i].szDesc));
Windows.SetTextAlign (hdc, Windows.TA_RIGHT + Windows.TA_TOP);
Windows.TextOut (hdc, x + 30 * cxCaps + 50 * cxChar, y,
szBuffer,
Windows.wsprintf (szBuffer, "%5d",
Windows.GetSystemMetrics (SystemDef.sysmetrics[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;
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
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 *)
"Get System Metrics (final): 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 SysMets.