Last updated: 11. 1.1998, 0:11
<*/NOWARN:F*>
(*-------------------------------------------------
CHECKER2.C --- Mouse Hit-Test Demo Program No. 2
(c) Charles Petzold, 1996
Checker2.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1997
-------------------------------------------------*)
MODULE Checker2;
IMPORT WINUSER;
IMPORT WINX;
IMPORT WINGDI;
IMPORT WIN32;
IMPORT SYSTEM;
CONST
szAppName = "Checker2";
DIVISIONS=5;
VAR
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
VAR
fState : ARRAY[0..DIVISIONS-1],[0..DIVISIONS-1] OF BOOLEAN;
cxBlock : INTEGER;
cyBlock : 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
<*/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
hdc : WIN32.HDC;
ps : WINUSER.PAINTSTRUCT;
rect : WIN32.RECT;
x : INTEGER;
y : INTEGER;
point : WIN32.POINT;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_SIZE :
cxBlock := VAL(INTEGER,WINUSER.LOWORD (lParam)) DIV DIVISIONS;
cyBlock := VAL(INTEGER,WINUSER.HIWORD (lParam)) DIV DIVISIONS;
RETURN 0;
| WINUSER.WM_SETFOCUS :
WINUSER.ShowCursor (TRUE);
RETURN 0;
| WINUSER.WM_KILLFOCUS :
WINUSER.ShowCursor (FALSE);
RETURN 0;
| WINUSER.WM_KEYDOWN :
WINUSER.GetCursorPos(point);
WINUSER.ScreenToClient (hwnd, point);
x := MaxInt (0, MinInt (DIVISIONS - 1, point.x DIV cxBlock));
y := MaxInt (0, MinInt (DIVISIONS - 1, point.y DIV cyBlock));
CASE (wParam) OF
| WINUSER.VK_UP :
DEC(y);
| WINUSER.VK_DOWN :
INC(y);
| WINUSER.VK_LEFT :
DEC(x);
| WINUSER.VK_RIGHT :
INC(x);
| WINUSER.VK_HOME :
x := 0;
y := 0;
| WINUSER.VK_END :
x := DIVISIONS - 1;
y := DIVISIONS - 1;
| WINUSER.VK_RETURN :
WINUSER.SendMessage (hwnd, WINUSER.WM_LBUTTONDOWN, WINUSER.MK_LBUTTON,
WINUSER.MAKELONG (x * cxBlock, y * cyBlock));
| WINUSER.VK_SPACE :
WINUSER.SendMessage (hwnd, WINUSER.WM_LBUTTONDOWN, WINUSER.MK_LBUTTON,
WINUSER.MAKELONG (x * cxBlock, y * cyBlock));
ELSE
END;
x := (x + DIVISIONS) REM DIVISIONS;
y := (y + DIVISIONS) REM DIVISIONS;
point.x := x * cxBlock + cxBlock DIV 2;
point.y := y * cyBlock + cyBlock DIV 2;
WINUSER.ClientToScreen (hwnd, point);
WINUSER.SetCursorPos (point.x, point.y);
RETURN 0;
| WINUSER.WM_LBUTTONDOWN :
x := VAL(INTEGER,WINUSER.LOWORD (lParam)) DIV cxBlock;
y := VAL(INTEGER,WINUSER.HIWORD (lParam)) DIV cyBlock;
IF (x < DIVISIONS) AND (y < DIVISIONS) THEN
fState[x][y] := NOT fState[x][y];
rect.left := x * cxBlock;
rect.top := y * cyBlock;
rect.right := (x + 1) * cxBlock;
rect.bottom := (y + 1) * cyBlock;
WINUSER.InvalidateRect (hwnd, rect, FALSE);
ELSE
WINUSER.MessageBeep (0);
END;
RETURN 0;
| WINUSER.WM_PAINT :
hdc := WINUSER.BeginPaint (hwnd, ps);
FOR x := 0 TO DIVISIONS-1 DO
FOR y := 0 TO DIVISIONS-1 DO
WINGDI.Rectangle (hdc, x * cxBlock, y * cyBlock,
(x + 1) * cxBlock, (y + 1) * cyBlock);
IF (fState [x][y]) THEN
WINGDI.MoveToEx (hdc, x * cxBlock, y * cyBlock,WINX.NIL_POINT);
WINGDI.LineTo (hdc, (x+1) * cxBlock, (y+1) * cyBlock);
WINGDI.MoveToEx (hdc, x * cxBlock, (y+1) * cyBlock,WINX.NIL_POINT);
WINGDI.LineTo (hdc, (x+1) * cxBlock, y * cyBlock);
END;
END;
END;
WINUSER.EndPaint (hwnd, ps);
RETURN 0;
| WINUSER.WM_DESTROY :
WINUSER.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
<*/POP*>
(*+++***********************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(***************************************************************************)
BEGIN
wc.cbSize := SIZE(WINUSER.WNDCLASSEX);
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 := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
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;
(***************************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (szAppName,
"Checker2 Mouse Hit-Test Demo: Translation to Stony Brook Modula-2",
WINUSER.WS_OVERLAPPEDWINDOW,
WINUSER.CW_USEDEFAULT,
WINUSER.CW_USEDEFAULT,
WINUSER.CW_USEDEFAULT,
WINUSER.CW_USEDEFAULT,
NIL,
NIL,
wc.hInstance,
NIL);
IF hwnd = NIL THEN
RETURN FALSE;
END;
WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT);
WINUSER.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (WINUSER.GetMessage (msg, NIL, 0, 0)) DO
WINUSER.TranslateMessage (msg);
WINUSER.DispatchMessage (msg);
END;
END;
END Checker2.