Last updated: 11. 1.1998, 0:42
<*/NOWARN:F*>
MODULE Colors2;
(*------------------------------------------------
COLORS2.C --- Version using Modeless Dialog Box
(c) Charles Petzold, 1996
Colors2.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1997
------------------------------------------------*)
%IF WIN32 %THEN
<*/Resource:COLORS2.RES*>
%ELSE
%END
IMPORT WIN32;
IMPORT WINUSER;
IMPORT SYSTEM;
IMPORT WINGDI;
IMPORT WINX;
CONST szAppName = "Colors2";
VAR
msg : WINUSER.MSG;
hwnd : WIN32.HWND;
wc : WINUSER.WNDCLASSEX;
hDlgModeless : WIN32.HWND;
iColor : ARRAY[0..2] OF 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];
BEGIN
CASE (iMsg) OF
| WINUSER.WM_DESTROY :
WINGDI.DeleteObject (
SYSTEM.CAST(WIN32.HGDIOBJ,WINUSER.SetClassLong (hwnd, WINUSER.GCL_HBRBACKGROUND,
SYSTEM.CAST(WIN32.LONG,WINGDI.GetStockObject (WINGDI.WHITE_BRUSH)))));
WINUSER.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
<*/POP*>
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE ColorScrDlg (hDlg : WIN32.HWND;
(**********************************************************************)
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.BOOL [EXPORT];
VAR
hwndParent : WIN32.HWND;
hCtrl : WIN32.HWND;
iCtrlID : INTEGER;
iIndex : INTEGER;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_INITDIALOG :
FOR iCtrlID := 10 TO 13-1 DO
hCtrl := WINUSER.GetDlgItem (hDlg, iCtrlID);
WINUSER.SetScrollRange (hCtrl, WINUSER.SB_CTL, 0, 255, FALSE);
WINUSER.SetScrollPos (hCtrl, WINUSER.SB_CTL, 0, FALSE);
END;
RETURN TRUE;
| WINUSER.WM_VSCROLL :
hCtrl := SYSTEM.CAST(WIN32.HWND,lParam);
iCtrlID := WINUSER.GetWindowLong (hCtrl, WINUSER.GWL_ID);
iIndex := iCtrlID - 10;
hwndParent := WINUSER.GetParent (hDlg);
CASE (WINUSER.LOWORD (wParam)) OF
| WINUSER.SB_PAGEDOWN :
iColor[iIndex] := iColor[iIndex] + 15; (* fall through *)
| WINUSER.SB_LINEDOWN :
iColor[iIndex] := MinInt (255, iColor[iIndex] + 1);
| WINUSER.SB_PAGEUP :
iColor[iIndex] := iColor[iIndex] - 15; (* fall through *)
| WINUSER.SB_LINEUP :
iColor[iIndex] := MaxInt (0, iColor[iIndex] - 1);
| WINUSER.SB_TOP :
iColor[iIndex] := 0;
| WINUSER.SB_BOTTOM :
iColor[iIndex] := 255;
| WINUSER.SB_THUMBPOSITION :
iColor[iIndex] := WINUSER.HIWORD (wParam);
| WINUSER.SB_THUMBTRACK :
iColor[iIndex] := WINUSER.HIWORD (wParam);
ELSE
RETURN FALSE;
END;
WINUSER.SetScrollPos (hCtrl, WINUSER.SB_CTL, iColor[iIndex], TRUE);
WINUSER.SetDlgItemInt (hDlg, iCtrlID + 3, iColor[iIndex], FALSE);
WINGDI.DeleteObject (
(SYSTEM.CAST(WIN32.HGDIOBJ,WINUSER.SetClassLong (hwndParent, WINUSER.GCL_HBRBACKGROUND,
(SYSTEM.CAST(WIN32.LONG, WINGDI.CreateSolidBrush (
WINGDI.RGB (iColor[0], iColor[1], iColor[2]))))))));
WINUSER.InvalidateRect (hwndParent, WINX.NIL_RECT, TRUE);
RETURN TRUE;
ELSE
RETURN FALSE;
END;
END ColorScrDlg;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR rc : CARDINAL;
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 (wc.hInstance,WINUSER.IDI_APPLICATION^);
wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
wc.hbrBackground := WINGDI.CreateSolidBrush(00000h);
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := WINUSER.LoadIcon (wc.hInstance,WINUSER.IDI_APPLICATION^);
rc := WINUSER.RegisterClassEx(wc);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (szAppName, "Colors Scroll:Translation to Stony Brook Modula-2",
WINUSER.WS_OVERLAPPEDWINDOW BOR WINUSER.WS_CLIPCHILDREN,
WINUSER.CW_USEDEFAULT,
WINUSER.CW_USEDEFAULT,
WINUSER.CW_USEDEFAULT,
WINUSER.CW_USEDEFAULT,
NIL,
NIL,
WINX.Instance,
NIL);
IF hwnd = NIL THEN
RETURN FALSE;
END;
WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT);
WINUSER.UpdateWindow (hwnd);
hDlgModeless := WINUSER.CreateDialog (WINX.Instance, "ColorScrDlg", hwnd, ColorScrDlg);
RETURN TRUE;
END InitMainWindow;
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
IF (hDlgModeless = NIL) OR (WINUSER.IsDialogMessage (hDlgModeless, msg)=FALSE) THEN
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
END;
END;
END Colors2.