SysMets3.mod: Translation to XDS Modula-2

Last updated: 17. 1.1998, 19: 1

<* +M2EXTENSIONS *>
(*----------------------------------------------------
   SYSMETS3.C      --- System Metrics Display Program No. 3
                   (c) Charles Petzold, 1996
   SysMets3.mod    --- Translation to XDS Modula-2
                   (c) Peter Stadler,   1997
  ----------------------------------------------------*)

MODULE SysMets3;
IMPORT SYSTEM;

IMPORT Windows;

IMPORT SysMets;
IMPORT Strings;


CONST
  szAppName = "SysMets3";
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 := 40 * cxChar + 22 * cxCaps;
      RETURN 0;

  | Windows.WM_SIZE :
       cxClient := Windows.LOWORD (lParam);
       cyClient := Windows.HIWORD (lParam);

       iVscrollMax := MaxInt (0, SysMets.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 / cyChar);
      | SYSTEM.CAST(SYSTEM.CARD16,Windows.SB_PAGEDOWN) :
           iVscrollInc := MaxInt (1, cyClient / 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
           INC(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
            INC(iHscrollPos,iHscrollInc);
            Windows.ScrollWindow (hwnd, -cxChar * iHscrollInc, 0, NIL, NIL);
            Windows.SetScrollPos (hwnd, Windows.SB_HORZ, iHscrollPos, TRUE);
       END;
       RETURN 0;

  | Windows.WM_PAINT :
       hdc := Windows.BeginPaint (hwnd, ps);

       iPaintBeg := MaxInt (0, iVscrollPos + ps.rcPaint.top DIV cyChar - 1);
       iPaintEnd := MinInt (SysMets.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,
                     SysMets.sysmetrics[i].szLabel,
                     Strings.Length(SysMets.sysmetrics[i].szLabel));

            Windows.TextOut (hdc, x + 22 * cxCaps, y,
                     SysMets.sysmetrics[i].szDesc,
                     Strings.Length(SysMets.sysmetrics[i].szDesc));

            Windows.SetTextAlign (hdc, Windows.TA_RIGHT + Windows.TA_TOP);

            Windows.TextOut (hdc, x + 22 * cxCaps + 40 * cxChar, y,
                     szBuffer,
            Windows.wsprintf (szBuffer, "%5d",
                                         Windows.GetSystemMetrics (SysMets.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 No. 3: 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 SysMets3.