Last updated: 12. 2.1998, 22:31
<*/NOWARN:F*>
MODULE GrafMenu;
(*----------------------------------------------
GRAFMENU.C --- Demonstrates Bitmap Menu Items
(c) Charles Petzold, 1996
GrafMenu.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1998
----------------------------------------------*)
%IF WIN32 %THEN
<*/Resource:GRAFMENU.RES*>
%ELSE
%END
IMPORT h2d_GrafMenu;
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINX;
IMPORT WINGDI;
IMPORT SYSTEM;
IMPORT Str;
CONST
szAppName = "GrafMenu";
VAR
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
hBitmapHelp : WIN32.HBITMAP;
hBitmapFile : WIN32.HBITMAP;
hBitmapEdit : WIN32.HBITMAP;
hBitmapFont : WIN32.HBITMAP;
hBitmapPopFont : ARRAY[0..2] OF WIN32.HBITMAP;
hMenu : WIN32.HMENU;
hMenuPopup : WIN32.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 : WINGDI.LOGFONT;
VAR (* static in WndProc *)
iCurrentFont : INTEGER = h2d_GrafMenu.IDM_COUR;
pstr : WIN32.PSTR;
(*++++*****************************************************************)
PROCEDURE StretchBitmap (hBitmap1 : WIN32.HBITMAP) : WIN32.HBITMAP;
(**********************************************************************)
VAR
bm1 : WINGDI.BITMAP;
bm2 : WINGDI.BITMAP;
hBitmap2 : WIN32.HBITMAP;
hdc : WIN32.HDC;
hdcMem1 : WIN32.HDC;
hdcMem2 : WIN32.HDC;
tm : WINGDI.TEXTMETRIC;
BEGIN
hdc := WINGDI.CreateIC ("DISPLAY", WINX.NIL_ASTR, WINX.NIL_ASTR, WINX.NIL_DEVMODEA);
WINGDI.GetTextMetrics (hdc, tm);
hdcMem1 := WINGDI.CreateCompatibleDC (hdc);
hdcMem2 := WINGDI.CreateCompatibleDC (hdc);
WINGDI.DeleteDC (hdc);
WINGDI.GetObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap1), SIZE (WINGDI.BITMAP), SYSTEM.CAST(WIN32.PSTR,SYSTEM.ADR(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 := WINGDI.CreateBitmapIndirect (bm2);
WINGDI.SelectObject (hdcMem1, SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap1));
WINGDI.SelectObject (hdcMem2, SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap2));
WINGDI.StretchBlt (hdcMem2, 0, 0, bm2.bmWidth, bm2.bmHeight,
hdcMem1, 0, 0, bm1.bmWidth, bm1.bmHeight, WINGDI.SRCCOPY);
WINGDI.DeleteDC (hdcMem1);
WINGDI.DeleteDC (hdcMem2);
WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap1));
RETURN hBitmap2;
END StretchBitmap;
(*++++*****************************************************************)
PROCEDURE GetBitmapFont (i : INTEGER) : WIN32.HBITMAP;
(**********************************************************************)
VAR
hBitmap : WIN32.HBITMAP;
hdc : WIN32.HDC;
hdcMem : WIN32.HDC;
hFont : WIN32.HFONT;
size : WIN32.WSIZE;
tm : WINGDI.TEXTMETRIC;
BEGIN
hdc := WINGDI.CreateIC ("DISPLAY", WINX.NIL_ASTR, WINX.NIL_ASTR, WINX.NIL_DEVMODEA);
WINGDI.GetTextMetrics (hdc, tm);
lf.lfHeight := 2 * tm.tmHeight;
Str.Copy(lf.lfFaceName,szFaceName[i]);
hdcMem := WINGDI.CreateCompatibleDC (hdc);
hFont := SYSTEM.CAST(WIN32.HFONT, WINGDI.SelectObject (hdcMem, SYSTEM.CAST(WIN32.HGDIOBJ,WINGDI.CreateFontIndirect(lf))));
WINGDI.GetTextExtentPoint (hdcMem, szFaceName[i], LENGTH(szFaceName[i]), size);
hBitmap := WINGDI.CreateBitmap (size.cx, size.cy, 1, 1, NIL);
WINGDI.SelectObject (hdcMem, SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap));
WINGDI.TextOut (hdcMem, 0, 0, szFaceName[i], LENGTH (szFaceName[i]));
WINGDI.DeleteObject (WINGDI.SelectObject (hdcMem, SYSTEM.CAST(WIN32.HGDIOBJ,hFont)));
WINGDI.DeleteDC (hdcMem);
WINGDI.DeleteDC (hdc);
RETURN hBitmap;
END GetBitmapFont;
<*/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_CREATE :
WINUSER.CheckMenuItem (WINUSER.GetMenu (hwnd), iCurrentFont, WINUSER.MF_CHECKED);
RETURN 0;
| WINUSER.WM_SYSCOMMAND :
CASE (WINUSER.LOWORD (wParam)) OF
| h2d_GrafMenu.IDM_HELP :
WINUSER.MessageBox (hwnd, "Help not yet implemented!",
szAppName, WINUSER.MB_OK BOR WINUSER.MB_ICONEXCLAMATION);
RETURN 0;
ELSE
END;
| WINUSER.WM_COMMAND :
CASE (WINUSER.LOWORD (wParam)) OF
| h2d_GrafMenu.IDM_NEW :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_GrafMenu.IDM_OPEN :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_GrafMenu.IDM_SAVE :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_GrafMenu.IDM_SAVEAS :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_GrafMenu.IDM_UNDO :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_GrafMenu.IDM_CUT :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_GrafMenu.IDM_COPY :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_GrafMenu.IDM_PASTE :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_GrafMenu.IDM_DEL :
WINUSER.MessageBeep (0);
RETURN 0;
| h2d_GrafMenu.IDM_COUR :
hMenu := WINUSER.GetMenu (hwnd);
WINUSER.CheckMenuItem (hMenu, iCurrentFont, WINUSER.MF_UNCHECKED);
iCurrentFont := WINUSER.LOWORD (wParam);
WINUSER.CheckMenuItem (hMenu, iCurrentFont, WINUSER.MF_CHECKED);
RETURN 0;
| h2d_GrafMenu.IDM_ARIAL :
hMenu := WINUSER.GetMenu (hwnd);
WINUSER.CheckMenuItem (hMenu, iCurrentFont, WINUSER.MF_UNCHECKED);
iCurrentFont := WINUSER.LOWORD (wParam);
WINUSER.CheckMenuItem (hMenu, iCurrentFont, WINUSER.MF_CHECKED);
RETURN 0;
| h2d_GrafMenu.IDM_TIMES :
hMenu := WINUSER.GetMenu (hwnd);
WINUSER.CheckMenuItem (hMenu, iCurrentFont, WINUSER.MF_UNCHECKED);
iCurrentFont := WINUSER.LOWORD (wParam);
WINUSER.CheckMenuItem (hMenu, iCurrentFont, WINUSER.MF_CHECKED);
RETURN 0;
ELSE
END;
| WINUSER.WM_DESTROY :
WINUSER.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END WndProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
i : INTEGER;
rc : INTEGER;
pstr : WIN32.PSTR;
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 := NIL;
wc.lpszClassName := SYSTEM.ADR(szAppName);
wc.hIconSm := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);
rc := WINUSER.RegisterClassEx (wc);
hMenu := WINUSER.CreateMenu ();
hMenuPopup := WINUSER.LoadMenu (WINX.Instance, "MenuFile");
hBitmapFile := StretchBitmap (WINUSER.LoadBitmap (WINX.Instance, "BitmapFile"));
pstr := SYSTEM.CAST(WIN32.PSTR,SYSTEM.CAST(WIN32.LONG,hBitmapFile));
WINUSER.AppendMenu (hMenu, WINUSER.MF_BITMAP BOR WINUSER.MF_POPUP, SYSTEM.CAST(INTEGER,hMenuPopup),
pstr^);
hMenuPopup := WINUSER.LoadMenu (WINX.Instance, "MenuEdit");
hBitmapEdit := StretchBitmap (WINUSER.LoadBitmap (WINX.Instance, "BitmapEdit"));
pstr := SYSTEM.CAST(WIN32.PSTR,SYSTEM.CAST(WIN32.LONG,hBitmapEdit));
WINUSER.AppendMenu (hMenu, WINUSER.MF_BITMAP BOR WINUSER.MF_POPUP, SYSTEM.CAST(INTEGER,hMenuPopup),
pstr^);
hMenuPopup := WINUSER.CreateMenu ();
FOR i := 0 TO 3-1 DO
hBitmapPopFont[i] := GetBitmapFont (i);
pstr := SYSTEM.CAST(WIN32.PSTR,SYSTEM.CAST(WIN32.LONG,hBitmapPopFont[i]));
WINUSER.AppendMenu (hMenuPopup, WINUSER.MF_BITMAP, h2d_GrafMenu.IDM_COUR + i,
pstr^);
END;
hBitmapFont := StretchBitmap (WINUSER.LoadBitmap (WINX.Instance, "BitmapFont"));
pstr := SYSTEM.CAST(WIN32.PSTR,SYSTEM.CAST(WIN32.LONG,hBitmapFont));
WINUSER.AppendMenu (hMenu, WINUSER.MF_BITMAP BOR WINUSER.MF_POPUP, SYSTEM.CAST(INTEGER,hMenuPopup),
pstr^);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hwnd := WINUSER.CreateWindow (szAppName,
"Bitmap 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;
hMenu := WINUSER.GetSystemMenu (hwnd, FALSE);
hBitmapHelp := StretchBitmap (WINUSER.LoadBitmap (WINX.Instance, "BitmapHelp"));
WINUSER.AppendMenu (hMenu, WINUSER.MF_SEPARATOR, 0, WINX.NIL_ASTR);
pstr := SYSTEM.CAST(WIN32.PSTR,SYSTEM.CAST(WIN32.LONG,hBitmapHelp));
WINUSER.AppendMenu (hMenu, WINUSER.MF_BITMAP, h2d_GrafMenu.IDM_HELP, pstr^);
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;
WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmapHelp));
WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmapEdit));
WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmapFile));
WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmapFont));
FOR i := 0 TO 3-1 DO
WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmapPopFont[i]));
END;
END;
END GrafMenu.