Last updated: 18. 1.1998, 15:46
<*/NOWARN:F*>
MODULE MenuDemo;
(*-----------------------------------------
MENUDEMO.C --- Menu Demonstration
(c) Charles Petzold, 1996
MenuDemo.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1997
-----------------------------------------*)
%IF WIN32 %THEN
<*/Resource:MENUDEMO.RES*>
%ELSE
%END
IMPORT h2d_MenuDemo;
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINX;
IMPORT WINGDI;
IMPORT SYSTEM;
CONST
szAppName = "MenuDemo";
VAR
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
TYPE
Color = INTEGER;
ColorArr = ARRAY[0..4] OF Color;
CONST (* static in WndProc *)
iColorID = ColorArr
{ WINGDI.WHITE_BRUSH, WINGDI.LTGRAY_BRUSH, WINGDI.GRAY_BRUSH,
WINGDI.DKGRAY_BRUSH, WINGDI.BLACK_BRUSH };
VAR
iSelection : INTEGER = h2d_MenuDemo.IDM_WHITE;
<*/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
hMenu : WIN32.HMENU;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_COMMAND :
hMenu := WINUSER.GetMenu (hwnd);
CASE (WINUSER.LOWORD (wParam)) OF
| h2d_MenuDemo.IDM_NEW :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_MenuDemo.IDM_OPEN :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_MenuDemo.IDM_SAVE :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_MenuDemo.IDM_SAVEAS :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_MenuDemo.IDM_EXIT :
WINUSER.SendMessage (hwnd, WINUSER.WM_CLOSE, 0, 00000h);
RETURN 0;
| h2d_MenuDemo.IDM_UNDO :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_MenuDemo.IDM_CUT :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_MenuDemo.IDM_COPY :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_MenuDemo.IDM_PASTE :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_MenuDemo.IDM_DEL :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_MenuDemo.IDM_WHITE : (* Note: Logic below *)
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_UNCHECKED);
iSelection := WINUSER.LOWORD (wParam);
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_CHECKED);
WINUSER.SetClassLong (hwnd, WINUSER.GCL_HBRBACKGROUND,
SYSTEM.CAST(WIN32.LONG,WINGDI.GetStockObject(iColorID[WINUSER.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_LTGRAY : (* assumes that IDM_WHITE *)
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_UNCHECKED);
iSelection := WINUSER.LOWORD (wParam);
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_CHECKED);
WINUSER.SetClassLong (hwnd, WINUSER.GCL_HBRBACKGROUND,
SYSTEM.CAST(WIN32.LONG,WINGDI.GetStockObject(iColorID[WINUSER.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_GRAY : (* through IDM_BLACK are *)
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_UNCHECKED);
iSelection := WINUSER.LOWORD (wParam);
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_CHECKED);
WINUSER.SetClassLong (hwnd, WINUSER.GCL_HBRBACKGROUND,
SYSTEM.CAST(WIN32.LONG,WINGDI.GetStockObject(iColorID[WINUSER.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_DKGRAY : (* consecutive numbers in *)
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_UNCHECKED);
iSelection := WINUSER.LOWORD (wParam);
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_CHECKED);
WINUSER.SetClassLong (hwnd, WINUSER.GCL_HBRBACKGROUND,
SYSTEM.CAST(WIN32.LONG,WINGDI.GetStockObject(iColorID[WINUSER.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_BLACK : (* the order shown here. *)
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_UNCHECKED);
iSelection := WINUSER.LOWORD (wParam);
WINUSER.CheckMenuItem (hMenu, iSelection, WINUSER.MF_CHECKED);
WINUSER.SetClassLong (hwnd, WINUSER.GCL_HBRBACKGROUND,
SYSTEM.CAST(WIN32.LONG,WINGDI.GetStockObject(iColorID[WINUSER.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_START :
IF (WINUSER.SetTimer (hwnd, 1, 1000, NIL)=1) THEN
WINUSER.EnableMenuItem (hMenu, h2d_MenuDemo.IDM_START, WINUSER.MF_GRAYED);
WINUSER.EnableMenuItem (hMenu, h2d_MenuDemo.IDM_STOP, WINUSER.MF_ENABLED);
END;
RETURN 0;
| h2d_MenuDemo.IDM_STOP :
WINUSER.KillTimer (hwnd, 1);
WINUSER.EnableMenuItem (hMenu, h2d_MenuDemo.IDM_START, WINUSER.MF_ENABLED);
WINUSER.EnableMenuItem (hMenu, h2d_MenuDemo.IDM_STOP, WINUSER.MF_GRAYED);
RETURN 0;
| h2d_MenuDemo.IDM_HELP :
WINUSER.MessageBox (hwnd, "Help not yet implemented!",
szAppName, WINUSER.MB_ICONEXCLAMATION BOR WINUSER.MB_OK);
RETURN 0;
| h2d_MenuDemo.IDM_ABOUT :
WINUSER.MessageBox (hwnd, "Menu Demonstration Program.",
szAppName, WINUSER.MB_ICONINFORMATION BOR WINUSER.MB_OK);
RETURN 0;
ELSE
RETURN 0;
END;
| WINUSER.WM_TIMER :
WINUSER.MessageBeep (0);
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;
(**********************************************************************)
BEGIN
wc.cbSize := SIZE(WINUSER.WNDCLASSEX);
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 := SYSTEM.ADR(szAppName);
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);
RETURN WINUSER.RegisterClassEx (wc)#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow
(szAppName, (* window class name *)
"Menu Demonstration: 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 *)
WINX.Instance, (* 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;
(*++++*****************************************************************)
BEGIN
IF InitApplication() AND InitMainWindow() THEN
WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
END;
END MenuDemo.