Colors1.mod: Translation to XDS Modula-2

Last updated: 18. 1.1998, 14:15

<* +M2EXTENSIONS *>
MODULE Colors1;
(*----------------------------------------
   COLORS1.C       --- Colors Using Scroll Bars
                   (c) Charles Petzold, 1996, Chapter 8
   Colors1.mod     --- Translation to XDS Modula-2
                   (c) Peter Stadler,   1997
  ----------------------------------------*)

IMPORT Windows;



IMPORT SYSTEM;
IMPORT WholeStr;


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



    

    

(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc (hwnd        : Windows.HWND;
(**********************************************************************)
                                      iMsg        : Windows.UINT;
                                      wParam      : Windows.WPARAM;
                                      lParam      : Windows.LPARAM) : Windows.LRESULT;
VAR
  i    :  INTEGER;
  currentObject : Windows.HBRUSH;
  currentBrush : Windows.HBRUSH;
BEGIN
  CASE (iMsg) OF
    | Windows.WM_CREATE :
         FOR i := 0 TO 3-1 DO
           hBrush[i] := Windows.CreateSolidBrush (crPrim[i]);
         END;
         hBrushStatic := Windows.CreateSolidBrush (Windows.GetSysColor (Windows.COLOR_BTNHIGHLIGHT));
         cyChar := Windows.HIWORD (Windows.GetDialogBaseUnits ());
         RETURN 0;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    | Windows.WM_SYSCOLORCHANGE :
         Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hBrushStatic));

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

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

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

         Windows.PostQuitMessage (0);
         RETURN 0;
  ELSE
     RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
  END;
  RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END WndProc;




    

    

(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] ScrollProc (hwnd        : Windows.HWND;
(**********************************************************************)
                                        iMsg        : Windows.UINT;
                                        wParam      : Windows.WPARAM;
                                        lParam      : Windows.LPARAM) : Windows.LRESULT;

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

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

    | Windows.WM_SETFOCUS :
        iFocus := i;
  ELSE
    RETURN Windows.CallWindowProc (fnOldScr[i], hwnd, iMsg, wParam, lParam);
  END;
  RETURN Windows.CallWindowProc (fnOldScr[i], hwnd, iMsg, wParam, lParam);
END ScrollProc;

(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)

BEGIN
  wc.cbSize        := SIZE(wc);
  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 := Windows.CreateSolidBrush(000h);
  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;
(**********************************************************************)
VAR
  i   :  CARDINAL;
BEGIN
  hwnd := Windows.CreateWindow (szAppName,
                        "Color Scroll: Translation to XDS Modula-2",
                        Windows.WS_OVERLAPPEDWINDOW,
                        Windows.CW_USEDEFAULT,
                        Windows.CW_USEDEFAULT,
                        Windows.CW_USEDEFAULT,
                        Windows.CW_USEDEFAULT,
                        NIL,
                        NIL,
                        Windows.MyInstance(),
                        NIL);


     hwndRect := Windows.CreateWindow ("static",
                              "",
                              Windows.WS_CHILD + Windows.WS_VISIBLE + Windows.SS_WHITERECT,
                              0,
                              0,
                              0,
                              0,
                              hwnd,
                              SYSTEM.CAST(Windows.HMENU,9),
                              Windows.MyInstance(),
                              NIL);

     FOR i := 0 TO 3-1 DO
       hwndScrol[i] := Windows.CreateWindow ("scrollbar",
                           "",
                           Windows.WS_CHILD + Windows.WS_VISIBLE + Windows.WS_TABSTOP + Windows.SBS_VERT,
                           0,
                           0,
                           0,
                           0,
                           hwnd,
                           SYSTEM.CAST(Windows.HMENU,i),
                           Windows.MyInstance(),
                           NIL);

       hwndLabel[i] := Windows.CreateWindow ("static",
                           szColorLabel[i],
                           Windows.WS_CHILD + Windows.WS_VISIBLE + Windows.SS_CENTER,
                           0,
                           0,
                           0,
                           0,
                           hwnd,
                           SYSTEM.CAST(Windows.HMENU,i+3),
                           Windows.MyInstance(),
                           NIL);

       hwndValue[i] := Windows.CreateWindow ("static",
                           "0",
                           Windows.WS_CHILD + Windows.WS_VISIBLE + Windows.SS_CENTER,
                           0,
                           0,
                           0,
                           0,
                           hwnd,
                           SYSTEM.CAST(Windows.HMENU,i+6),
                           Windows.MyInstance(),
                           NIL);

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

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

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