home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / windows / print / myprint.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-04  |  13.6 KB  |  432 lines
  1. PROGRAM MyPrint;
  2.  
  3. {$R MYPRINT}
  4. {$X+}
  5.  
  6. USES WinTypes, WinProcs, OWindows, ODialogs, Strings, WinDos;
  7.  
  8. CONST
  9.   { Command ID }
  10.   cm_About       = 100;
  11.   cm_ExtDevMode  = 111;
  12.   cm_DevCaps     = 112;
  13.   cm_GetDevCap   = 113;
  14.   cm_ShowPrinter = 114;
  15.   cm_DeviceMode  = 115;
  16.  
  17.   cm_LoadBitmap  = 201;
  18.   cm_PrintBitmap = 202;
  19.  
  20.   id_ListBox      = 101;
  21.  
  22. TYPE
  23.   pSetupDialog = ^tSetupDialog;
  24.   tSetupDialog = OBJECT (tDialog)
  25.     Auswahl: pChar;
  26.     CONSTRUCTOR Init (aParent: pWindowsObject; aName: pChar; STD: pChar);
  27.     PROCEDURE SetupWindow; VIRTUAL;
  28.   END;
  29.  
  30.   pMyWindow = ^tMyWindow;
  31.   tMyWindow = OBJECT (tWindow)
  32.     CONSTRUCTOR Init (aParent: pWindowsObject; aTitle: pChar);
  33.     PROCEDURE GetWindowClass (VAR aWndClass: tWndClass); VIRTUAL;
  34.     PROCEDURE wmrButtonDown (VAR Msg: tMessage); VIRTUAL wm_First + wm_RButtonDown;
  35.     PROCEDURE About (VAR Msg: tMessage); VIRTUAL cm_First + cm_About;
  36.     PROCEDURE DevCaps (VAR Msg: tMessage); VIRTUAL cm_First + cm_DevCaps;
  37.     PROCEDURE GetDevCaps (VAR Msg: tMessage); VIRTUAL cm_First + cm_GetDevCap;
  38.     PROCEDURE Options (VAR Msg: tMessage); VIRTUAL cm_First + cm_ExtDevMode;
  39.     PROCEDURE Options2 (VAR Msg: tMessage); VIRTUAL cm_First + cm_DeviceMode;
  40.  
  41.     PROCEDURE LoadABitmap (VAR Msg: tMessage); VIRTUAL cm_First + cm_LoadBitmap;
  42.     PROCEDURE PrintBitmap (VAR Msg: tMessage); VIRTUAL cm_First + cm_PrintBitmap;
  43.     PROCEDURE ShowPrinter (VAR Msg: tMessage); VIRTUAL cm_First + cm_ShowPrinter;
  44.   END;
  45.  
  46.   tMyApplication = OBJECT (tApplication)
  47.     PROCEDURE InitMainWindow; VIRTUAL;
  48.   END;
  49.  
  50.   pChar39 = ARRAY [0..39] OF CHAR;
  51.  
  52. VAR
  53.   DruckerName, TreiberName, DruckerPort: pChar39;
  54.   DeviceMode: tDevMode;
  55.  
  56.  
  57. (**********************************************************************************)
  58.  
  59. TYPE
  60.   pAbortDlg = ^tAbortDlg;
  61.   tAbortDlg = OBJECT (tDialog)
  62.    PROCEDURE SetupWindow; VIRTUAL;
  63.    PROCEDURE wmCommand(VAR Msg: tMessage); VIRTUAL wm_First + wm_Command;
  64.   END;
  65.  
  66. VAR
  67.   Abort: BOOLEAN;
  68.   AbortWindow: hWND;
  69.  
  70. PROCEDURE tAbortDlg.SetupWindow;
  71. BEGIN
  72.   Abort:= FALSE;
  73.   SetFocus(hWindow);
  74.   AbortWindow:= hWindow;
  75. END;
  76.  
  77. PROCEDURE tAbortDlg.wmCommand(VAR Msg: tMessage);
  78. BEGIN
  79.   Abort:= TRUE;
  80. END;
  81.  
  82. FUNCTION AbortProc(DC: hDC; Code: INTEGER): Bool; EXPORT;
  83. VAR
  84.   Msg: tMsg;
  85. BEGIN
  86.   WHILE (NOT Abort) AND PeekMessage(Msg, 0, 0, 0, pm_Remove) DO
  87.   IF NOT IsDialogMessage(AbortWindow, Msg) THEN
  88.   BEGIN
  89.     TranslateMessage(Msg);
  90.     DispatchMessage(Msg);
  91.   END;
  92.   IF Abort THEN AbortProc:= FALSE ELSE AbortProc:= TRUE;
  93. END;
  94.  
  95. (**********************************************************************************)
  96.  
  97. FUNCTION CallMeNames: BOOLEAN;
  98. VAR
  99.   Printer: ARRAY [0..80] OF CHAR;
  100.   KommaPtr, KommaPos: pChar;
  101. BEGIN
  102.   GetProfileString ('windows', 'device', NIL, Printer, SizeOf(Printer));
  103.   KommaPtr := Printer;
  104.   KommaPos := StrScan (KommaPtr, ',');
  105.   StrLCopy (DruckerName, KommaPtr, (KommaPos - KommaPtr));
  106.   KommaPtr := KommaPos +1;
  107.   KommaPos := StrScan (KommaPtr, ',');
  108.   StrLCopy (TreiberName, KommaPtr, (KommaPos - KommaPtr));
  109.   KommaPtr := KommaPos +1;
  110.   StrLCopy (DruckerPort, KommaPtr, StrLen(KommaPtr));
  111. END;
  112.  
  113. FUNCTION GetPrinterDC : hDC;
  114. BEGIN
  115.   CallMeNames;
  116.   GetPrinterDC := CreateDC (TreiberName, DruckerName, DruckerPort, NIL);
  117. END;
  118.  
  119. (**************************** TSetupDlg *******************************************)
  120. {- Return pointer to next token in P or previous P if P = nil }
  121. FUNCTION NextToken(P: pChar; C: CHAR): pChar;
  122. CONST
  123.   Next: pChar = NIL;
  124. BEGIN
  125.   IF P = NIL THEN P := Next;
  126.   Next := StrScan(P, C);
  127.   IF Next <> NIL THEN
  128.   BEGIN
  129.     Next^ := #0;
  130.     Next := @Next[1]
  131.   END;
  132.   NextToken := P
  133. END;
  134.  
  135. CONSTRUCTOR tSetupDialog.Init (aParent: pWindowsObject; aName: pChar; STD: pChar);
  136. BEGIN
  137.   tDialog.Init (aParent, aName);
  138.   Auswahl := STD;
  139. END;
  140.  
  141. PROCEDURE tSetupDialog.SetupWindow;
  142. VAR
  143.   i: INTEGER;
  144.   P: pChar;
  145.   Buffer: ARRAY [0..4096] OF CHAR;
  146. BEGIN
  147.   GetProfileString ('devices', NIL, #0'', Buffer, SizeOf(Buffer));
  148.   i := 0;
  149.   P := NextToken (Buffer, #0);
  150.   WHILE (StrLen(P) <> 0) DO
  151.   BEGIN
  152.     SendDlgItemMsg (id_ListBox, lb_AddString, 0, LONGINT(P));
  153.     IF (StrComp(Auswahl, P) = 0) THEN
  154.       SendDlgItemMsg (id_ListBox, lb_SetCurSel, i, 0);
  155.     P := NextToken (NIL, #0);
  156.     Inc(i);
  157.   END;
  158. END;
  159.  
  160. (************************** TMyWindow *********************************************)
  161. CONSTRUCTOR tMyWindow.Init (aParent: pWindowsObject; aTitle: pChar);
  162. BEGIN
  163.   tWindow.Init (aParent, aTitle);
  164.   Attr.Menu := LoadMenu(hInstance, 'PrtMenu');
  165.   Attr.w := 550;
  166.   Attr.h := 400;
  167. END;
  168.  
  169. PROCEDURE tMyWindow.GetWindowClass (VAR aWndClass: tWndClass);
  170. BEGIN
  171.   tWindow.GetWindowClass (aWndClass);
  172.   aWndClass.hIcon := LoadIcon (hInstance, 'MYICON');
  173. END;
  174.  
  175. PROCEDURE tMyWindow.wmrButtonDown (VAR Msg: tMessage);
  176. BEGIN
  177.   InvalidateRect (hWindow, NIL, TRUE);
  178. END;
  179.  
  180. PROCEDURE tMyWindow.About (VAR Msg: tMessage);
  181. VAR
  182.   Dialog: tDialog;
  183. BEGIN
  184.   Dialog.Init(@Self, 'AboutBox');
  185.   Dialog.Execute;
  186.   Dialog.Done;
  187. END;
  188.  
  189. PROCEDURE tMyWindow.Options (VAR Msg: tMessage);
  190. VAR
  191.   PrinterLibHandle: tHandle;
  192.   DriverFileName: pChar39;
  193.   ProcAddress: tFarProc;
  194. BEGIN
  195.   CallMeNames;
  196.   DriverFileName := TreiberName;
  197.   StrCat (DriverFileName, '.DRV');
  198.   PrinterLibHandle := LoadLibrary (DriverFileName);
  199.   ProcAddress := GetProcAddress (PrinterLibHandle, 'ExtDeviceMode');
  200.   IF (ProcAddress <> NIL) THEN
  201.     tExtDeviceMode(ProcAddress) (Application^.MainWindow^.hWindow,
  202.       PrinterLibHandle, DeviceMode, DriverFileName, DruckerPort, DeviceMode,
  203.       NIL, dm_Prompt OR dm_Update)
  204.   ELSE BEGIN
  205.     ProcAddress := GetProcAddress(PrinterLibHandle, 'DEVICEMODE');
  206.     IF (ProcAddress <> NIL)
  207.       THEN tDeviceMode(ProcAddress) (Application^.MainWindow^.hWindow,
  208.                              PrinterLibHandle, DriverFileName, DruckerPort);
  209.   END;
  210.   FreeLibrary (PrinterLibHandle);
  211. END;
  212.  
  213. PROCEDURE tMyWindow.Options2 (VAR Msg: tMessage);
  214. VAR
  215.   PrinterLibHandle: tHandle;
  216.   DriverFileName: pChar39;
  217.   ProcAddress: tFarProc;
  218. BEGIN
  219.   CallMeNames;
  220.   DriverFileName := TreiberName;
  221.   StrCat (DriverFileName, '.DRV');
  222.   PrinterLibHandle := LoadLibrary (DriverFileName);
  223.   ProcAddress := GetProcAddress(PrinterLibHandle, 'DEVICEMODE');
  224.   IF (ProcAddress <> NIL)
  225.     THEN tDeviceMode(ProcAddress) (Application^.MainWindow^.hWindow,
  226.                       PrinterLibHandle, DriverFileName, DruckerPort);
  227.   FreeLibrary (PrinterLibHandle);
  228. END;
  229.  
  230. PROCEDURE tMyWindow.DevCaps (VAR Msg: tMessage);
  231. VAR
  232.   Dialog: pDialog;
  233.   DestStr: ARRAY [0..79] OF CHAR;
  234.   DataSize: LONGINT;
  235.   Information: ARRAY [0..1] OF WORD;
  236.   DC: hDC;
  237.   DeviceMode: tDevMode;
  238.   DeviceModePtr: pDevMode;
  239.   ProcAddress: tFarProc;
  240.   DriverFileName: pChar39;
  241.   PrinterLibHandle: tHandle;
  242. BEGIN
  243.   CallMeNames;
  244.   DriverFileName := TreiberName;
  245.   StrCat (DriverFileName, '.DRV');
  246.   PrinterLibHandle := LoadLibrary (DriverFileName);
  247.   ProcAddress := GetProcAddress (PrinterLibHandle, 'ExtDeviceMode');
  248.   IF (ProcAddress <> NIL) THEN
  249.   BEGIN
  250.     DataSize := tExtDeviceMode(ProcAddress) (0, PrinterLibHandle, DeviceMode,
  251.       DruckerName, DruckerPort, DeviceMode, NIL, 0);
  252.     GetMem (DeviceModePtr, DataSize);
  253.     tExtDeviceMode(ProcAddress) (hWindow, PrinterLibHandle, DeviceModePtr^,
  254.       DruckerName, DruckerPort, DeviceMode, NIL, dm_Copy);
  255.     DC := GetDC (hWindow);
  256.  
  257.     DeviceModePtr^.dmCopies := 1;
  258.     DeviceModePtr^.dmDefaultSource := dmBin_Upper;
  259.     DeviceModePtr^.dmPrintQuality := dmRes_High;
  260.     Information[0] := Ofs(DeviceModePtr^.dmDeviceName);
  261.     Information[1] := Seg(DeviceModePtr^.dmDeviceName);
  262.     wvSprintF (DestStr, 'Druckername : %s', Information);
  263.     TextOut(DC, 10, 10, DestStr, StrLen(DestStr));
  264.  
  265.     Information[0] := Hi(DeviceModePtr^.dmSpecVersion);
  266.     Information[1] := Lo(DeviceModePtr^.dmSpecVersion);
  267.     wvSprintF (DestStr, 'Versionsnummer des Druckertreibers : %2x.%02x', Information);
  268.     TextOut (DC, 10, 30, DestStr, StrLen(DestStr));
  269.  
  270.     Information[0] := DeviceModePtr^.dmSize;
  271.     wvSprintF (DestStr, 'Gr÷▀e von TDevMode : %4u Bytes', Information);
  272.     TextOut (DC, 10, 50, DestStr, StrLen(DestStr));
  273.  
  274.     Information[0] := DeviceModePtr^.dmOrientation;
  275.     wvSprintF (DestStr, 'Papierausrichung : %4u = Portrait', Information);
  276.     TextOut (DC, 10, 70, DestStr, StrLen(DestStr));
  277.  
  278.     Information[0] := DeviceModePtr^.dmPaperSize;
  279.     wvSprintF (DestStr, 'Papergr÷▀e : %4u = DIN A 4 (210 x 297 mm)', Information);
  280.     TextOut (DC, 10, 90, DestStr, StrLen(DestStr));
  281.  
  282.     Information[0] := DeviceModePtr^.dmCopies;
  283.     wvSprintF (DestStr, 'Anzahl der Kopien : %4u', Information);
  284.     TextOut (DC, 10, 110, DestStr, StrLen(DestStr));
  285.  
  286.     Information[0] := DeviceModePtr^.dmDefaultSource;
  287.     wvSprintF (DestStr, 'eingestellter Papierschacht : %4u = dmBin_Upper', Information);
  288.     TextOut (DC, 10, 130, DestStr, StrLen(DestStr));
  289.  
  290.     Information[0] := -DeviceModePtr^.dmPrintQuality;
  291.     (* normalerweise sollte das Minuszeichen nicht notwendig sein! *)
  292.     (* Aber es geht wirklich nicht ohne...!                        *)
  293.     wvSprintF (DestStr, 'DruckqualitΣt : %4i = dmRes_High', Information);
  294.     TextOut (DC, 10, 150, DestStr, StrLen(DestStr));
  295.  
  296.     ReleaseDC (hWindow, DC);
  297.     FreeLibrary (PrinterLibHandle);
  298.   END;
  299. END;
  300.  
  301. PROCEDURE tMyWindow.GetDevCaps (VAR Msg: tMessage);
  302. VAR
  303.   PrtDC, ScrDC: hDC;
  304.   DestStr: ARRAY [0..79] OF CHAR;
  305.   Information: ARRAY [0..1] OF WORD;
  306. BEGIN
  307.   PrtDC := GetPrinterDC;
  308.   ScrDC := GetDC (hWindow);
  309.   Information[0] := Hi(GetDeviceCaps (PrtDC, DriverVersion));
  310.   Information[1] := Lo(GetDeviceCaps (PrtDC, DriverVersion));
  311.   wvSprintF (DestStr, 'Treiberversion : %2x.%2x', Information);
  312.   TextOut (ScrDC, 10, 10, DestStr, StrLen(DestStr));
  313.  
  314.   Information[0] := GetDeviceCaps (PrtDC, Technology);
  315.   wvSprintF (DestStr, 'Druckertechnologie : %4u', Information);
  316.   TextOut (ScrDC, 10, 30, DestStr, StrLen(DestStr));
  317.  
  318.   Information[0] := GetDeviceCaps (PrtDC, HorzRes);
  319.   Information[1] := GetDeviceCaps (PrtDC, VertRes);
  320.   wvSprintF (DestStr, 'Aufl÷sung in Pixel :  %4u x %4u', Information);
  321.   TextOut (ScrDC, 10, 50, DestStr, StrLen(DestStr));
  322.  
  323.   Information[0] := GetDeviceCaps (PrtDC, HorzSize);
  324.   Information[1] := GetDeviceCaps (PrtDC, VertSize);
  325.   wvSprintF (DestStr, 'Aufl÷sung in mm : %4u x %4u', Information);
  326.   TextOut (ScrDC, 10, 70, DestStr, StrLen(DestStr));
  327.  
  328.   Information[0] := GetDeviceCaps (PrtDC, LogPixelsX);
  329.   Information[1] := GetDeviceCaps (PrtDC, LogPixelsY);
  330.   wvSprintF (DestStr, 'Pixel pro Zoll : %4u x %4u', Information);
  331.   TextOut (ScrDC, 10, 90, DestStr, StrLen(DestStr));
  332.  
  333.   Information[0] := GetDeviceCaps (PrtDC, NumColors);
  334.   wvSprintF (DestStr, 'Farbaufl÷sung des GerΣtes : %4u', Information);
  335.   TextOut (ScrDC, 10, 110, DestStr, StrLen(DestStr));
  336.  
  337.   Information[0] := GetDeviceCaps (PrtDC, NumFonts);
  338.   wvSprintF (DestStr, 'Anzahl der Schriften : %4u', Information);
  339.   TextOut (ScrDC, 10, 130, DestStr, StrLen(DestStr));
  340.  
  341.   Information[0] := GetDeviceCaps (PrtDC, RasterCaps);
  342.   wvSprintF (DestStr, 'RasterfΣhigkeiten : %4u', Information);
  343.   TextOut (ScrDC, 10, 150, DestStr, StrLen(DestStr));
  344.  
  345.   Information[0] := GetDeviceCaps (PrtDC, TextCaps);
  346.   wvSprintF (DestStr, 'TextdarstellungsfΣhigkeiten : %4u', Information);
  347.   TextOut (ScrDC, 10, 170, DestStr, StrLen(DestStr));
  348.  
  349.   ReleaseDC (hWindow, ScrDC);
  350.   DeleteDC (PrtDC);
  351. END;
  352.  
  353. PROCEDURE tMyWindow.LoadABitmap (VAR Msg: tMessage);
  354. VAR
  355.   MemDC, ScreenDC: hDC;
  356.   Bitmap: tBitmap;
  357.   OldBitmap, NewBitmap: hBitmap;
  358. BEGIN
  359.   ScreenDC := GetDC (hWindow);
  360.   MemDC := CreateCompatibleDC (ScreenDC);
  361.   NewBitmap := LoadBitmap (hInstance, 'Blaise');
  362.   OldBitmap := SelectObject (MemDC, NewBitmap);
  363.   GetObject (NewBitmap, SizeOf (tBitmap), @Bitmap);
  364.   BitBlt (ScreenDC, 0, 0, Bitmap.bmWidth, Bitmap.bmHeight, MemDC, 0, 0, SrcCopy);
  365.   DeleteDC (MemDC);
  366.   ReleaseDC (hWindow, ScreenDC);
  367.   DeleteObject (NewBitmap);
  368. END;
  369.  
  370. PROCEDURE tMyWindow.PrintBitmap (VAR Msg: tMessage);
  371. VAR
  372.   MemDC, ScreenDC, PrtDC: hDC;
  373.   OldBitmap, NewBitmap: hBitmap;
  374.   AbortDlg: pAbortDlg;
  375.   AbortCallBack: tFarProc;
  376.   EscapErr: INTEGER;
  377.   Bitmap: tBitmap;
  378.   JobName: pChar;
  379. BEGIN
  380.   ScreenDC := GetDC (hWindow);
  381.   MemDC := CreateCompatibleDC (ScreenDC);
  382.   ReleaseDC (hWindow, ScreenDC);
  383.  
  384.   NewBitmap := LoadBitmap (hInstance, 'Blaise');
  385.   GetObject (NewBitmap, SizeOf (tBitmap), @Bitmap);
  386.   OldBitmap := SelectObject (MemDC, NewBitmap);
  387.  
  388.   PrtDC := GetPrinterDC;
  389.   IF (PrtDC <> 0) THEN BEGIN
  390.     GetMem (JobName, 8);
  391.     StrPCopy (JobName, 'Blaise');
  392.     MessageBox (hWindow, 'Ab mit der Abort-Box','Information',mb_OK);
  393.     New (AbortDlg, Init(Application^.MainWindow, 'ABORTBOX'));
  394.     AbortDlg^.Create;
  395.     AbortCallBack := MakeProcInstance(@AbortProc, hInstance);
  396.  
  397.     EscapErr := Escape(PrtDC, SetAbortProc, 0, AbortCallBack, NIL);
  398.     Escape (PrtDC, StartDoc, StrLen(JobName), JobName, NIL);
  399.     BitBlt (PrtDC, 10, 30, Bitmap.bmWidth, Bitmap.bmHeight,
  400.             MemDC, 0, 0, SrcCopy);
  401.     Escape (PrtDC, NewFrame, 0, NIL, NIL);
  402.     Escape (PrtDC, EndDoc, 0, NIL, NIL);
  403.     DeleteDC (PrtDC);
  404.     AbortDlg^.CloseWindow;
  405.     MessageBox (hWindow, 'Druckauftrag abgeschickt', 'Information', mb_OK);
  406.   END;
  407.   SelectObject (MemDC, OldBitmap);
  408.   DeleteDC (MemDC);
  409.   DeleteObject (NewBitmap);
  410. END;
  411.  
  412. PROCEDURE tMyWindow.ShowPrinter (VAR Msg: tMessage);
  413. BEGIN
  414.   CallMeNames;
  415.   Application^.ExecDialog (New(pSetupDialog,
  416.     Init(@Self, 'SetupDlg', DruckerName)));
  417. END;
  418.  
  419. PROCEDURE tMyApplication.InitMainWindow;
  420. BEGIN
  421.   MainWindow := New (pMyWindow, Init(NIL, 'Drucken in Windows'));
  422. END;
  423.  
  424. VAR
  425.   GenericApp: tMyApplication;
  426.  
  427. BEGIN
  428.   GenericApp.Init ('GenericApp');
  429.   GenericApp.Run;
  430.   GenericApp.Done;
  431. END.
  432.