Last updated: 15. 2.1998, 17:47
<*/NOWARN:F*>
MODULE About2;
(*--------------------------------------------
ABOUT2.C --- About Box Demo Program No. 2
(c) Charles Petzold, 1996
About2.MOD --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1997
------------------------------------------*)
%IF WIN32 %THEN
<*/Resource:ABOUT2.RES*>
%ELSE
%END
IMPORT h2d_about2;
IMPORT WIN32;
IMPORT WINUSER;
IMPORT SYSTEM;
IMPORT WINGDI;
IMPORT WINX;
CONST szAppName = "About2";
VAR iCurrentColor : INTEGER = h2d_about2.IDD_BLACK;
iCurrentFigure : INTEGER = h2d_about2.IDD_RECT;
TYPE
COLORREFARRAY = ARRAY[0..7] OF WIN32.COLORREF;
VAR
msg : WINUSER.MSG;
hwnd : WIN32.HWND;
wc : WINUSER.WNDCLASSEX;
crColor : COLORREFARRAY;
hInstance : WIN32.HINSTANCE;
hCtrlBlock : WIN32.HWND;
iColor : INTEGER;
iFigure : INTEGER;
(*++++*****************************************************************)
PROCEDURE PaintWindow ( hwnd : WIN32.HWND;
iColor : INTEGER;
iFigure : INTEGER);
(**********************************************************************)
VAR
hBrush : WIN32.HBRUSH;
hdc : WIN32.HDC;
rect : WIN32.RECT;
BEGIN
hdc := WINUSER.GetDC (hwnd);
WINUSER.GetClientRect (hwnd, rect);
hBrush := WINGDI.CreateSolidBrush (crColor[iColor - h2d_about2.IDD_BLACK]);
hBrush := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.SelectObject (hdc, SYSTEM.CAST(WIN32.HGDIOBJ,hBrush)));
IF (iFigure = h2d_about2.IDD_RECT) THEN
WINGDI.Rectangle (hdc, rect.left, rect.top, rect.right, rect.bottom);
ELSE
WINGDI.Ellipse (hdc, rect.left, rect.top, rect.right, rect.bottom);
END;
WINGDI.DeleteObject (WINGDI.SelectObject (hdc, SYSTEM.CAST(WIN32.HGDIOBJ,hBrush)));
WINUSER.ReleaseDC (hwnd, hdc);
END PaintWindow;
(*++++*****************************************************************)
PROCEDURE PaintTheBlock ( hCtrl : WIN32.HWND;
iColor : INTEGER;
iFigure: INTEGER);
(**********************************************************************)
BEGIN
WINUSER.InvalidateRect (hCtrl, WINX.NIL_RECT, TRUE);
WINUSER.UpdateWindow (hCtrl);
PaintWindow (hCtrl, iColor, iFigure);
END PaintTheBlock;
<*/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 :
iColor := iCurrentColor;
iFigure := iCurrentFigure;
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, iColor);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_RECT, h2d_about2.IDD_ELL, iFigure);
hCtrlBlock := WINUSER.GetDlgItem (hDlg, h2d_about2.IDD_PAINT);
WINUSER.SetFocus (WINUSER.GetDlgItem (hDlg, iColor));
RETURN FALSE;
| WINUSER.WM_COMMAND :
CASE (WINUSER.LOWORD (wParam)) OF
| WINUSER.IDOK :
iCurrentColor := iColor;
iCurrentFigure := iFigure;
WINUSER.EndDialog (hDlg, 1);
RETURN TRUE;
| WINUSER.IDCANCEL :
WINUSER.EndDialog (hDlg, 0);
RETURN TRUE;
| h2d_about2.IDD_BLACK :
iColor := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_RED :
iColor := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_GREEN :
iColor := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_YELLOW :
iColor := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_BLUE :
iColor := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_MAGENTA :
iColor := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_CYAN :
iColor := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_WHITE :
iColor := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_RECT :
iFigure := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_RECT, h2d_about2.IDD_ELL, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_ELL :
iFigure := WINUSER.LOWORD (wParam);
WINUSER.CheckRadioButton (hDlg, h2d_about2.IDD_RECT, h2d_about2.IDD_ELL, WINUSER.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
ELSE
END;
| WINUSER.WM_PAINT :
PaintTheBlock (hCtrlBlock, iColor, iFigure);
ELSE
RETURN FALSE;
END;
RETURN FALSE;
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
ps : WINUSER.PAINTSTRUCT;
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_about2.IDM_ABOUT :
IF (WINUSER.DialogBox (hInstance, "AboutBox", hwnd,
AboutDlgProc)=1) THEN
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
END;
RETURN 0;
ELSE
RETURN 0;
END;
| WINUSER.WM_PAINT :
WINUSER.BeginPaint (hwnd, ps);
WINUSER.EndPaint (hwnd, ps);
PaintWindow (hwnd, iCurrentColor, iCurrentFigure);
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;
(**********************************************************************)
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);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (szAppName, "About Box Demo Program #2: 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
crColor := COLORREFARRAY
{ WINGDI.RGB (0, 0, 0), WINGDI.RGB ( 0, 0, 255),
WINGDI.RGB (0, 255, 0), WINGDI.RGB ( 0, 255, 255),
WINGDI.RGB (255, 0, 0), WINGDI.RGB (255, 0, 255),
WINGDI.RGB (255, 255, 0), WINGDI.RGB (255, 255, 255) };
IF InitApplication() AND InitMainWindow() THEN
WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
END;
END About2.