Colors1.mod: Translation to Stony Brook Modula-2

Last updated: 15. 1.1998, 21:42

<*/NOWARN:F*>
MODULE Colors1;
(*----------------------------------------
   COLORS1.C       --- Colors Using Scroll Bars
                   (c) Charles Petzold, 1996, Chapter 8
   Colors1.mod     --- Translation to Stony Brook Modula-2
                   (c) Peter Stadler,   1997
  ----------------------------------------*)

IMPORT WIN32;
IMPORT WINX;
IMPORT WINGDI;
IMPORT WINUSER;
IMPORT SYSTEM;
IMPORT WholeStr;


CONST
  szAppName    =  "Colors1";
TYPE
  ColorLabel   =  ARRAY[0..10] OF CHAR;
VAR
  fnOldScr     :  ARRAY[0..2] OF WINUSER.WNDPROC;
  hwndScrol    :  ARRAY[0..2] OF WIN32.HWND;
  hwndLabel    :  ARRAY[0..2] OF WIN32.HWND;
  hwndValue    :  ARRAY[0..2] OF WIN32.HWND;
  hwndRect     :  WIN32.HWND;
  color        :  ARRAY[0..2] OF INTEGER;
  iFocus       :  INTEGER;
  szColorLabel :  ARRAY[0..2] OF ColorLabel;
  hwnd         :  WIN32.HWND;
  msg          :  WINUSER.MSG;
  wc           :  WINUSER.WNDCLASSEX;
  crPrim       :  ARRAY[0..2] OF WIN32.COLORREF;
  hBrush       :  ARRAY[0..2] OF WIN32.HBRUSH;
  hBrushStatic :  WIN32.HBRUSH;
  cyChar       :  INTEGER;
  rcColor      :  WIN32.RECT;
  szBuffer     :  ARRAY[0..9] OF CHAR;
  cxClient     :  INTEGER;
  cyClient     :  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;

<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE WndProc (hwnd        : WIN32.HWND;
(**********************************************************************)
                   iMsg        : WIN32.UINT;
                   wParam      : WIN32.WPARAM;
                   lParam      : WIN32.LPARAM) : WIN32.LRESULT [EXPORT];
VAR
  i    :  INTEGER;
  currentObject : WIN32.HBRUSH;
  currentBrush : WIN32.HBRUSH;
