Last updated: 18. 1.1998, 16:18
<* +M2EXTENSIONS *>
MODULE About2;
(*--------------------------------------------
ABOUT2.C --- About Box Demo Program No. 2
(c) Charles Petzold, 1996
About2.MOD --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
------------------------------------------*)
IMPORT h2d_about2;
IMPORT Windows;
IMPORT SYSTEM;
CONST szAppName = "About2";
VAR iCurrentColor : INTEGER;
iCurrentFigure : INTEGER;
TYPE
COLORREFARRAY = ARRAY[0..7] OF Windows.COLORREF;
VAR
msg : Windows.MSG;
hwnd : Windows.HWND;
wc : Windows.WNDCLASSEX;
crColor : COLORREFARRAY;
hInstance : Windows.HINSTANCE;
hCtrlBlock : Windows.HWND;
iColor : INTEGER;
iFigure : INTEGER;
(*++++*****************************************************************)
PROCEDURE PaintWindow ( hwnd : Windows.HWND;
iColor : INTEGER;
iFigure : INTEGER);
(**********************************************************************)
VAR
hBrush : Windows.HBRUSH;
hdc : Windows.HDC;
rect : Windows.RECT;
BEGIN
hdc := Windows.GetDC (hwnd);
Windows.GetClientRect (hwnd, rect);
hBrush := Windows.CreateSolidBrush (crColor[iColor - h2d_about2.IDD_BLACK]);
hBrush := SYSTEM.CAST(Windows.HBRUSH, Windows.SelectObject (hdc, SYSTEM.CAST(Windows.HGDIOBJ,hBrush)));
IF (iFigure = h2d_about2.IDD_RECT) THEN
Windows.Rectangle (hdc, rect.left, rect.top, rect.right, rect.bottom);
ELSE
Windows.Ellipse (hdc, rect.left, rect.top, rect.right, rect.bottom);
END;
Windows.DeleteObject (Windows.SelectObject (hdc, SYSTEM.CAST(Windows.HGDIOBJ,hBrush)));
Windows.ReleaseDC (hwnd, hdc);
END PaintWindow;
(*++++*****************************************************************)
PROCEDURE PaintTheBlock ( hCtrl : Windows.HWND;
iColor : INTEGER;
iFigure: INTEGER);
(**********************************************************************)
BEGIN
Windows.InvalidateRect (hCtrl, NIL, TRUE);
Windows.UpdateWindow (hCtrl);
PaintWindow (hCtrl, iColor, iFigure);
END PaintTheBlock;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] AboutDlgProc (hDlg : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.BOOL;
BEGIN
CASE (iMsg) OF
| Windows.WM_INITDIALOG :
iColor := iCurrentColor;
iFigure := iCurrentFigure;
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, iColor);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_RECT, h2d_about2.IDD_ELL, iFigure);
hCtrlBlock := Windows.GetDlgItem (hDlg, h2d_about2.IDD_PAINT);
Windows.SetFocus (Windows.GetDlgItem (hDlg, iColor));
RETURN FALSE;
| Windows.WM_COMMAND :
CASE (Windows.LOWORD (wParam)) OF
| Windows.IDOK :
iCurrentColor := iColor;
iCurrentFigure := iFigure;
Windows.EndDialog (hDlg, 1);
RETURN TRUE;
| Windows.IDCANCEL :
Windows.EndDialog (hDlg, 0);
RETURN TRUE;
| h2d_about2.IDD_BLACK :
iColor := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_RED :
iColor := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_GREEN :
iColor := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_YELLOW :
iColor := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_BLUE :
iColor := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_MAGENTA :
iColor := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_CYAN :
iColor := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_WHITE :
iColor := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_BLACK, h2d_about2.IDD_WHITE, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_RECT :
iFigure := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_RECT, h2d_about2.IDD_ELL, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
| h2d_about2.IDD_ELL :
iFigure := Windows.LOWORD (wParam);
Windows.CheckRadioButton (hDlg, h2d_about2.IDD_RECT, h2d_about2.IDD_ELL, Windows.LOWORD (wParam));
PaintTheBlock (hCtrlBlock, iColor, iFigure);
RETURN TRUE;
ELSE
END;
| Windows.WM_PAINT :
PaintTheBlock (hCtrlBlock, iColor, iFigure);
ELSE
RETURN FALSE;
END;
RETURN FALSE;
END AboutDlgProc;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc (hwnd : Windows.HWND;
(**********************************************************************)
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
VAR
ps : Windows.PAINTSTRUCT;
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
(*
hInstance := ((PCREATESTRUCT) lParam)^.hInstance;
*)
hInstance := Windows.MyInstance();
RETURN 0;
| Windows.WM_COMMAND :
CASE (Windows.LOWORD (wParam)) OF
| h2d_about2.IDM_ABOUT :
IF (Windows.DialogBox (hInstance, "AboutBox", hwnd,
AboutDlgProc)=1) THEN
Windows.InvalidateRect (hwnd, NIL, TRUE);
END;
RETURN 0;
ELSE
RETURN 0;
END;
| Windows.WM_PAINT :
Windows.BeginPaint (hwnd, ps);
Windows.EndPaint (hwnd, ps);
PaintWindow (hwnd, iCurrentColor, iCurrentFigure);
RETURN 0;
| Windows.WM_DESTROY :
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR rc : CARDINAL;
BEGIN
wc.cbSize := SIZE(wc);
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 (wc.hInstance,szAppName);
wc.hCursor := Windows.LoadCursor (NIL, Windows.IDC_ARROW);
wc.hbrBackground := SYSTEM.CAST(Windows.HBRUSH,Windows.GetStockObject(Windows.WHITE_BRUSH));
wc.lpszMenuName := SYSTEM.ADR(szAppName);
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := Windows.LoadIcon (wc.hInstance,szAppName);
rc := Windows.RegisterClassEx(wc);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := Windows.CreateWindow (szAppName, "About Box Demo Program #2: Translation to XDS Modula-2",
Windows.WS_OVERLAPPEDWINDOW,
Windows.CW_USEDEFAULT,
Windows.CW_USEDEFAULT,
Windows.CW_USEDEFAULT,
Windows.CW_USEDEFAULT,
NIL,
NIL,
Windows.MyInstance(),
NIL);
IF hwnd = NIL THEN
RETURN FALSE;
END;
Windows.ShowWindow (hwnd, Windows.SW_SHOWDEFAULT);
Windows.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
BEGIN
iCurrentColor := h2d_about2.IDD_BLACK;
iCurrentFigure := h2d_about2.IDD_RECT;
crColor := COLORREFARRAY
{ Windows.RGB (0, 0, 0), Windows.RGB ( 0, 0, 255),
Windows.RGB (0, 255, 0), Windows.RGB ( 0, 255, 255),
Windows.RGB (255, 0, 0), Windows.RGB (255, 0, 255),
Windows.RGB (255, 255, 0), Windows.RGB (255, 255, 255) };
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END About2.