Last updated: 18. 1.1998, 15:43
<* +M2EXTENSIONS *>
MODULE MenuDemo;
(*-----------------------------------------
MENUDEMO.C --- Menu Demonstration
(c) Charles Petzold, 1996
MenuDemo.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
-----------------------------------------*)
IMPORT h2d_MenuDemo;
IMPORT Windows;
IMPORT SYSTEM;
CONST
szAppName = "MenuDemo";
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
TYPE
Color = Windows.STOCK_ENUM;
ColorArr = ARRAY[0..4] OF Color;
CONST (* static in WndProc *)
iColorID = ColorArr
{ Windows.WHITE_BRUSH, Windows.LTGRAY_BRUSH, Windows.GRAY_BRUSH,
Windows.DKGRAY_BRUSH, Windows.BLACK_BRUSH };
VAR
iSelection : INTEGER;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc (hwnd : Windows.HWND;
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
(**********************************************************************)
VAR
hMenu : Windows.HMENU;
BEGIN
CASE (iMsg) OF
| Windows.WM_COMMAND :
hMenu := Windows.GetMenu (hwnd);
CASE (Windows.LOWORD (wParam)) OF
| h2d_MenuDemo.IDM_NEW :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_MenuDemo.IDM_OPEN :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_MenuDemo.IDM_SAVE :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_MenuDemo.IDM_SAVEAS :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_MenuDemo.IDM_EXIT :
Windows.SendMessage (hwnd, Windows.WM_CLOSE, 0, 00000h);
RETURN 0;
| h2d_MenuDemo.IDM_UNDO :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_MenuDemo.IDM_CUT :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_MenuDemo.IDM_COPY :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_MenuDemo.IDM_PASTE :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_MenuDemo.IDM_DEL :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_MenuDemo.IDM_WHITE : (* Note: Logic below *)
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_UNCHECKED);
iSelection := Windows.LOWORD (wParam);
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_CHECKED);
Windows.SetClassLong (hwnd, Windows.GCL_HBRBACKGROUND,
SYSTEM.CAST(Windows.LONG,Windows.GetStockObject(iColorID[Windows.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
Windows.InvalidateRect (hwnd, NIL, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_LTGRAY : (* assumes that IDM_WHITE *)
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_UNCHECKED);
iSelection := Windows.LOWORD (wParam);
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_CHECKED);
Windows.SetClassLong (hwnd, Windows.GCL_HBRBACKGROUND,
SYSTEM.CAST(Windows.LONG,Windows.GetStockObject(iColorID[Windows.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
Windows.InvalidateRect (hwnd, NIL, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_GRAY : (* through IDM_BLACK are *)
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_UNCHECKED);
iSelection := Windows.LOWORD (wParam);
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_CHECKED);
Windows.SetClassLong (hwnd, Windows.GCL_HBRBACKGROUND,
SYSTEM.CAST(Windows.LONG,Windows.GetStockObject(iColorID[Windows.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
Windows.InvalidateRect (hwnd, NIL, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_DKGRAY : (* consecutive numbers in *)
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_UNCHECKED);
iSelection := Windows.LOWORD (wParam);
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_CHECKED);
Windows.SetClassLong (hwnd, Windows.GCL_HBRBACKGROUND,
SYSTEM.CAST(Windows.LONG,Windows.GetStockObject(iColorID[Windows.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
Windows.InvalidateRect (hwnd, NIL, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_BLACK : (* the order shown here. *)
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_UNCHECKED);
iSelection := Windows.LOWORD (wParam);
Windows.CheckMenuItem (hMenu, iSelection, Windows.MF_CHECKED);
Windows.SetClassLong (hwnd, Windows.GCL_HBRBACKGROUND,
SYSTEM.CAST(Windows.LONG,Windows.GetStockObject(iColorID[Windows.LOWORD (wParam) - h2d_MenuDemo.IDM_WHITE])));
Windows.InvalidateRect (hwnd, NIL, TRUE);
RETURN 0;
| h2d_MenuDemo.IDM_START :
IF (Windows.SetTimer (hwnd, 1, 1000, NIL)=1) THEN
Windows.EnableMenuItem (hMenu, h2d_MenuDemo.IDM_START, Windows.MF_GRAYED);
Windows.EnableMenuItem (hMenu, h2d_MenuDemo.IDM_STOP, Windows.MF_ENABLED);
END;
RETURN 0;
| h2d_MenuDemo.IDM_STOP :
Windows.KillTimer (hwnd, 1);
Windows.EnableMenuItem (hMenu, h2d_MenuDemo.IDM_START, Windows.MF_ENABLED);
Windows.EnableMenuItem (hMenu, h2d_MenuDemo.IDM_STOP, Windows.MF_GRAYED);
RETURN 0;
| h2d_MenuDemo.IDM_HELP :
Windows.MessageBox (hwnd, "Help not yet implemented!",
szAppName, Windows.MB_ICONEXCLAMATION + Windows.MB_OK);
RETURN 0;
| h2d_MenuDemo.IDM_ABOUT :
Windows.MessageBox (hwnd, "Menu Demonstration Program.",
szAppName, Windows.MB_ICONINFORMATION + Windows.MB_OK);
RETURN 0;
ELSE
RETURN 0;
END;
| Windows.WM_TIMER :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| Windows.WM_DESTROY :
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
BEGIN
wc.cbSize := SIZE(Windows.WNDCLASSEX);
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 (NIL, Windows.IDI_APPLICATION);
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 (NIL, Windows.IDI_APPLICATION);
RETURN Windows.RegisterClassEx (wc)#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := Windows.CreateWindow
(szAppName, (* window class name *)
"Menu Demonstration, Translation to XDS Modula-2",
(* window caption *)
Windows.WS_OVERLAPPEDWINDOW, (* window style *)
Windows.CW_USEDEFAULT, (* initial x position *)
Windows.CW_USEDEFAULT, (* initial y position *)
Windows.CW_USEDEFAULT, (* initial x size *)
Windows.CW_USEDEFAULT, (* initial y size *)
NIL, (* parent window handle *)
NIL, (* window menu handle *)
Windows.MyInstance(), (* program instance handle *)
NIL); (* creation parameters *)
IF hwnd = NIL THEN
RETURN FALSE;
END;
Windows.ShowWindow (hwnd, Windows.SW_SHOWDEFAULT);
Windows.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
(*++++*****************************************************************)
BEGIN
iSelection := h2d_MenuDemo.IDM_WHITE;
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END MenuDemo.