Last updated: 17. 1.1998, 20:29
<*/NOWARN:F*> MODULE Print1; (*--------------------------------------- PRINT1.C --- Bare Bones Printing (c) Charles Petzold, 1996 Print1.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 = "Print1"; szCaption = "Print Program 1"; 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*> (*++++*****************************************************************) PROCEDURE PrintMyPage(hwnd : WIN32.HWND) : BOOLEAN; (**********************************************************************) VAR bError : BOOLEAN = FALSE; hdcPrn : WIN32.HDC; xPage : INTEGER; yPage : INTEGER; BEGIN hdcPrn := GetPrinterDC (); IF (NIL = hdcPrn) THEN RETURN TRUE; END; xPage := WINGDI.GetDeviceCaps (hdcPrn, WINGDI.HORZRES); yPage := WINGDI.GetDeviceCaps (hdcPrn, WINGDI.VERTRES); 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; WINGDI.DeleteDC (hdcPrn); RETURN bError; 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("Print1: Printing"), NIL }; IF InitApplication() AND InitMainWindow() THEN WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO WINUSER.TranslateMessage(msg); WINUSER.DispatchMessage(msg); END; END; END Print1.