Last updated: 15. 1.1998, 21:42
<*/NOWARN:F*>
MODULE Print3;
(*---------------------------------------
PRINT3.C --- Printing with Dialog Box
(c) Charles Petzold, 1996
Print3.mod --- Translation to Stony Brook Modula-2
(c) Peter Stadler, 1997
---------------------------------------*)
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINGDI;
IMPORT WINX;
IMPORT COMMDLG;
IMPORT SYSTEM;
IMPORT WINSPOOL;
CONST
szAppName = "Print3";
szCaption = "Print Program 3 (Dialog Box)";
VAR
bUserAbort : BOOLEAN;
hDlgPrint : WIN32.HWND;
VAR
hwnd : WIN32.HWND;
msg : WINUSER.MSG;
wc : WINUSER.WNDCLASSEX;
hInst : WIN32.HINSTANCE;
(* static in PageGDICalls *)
CONST
szTextStr = "Hello, Printer!";
(* static in WndProc *)
VAR
cxClient : INTEGER;
cyClient : INTEGER;
(* static in PrintMyPage *)
VAR
di : WINGDI.DOCINFO;
(*++++*****************************************************************)
PROCEDURE GetPrinterDC() : WIN32.HDC;
(**********************************************************************)
VAR
pinfo5 : ARRAY[0..2] OF WINSPOOL.PRINTER_INFO_5;
dwNeeded : WIN32.DWORD;
dwReturned: WIN32.DWORD;
BEGIN
IF (WINSPOOL.EnumPrinters (WINSPOOL.PRINTER_ENUM_DEFAULT, WINX.NIL_ASTR, 5, SYSTEM.CAST(WIN32.LPBYTE,pinfo5),
SIZE (pinfo5), dwNeeded, dwReturned)) THEN
RETURN WINGDI.CreateDC (WINX.NIL_ASTR, pinfo5[0].pPrinterName^, WINX.NIL_ASTR, WINX.NIL_DEVMODEA);
END;
RETURN NIL; (* EnumPrinters failed, so RETURN null hdc *)
END GetPrinterDC;
(*++++*****************************************************************)
PROCEDURE PageGDICalls(hdcPrn : WIN32.HDC;
cxPage : INTEGER;
cyPage : INTEGER);
(**********************************************************************)
BEGIN
WINGDI.Rectangle (hdcPrn, 0, 0, cxPage, cyPage);
WINGDI.MoveToEx (hdcPrn, 0, 0, WINX.NIL_POINT);
WINGDI.LineTo (hdcPrn, cxPage, cyPage);
WINGDI.MoveToEx (hdcPrn, cxPage, 0, WINX.NIL_POINT);
WINGDI.LineTo (hdcPrn, 0, cyPage);
WINGDI.SaveDC (hdcPrn);
WINGDI.SetMapMode (hdcPrn, WINGDI.MM_ISOTROPIC);
WINGDI.SetWindowExtEx (hdcPrn, 1000, 1000, WINX.NIL_SIZE);
WINGDI.SetViewportExtEx (hdcPrn, cxPage DIV 2, -cyPage DIV 2, WINX.NIL_SIZE);
WINGDI.SetViewportOrgEx (hdcPrn, cxPage DIV 2, cyPage DIV 2, WINX.NIL_POINT);
WINGDI.Ellipse (hdcPrn, -500, 500, 500, -500);
WINGDI.SetTextAlign (hdcPrn, WINGDI.TA_BASELINE BOR WINGDI.TA_CENTER);
WINGDI.TextOut (hdcPrn, 0, 0, szTextStr, SIZE (szTextStr) - 1);
WINGDI.RestoreDC (hdcPrn, -1);
END PageGDICalls;
<*/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
hdc : WIN32.HDC;
hMenu : WIN32.HMENU;
ps : WINUSER.PAINTSTRUCT;
BEGIN
CASE (iMsg) OF
| WINUSER.WM_CREATE :
hMenu := WINUSER.GetSystemMenu (hwnd, FALSE);
WINUSER.AppendMenu (hMenu, WINUSER.MF_SEPARATOR, 0, WINX.NIL_ASTR);
WINUSER.AppendMenu (hMenu, 0, 1, "Print");
RETURN 0;
| WINUSER.WM_SIZE :
cxClient := WINUSER.LOWORD (lParam);
cyClient := WINUSER.HIWORD (lParam);
RETURN 0;
| WINUSER.WM_SYSCOMMAND :
IF (wParam = 1) THEN
IF (PrintMyPage (hwnd)) THEN
WINUSER.MessageBox (hwnd, "Could not print page!",
szAppName, WINUSER.MB_OK BOR WINUSER.MB_ICONEXCLAMATION);
END;
RETURN 0;
END;
| WINUSER.WM_PAINT :
hdc := WINUSER.BeginPaint (hwnd, ps);
PageGDICalls (hdc, cxClient, cyClient);
WINUSER.EndPaint (hwnd, ps);
RETURN 0;
| WINUSER.WM_DESTROY :
WINUSER.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
<*/POP*>
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE PrintDlgProc (hDlg : WIN32.HWND;
iMsg : WIN32.UINT;
wParam : WIN32.WPARAM;
lParam : WIN32.LPARAM) : WIN32.BOOL [EXPORT];
(**********************************************************************)
BEGIN
CASE (iMsg) OF
| WINUSER.WM_INITDIALOG :
WINUSER.SetWindowText (hDlg, szAppName);
WINUSER.EnableMenuItem (WINUSER.GetSystemMenu (hDlg, FALSE), WINUSER.SC_CLOSE,
WINUSER.MF_GRAYED);
RETURN TRUE;
| WINUSER.WM_COMMAND :
bUserAbort := TRUE;
WINUSER.EnableWindow (WINUSER.GetParent (hDlg), TRUE);
WINUSER.DestroyWindow (hDlg);
hDlgPrint := NIL;
RETURN TRUE;
ELSE
END;
RETURN FALSE;
END PrintDlgProc;
<*/POP*>
<*/PUSH*>
%IF WIN32 %THEN
<*/CALLS:WIN32SYSTEM*>
%ELSE
<*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE AbortProc (hdcPrn : WIN32.HDC;
iCode : INTEGER) : WIN32.BOOL [EXPORT];
(**********************************************************************)
VAR
msg : WINUSER.MSG;
BEGIN
WHILE (NOT bUserAbort AND WINUSER.PeekMessage (msg, NIL, 0, 0, WINUSER.PM_REMOVE)) DO
IF (hDlgPrint=NIL) OR (NOT WINUSER.IsDialogMessage (hDlgPrint, msg)) THEN
WINUSER.TranslateMessage (msg);
WINUSER.DispatchMessage (msg);
END;
END;
RETURN NOT bUserAbort;
END AbortProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE PrintMyPage(hwnd : WIN32.HWND) : BOOLEAN;
(**********************************************************************)
VAR
bError : BOOLEAN = FALSE;
hdcPrn : WIN32.HDC;
xPage : INTEGER16;
yPage : INTEGER16;
BEGIN
hdcPrn := GetPrinterDC ();
IF (NIL = hdcPrn) THEN
RETURN TRUE;
END;
xPage := WINGDI.GetDeviceCaps (hdcPrn, WINGDI.HORZRES);
yPage := WINGDI.GetDeviceCaps (hdcPrn, WINGDI.VERTRES);
WINUSER.EnableWindow (hwnd, FALSE);
bUserAbort := FALSE;
hDlgPrint := WINUSER.CreateDialog (hInst, "PrintDlgBox", hwnd, PrintDlgProc);
WINGDI.SetAbortProc (hdcPrn, SYSTEM.CAST(WINGDI.ABORTPROC,AbortProc));
IF (WINGDI.StartDoc (hdcPrn, di) > 0) THEN
IF (WINGDI.StartPage (hdcPrn) > 0) THEN
PageGDICalls (hdcPrn, xPage, yPage);
IF (WINGDI.EndPage (hdcPrn) > 0) THEN
WINGDI.EndDoc (hdcPrn);
ELSE
bError := TRUE;
END;
END;
ELSE
bError := TRUE;
END;
IF (NOT bUserAbort) THEN
WINUSER.EnableWindow (hwnd, TRUE);
WINUSER.DestroyWindow (hDlgPrint);
END;
WINGDI.DeleteDC (hdcPrn);
RETURN bError OR bUserAbort;
END PrintMyPage;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
rc : CARDINAL;
BEGIN
wc.cbSize := SIZE(wc);
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);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hInst := WINX.Instance;
hwnd := WINUSER.CreateWindow (
szAppName, (* window class name *)
szCaption, (* 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
di := WINGDI.DOCINFO{ SIZE(WINGDI.DOCINFO), SYSTEM.ADR("Print3: Printing"), NIL };
IF InitApplication() AND InitMainWindow() THEN
WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
WINUSER.TranslateMessage(msg);
WINUSER.DispatchMessage(msg);
END;
END;
END Print3.