home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9202 / tpw / print / print.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-08-25  |  11.1 KB  |  342 lines
  1. PROGRAM Print;
  2.  
  3. {$R PRINT}
  4.  
  5. USES WObjects, WinTypes, WinProcs, Strings, WinDos;
  6.  
  7. CONST
  8.   { Command ID }
  9.   idm_About    = 100;
  10.   idm_Print    = 110;
  11.   idm_PrintOpt = 111;
  12.   idm_DevCaps  = 112;
  13.   idm_GetDevCap= 113;
  14.  
  15.   idm_LoadBitmap  = 201;
  16.   idm_PrintBitmap = 202;
  17.  
  18. TYPE
  19.   PMyDialog = ^TMyDialog;
  20.   TMyDialog = OBJECT (TDialog)
  21.   END;
  22.  
  23.   PMyWindow = ^TMyWindow;
  24.   TMyWindow = OBJECT (TWindow)
  25.     CONSTRUCTOR Init (AParent: PWindowsObject; ATitle: PChar);
  26.     PROCEDURE GetWindowClass (VAR AWndClass: TWndClass); VIRTUAL;
  27.     PROCEDURE WMRButtonDown (VAR Msg: TMessage); VIRTUAL wm_First + wm_RButtonDown;
  28.     PROCEDURE About (VAR Msg: TMessage); VIRTUAL cm_First + idm_About;
  29.     PROCEDURE Print (VAR Msg: TMessage); VIRTUAL cm_First + idm_Print;
  30.     PROCEDURE DevCaps (VAR Msg: TMessage); VIRTUAL cm_First + idm_DevCaps;
  31.     PROCEDURE GetDevCaps (VAR Msg: TMessage); VIRTUAL cm_First + idm_GetDevCap;
  32.     PROCEDURE Options (VAR Msg: TMessage); VIRTUAL cm_First + idm_PrintOpt;
  33.     PROCEDURE LoadABitmap (VAR Msg: TMessage); VIRTUAL cm_First + idm_LoadBitmap;
  34.     PROCEDURE PrintBitmap (VAR Msg: TMessage); VIRTUAL cm_First + idm_PrintBitmap;
  35.   END;
  36.  
  37.   TMyApplication = OBJECT (TApplication)
  38.     PROCEDURE InitMainWindow; VIRTUAL;
  39.   END;
  40.  
  41.   PChar39 = ARRAY [0..39] OF CHAR;
  42.  
  43. VAR
  44.   DruckerName, TreiberName, DruckerPort: PChar39;
  45.   DeviceMode: TDevMode;
  46.  
  47. FUNCTION AbortProc (Window: HWnd; Msg, wParam: WORD; lParam: Longint): BOOL; EXPORT;
  48. BEGIN
  49.   MessageBeep(0);
  50.   IF (Msg = wm_Command) THEN BEGIN
  51.     DestroyWindow(Window);
  52.     AbortProc := TRUE;
  53.   END
  54.   ELSE IF (Msg = wm_InitDialog) THEN BEGIN
  55.     SetFocus(Window);
  56.     AbortProc := TRUE;
  57.   END ELSE AbortProc := FALSE;
  58. END;
  59.  
  60. FUNCTION CallMeNames: BOOLEAN;
  61. VAR
  62.   Printer: ARRAY [0..80] OF CHAR;
  63.   KommaPtr, KommaPos: PChar;
  64. BEGIN
  65.   GetProfileString ('windows', 'device', NIL, Printer, SizeOf(Printer));
  66.   KommaPtr := Printer;
  67.   KommaPos := StrScan (KommaPtr, ',');
  68.   StrLCopy (DruckerName, KommaPtr, (KommaPos - KommaPtr));
  69.   KommaPtr := KommaPos +1;
  70.   KommaPos := StrScan (KommaPtr, ',');
  71.   StrLCopy (TreiberName, KommaPtr, (KommaPos - KommaPtr));
  72.   KommaPtr := KommaPos +1;
  73.   StrLCopy (DruckerPort, KommaPtr, StrLen(KommaPtr));
  74. END;
  75.  
  76. FUNCTION GetPrinterDC : HDC;
  77. BEGIN
  78.   CallMeNames;
  79.   GetPrinterDC := CreateDC (TreiberName, DruckerName, DruckerPort, NIL);
  80. END;
  81.  
  82.  
  83. CONSTRUCTOR TMyWindow.Init (AParent: PWindowsObject; ATitle: PChar);
  84. BEGIN
  85.   TWindow.Init (AParent, ATitle);
  86.   Attr.Menu := LoadMenu(HInstance, 'Generic');
  87.   Attr.w := 400;
  88.   Attr.h := 300;
  89. END;
  90.  
  91. PROCEDURE TMyWindow.GetWindowClass (VAR AWndClass: TWndClass);
  92. BEGIN
  93.   TWindow.GetWindowClass (AWndClass);
  94.   AWndClass.hIcon := LoadIcon (HInstance, 'MYICON');
  95. END;
  96.  
  97. PROCEDURE TMyWindow.WMRButtonDown (VAR Msg: TMessage);
  98. BEGIN
  99.   InvalidateRect (HWindow, NIL, True);
  100. END;
  101.  
  102. PROCEDURE TMyWindow.About (VAR Msg: TMessage);
  103. VAR
  104.   Dialog: TDialog;
  105. BEGIN
  106.   Dialog.Init(@Self, 'AboutBox');
  107.   Dialog.Execute;
  108.   Dialog.Done;
  109. END;
  110.  
  111. PROCEDURE TMyWindow.Print (VAR Msg: TMessage);
  112. VAR
  113.   AbortDialog: PMyDialog;
  114.   lpAbortProc: TFarProc;
  115.   lpTemp: Pointer;
  116.   PrinterDC: HDC;
  117.   hAbortDlgWindow: HWnd;
  118. BEGIN
  119.   PrinterDC := GetPrinterDC;
  120.   IF (PrinterDC < 32) THEN BEGIN
  121.     MessageBox (HWindow, 'Cannot print this file', NIL, mb_Ok OR mb_IconHand);
  122.     Exit;
  123.   END;
  124.   Escape (PrinterDC, SetAbortProc, 0, MakeProcInstance(@AbortProc, hInstance), NIL);
  125.   IF (Escape(PrinterDC, StartDoc, 0, NIL, NIL) < 0) THEN BEGIN
  126.     MessageBox (HWindow, 'Unable to start print job', NIL, mb_Ok OR mb_IconHand);
  127.     FreeProcInstance (lpAbortProc);
  128.     DeleteDC (PrinterDC);
  129.     EXIT;
  130.   END;
  131.   AbortDialog := New(PMyDialog, Init(@Self, 'AbortDlg'));
  132.   Application^.ExecDialog(AbortDialog);
  133.   MessageBeep(0);
  134. END;
  135.  
  136. PROCEDURE TMyWindow.Options (VAR Msg: TMessage);
  137. VAR
  138.   PrinterLibHandle: THandle;
  139.   DriverFileName: PChar39;
  140.   ProcAddress: TFarProc;
  141. BEGIN
  142.   CallMeNames;
  143.   DriverFileName := TreiberName;
  144.   StrCat (DriverFileName, '.DRV');
  145.   PrinterLibHandle := LoadLibrary (DriverFileName);
  146.   ProcAddress := GetProcAddress (PrinterLibHandle, 'ExtDeviceMode');
  147.   IF (ProcAddress <> NIL) THEN
  148.     TExtDeviceMode(ProcAddress) (Application^.MainWindow^.HWindow,
  149.       PrinterLibHandle, DeviceMode, DriverFileName, DruckerPort, DeviceMode,
  150.       NIL, dm_Prompt OR dm_Update)
  151.   ELSE BEGIN
  152.     ProcAddress := GetProcAddress(PrinterLibHandle, 'DEVICEMODE');
  153.     IF (ProcAddress <> NIL)
  154.       THEN TDeviceMode(ProcAddress) (Application^.MainWindow^.HWindow,
  155.                              PrinterLibHandle, DriverFileName, DruckerPort);
  156.   END;
  157.   FreeLibrary (PrinterLibHandle);
  158. END;
  159.  
  160. PROCEDURE TMyWindow.DevCaps (VAR Msg: TMessage);
  161. VAR
  162.   Dialog: PDialog;
  163.   DestStr: ARRAY [0..79] OF CHAR;
  164.   DataSize: Longint;
  165.   Information: ARRAY [0..1] OF WORD;
  166.   DC: HDC;
  167.   DeviceMode: TDevMode;
  168.   DeviceModePtr: PDevMode;
  169.   ProcAddress: TFarProc;
  170.   DriverFileName: PChar39;
  171.   PrinterLibHandle: THandle;
  172. BEGIN
  173.   CallMeNames;
  174.   DriverFileName := TreiberName;
  175.   StrCat (DriverFileName, '.DRV');
  176.   PrinterLibHandle := LoadLibrary (DriverFileName);
  177.   ProcAddress := GetProcAddress (PrinterLibHandle, 'ExtDeviceMode');
  178.   IF (ProcAddress <> NIL) THEN
  179.   BEGIN
  180.     DataSize := TExtDeviceMode(ProcAddress) (0, PrinterLibHandle, DeviceMode,
  181.       DruckerName, DruckerPort, DeviceMode, NIL, 0);
  182.     GetMem (DeviceModePtr, DataSize);
  183.     TExtDeviceMode(ProcAddress) (HWindow, PrinterLibHandle, DeviceModePtr^,
  184.       DruckerName, DruckerPort, DeviceMode, NIL, dm_Copy);
  185.     DC := GetDC (HWindow);
  186.  
  187.     DeviceModePtr^.dmCopies := 1;
  188.     DeviceModePtr^.dmDefaultSource := dmBin_Upper;
  189.     DeviceModePtr^.dmPrintQuality := dmRes_High;
  190.     Information[0] := Ofs(DeviceModePtr^.dmDeviceName);
  191.     Information[1] := Seg(DeviceModePtr^.dmDeviceName);
  192.     WVSPrintF (DestStr, 'Druckername : %s', Information);
  193.     TextOut(DC, 10, 10, DestStr, StrLen(DestStr));
  194.  
  195.     Information[0] := Hi(DeviceModePtr^.dmSpecVersion);
  196.     Information[1] := Lo(DeviceModePtr^.dmSpecVersion);
  197.     WVSPrintF (DestStr, 'Versionsnummer des Druckertreibers : %2x.%02x', Information);
  198.     TextOut (DC, 10, 30, DestStr, StrLen(DestStr));
  199.  
  200.     Information[0] := DeviceModePtr^.dmSize;
  201.     WVSPrintF (DestStr, 'Gr÷▀e von TDevMode : %4u Bytes', Information);
  202.     TextOut (DC, 10, 50, DestStr, StrLen(DestStr));
  203.  
  204.     Information[0] := DeviceModePtr^.dmOrientation;
  205.     WVSPrintF (DestStr, 'Papierausrichung : %4u = Portrait', Information);
  206.     TextOut (DC, 10, 70, DestStr, StrLen(DestStr));
  207.  
  208.     Information[0] := DeviceModePtr^.dmPaperSize;
  209.     WVSPrintF (DestStr, 'Papergr÷▀e : %4u = DIN A 4 (210 x 297 mm)', Information);
  210.     TextOut (DC, 10, 90, DestStr, StrLen(DestStr));
  211.  
  212.     Information[0] := DeviceModePtr^.dmCopies;
  213.     WVSPrintF (DestStr, 'Anzahl der Kopien : %4u', Information);
  214.     TextOut (DC, 10, 110, DestStr, StrLen(DestStr));
  215.  
  216.     Information[0] := DeviceModePtr^.dmDefaultSource;
  217.     WVSPrintF (DestStr, 'eingestellter Papierschacht : %4u = dmBin_Upper', Information);
  218.     TextOut (DC, 10, 130, DestStr, StrLen(DestStr));
  219.  
  220.     Information[0] := DeviceModePtr^.dmPrintQuality;
  221.     WVSPrintF (DestStr, 'DruckqualitΣt : %4i = dmRes_High', Information);
  222.     TextOut (DC, 10, 150, DestStr, StrLen(DestStr));
  223.  
  224.     ReleaseDC (HWindow, DC);
  225.     FreeLibrary (PrinterLibHandle);
  226.   END;
  227. END;
  228.  
  229. PROCEDURE TMyWindow.GetDevCaps (VAR Msg: TMessage);
  230. VAR
  231.   PrtDC, ScrDC: HDC;
  232.   DestStr: ARRAY [0..79] OF CHAR;
  233.   Information: ARRAY [0..1] OF WORD;
  234. BEGIN
  235.   PrtDC := GetPrinterDC;
  236.   ScrDC := GetDC (HWindow);
  237.   Information[0] := Hi(GetDeviceCaps (PrtDC, DriverVersion));
  238.   Information[1] := Lo(GetDeviceCaps (PrtDC, DriverVersion));
  239.   WVSPrintF (DestStr, 'Treiberversion : %2x.%2x', Information);
  240.   TextOut (ScrDC, 10, 10, DestStr, StrLen(DestStr));
  241.  
  242.   Information[0] := GetDeviceCaps (PrtDC, Technology);
  243.   WVSPrintF (DestStr, 'Druckertechnologie : %4u', Information);
  244.   TextOut (ScrDC, 10, 30, DestStr, StrLen(DestStr));
  245.  
  246.   Information[0] := GetDeviceCaps (PrtDC, HorzRes);
  247.   Information[1] := GetDeviceCaps (PrtDC, VertRes);
  248.   WVSPrintF (DestStr, 'Aufl÷sung in Pixel :  %4u x %4u', Information);
  249.   TextOut (ScrDC, 10, 50, DestStr, StrLen(DestStr));
  250.  
  251.   Information[0] := GetDeviceCaps (PrtDC, HorzSize);
  252.   Information[1] := GetDeviceCaps (PrtDC, VertSize);
  253.   WVSPrintF (DestStr, 'Aufl÷sung in mm : %4u x %4u', Information);
  254.   TextOut (ScrDC, 10, 70, DestStr, StrLen(DestStr));
  255.  
  256.   Information[0] := GetDeviceCaps (PrtDC, LogPixelsX);
  257.   Information[1] := GetDeviceCaps (PrtDC, LogPixelsY);
  258.   WVSPrintF (DestStr, 'Pixel pro Zoll : %4u x %4u', Information);
  259.   TextOut (ScrDC, 10, 90, DestStr, StrLen(DestStr));
  260.  
  261.   Information[0] := GetDeviceCaps (PrtDC, NumColors);
  262.   WVSPrintF (DestStr, 'Farbaufl÷sung des GerΣtes : %4u', Information);
  263.   TextOut (ScrDC, 10, 110, DestStr, StrLen(DestStr));
  264.  
  265.   Information[0] := GetDeviceCaps (PrtDC, NumFonts);
  266.   WVSPrintF (DestStr, 'Anzahl der Schriften : %4u', Information);
  267.   TextOut (ScrDC, 10, 130, DestStr, StrLen(DestStr));
  268.  
  269.   Information[0] := GetDeviceCaps (PrtDC, RasterCaps);
  270.   WVSPrintF (DestStr, 'RasterfΣhigkeiten : %4u', Information);
  271.   TextOut (ScrDC, 10, 150, DestStr, StrLen(DestStr));
  272.  
  273.   Information[0] := GetDeviceCaps (PrtDC, TextCaps);
  274.   WVSPrintF (DestStr, 'TextdarstellungsfΣhigkeiten : %4u', Information);
  275.   TextOut (ScrDC, 10, 170, DestStr, StrLen(DestStr));
  276.  
  277.   ReleaseDC (HWindow, ScrDC);
  278.   DeleteDC (PrtDC);
  279. END;
  280.  
  281. PROCEDURE TMyWindow.LoadABitmap (VAR Msg: TMessage);
  282. VAR
  283.   MemDC, ScreenDC: HDC;
  284.   Bitmap: TBitmap;
  285.   OldBitmap, NewBitmap: HBitmap;
  286. BEGIN
  287.   ScreenDC := GetDC (HWindow);
  288.   MemDC := CreateCompatibleDC (ScreenDC);
  289.   NewBitmap := LoadBitmap (HInstance, 'Blaise');
  290.   OldBitmap := SelectObject (MemDC, NewBitmap);
  291.   GetObject (NewBitmap, SizeOf (TBitmap), @Bitmap);
  292.   BitBlt (ScreenDC, 0, 0, Bitmap.bmWidth, Bitmap.bmHeight, MemDC, 0, 0, SRCCopy);
  293.   DeleteDC (MemDC);
  294.   ReleaseDC (HWindow, ScreenDC);
  295.   DeleteObject (NewBitmap);
  296. END;
  297.  
  298. PROCEDURE TMyWindow.PrintBitmap (VAR Msg: TMessage);
  299. VAR
  300.   MemDC, ScreenDC, PrtDC: HDC;
  301.   OldBitmap, NewBitmap: HBitmap;
  302.   Bitmap: TBitmap;
  303.   JobName: PChar;
  304. BEGIN
  305.   ScreenDC := GetDC (HWindow);
  306.   MemDC := CreateCompatibleDC (ScreenDC);
  307.   ReleaseDC (HWindow, ScreenDC);
  308.  
  309.   NewBitmap := LoadBitmap (HInstance, 'Blaise');
  310.   GetObject (NewBitmap, SizeOf (TBitmap), @Bitmap);
  311.   OldBitmap := SelectObject (MemDC, NewBitmap);
  312.  
  313.   PrtDC := GetPrinterDC;
  314.   IF (PrtDC <> 0) THEN BEGIN
  315.     GetMem (JobName, 8);
  316.     StrPCopy (JobName, 'Blaise');
  317.     Escape (PrtDC, StartDoc, 7, JobName, NIL);
  318.     BitBlt (PrtDC, 10, 30, Bitmap.bmWidth, Bitmap.bmHeight,
  319.             MemDC, 0, 0, SRCCopy);
  320.     Escape (PrtDC, NewFrame, 0, NIL, NIL);
  321.     Escape (PrtDC, EndDoc, 0, NIL, NIL);
  322.     DeleteDC (PrtDC);
  323.     MessageBox (HWindow, 'Druckauftrag abgeschickt', 'Information', mb_Ok);
  324.   END;
  325.   SelectObject (MemDC, OldBitmap);
  326.   DeleteDC (MemDC);
  327.   DeleteObject (NewBitmap);
  328. END;
  329.  
  330. PROCEDURE TMyApplication.InitMainWindow;
  331. BEGIN
  332.   MainWindow := New (PMyWindow, Init(NIL, 'Drucken in Windows'));
  333. END;
  334.  
  335. VAR
  336.   GenericApp: TMyApplication;
  337.  
  338. BEGIN
  339.   GenericApp.Init ('GenericApp');
  340.   GenericApp.Run;
  341.   GenericApp.Done;
  342. END.