BEGIN
  CASE (iMsg) OF
    | WINUSER.WM_CREATE :
         FOR i := 0 TO 3-1 DO
           hBrush[i] := WINGDI.CreateSolidBrush (crPrim[i]);
         END;
         hBrushStatic := WINGDI.CreateSolidBrush (WINUSER.GetSysColor (WINUSER.COLOR_BTNHIGHLIGHT));
         cyChar := WINUSER.HIWORD (WINUSER.GetDialogBaseUnits ());
         RETURN 0;

    | WINUSER.WM_SIZE :
         cxClient := WINUSER.LOWORD (lParam);
         cyClient := WINUSER.HIWORD (lParam);
         WINUSER.SetRect (rcColor, cxClient / 2, 0, cxClient, cyClient);
         WINUSER.MoveWindow (hwndRect, 0, 0, cxClient / 2, cyClient, TRUE);

         FOR i := 0 TO 3-1 DO
           WINUSER.MoveWindow (hwndScrol[i],
                (2 * i + 1) * cxClient / 14, 2 * cyChar,
                cxClient / 14, cyClient - 4 * cyChar, TRUE);

           WINUSER.MoveWindow (hwndLabel[i],
                (4 * i + 1) * cxClient / 28, cyChar / 2,
                cxClient / 7, cyChar, TRUE);

           WINUSER.MoveWindow (hwndValue[i],
                (4 * i + 1) * cxClient / 28, cyClient - 3 * cyChar / 2,
                cxClient / 7, cyChar, TRUE);
         END;
         WINUSER.SetFocus (hwnd);
         RETURN 0;

    | WINUSER.WM_SETFOCUS :
         WINUSER.SetFocus (hwndScrol[iFocus]);
         RETURN 0;

    | WINUSER.WM_VSCROLL :
         i := WINUSER.GetWindowLong (SYSTEM.CAST(WIN32.HWND, lParam), WINUSER.GWL_ID);

         CASE (WINUSER.LOWORD (wParam)) OF
           | WINUSER.SB_PAGEDOWN :
                color[i] := color[i] + 15;
                                         (* fall through  *)
           | WINUSER.SB_LINEDOWN :
                color[i] := MinInt (255, color[i] + 1);

           | WINUSER.SB_PAGEUP :
                color[i] := color[i] - 15;
                                        (*  fall through *)
           | WINUSER.SB_LINEUP :
                color[i] := MaxInt (0, color[i] - 1);

           | WINUSER.SB_TOP :
                color[i] := 0;

           | WINUSER.SB_BOTTOM :
                color[i] := 255;

           | WINUSER.SB_THUMBPOSITION :
           | WINUSER.SB_THUMBTRACK :
                color[i] := WINUSER.HIWORD (wParam);

         ELSE
         END;
         WINUSER.SetScrollPos  (hwndScrol[i], WINUSER.SB_CTL, color[i], TRUE);
         WholeStr.IntToStr(color[i],szBuffer);
         WINUSER.SetWindowText (hwndValue[i], szBuffer);

         currentBrush :=  WINGDI.CreateSolidBrush(WINGDI.RGB(color[0], color[1], color[2]));
         currentObject :=  SYSTEM.CAST(WIN32.HBRUSH,
            WINUSER.SetClassLong(hwnd,WINUSER.GCL_HBRBACKGROUND,
              SYSTEM.CAST(WIN32.WORD,currentBrush)));
         WINGDI.DeleteObject(SYSTEM.CAST(WIN32.HGDIOBJ,currentObject));

         WINUSER.InvalidateRect (hwnd, rcColor, TRUE);
         RETURN 0;

    | WINUSER.WM_CTLCOLORSCROLLBAR :
         i := WINUSER.GetWindowLong (SYSTEM.CAST(WIN32.HWND,lParam), WINUSER.GWL_ID);

         RETURN SYSTEM.CAST(WIN32.LRESULT,hBrush[i]);

    | WINUSER.WM_CTLCOLORSTATIC :
         i := WINUSER.GetWindowLong (SYSTEM.CAST(WIN32.HWND, lParam), WINUSER.GWL_ID);

         IF (i >= 3) AND (i <= 8) THEN   (* static text controls *)
           WINGDI.SetTextColor (SYSTEM.CAST(WIN32.HDC, wParam), crPrim[i REM 3]);
           WINGDI.SetBkColor (SYSTEM.CAST(WIN32.HDC, wParam), WINUSER.GetSysColor (WINUSER.COLOR_BTNHIGHLIGHT));
           RETURN SYSTEM.CAST(WIN32.LRESULT, hBrushStatic);
         END;

    | WINUSER.WM_SYSCOLORCHANGE :
         WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBrushStatic));

         hBrushStatic := WINGDI.CreateSolidBrush (
                             WINUSER.GetSysColor (WINUSER.COLOR_BTNHIGHLIGHT));
         RETURN 0;

    | WINUSER.WM_DESTROY :
         WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,
              WINUSER.SetClassLong (hwnd, WINUSER.GCL_HBRBACKGROUND,
                   SYSTEM.CAST(WIN32.DWORD, WINGDI.GetStockObject(WINGDI.WHITE_BRUSH)))));

         FOR i := 0 TO 3-1 DO
           WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBrush[i]));
         END;
         WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBrushStatic));

         WINUSER.PostQuitMessage (0);
         RETURN 0;
  ELSE
     RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
  END;
  RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END WndProc;
<*/POP*>

<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE ScrollProc (hwnd        : WIN32.HWND;
(**********************************************************************)
                     iMsg        : WIN32.UINT;
                     wParam      : WIN32.WPARAM;
                     lParam      : WIN32.LPARAM) : WIN32.LRESULT [EXPORT];

VAR
  i    :   INTEGER;
BEGIN
  i := WINUSER.GetWindowLong (hwnd, WINUSER.GWL_ID);
  CASE (iMsg) OF
    | WINUSER.WM_KEYDOWN :
        IF (wParam = WINUSER.VK_TAB) THEN
           IF(WINUSER.GetKeyState (WINUSER.VK_SHIFT) < 0) THEN

               WINUSER.SetFocus (hwndScrol[(i + 2) REM 3]);
           ELSE
               WINUSER.SetFocus (hwndScrol[(i + 1) REM 3]);
           END;
        END;

    | WINUSER.WM_SETFOCUS :
        iFocus := i;
  ELSE
    RETURN WINUSER.CallWindowProc (fnOldScr[i], hwnd, iMsg, wParam, lParam);
  END;
  RETURN WINUSER.CallWindowProc (fnOldScr[i], hwnd, iMsg, wParam, lParam);
END ScrollProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)

BEGIN
  wc.cbSize        := SIZE(wc);
  wc.style         := WINUSER.CS_HREDRAW  BOR WINUSER.CS_VREDRAW;
  wc.lpfnWndProc   := WndProc;
  wc.cbClsExtra    := 0;
  wc.cbWndExtra    := 0;
  wc.hInstance     := WINX.Instance;
  wc.hIcon         := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);
  wc.hCursor       := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
  wc.hbrBackground := WINGDI.CreateSolidBrush(000h);
  wc.lpszMenuName  := NIL;
  wc.lpszClassName := SYSTEM.ADR(szAppName);
  wc.hIconSm       := WINUSER.LoadIcon (NIL,WINUSER.IDI_APPLICATION^);

  RETURN WINUSER.RegisterClassEx(wc)#0;
END InitApplication;

(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
VAR
  i   :  CARDINAL;
BEGIN
  hwnd := WINUSER.CreateWindow (szAppName,
                        "Color Scroll: Translation to Stony Brook Modula-2",
                        WINUSER.WS_OVERLAPPEDWINDOW,
                        WINUSER.CW_USEDEFAULT,
                        WINUSER.CW_USEDEFAULT,
                        WINUSER.CW_USEDEFAULT,
                        WINUSER.CW_USEDEFAULT,
                        NIL,
                        NIL,
                        WINX.Instance,
                        NIL);


     hwndRect := WINUSER.CreateWindow ("static",
                              "",
                              WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.SS_WHITERECT,
                              0,
                              0,
                              0,
                              0,
                              hwnd,
                              SYSTEM.CAST(WIN32.HMENU,9),
                              WINX.Instance,
                              NIL);

     FOR i := 0 TO 3-1 DO
       hwndScrol[i] := WINUSER.CreateWindow ("scrollbar",
                           "",
                           WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.WS_TABSTOP BOR WINUSER.SBS_VERT,
                           0,
                           0,
                           0,
                           0,
                           hwnd,
                           SYSTEM.CAST(WIN32.HMENU,i),
                           WINX.Instance,
                           NIL);

       hwndLabel[i] := WINUSER.CreateWindow ("static",
                           szColorLabel[i],
                           WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.SS_CENTER,
                           0,
                           0,
                           0,
                           0,
                           hwnd,
                           SYSTEM.CAST(WIN32.HMENU,i+3),
                           WINX.Instance,
                           NIL);

       hwndValue[i] := WINUSER.CreateWindow ("static",
                           "0",
                           WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.SS_CENTER,
                           0,
                           0,
                           0,
                           0,
                           hwnd,
                           SYSTEM.CAST(WIN32.HMENU,i+6),
                           WINX.Instance,
                           NIL);

       fnOldScr[i] := SYSTEM.CAST(WINUSER.WNDPROC,WINUSER.SetWindowLong (hwndScrol[i],
                                               WINUSER.GWL_WNDPROC,
                                              SYSTEM.CAST(WIN32.LONG,ScrollProc)));

       WINUSER.SetScrollRange (hwndScrol[i], WINUSER.SB_CTL, 0, 255, FALSE);
       WINUSER.SetScrollPos   (hwndScrol[i], WINUSER.SB_CTL, 0, FALSE);
     END;
  WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT);
  WINUSER.UpdateWindow (hwnd);
  RETURN TRUE;
END InitMainWindow;

BEGIN
  szColorLabel[0] := "Red";
  szColorLabel[1] := "Green";
  szColorLabel[2] := "Blue";
  crPrim[0] := WINGDI.RGB (255, 0, 0);
  crPrim[1] := WINGDI.RGB (0, 255, 0);
  crPrim[2] := WINGDI.RGB (0, 0, 255);
  IF InitApplication()  AND  InitMainWindow() THEN
    WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
      WINUSER.TranslateMessage(msg);
      WINUSER.DispatchMessage(msg);
    END;
  END;
END Colors1.