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