Last updated: 22. 2.1998, 10:19
<* +M2EXTENSIONS *>
MODULE GrafMenu;
(*----------------------------------------------
GRAFMENU.C --- Demonstrates Bitmap Menu Items
(c) Charles Petzold, 1996
GrafMenu.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1998
----------------------------------------------*)
IMPORT h2d_GrafMenu;
IMPORT Windows;
IMPORT SYSTEM;
IMPORT Str;
CONST
szAppName = "GrafMenu";
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
hBitmapHelp : Windows.HBITMAP;
hBitmapFile : Windows.HBITMAP;
hBitmapEdit : Windows.HBITMAP;
hBitmapFont : Windows.HBITMAP;
hBitmapPopFont : ARRAY[0..2] OF Windows.HBITMAP;
hMenu : Windows.HMENU;
hMenuPopup : Windows.HMENU;
i : INTEGER;
TYPE
FontName = ARRAY[0..14] OF CHAR;
FontNameArr = ARRAY[0..2] OF FontName;
CONST (* static *)
szFaceName = FontNameArr
{ "Courier New", "Arial",
"Times New Roman" };
VAR (* static *)
lf : Windows.LOGFONT;
VAR (* static in WndProc *)
iCurrentFont : INTEGER;
pstr : Windows.PSTR;
(*++++*****************************************************************)
PROCEDURE StretchBitmap (hBitmap1 : Windows.HBITMAP) : Windows.HBITMAP;
(**********************************************************************)
VAR
bm1 : Windows.BITMAP;
bm2 : Windows.BITMAP;
hBitmap2 : Windows.HBITMAP;
hdc : Windows.HDC;
hdcMem1 : Windows.HDC;
hdcMem2 : Windows.HDC;
tm : Windows.TEXTMETRIC;
ch2 : ARRAY[0..1] OF Windows.WCHAR;
BEGIN
hdc := Windows.CreateIC ("DISPLAY", ch2, NIL, NIL);
Windows.GetTextMetrics (hdc, tm);
hdcMem1 := Windows.CreateCompatibleDC (hdc);
hdcMem2 := Windows.CreateCompatibleDC (hdc);
Windows.DeleteDC (hdc);
(*
GetObject (hBitmap1, sizeof (BITMAP), (PSTR) &bm1) ;
*)
Windows.GetObject (SYSTEM.CAST(Windows.HGDIOBJ,hBitmap1), SIZE(Windows.BITMAP), bm1);
bm2 := bm1;
bm2.bmWidth := (tm.tmAveCharWidth * bm2.bmWidth) DIV 4;
bm2.bmHeight := (tm.tmHeight * bm2.bmHeight) DIV 8;
bm2.bmWidthBytes := ((bm2.bmWidth + 15) DIV 16) * 2;
hBitmap2 := Windows.CreateBitmapIndirect (bm2);
Windows.SelectObject (hdcMem1, SYSTEM.CAST(Windows.HGDIOBJ,hBitmap1));
Windows.SelectObject (hdcMem2, SYSTEM.CAST(Windows.HGDIOBJ,hBitmap2));
Windows.StretchBlt (hdcMem2, 0, 0, bm2.bmWidth, bm2.bmHeight,
hdcMem1, 0, 0, bm1.bmWidth, bm1.bmHeight, Windows.SRCCOPY);
Windows.DeleteDC (hdcMem1);
Windows.DeleteDC (hdcMem2);
Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hBitmap1));
RETURN hBitmap2;
END StretchBitmap;
(*++++*****************************************************************)
PROCEDURE GetBitmapFont (i : INTEGER) : Windows.HBITMAP;
(**********************************************************************)
VAR
hBitmap : Windows.HBITMAP;
hdc : Windows.HDC;
hdcMem : Windows.HDC;
hFont : Windows.HFONT;
size : Windows.SIZEL;
tm : Windows.TEXTMETRIC;
ch2 : ARRAY[0..1] OF Windows.WCHAR;
BEGIN
hdc := Windows.CreateIC ("DISPLAY", ch2, NIL, NIL);
Windows.GetTextMetrics (hdc, tm);
lf.lfHeight := 2 * tm.tmHeight;
Str.Copy(lf.lfFaceName,szFaceName[i]);
hdcMem := Windows.CreateCompatibleDC (hdc);
hFont := SYSTEM.CAST(Windows.HFONT, Windows.SelectObject (hdcMem, SYSTEM.CAST(Windows.HGDIOBJ,Windows.CreateFontIndirect(lf))));
Windows.GetTextExtentPoint (hdcMem, szFaceName[i], LENGTH(szFaceName[i]), size);
hBitmap := Windows.CreateBitmap (size.x, size.y, 1, 1, "");
Windows.SelectObject (hdcMem, SYSTEM.CAST(Windows.HGDIOBJ,hBitmap));
Windows.TextOut (hdcMem, 0, 0, szFaceName[i], LENGTH (szFaceName[i]));
Windows.DeleteObject (Windows.SelectObject (hdcMem, SYSTEM.CAST(Windows.HGDIOBJ,hFont)));
Windows.DeleteDC (hdcMem);
Windows.DeleteDC (hdc);
RETURN hBitmap;
END GetBitmapFont;
(*++++*****************************************************************)
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_CREATE :
Windows.CheckMenuItem (Windows.GetMenu (hwnd), iCurrentFont, Windows.MF_CHECKED);
RETURN 0;
| Windows.WM_SYSCOMMAND :
CASE (Windows.LOWORD (wParam)) OF
| h2d_GrafMenu.IDM_HELP :
Windows.MessageBox (hwnd, "Help not yet implemented!",
szAppName, Windows.MB_OK + Windows.MB_ICONEXCLAMATION);
RETURN 0;
ELSE
END;
| Windows.WM_COMMAND :
CASE (Windows.LOWORD (wParam)) OF
| h2d_GrafMenu.IDM_NEW :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_GrafMenu.IDM_OPEN :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_GrafMenu.IDM_SAVE :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_GrafMenu.IDM_SAVEAS :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_GrafMenu.IDM_UNDO :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_GrafMenu.IDM_CUT :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_GrafMenu.IDM_COPY :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_GrafMenu.IDM_PASTE :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_GrafMenu.IDM_DEL :
Windows.MessageBeep (SYSTEM.CAST(Windows.MB_SET,0));
RETURN 0;
| h2d_GrafMenu.IDM_COUR :
hMenu := Windows.GetMenu (hwnd);
Windows.CheckMenuItem (hMenu, iCurrentFont, Windows.MF_UNCHECKED);
iCurrentFont := Windows.LOWORD (wParam);
Windows.CheckMenuItem (hMenu, iCurrentFont, Windows.MF_CHECKED);
RETURN 0;
| h2d_GrafMenu.IDM_ARIAL :
hMenu := Windows.GetMenu (hwnd);
Windows.CheckMenuItem (hMenu, iCurrentFont, Windows.MF_UNCHECKED);
iCurrentFont := Windows.LOWORD (wParam);
Windows.CheckMenuItem (hMenu, iCurrentFont, Windows.MF_CHECKED);
RETURN 0;
| h2d_GrafMenu.IDM_TIMES :
hMenu := Windows.GetMenu (hwnd);
Windows.CheckMenuItem (hMenu, iCurrentFont, Windows.MF_UNCHECKED);
iCurrentFont := Windows.LOWORD (wParam);
Windows.CheckMenuItem (hMenu, iCurrentFont, Windows.MF_CHECKED);
RETURN 0;
ELSE
END;
| Windows.WM_DESTROY :
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END WndProc;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
i : INTEGER;
rc : INTEGER;
pstr : Windows.PSTR;
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 := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := Windows.LoadIcon (NIL, Windows.IDI_APPLICATION);
rc := Windows.RegisterClassEx (wc);
hMenu := Windows.CreateMenu ();
hMenuPopup := Windows.LoadMenu (Windows.MyInstance(), "MenuFile");
hBitmapFile := StretchBitmap (Windows.LoadBitmap (Windows.MyInstance(), "BitmapFile"));
pstr := SYSTEM.CAST(Windows.PSTR,SYSTEM.CAST(Windows.LONG,hBitmapFile));
Windows.AppendMenu (hMenu, Windows.MF_BITMAP + Windows.MF_POPUP, SYSTEM.CAST(INTEGER,hMenuPopup),
pstr);
hMenuPopup := Windows.LoadMenu (Windows.MyInstance(), "MenuEdit");
hBitmapEdit := StretchBitmap (Windows.LoadBitmap (Windows.MyInstance(), "BitmapEdit"));
pstr := SYSTEM.CAST(Windows.PSTR,SYSTEM.CAST(Windows.LONG,hBitmapEdit));
Windows.AppendMenu (hMenu, Windows.MF_BITMAP + Windows.MF_POPUP, SYSTEM.CAST(INTEGER,hMenuPopup),
pstr);
hMenuPopup := Windows.CreateMenu ();
FOR i := 0 TO 3-1 DO
hBitmapPopFont[i] := GetBitmapFont (i);
pstr := SYSTEM.CAST(Windows.PSTR,SYSTEM.CAST(Windows.LONG,hBitmapPopFont[i]));
Windows.AppendMenu (hMenuPopup, Windows.MF_BITMAP, h2d_GrafMenu.IDM_COUR + i,
pstr);
END;
hBitmapFont := StretchBitmap (Windows.LoadBitmap (Windows.MyInstance(), "BitmapFont"));
pstr := SYSTEM.CAST(Windows.PSTR,SYSTEM.CAST(Windows.LONG,hBitmapFont));
Windows.AppendMenu (hMenu, Windows.MF_BITMAP + Windows.MF_POPUP, SYSTEM.CAST(INTEGER,hMenuPopup),
pstr);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := Windows.CreateWindow (szAppName,
"Bitmap 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;
hMenu := Windows.GetSystemMenu (hwnd, FALSE);
hBitmapHelp := StretchBitmap (Windows.LoadBitmap (Windows.MyInstance(), "BitmapHelp"));
Windows.AppendMenu (hMenu, Windows.MF_SEPARATOR, 0, NIL);
pstr := SYSTEM.CAST(Windows.PSTR,SYSTEM.CAST(Windows.LONG,hBitmapHelp));
Windows.AppendMenu (hMenu, Windows.MF_BITMAP, h2d_GrafMenu.IDM_HELP, pstr);
Windows.ShowWindow (hwnd, Windows.SW_SHOWDEFAULT);
Windows.UpdateWindow (hwnd);
RETURN TRUE;
END InitMainWindow;
(*++++*****************************************************************)
BEGIN
iCurrentFont := h2d_GrafMenu.IDM_COUR;
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hBitmapHelp));
Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hBitmapEdit));
Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hBitmapFile));
Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hBitmapFont));
FOR i := 0 TO 3-1 DO
Windows.DeleteObject (SYSTEM.CAST(Windows.HGDIOBJ,hBitmapPopFont[i]));
END;
END;
END GrafMenu.