Last updated: 26. 2.1998, 21:40
<*/NOWARN:F*> MODULE Multi1; (*--------------------------------------- MULTI1.C --- Multitasking Demo (c) Charles Petzold, 1996 Multi1.mod --- Translation to Stony Brook Modula-2 (c) Peter Stadler, 1997 ---------------------------------------*) IMPORT WINUSER; IMPORT WIN32; IMPORT WINX; IMPORT WINGDI; IMPORT SYSTEM; IMPORT Lib; IMPORT RealMath; VAR cyChar : INTEGER; CONST szAppName = "Multi1"; VAR hwnd : WIN32.HWND; msg : WINUSER.MSG; wc : WINUSER.WNDCLASSEX; VAR iNum1 : INTEGER; iLine1 : INTEGER; cyClient1 : INTEGER; iNum2 : INTEGER; iLine2 : INTEGER; cyClient2 : INTEGER; iNum3 : INTEGER; iLine3 : INTEGER; cyClient3 : INTEGER; iNext3 : INTEGER; cxClient4 : INTEGER; cyClient4 : INTEGER; hwndChild : ARRAY[0..3] OF WIN32.HWND; TYPE CHILD = ARRAY[0..5] OF CHAR; CHILDPROC = ARRAY[0..3] OF WIN32.HINSTANCE; CHILDCLASS = ARRAY[0..3] OF CHILD; CONST szChildClass = CHILDCLASS { "Child1", "Child2", "Child3", "Child4" }; (*++++*****************************************************************) 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 CheckBottom (hwnd : WIN32.HWND; cyClient : INTEGER; iLine : INTEGER) : INTEGER; (**********************************************************************) BEGIN IF (iLine * cyChar + cyChar > cyClient) THEN WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE); WINUSER.UpdateWindow (hwnd); iLine := 0; END; RETURN iLine; END CheckBottom; (* Window 1: Display increasing sequence of numbers *) (* ************************************************ *) <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE WndProc1(hwnd : WIN32.HWND; (**********************************************************************) iMsg : WIN32.UINT; wParam : WIN32.WPARAM; lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT] ; VAR szBuffer : ARRAY[0..15] OF CHAR; hdc : WIN32.HDC; BEGIN CASE (iMsg) OF | WINUSER.WM_SIZE : cyClient1 := WINUSER.HIWORD (lParam); RETURN 0; | WINUSER.WM_TIMER : IF (iNum1 < 0) THEN iNum1 := 0; END; iLine1 := CheckBottom (hwnd, cyClient1, iLine1); WINUSER.wsprintf (szBuffer, "%d", iNum1); INC(iNum1); hdc := WINUSER.GetDC (hwnd); WINGDI.TextOut (hdc, 0, iLine1 * cyChar, szBuffer, LENGTH(szBuffer)); WINUSER.ReleaseDC (hwnd, hdc); INC(iLine1); RETURN 0; ELSE RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam); END; END WndProc1; <*/POP*> (* Window 2: Display increasing sequence of prime numbers *) (* ****************************************************** *) <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE WndProc2(hwnd : WIN32.HWND; (**********************************************************************) iMsg : WIN32.UINT; wParam : WIN32.WPARAM; lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT]; VAR szBuffer : ARRAY[0..15] OF CHAR; hdc : WIN32.HDC; i,iSqrt : INTEGER; BEGIN CASE (iMsg) OF | WINUSER.WM_SIZE : cyClient2 := WINUSER.HIWORD (lParam); RETURN 0; | WINUSER.WM_TIMER : REPEAT INC(iNum2); IF (iNum2 < 0) THEN iNum2 := 0; END; iSqrt := VAL(INTEGER,RealMath.sqrt (FLOAT(iNum2))); i := 2; LOOP IF (iNum2 MOD i = 0) THEN EXIT; END; INC(i); IF(i>iSqrt) THEN EXIT; END; END; UNTIL (i > iSqrt); iLine2 := CheckBottom (hwnd, cyClient2, iLine2); WINUSER.wsprintf (szBuffer, "%d", iNum2); hdc := WINUSER.GetDC (hwnd); WINGDI.TextOut (hdc, 0, iLine2 * cyChar, szBuffer, LENGTH(szBuffer)); WINUSER.ReleaseDC (hwnd, hdc); INC(iLine2); RETURN 0; ELSE RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam); END; END WndProc2; <*/POP*> (* Window 3: Display increasing sequence of Fibonacci numbers *) (* *********************************************************- *) <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE WndProc3(hwnd : WIN32.HWND; (**********************************************************************) iMsg : WIN32.UINT; wParam : WIN32.WPARAM; lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT]; VAR szBuffer : ARRAY[0..15] OF CHAR; hdc : WIN32.HDC; iTemp : INTEGER; BEGIN CASE (iMsg) OF | WINUSER.WM_SIZE : cyClient3 := WINUSER.HIWORD (lParam); RETURN 0; | WINUSER.WM_TIMER : IF (iNum3 < 0) THEN iNum3 := 0; iNext3 := 1; END; iLine3 := CheckBottom (hwnd, cyClient3, iLine3); WINUSER.wsprintf (szBuffer, "%d", iNum3); hdc := WINUSER.GetDC (hwnd); WINGDI.TextOut (hdc, 0, iLine3 * cyChar, szBuffer, LENGTH(szBuffer)); WINUSER.ReleaseDC (hwnd, hdc); iTemp := iNum3; iNum3 := iNext3; iNext3 := iNext3+iTemp; INC(iLine3); RETURN 0; ELSE RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam); END; END WndProc3; <*/POP*> (* Window 4: Display circles of random radii *) (* ***************************************-- *) <*/PUSH*> %IF WIN32 %THEN <*/CALLS:WIN32SYSTEM*> %ELSE <*/CALLS:WINSYSTEM*> %END (*++++*****************************************************************) PROCEDURE WndProc4(hwnd : WIN32.HWND; (**********************************************************************) iMsg : WIN32.UINT; wParam : WIN32.WPARAM; lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT]; VAR hdc : WIN32.HDC; iDiameter: INTEGER; BEGIN CASE (iMsg) OF | WINUSER.WM_SIZE : cxClient4 := WINUSER.LOWORD (lParam); cyClient4 := WINUSER.HIWORD (lParam); RETURN 0; | WINUSER.WM_TIMER : WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE); WINUSER.UpdateWindow (hwnd); iDiameter := SYSTEM.CAST(INTEGER,Lib.RANDOM(1000) MOD VAL(CARDINAL,MaxInt(1,MinInt(cxClient4,cyClient4)))); hdc := WINUSER.GetDC (hwnd); WINGDI.Ellipse (hdc, (cxClient4 - iDiameter) DIV 2, (cyClient4 - iDiameter) DIV 2, (cxClient4 + iDiameter) DIV 2, (cyClient4 + iDiameter) DIV 2); WINUSER.ReleaseDC (hwnd, hdc); RETURN 0; ELSE RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam); END; END WndProc4; (* *) <*/POP*> (* *) (* Main window to create child windows *) (* *********************************-- *) <*/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 hInstance : WIN32.HINSTANCE; i : INTEGER; cxClient : INTEGER; cyClient : INTEGER; wc : WINUSER.WNDCLASSEX; rc : CARDINAL; BEGIN CASE (iMsg) OF | WINUSER.WM_CREATE : hInstance := SYSTEM.CAST(WIN32.HINSTANCE,WINUSER.GetWindowLong (hwnd, WINUSER.GWL_HINSTANCE)); wc.cbSize := SIZE (wc); wc.style := WINUSER.CS_HREDRAW BOR WINUSER.CS_VREDRAW; wc.cbClsExtra := 0; wc.cbWndExtra := 0; wc.hInstance := hInstance; wc.hIcon := NIL; wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^); wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH)); wc.lpszMenuName := NIL; wc.hIconSm := NIL; FOR i := 0 TO 4-1 DO wc.lpfnWndProc := SYSTEM.CAST(WINUSER.WNDPROC,ChildProc[i]); wc.lpszClassName := SYSTEM.ADR(szChildClass[i]); rc := WINUSER.RegisterClassEx(wc); hwndChild[i] := WINUSER.CreateWindow (szChildClass[i], "", WINUSER.WS_CHILDWINDOW BOR WINUSER.WS_BORDER BOR WINUSER.WS_VISIBLE, 0, 0, 0, 0, hwnd, SYSTEM.CAST(WIN32.HMENU,i), hInstance, NIL); END; cyChar := WINUSER.HIWORD (WINUSER.GetDialogBaseUnits ()); WINUSER.SetTimer (hwnd, 1, 10, NIL); RETURN 0; | WINUSER.WM_SIZE : cxClient := WINUSER.LOWORD (lParam); cyClient := WINUSER.HIWORD (lParam); FOR i := 0 TO 4-1 DO IF(i>1) THEN WINUSER.MoveWindow (hwndChild[i], (i REM 2) * cxClient DIV 2, (1*cyClient DIV 2), cxClient DIV 2, cyClient DIV 2, TRUE); ELSE WINUSER.MoveWindow (hwndChild[i], (i REM 2) * cxClient DIV 2, (0 * cyClient DIV 2), cxClient DIV 2, cyClient DIV 2, TRUE); END; END; RETURN 0; | WINUSER.WM_TIMER : FOR i := 0 TO 4-1 DO WINUSER.SendMessage (hwndChild[i], WINUSER.WM_TIMER, wParam, lParam); END; RETURN 0; | WINUSER.WM_CHAR : IF (wParam = 27) (* '\x1B'*) THEN WINUSER.DestroyWindow (hwnd); END; RETURN 0; | WINUSER.WM_DESTROY : WINUSER.KillTimer (hwnd, 1); WINUSER.PostQuitMessage (0); RETURN 0; ELSE RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam); END; END WndProc; <*/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 (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^); rc := WINUSER.RegisterClassEx(wc); RETURN rc#0; END InitApplication; (*++++*****************************************************************) PROCEDURE InitMainWindow () : BOOLEAN; (**********************************************************************) BEGIN hwnd := WINUSER.CreateWindow ( szAppName, (* window class name *) "Multitasking Demo: Translation to Stony Brook Modula-2", (* window caption *) WINUSER.WS_OVERLAPPEDWINDOW, (* window style *) WINUSER.CW_USEDEFAULT, (* initial x position *) WINUSER.CW_USEDEFAULT, (* initial y position *) WINUSER.CW_USEDEFAULT, (* initial x size *) WINUSER.CW_USEDEFAULT, (* initial y size *) NIL, (* parent window handle *) NIL, (* window menu handle *) wc.hInstance, (* program instance handle *) NIL); (* creation parameters *) IF hwnd = NIL THEN RETURN FALSE; END; WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT); WINUSER.UpdateWindow (hwnd); RETURN TRUE; END InitMainWindow; CONST ChildProc = CHILDPROC { SYSTEM.CAST(WIN32.HINSTANCE,WndProc1), SYSTEM.CAST(WIN32.HINSTANCE,WndProc2), SYSTEM.CAST(WIN32.HINSTANCE,WndProc3), SYSTEM.CAST(WIN32.HINSTANCE,WndProc4) }; BEGIN Lib.RANDOMIZE((*1000*)); iNum2 := 1; iNum3 := 0; iNext3 := 1; IF InitApplication() AND InitMainWindow() THEN WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO WINUSER.TranslateMessage(msg); WINUSER.DispatchMessage(msg); END; END; END Multi1.