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.