Last updated: 15. 2.1998, 17:48
<*/NOWARN:F*>
MODULE About3;
(*------------------------------------------
ABOUT3.C --- About Box Demo Program No. 3
(c) Charles Petzold, 1996
About3.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1997
------------------------------------------*)
%IF WIN32 %THEN
<*/Resource:ABOUT3.RES*>
%ELSE
%END
IMPORT h2d_about3;
IMPORT WIN32;
IMPORT WINUSER;
IMPORT SYSTEM;
IMPORT WINGDI;
IMPORT WINX;
CONST szAppName = "About3";
VAR
msg : WINUSER.MSG;
hwnd : WIN32.HWND;
wc : WINUSER.WNDCLASSEX;
hInstance : WIN32.HINSTANCE;
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE AboutDlgProc (hDlg : WIN32.HWND;
(**********************************************************************)
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.BOOL [EXPORT];
BEGIN
CASE (iMsg) OF
| WINUSER.WM_INITDIALOG :
RETURN TRUE;
| WINUSER.WM_COMMAND :
CASE (WINUSER.LOWORD (wParam)) OF
| WINUSER.IDOK :
WINUSER.EndDialog (hDlg, 0);
RETURN TRUE;
ELSE
RETURN FALSE;
END;
ELSE
RETURN FALSE;
END;
END AboutDlgProc;
<*/POP*>
<*/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
lpcr : WINUSER.LPCREATESTRUCT;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_CREATE :
lpcr := SYSTEM.CAST(WINUSER.LPCREATESTRUCT,lParam);
hInstance := lpcr^.hInstance;
RETURN 0;
| WINUSER.WM_COMMAND :
CASE (WINUSER.LOWORD (wParam)) OF
| h2d_about3.IDM_ABOUT :
WINUSER.DialogBox (hInstance, "AboutBox", hwnd,
AboutDlgProc);
RETURN 0;
ELSE
RETURN 0;
END;
| WINUSER.WM_DESTROY :
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 EllipPushwndProc (hwnd : WIN32.HWND;
(**********************************************************************)
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.LRESULT [EXPORT];
VAR
szText : ARRAY[0..39] OF CHAR;
hBrush : WIN32.HBRUSH;
hdc : WIN32.HDC;
ps : WINUSER.PAINTSTRUCT;
rect : WIN32.RECT;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_PAINT :
WINUSER.GetClientRect (hwnd, rect);
WINUSER.GetWindowText (hwnd, szText, SIZE (szText));
hdc := WINUSER.BeginPaint (hwnd, ps);
hBrush := WINGDI.CreateSolidBrush (WINUSER.GetSysColor (WINUSER.COLOR_WINDOW));
hBrush := SYSTEM.CAST(WIN32.HBRUSH,WINGDI.SelectObject (hdc, SYSTEM.CAST(WIN32.HGDIOBJ,hBrush)));
WINGDI.SetBkColor (hdc, WINUSER.GetSysColor (WINUSER.COLOR_WINDOW));
WINGDI.SetTextColor (hdc, WINUSER.GetSysColor (WINUSER.COLOR_WINDOWTEXT));
WINGDI.Ellipse (hdc, rect.left, rect.top, rect.right, rect.bottom);
WINUSER.DrawText (hdc, szText, -1, rect,
WINUSER.DT_SINGLELINE BOR WINUSER.DT_CENTER BOR WINUSER.DT_VCENTER);
WINGDI.DeleteObject (WINGDI.SelectObject (hdc, SYSTEM.CAST(WIN32.HGDIOBJ,hBrush)));
WINUSER.EndPaint (hwnd, ps);
RETURN 0;
| WINUSER.WM_KEYUP :
IF (wParam # WINUSER.VK_SPACE) THEN
RETURN 0;
END;
(* fall through *)
| WINUSER.WM_LBUTTONUP :
WINUSER.SendMessage (WINUSER.GetParent (hwnd), WINUSER.WM_COMMAND,
WINUSER.GetWindowLong (hwnd, WINUSER.GWL_ID), SYSTEM.CAST(WIN32.LPARAM,hwnd));
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END EllipPushwndProc;
<*/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,szAppName);
wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH,WINGDI.GetStockObject(WINGDI.WHITE_BRUSH));
wc.lpszMenuName := SYSTEM.ADR(szAppName);
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := WINUSER.LoadIcon (wc.hInstance,szAppName);
rc := WINUSER.RegisterClassEx(wc);
wc.cbSize := SIZE(wc);
wc.style := WINUSER.CS_HREDRAW BOR WINUSER.CS_VREDRAW;
wc.lpfnWndProc := EllipPushwndProc;
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hInstance := WINX.Instance;
wc.hIcon := WINUSER.LoadIcon (wc.hInstance,szAppName);
wc.hCursor := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH,WINUSER.COLOR_BTNFACE + 1);
wc.lpszMenuName := NIL;
wc.lpszClassName := SYSTEM.ADR("EllipPush");
wc.hIconSm := NIL;
rc := WINUSER.RegisterClassEx(wc);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (szAppName, "About Box Demo Program #3: 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);
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 About3.