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.