Last updated: 26. 1.1998, 20:44
<* +M2EXTENSIONS *>
MODULE Print1;
(*---------------------------------------
PRINT1.C --- Bare Bones Printing
(c) Charles Petzold, 1996
Print1.mod --- Translation to XDS Modula-2
(c) Peter Stadler, 1997
---------------------------------------*)
IMPORT Windows;
IMPORT SYSTEM;
CONST
szAppName = "Print1";
szCaption = "Print Program 1";
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.PBYTE,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 PrintMyPage(hwnd : Windows.HWND) : BOOLEAN;
(**********************************************************************)
VAR
bError : BOOLEAN;
hdcPrn : Windows.HDC;
xPage : INTEGER;
yPage : INTEGER;
BEGIN
bError := FALSE;
hdcPrn := GetPrinterDC ();
IF (NIL = hdcPrn) THEN
RETURN TRUE;
END;
xPage := Windows.GetDeviceCaps (hdcPrn, Windows.HORZRES);
yPage := Windows.GetDeviceCaps (hdcPrn, Windows.VERTRES);
IF (Windows.StartDoc (hdcPrn, di)> 0) THEN
IF (Windows.StartPage (hdcPrn) > 0) THEN
PageGDICalls (hdcPrn, xPage, yPage);
IF (Windows.EndPage (hdcPrn) > 0) THEN
Windows.EndDoc (hdcPrn);
ELSE
bError := TRUE;
END;
END;
ELSE
bError := TRUE;
END;
Windows.DeleteDC (hdcPrn);
RETURN bError;
END PrintMyPage;
(*++++*****************************************************************)
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, SYSTEM.CAST(Windows.MF_SET,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 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;
(*++++*****************************************************************)
CONST
print = "Print1: Printing";
BEGIN
di := Windows.DOCINFO{ SIZE(Windows.DOCINFO), SYSTEM.ADR(print), NIL,NIL,0 };
IF InitApplication() AND InitMainWindow() THEN
WHILE (Windows.GetMessage(msg,NIL,0,0)) DO
Windows.TranslateMessage(msg);
Windows.DispatchMessage(msg);
END;
END;
END Print1.