Last updated: 26. 1.1998, 20:59
<* +M2EXTENSIONS *> MODULE Print3; (*--------------------------------------- PRINT3.C --- Printing with Dialog Box (c) Charles Petzold, 1996 Print3.mod --- Translation to XDS Modula-2 (c) Peter Stadler, 1997 ---------------------------------------*) IMPORT Windows; IMPORT SYSTEM; CONST szAppName = "Print3"; szCaption = "Print Program 3 (Dialog Box)"; 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.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 [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 [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.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 PrintMyPage(hwnd : Windows.HWND) : BOOLEAN; (**********************************************************************) VAR bError : BOOLEAN; hdcPrn : Windows.HDC; xPage : SYSTEM.INT16; yPage : SYSTEM.INT16; BEGIN bError := FALSE; 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) 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; IF (NOT bUserAbort) THEN Windows.EnableWindow (hwnd, TRUE); Windows.DestroyWindow (hDlgPrint); END; Windows.DeleteDC (hdcPrn); RETURN bError OR bUserAbort; 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 = "Print3: 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 Print3.