Last updated: 26. 1.1998, 20:35
<* +M2EXTENSIONS *>
MODULE Print4;
(*---------------------------------------
PRINT4.C --- Printing with Banding
(c) Charles Petzold, 1996
Print4.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
---------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
IMPORT Windows;
CONST
szAppName = "Print4";
szCaption = "Print Program 4 (Banding)";
VAR
bUserAbort : BOOLEAN;
hDlgPrint : Windows.HWND;
VAR
hwnd : Windows.HWND;
msg : Windows.MSG;
wc : Windows.WNDCLASSEX;
hInst : Windows.HINSTANCE;
(* static in PageGDICalls *)
CONST
szTextStr = "Hello, Printer!";
(* static in WndProc *)
VAR
cxClient : INTEGER;
cyClient : INTEGER;
(* static in PrintMyPage *)
VAR
di : Windows.DOCINFO;
(*++++*****************************************************************)
PROCEDURE GetPrinterDC() : Windows.HDC;
(**********************************************************************)
VAR
pinfo5 : ARRAY[0..2] OF Windows.PRINTER_INFO_5;
dwNeeded : Windows.DWORD;
dwReturned: Windows.DWORD;
BEGIN
IF (Windows.EnumPrinters (Windows.PRINTER_ENUM_DEFAULT, NIL, 5, SYSTEM.CAST(Windows.LPBYTE,pinfo5),
SIZE (pinfo5), dwNeeded, dwReturned)) THEN
RETURN Windows.CreateDC (NIL, pinfo5[0].pPrinterName^, NIL, NIL);
END;
RETURN NIL; (* EnumPrinters failed, so RETURN null hdc *)
END GetPrinterDC;
(*++++*****************************************************************)
PROCEDURE PageGDICalls(hdcPrn : Windows.HDC;
cxPage : INTEGER;
cyPage : INTEGER);
(**********************************************************************)
BEGIN
Windows.Rectangle (hdcPrn, 0, 0, cxPage, cyPage);
Windows.MoveToEx (hdcPrn, 0, 0, NIL);
Windows.LineTo (hdcPrn, cxPage, cyPage);
Windows.MoveToEx (hdcPrn, cxPage, 0, NIL);
Windows.LineTo (hdcPrn, 0, cyPage);
Windows.SaveDC (hdcPrn);
Windows.SetMapMode (hdcPrn, Windows.MM_ISOTROPIC);
Windows.SetWindowExtEx (hdcPrn, 1000, 1000, NIL);
Windows.SetViewportExtEx (hdcPrn, cxPage DIV 2, -cyPage DIV 2, NIL);
Windows.SetViewportOrgEx (hdcPrn, cxPage DIV 2, cyPage DIV 2, NIL);
Windows.Ellipse (hdcPrn, -500, 500, 500, -500);
Windows.SetTextAlign (hdcPrn, Windows.TA_BASELINE + Windows.TA_CENTER);
Windows.TextOut (hdcPrn, 0, 0, szTextStr, SIZE (szTextStr) - 1);
Windows.RestoreDC (hdcPrn, -1);
END PageGDICalls;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] WndProc (hwnd : Windows.HWND;
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.LRESULT;
(**********************************************************************)
VAR
hdc : Windows.HDC;
hMenu : Windows.HMENU;
ps : Windows.PAINTSTRUCT;
BEGIN
CASE (iMsg) OF
| Windows.WM_CREATE :
hMenu := Windows.GetSystemMenu (hwnd, FALSE);
Windows.AppendMenu (hMenu, Windows.MF_SEPARATOR, 0, NIL);
Windows.AppendMenu (hMenu, 0, 1, "Print");
RETURN 0;
| Windows.WM_SIZE :
cxClient := Windows.LOWORD (lParam);
cyClient := Windows.HIWORD (lParam);
RETURN 0;
| Windows.WM_SYSCOMMAND :
IF (wParam = 1) THEN
IF (PrintMyPage (hwnd)) THEN
Windows.MessageBox (hwnd, "Could not print page!",
szAppName, Windows.MB_OK + Windows.MB_ICONEXCLAMATION);
END;
RETURN 0;
END;
| Windows.WM_PAINT :
hdc := Windows.BeginPaint (hwnd, ps);
PageGDICalls (hdc, cxClient, cyClient);
Windows.EndPaint (hwnd, ps);
RETURN 0;
| Windows.WM_DESTROY :
Windows.PostQuitMessage (0);
RETURN 0;
ELSE
RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam);
END;
END WndProc;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] PrintDlgProc (hDlg : Windows.HWND;
iMsg : Windows.UINT;
wParam : Windows.WPARAM;
lParam : Windows.LPARAM) : Windows.BOOL;
(**********************************************************************)
BEGIN
CASE (iMsg) OF
| Windows.WM_INITDIALOG :
Windows.SetWindowText (hDlg, szAppName);
Windows.SetWindowText (hDlg, szAppName);
Windows.EnableMenuItem (Windows.GetSystemMenu (hDlg, FALSE), Windows.SC_CLOSE,
Windows.MF_GRAYED);
RETURN TRUE;
| Windows.WM_COMMAND :
bUserAbort := TRUE;
Windows.EnableWindow (Windows.GetParent (hDlg), TRUE);
Windows.DestroyWindow (hDlg);
hDlgPrint := NIL;
RETURN TRUE;
ELSE
END;
RETURN FALSE;
END PrintDlgProc;
(*++++*****************************************************************)
PROCEDURE [Windows.CALLBACK] AbortProc (hdcPrn : Windows.HDC;
iCode : INTEGER) : Windows.BOOL;
(**********************************************************************)
VAR
msg : Windows.MSG;
BEGIN
WHILE (NOT bUserAbort AND Windows.PeekMessage (msg, NIL, 0, 0, Windows.PM_REMOVE)) DO
IF (hDlgPrint=NIL) OR (NOT Windows.IsDialogMessage (hDlgPrint, msg)) THEN
Windows.TranslateMessage (msg);
Windows.DispatchMessage (msg);
END;
END;
RETURN NOT bUserAbort;
END AbortProc;
(*++++*****************************************************************)
PROCEDURE PrintMyPage(hwnd : Windows.HWND) : BOOLEAN;
(**********************************************************************)
VAR
bError : BOOLEAN = FALSE;
hdcPrn : Windows.HDC;
xPage : INTEGER16;
yPage : INTEGER16;
rect : Windows.RECT;
BEGIN
hdcPrn := GetPrinterDC ();
IF (NIL = hdcPrn) THEN
RETURN TRUE;
END;
xPage := Windows.GetDeviceCaps (hdcPrn, Windows.HORZRES);
yPage := Windows.GetDeviceCaps (hdcPrn, Windows.VERTRES);
Windows.EnableWindow (hwnd, FALSE);
bUserAbort := FALSE;
hDlgPrint := Windows.CreateDialog (hInst, "PrintDlgBox", hwnd, PrintDlgProc);
Windows.SetAbortProc (hdcPrn, SYSTEM.CAST(Windows.ABORTPROC,AbortProc));
IF (Windows.StartDoc (hdcPrn, di) > 0) AND
(Windows.StartPage (hdcPrn) > 0) AND
(Windows.ExtEscape (hdcPrn, Windows.NEXTBAND, 0, NIL, SIZE (rect), NIL (*rect*)) > 0) THEN
WHILE (NOT Windows.IsRectEmpty (rect) AND (NOT bUserAbort)) DO
Windows.Rectangle (hdcPrn, rect.left, rect.top, rect.right,
rect.bottom);
PageGDICalls (hdcPrn, xPage, yPage);
IF (Windows.ExtEscape (hdcPrn, Windows.NEXTBAND, 0, NIL, SIZE (rect),
NIL(*rect*) )< 0) THEN
bError := TRUE; (* If error, set flag and *)
(* break; *) (* break out of loop *)
END;
END;
ELSE
bError := TRUE;
END;
IF (NOT bError) THEN
IF (bUserAbort) THEN
Windows.AbortDoc (hdcPrn);
ELSE
IF (Windows.EndPage (hdcPrn)#0) THEN
Windows.EndDoc (hdcPrn);
END;
END;
END;
IF (NOT bUserAbort) THEN
Windows.EnableWindow (hwnd, TRUE);
Windows.DestroyWindow (hDlgPrint);
END;
Windows.DeleteDC (hdcPrn);
RETURN bError OR bUserAbort;
END PrintMyPage;
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
rc : CARDINAL;
BEGIN
wc.cbSize := SIZE(wc);
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);
RETURN rc#0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
hInst := Windows.MyInstance();
hwnd := Windows.CreateWindow (
szAppName, (* window class name *)
szCaption, (* 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
di := Windows.DOCINFO{ SIZE(Windows.DOCINFO), SYSTEM.ADR("Print4: Printing"), NIL };
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END Print4.