home *** CD-ROM | disk | FTP | other *** search
/ Freelog 11 / Freelog011.iso / BestOf / PhoenixMail / Source / comps / XPrinter.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-02-20  |  21.0 KB  |  747 lines
  1. {*****************************************************************************
  2.  *
  3.  *  Parts of this code were changed by Michael Haller
  4.  *  E-mail:     michael@discountdrive.com
  5.  *  Homepage:   http://www.discountdrive.com/sunrise/
  6.  *
  7.  *  The copyright has the original author of this code.
  8.  *
  9.  *****************************************************************************}
  10.  
  11.  
  12.  
  13.  
  14. (*********************************************************************)
  15. (*                                                                   *)
  16. (*   XPrint: Eine Komponente zur gerΣteunabhΣngigen Druckerausgabe   *)
  17. (*                                                                   *)
  18. (*   (c) 1997 Rainer Reusch fⁿr Toolbox                              *)
  19. (*   (c) 1997 Rainer Reusch fⁿr Computer & Literatur                 *)
  20. (*                                                                   *)
  21. (*   Borland Delphi 1.0, 2.0, 3.0, Borland C++Builder 1.0            *)
  22. (*                                                                   *)
  23. (****V1.4*************************************************************)
  24.  
  25. {$A+,B-,C-,D-,E-,F-,G+,H+,I-,J+,K-,L-,M-,N-,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y-,Z1}
  26.  
  27. UNIT XPrinter;
  28.  
  29. INTERFACE
  30.  
  31. USES
  32.   {$IFDEF VER80}
  33.   WinTypes,
  34.   {$ELSE}
  35.   WinSpool, 
  36.   {$ENDIF}
  37.   WinProcs, Classes, Graphics, SysUtils, Printers;
  38.  
  39. TYPE
  40.   TXPrinterOrientation  = (xpoPortrait, xpoLandscape);
  41.   TXPrinterCapability   = (xpcCopies, xpcOrientation, xpcCollation);
  42.   TXPrinterCapabilities = SET OF TXPrinterCapability;
  43.   TScaling = (pscDot,          { Skalierungseinheit "Pixel" (gerΣteabhΣngig) }
  44.               pscMil,          {                    1/1000"                  }
  45.               pscMetric10,     {                    1/10mm                   }
  46.               pscMetric100);   {                    1/100mm                  }
  47.  
  48.   TXPrint = CLASS (TComponent)
  49.   PRIVATE
  50.     { Eigenschaften }
  51.     fScaling : TScaling;   { eingestellte Skalierung }
  52.     fMarginLeft,           { Randeinstellungen }
  53.     fMarginTop,
  54.     fMarginRight,
  55.     fMarginBottom : INTEGER;
  56.     fPrintWidth,           { bedruckbarer Bereich }
  57.     fPrintHeight  : INTEGER;
  58.     fPrintersInstalled : WORD;   { Anzahl vorhandener Drucker }
  59.     { Druckerparameter }
  60.     pLogPixelsX,           { Aufl÷sung (dpi) }
  61.     pLogPixelsY,
  62.     pPhysicalWidth,        { Blattgr÷▀e in Pixeln }
  63.     pPhysicalHeight,
  64.     pHorzRes,              { bedruckbarer Bereich in Pixeln }
  65.     pVertRes,
  66.     pPhysicalOffsetX,      { Abstand bedruckbarer Bereich vom Blattrand }
  67.     pPhysicalOffsetY : INTEGER;
  68.     { fⁿr den internen Gebrauch }
  69.     k : INTEGER;           { Skalierungsfaktor }
  70.     FontBackup : TFont;    { Backup fⁿr Font }
  71.     SizeBackup : INTEGER;  { zuletzt eingestellte Font-Gr÷▀e in Twips }
  72.     PrintOpened : BOOLEAN; { true, nach BeginDoc }
  73.     DummyCreated: BOOLEAN; { true, wenn Dummy-Canvas angelegt wurde }
  74.     FUNCTION  PrintersInstalled : WORD;
  75.     PROCEDURE SetupPrinter;
  76.     PROCEDURE SetScaling(VALUE : TScaling);
  77.     FUNCTION  GetPrinterAvailable : BOOLEAN;
  78.     FUNCTION  GetPrinting : BOOLEAN;
  79.     FUNCTION  GetFont : TFont;
  80.     PROCEDURE SetFont(VALUE : TFont);
  81.     FUNCTION  GetAborted : BOOLEAN;
  82.     FUNCTION  GetMinMarginLeft : INTEGER;
  83.     FUNCTION  GetMinMarginTop : INTEGER;
  84.     FUNCTION  GetMinMarginRight : INTEGER;
  85.     FUNCTION  GetMinMarginBottom : INTEGER;
  86.     FUNCTION  GetPrinterCapabilities : TXPrinterCapabilities;
  87.     FUNCTION  GetCopies : INTEGER;
  88.     PROCEDURE SetCopies(VALUE : INTEGER);
  89.     FUNCTION  GetFonts : TStrings;
  90.     FUNCTION  GetHandle: HDC;
  91.     FUNCTION  GetPageNumber : INTEGER;
  92.     FUNCTION  GetPrinters : TStrings;
  93.     FUNCTION  GetTitle : STRING;
  94.     PROCEDURE SetTitle(VALUE : STRING);
  95.     FUNCTION  GetCurrentPrinter : INTEGER;
  96.     PROCEDURE SetCurrentPrinter(VALUE : INTEGER);
  97.     FUNCTION  GetOrientation : TXPrinterOrientation;
  98.     PROCEDURE SetOrientation(VALUE : TXPrinterOrientation);
  99.   PROTECTED
  100.     PROCEDURE DriverParams;
  101.     PROCEDURE ClosePrinting;
  102.     FUNCTION  DotValX(ScaledVal : INTEGER) : INTEGER;
  103.     FUNCTION  DotValY(ScaledVal : INTEGER) : INTEGER;
  104.     FUNCTION  ScaleValX(DotVal : INTEGER) : INTEGER;
  105.     FUNCTION  ScaleValY(DotVal : INTEGER) : INTEGER;
  106.   PUBLIC
  107.     Canvas : TCanvas;
  108.     CONSTRUCTOR Create(AOwner: TComponent); Override;
  109.     DESTRUCTOR  Destroy; Override;
  110.     PROCEDURE Abort;
  111.     PROCEDURE BeginDoc;
  112.     PROCEDURE EndDoc;
  113.     PROCEDURE NewPage;
  114.     PROCEDURE SetFontSize(FontSize : INTEGER);
  115.     PROCEDURE SelectFont(AFont : TFont);
  116.     FUNCTION  XBounds(ALeft, ATop, AWidth, AHeight: INTEGER): tRect;
  117.     PROPERTY PrinterAvailable : BOOLEAN Read GetPrinterAvailable;
  118.     PROPERTY CurrentPrinter : INTEGER Read  GetCurrentPrinter
  119.                                       Write SetCurrentPrinter;
  120.     PROPERTY PrintWidth : INTEGER Read fPrintWidth;
  121.     PROPERTY PrintHeight : INTEGER Read fPrintHeight;
  122.     PROPERTY MinMarginLeft : INTEGER Read GetMinMarginLeft;
  123.     PROPERTY MinMarginTop : INTEGER Read GetMinMarginTop;
  124.     PROPERTY MinMarginRight : INTEGER Read GetMinMarginRight;
  125.     PROPERTY MinMarginBottom : INTEGER Read GetMinMarginBottom;
  126.     PROPERTY Capabilities : TXPrinterCapabilities Read GetPrinterCapabilities;
  127.     PROPERTY Fonts : TStrings Read GetFonts;
  128.     PROPERTY Handle : HDC Read GetHandle;
  129.     PROPERTY PageNumber : INTEGER Read GetPageNumber;
  130.     PROPERTY Printers : TStrings Read GetPrinters;
  131.     PROPERTY Printing : BOOLEAN Read GetPrinting;
  132.     PROPERTY XResolution : INTEGER Read pLogPixelsX;
  133.     PROPERTY YResolution : INTEGER Read pLogPixelsY;
  134.   PUBLISHED
  135.     PROPERTY Scaling : TScaling                 Read    fScaling
  136.                                                 Write   SetScaling
  137.                                                 DEFAULT pscDot;
  138.     PROPERTY MarginLeft : INTEGER               Read  fMarginLeft
  139.                                                 Write fMarginLeft;
  140.     PROPERTY MarginTop : INTEGER                Read  fMarginTop
  141.                                                 Write fMarginTop;
  142.     PROPERTY MarginRight : INTEGER              Read  fMarginRight
  143.                                                 Write fMarginRight;
  144.     PROPERTY MarginBottom : INTEGER             Read  fMarginBottom
  145.                                                 Write fMarginBottom;
  146.     PROPERTY Font : TFont                       Read  GetFont
  147.                                                 Write SetFont;
  148.     PROPERTY Aborted : BOOLEAN                  Read  GetAborted;
  149.     PROPERTY Copies : INTEGER                   Read  GetCopies
  150.                                                 Write SetCopies;
  151.     PROPERTY Title : STRING                     Read  GetTitle
  152.                                                 Write SetTitle;
  153.     PROPERTY Orientation : TXPrinterOrientation Read  GetOrientation
  154.                                                 Write SetOrientation;
  155.   END;
  156.  
  157. PROCEDURE Register;
  158.  
  159. IMPLEMENTATION
  160.  
  161. CONSTRUCTOR TXPrint.Create;
  162. BEGIN
  163.   Inherited Create(AOwner);
  164.   PrintOpened:=FALSE;
  165.   pLogPixelsX:=300;   { angenommene Werte als Default }
  166.   pLogPixelsY:=300;
  167.   k:=1;
  168.   fPrintersInstalled := 0;
  169.   try
  170.   DummyCreated:=FALSE;
  171.   fPrintersInstalled:=PrintersInstalled;
  172.   IF fPrintersInstalled>0 THEN
  173.   BEGIN
  174.     Canvas:=Printer.Canvas;
  175.     Printer.PrinterIndex:=-1;
  176.   END
  177.   ELSE
  178.   BEGIN
  179.     Canvas:=TCanvas.Create;
  180.     DummyCreated:=TRUE;
  181.   END;
  182.   PrintOpened:=FALSE;
  183.   pLogPixelsX:=300;   { angenommene Werte als Default }
  184.   pLogPixelsY:=300;
  185.   k:=1;
  186.   except end;
  187. END;
  188.  
  189. DESTRUCTOR TXPrint.Destroy;
  190. BEGIN
  191.   IF DummyCreated THEN Canvas.Free;
  192.   Inherited Destroy;
  193. END;
  194.  
  195. PROCEDURE TXPrint.DriverParams;
  196. { Druckertreiber-Parameter ermitteln }
  197. {$IFDEF VER80}
  198. VAR
  199.   r : tPoint;
  200. {$ENDIF}
  201. BEGIN
  202.   try
  203.   IF fPrintersInstalled>0 THEN
  204.   BEGIN
  205.     pLogPixelsX:=GetDeviceCaps(Printer.Handle,LOGPIXELSX);
  206.     pLogPixelsY:=GetDeviceCaps(Printer.Handle,LOGPIXELSY);
  207.     {$IFDEF VER80}
  208.     Escape(Printer.Handle,GetPhysPageSize,0,NIL,@r);
  209.     pPhysicalWidth:=r.x;
  210.     pPhysicalHeight:=r.y;
  211.     {$ELSE}
  212.     pPhysicalWidth:=GetDeviceCaps(Printer.Handle,PHYSICALWIDTH);
  213.     pPhysicalHeight:=GetDeviceCaps(Printer.Handle,PHYSICALHEIGHT);
  214.     {$ENDIF}
  215.     pHorzRes:=GetDeviceCaps(Printer.Handle,HORZRES);
  216.     pVertRes:=GetDeviceCaps(Printer.Handle,VERTRES);
  217.     {$IFDEF VER80}
  218.     Escape(Printer.Handle,GetPrintingOffset,0,NIL,@r);
  219.     pPhysicalOffsetX:=r.x;
  220.     pPhysicalOffsetY:=r.y;
  221.     {$ELSE}
  222.     pPhysicalOffsetX:=GetDeviceCaps(Printer.Handle,PHYSICALOFFSETX);
  223.     pPhysicalOffsetY:=GetDeviceCaps(Printer.Handle,PHYSICALOFFSETY);
  224.     {$ENDIF}
  225.   END;
  226.   except end;
  227. END;
  228.  
  229. PROCEDURE TXPrint.ClosePrinting;
  230. BEGIN
  231.   IF fPrintersInstalled>0 THEN
  232.   BEGIN
  233.     { ursprⁿnglichen Font wieder setzen }
  234.     Canvas.Font.Color:=FontBackup.Color;
  235.     Canvas.Font.Height:=FontBackup.Height;
  236.     Canvas.Font.Name:=FontBackup.Name;
  237.     Canvas.Font.Pitch:=FontBackup.Pitch;
  238.     Canvas.Font.Size:=FontBackup.Size;
  239.     Canvas.Font.Style:=FontBackup.Style;
  240.     FontBackup.Free;
  241.   END;
  242.   PrintOpened:=FALSE;
  243. END;
  244.  
  245. FUNCTION TXPrint.DotValX(ScaledVal : INTEGER) : INTEGER;
  246. { Rechnet skalierten Wert in Pixel um,
  247.   abhΣngig von der Skalierung und der hor. Druckeraufl÷sung }
  248. BEGIN
  249.   IF Scaling=pscDot THEN
  250.     DotValX:=ScaledVal
  251.   ELSE
  252.     DotValX:=LONGINT(ScaledVal)*pLogPixelsX DIV k;
  253. END;
  254.  
  255. FUNCTION TXPrint.DotValY(ScaledVal : INTEGER) : INTEGER;
  256. { Rechnet skalierten Wert in Pixel um,
  257.   abhΣngig von der Skalierung und der vert. Druckeraufl÷sung }
  258. BEGIN
  259.   IF Scaling=pscDot THEN
  260.     DotValY:=ScaledVal
  261.   ELSE
  262.     DotValY:=LONGINT(ScaledVal)*pLogPixelsY DIV k;
  263. END;
  264.  
  265. FUNCTION TXPrint.ScaleValX(DotVal : INTEGER) : INTEGER;
  266. { Rechnet einen Pixelwert in skalierten Wert um,
  267.   abhΣngig von der Skalierung und der hor. Druckeraufl÷sung }
  268. BEGIN
  269.   IF Scaling=pscDot THEN
  270.     ScaleValX:=DotVal
  271.   ELSE
  272.     ScaleValX:=LONGINT(DotVal)*k DIV pLogPixelsX;
  273. END;
  274.  
  275. FUNCTION TXPrint.ScaleValY(DotVal : INTEGER) : INTEGER;
  276. { Rechnet einen Pixelwert in skalierten Wert um,
  277.   abhΣngig von der Skalierung und der vert. Druckeraufl÷sung }
  278. BEGIN
  279.   IF Scaling=pscDot THEN
  280.     ScaleValY:=DotVal
  281.   ELSE
  282.     ScaleValY:=LONGINT(DotVal)*k DIV pLogPixelsY;
  283. END;
  284.  
  285. PROCEDURE TXPrint.Abort;
  286. { Druckausgabe abbrechen }
  287. BEGIN
  288.   IF fPrintersInstalled>0 THEN
  289.   BEGIN
  290.     Printer.Abort;
  291.     ClosePrinting;
  292.   END;
  293. END;
  294.  
  295. PROCEDURE TXPrint.SetupPrinter;
  296. { Druckereinstellungen setzen }
  297. VAR
  298.   kx1, ky1, ox, oy, i : LONGINT;
  299.   kx2, ky2 : INTEGER;
  300. BEGIN
  301.   IF fPrintersInstalled>0 THEN
  302.   WITH Printer DO
  303.   BEGIN
  304.     IF fScaling=pscDot THEN
  305.     BEGIN   { keine Skalierung }
  306.       { bedruckbarer Bereich }
  307.       i:=LONGINT(pHorzRes-(MarginLeft-pPhysicalOffsetX)-1); { Pixel }
  308.       i:=i-MarginRight+pPhysicalWidth-pPhysicalOffsetX-pHorzRes;
  309.       fPrintWidth:=i;
  310.       i:=LONGINT(pVertRes-(MarginTop-pPhysicalOffsetY)-1);
  311.       i:=i-MarginBottom+pPhysicalHeight-pPhysicalOffsetY-pVertRes;
  312.       fPrintHeight:=i;
  313.     END
  314.     ELSE
  315.     BEGIN   { Skalierung }
  316.       { bedruckbarer Bereich }
  317.       i:=LONGINT(pHorzRes-(DotValX(MarginLeft)-pPhysicalOffsetX)-1); { Pixel }
  318.       i:=i-DotValX(MarginRight)+pPhysicalWidth-pPhysicalOffsetX-pHorzRes;
  319.       fPrintWidth:=LONGINT(k)*i DIV pLogPixelsX;
  320.       i:=LONGINT(pVertRes-(DotValY(MarginTop)-pPhysicalOffsetY)-1);
  321.       i:=i-DotValY(MarginBottom)+pPhysicalHeight-pPhysicalOffsetY-pVertRes;
  322.       fPrintHeight:=LONGINT(k)*i DIV pLogPixelsY;
  323.       { Skalierung }
  324.       kx2:=7200;   { ─nderung V1.4 }
  325.       ky2:=7200;
  326.       kx1:=k*LONGINT(7200 DIV pLogPixelsX);
  327.       WHILE kx1>32767 DO
  328.       BEGIN
  329.         kx1:=kx1 DIV 2;
  330.         kx2:=kx2 DIV 2;
  331.       END;
  332.       ky1:=k*LONGINT(7200 DIV pLogPixelsY);
  333.       WHILE ky1>32767 DO
  334.       BEGIN
  335.         ky1:=ky1 DIV 2;
  336.         ky2:=ky2 DIV 2;
  337.       END;
  338.       SetMapMode(Handle,MM_Isotropic);   { Breite und H÷he im gleichen VerhΣltnis }
  339.       ox:=(LONGINT(MarginLeft)*pLogPixelsX DIV k)-pPhysicalOffsetX;
  340.       oy:=(LONGINT(MarginTop)*pLogPixelsY DIV k)-pPhysicalOffsetY;
  341.       {$IFDEF VER80}
  342.       SetWindowExt(Handle,kx1,ky1);
  343.       SetViewportExt(Handle,kx2,ky2);
  344.       SetViewportOrg(Handle,ox,oy);
  345.       {$ELSE}
  346.       SetWindowExtEx(Handle,kx1,ky1,NIL);
  347.       SetViewPortExtEx(Handle,kx2,ky2,NIL);
  348.       SetViewPortOrgEx(Handle,ox,oy,NIL);
  349.       {$ENDIF}
  350.     END;
  351.   END;
  352. END;
  353.  
  354. PROCEDURE TXPrint.BeginDoc;
  355. { Druckausgabe ÷ffnen }
  356. VAR
  357.   FS : INTEGER;
  358. BEGIN
  359.   IF fPrintersInstalled>0 THEN
  360.   BEGIN
  361.     DriverParams;   { Druckerparameter ermitteln }
  362.     Printer.BeginDoc;
  363.     PrintOpened:=TRUE;
  364.     SetupPrinter;
  365.     WITH Printer DO
  366.     BEGIN
  367.       { Korrektur der Font-Aufl÷sung, falls Drucker gewechselt wurde
  368.         (geklaut im Quelltext der Unit PRINTERS) }
  369.       FS:=Canvas.Font.Size;
  370.       Canvas.Font.PixelsPerInch:=pLogPixelsY;
  371.       Canvas.Font.Size:=FS;
  372.       { Backup vom aktuellen Font erstellen }
  373.       FontBackup:=TFont.Create;
  374.       FontBackup.Color:=Canvas.Font.Color;
  375.       FontBackup.Height:=Canvas.Font.Height;
  376.       FontBackup.Name:=Canvas.Font.Name;
  377.       FontBackup.Pitch:=Canvas.Font.Pitch;
  378.       FontBackup.Size:=Canvas.Font.Size;
  379.       FontBackup.Style:=Canvas.Font.Style;
  380.       { Gr÷▀e des vorgegebenen Fonts anpassen }
  381.       FS:=Canvas.Font.Size;
  382.       SetFontSize(FS);
  383.     END;
  384.   END;
  385. END;
  386.  
  387. PROCEDURE TXPrint.EndDoc;
  388. { Druckerausgabe schlie▀en }
  389. BEGIN
  390.   IF fPrintersInstalled>0 THEN
  391.   BEGIN
  392.     Printer.EndDoc;
  393.     ClosePrinting;
  394.   END;
  395. END;
  396.  
  397. PROCEDURE TXPrint.NewPage;
  398. { neue Seite }
  399. BEGIN
  400.   IF (PrintersInstalled>0) AND PrintOpened THEN
  401.   BEGIN
  402.     Printer.NewPage;
  403.     SetupPrinter;
  404.     SetFontSize(SizeBackup);
  405.   END;
  406. END;
  407.  
  408. PROCEDURE TXPrint.SetFontSize;
  409. { Font-Gr÷▀e setzen }
  410. BEGIN
  411.   IF fPrintersInstalled>0 THEN
  412.   BEGIN
  413.     SizeBackup:=FontSize;
  414.     WITH Canvas.Font DO
  415.     IF (fScaling=pscDot) OR (NOT PrintOpened) THEN
  416.       Size:=Abs(FontSize)   { keine Skalierung }
  417.     ELSE
  418.       Size:=LONGINT(Abs(FontSize))*k DIV PixelsPerInch;   { Druckeraufl÷sung berⁿcksichtigen }
  419.   END;
  420. END;
  421.  
  422. PROCEDURE TXPrint.SelectFont(AFont : TFont);
  423. { Den angegebenen Font als Drucker-Font setzen }
  424. BEGIN
  425.   IF fPrintersInstalled>0 THEN
  426.   WITH Canvas.Font DO
  427.   BEGIN
  428.     Height:=-Abs(AFont.Height);
  429.     Name:=AFont.Name;
  430.     Pitch:=AFont.Pitch;
  431.     Style:=AFont.Style;
  432.     SetFontSize(AFont.Size);
  433.   END;
  434. END;
  435.  
  436. FUNCTION TXPrint.XBounds(ALeft, ATop, AWidth, AHeight: INTEGER): tRect;
  437. BEGIN
  438.   {$IFDEF VER80}
  439.   XBounds:=Bounds(DotValX(ALeft),DotValY(ATop),DotValX(AWidth),DotValY(AHeight));
  440.   {$ELSE}
  441.   XBounds:=Bounds(ALeft,ATop,AWidth,AHeight);
  442.   {$ENDIF}
  443. END;
  444.  
  445. FUNCTION TXPrint.PrintersInstalled : WORD;
  446. { Ermittelt, wieviele Drucker im System eingerichtet sind }
  447. {$IFDEF VER80}
  448. CONST
  449.   DevicesSize = 4096;
  450. VAR
  451.   i, j : WORD;
  452.   Devices: PChar;
  453.   {$ELSE}
  454. VAR
  455.   Buffer: PChar;
  456.   Count, NumInfo: Integer;
  457.   Flags: INTEGER;
  458.   Level: BYTE;
  459.   {$ENDIF}
  460. BEGIN
  461.   PrintersInstalled:=0;
  462.   {$IFDEF VER80}
  463.   GetMem(Devices, DevicesSize);
  464.   TRY
  465.     i:=0;
  466.     GetProfileString('devices', NIL, '', Devices, DevicesSize);
  467.     IF Devices[0]>#0 THEN
  468.     BEGIN   { mind. ein Drucker ist vorhanden }
  469.       j:=0;
  470.       REPEAT
  471.         Inc(j);
  472.         IF Devices[j]=#0 THEN
  473.         BEGIN
  474.           Inc(i);
  475.           Inc(j);
  476.         END;
  477.       UNTIL Devices[j]=#0;
  478.     END;
  479.   EXCEPT
  480.     i:=0;
  481.   END;
  482.   FreeMem(Devices, DevicesSize);
  483.   PrintersInstalled:=i;
  484.   {$ELSE}
  485.   TRY
  486.     IF Win32Platform = VER_PLATFORM_WIN32_NT THEN
  487.     BEGIN
  488.       Flags := PRINTER_ENUM_CONNECTIONS OR PRINTER_ENUM_LOCAL;
  489.       Level := 4;
  490.     END
  491.     ELSE
  492.     BEGIN
  493.       Flags := PRINTER_ENUM_LOCAL;
  494.       Level := 5;
  495.     END;
  496.     EnumPrinters(Flags, NIL, Level, NIL, 0, Count, NumInfo);
  497.     GetMem(Buffer, Count);
  498.     TRY
  499.       IF NOT EnumPrinters(Flags, NIL, Level, PByte(Buffer), Count, Count, NumInfo) THEN
  500.         Exit;
  501.       PrintersInstalled:=NumInfo;
  502.     FINALLY
  503.       FreeMem(Buffer, Count);
  504.     END;
  505.   EXCEPT
  506.     PrintersInstalled:=0;
  507.   END;
  508.   {$ENDIF}
  509. END;
  510.  
  511. FUNCTION TXPrint.GetPrinterAvailable : BOOLEAN;
  512. { Liefert true, wenn mindestens ein Drucker vorhanden ist }
  513. BEGIN
  514.   GetPrinterAvailable:=fPrintersInstalled>0;
  515. END;
  516.  
  517. FUNCTION TXPrint.GetPrinting;
  518. { Prⁿfen, ob gerade eine Druckerausgabe lΣuft }
  519. BEGIN
  520.   IF fPrintersInstalled>0 THEN
  521.     GetPrinting:=Printer.Printing
  522.   ELSE
  523.     GetPrinting:=FALSE;
  524. END;
  525.  
  526. PROCEDURE TXPrint.SetScaling;
  527. { Skalierung setzen }
  528. VAR
  529.   ML, MT, MR, MB : INTEGER;
  530. BEGIN
  531.   IF NOT PrintOpened THEN
  532.   BEGIN
  533.     { Randpositionen in Pixel umrechnen }
  534.     ML:=DotValX(MarginLeft);
  535.     MT:=DotValY(MarginTop);
  536.     MR:=DotValX(MarginRight);
  537.     MB:=DotValY(MarginBottom);
  538.     fScaling:=VALUE;
  539.     k:=1;
  540.     CASE fScaling OF
  541.       pscMetric10  : k:=254;
  542.       pscMetric100 : k:=2540;
  543.       pscMil       : k:=1000;
  544.     END { case };
  545.     { Randpositionen entsprechend Skalierung umrechnen }
  546.     MarginLeft:=ScaleValX(ML);
  547.     MarginTop:=ScaleValY(MT);
  548.     MarginRight:=ScaleValX(MR);
  549.     MarginBottom:=ScaleValY(MB);
  550.   END;
  551. END;
  552.  
  553. FUNCTION TXPrint.GetFont;
  554. { aktueller Druck-Font }
  555. BEGIN
  556.   GetFont:=Canvas.Font
  557. END;
  558.  
  559. PROCEDURE TXPrint.SetFont;
  560. { aktuellen Druck-Font setzen (nur die Inhalte) }
  561. BEGIN
  562.   Canvas.Font.Color:=VALUE.Color;
  563.   Canvas.Font.Height:=VALUE.Height;
  564.   Canvas.Font.Name:=VALUE.Name;
  565.   Canvas.Font.Pitch:=VALUE.Pitch;
  566.   Canvas.Font.Size:=VALUE.Size;
  567.   Canvas.Font.Style:=VALUE.Style;
  568. END;
  569.  
  570. FUNCTION TXPrint.GetAborted;
  571. { Abfrage auf Abbruch }
  572. BEGIN
  573.   IF fPrintersInstalled>0 THEN
  574.     GetAborted:=Printer.Aborted
  575.   ELSE
  576.     GetAborted:=FALSE;
  577. END;
  578.  
  579. FUNCTION TXPrint.GetMinMarginLeft : INTEGER;
  580. { linker Rand: kleinstm÷gliche Randposition, gegeben durch den Druckertreiber }
  581. BEGIN
  582.   GetMinMarginLeft:=ScaleValX(pPhysicalOffsetX);
  583. END;
  584.  
  585. FUNCTION TXPrint.GetMinMarginRight : INTEGER;
  586. { rechter Rand: kleinstm÷gliche Randposition, gegeben durch den Druckertreiber }
  587. BEGIN
  588.   GetMinMarginRight:=ScaleValX(pPhysicalWidth-pHorzRes-pPhysicalOffsetX);
  589. END;
  590.  
  591. FUNCTION TXPrint.GetMinMarginTop : INTEGER;
  592. { oberer Rand: kleinstm÷gliche Randposition, gegeben durch den Druckertreiber }
  593. BEGIN
  594.   GetMinMarginTop:=ScaleValY(pPhysicalOffsetY);
  595. END;
  596.  
  597. FUNCTION TXPrint.GetMinMarginBottom : INTEGER;
  598. { unterer Rand: kleinstm÷gliche Randposition, gegeben durch den Druckertreiber }
  599. BEGIN
  600.   GetMinMarginBottom:=ScaleValY(pPhysicalHeight-pVertRes-pPhysicalOffsetY);
  601. END;
  602.  
  603. FUNCTION TXPrint.GetPrinterCapabilities : TXPrinterCapabilities;
  604. { Druckereigenschaften }
  605. VAR
  606.   r : TXPrinterCapabilities;
  607. BEGIN
  608.   r:=[];
  609.   IF fPrintersInstalled>0 THEN
  610.   BEGIN
  611.     {$IFNDEF VER80}
  612.     IF pcCopies IN Printer.Capabilities THEN r:=[xpcCopies];
  613.     IF pcOrientation IN Printer.Capabilities THEN r:=r+[xpcOrientation];
  614.     IF pcCollation IN Printer.Capabilities THEN r:=r+[xpcCollation];
  615.     {$ENDIF}
  616.   END;
  617.   GetPrinterCapabilities:=r;
  618. END;
  619.  
  620. FUNCTION TXPrint.GetCopies;
  621. { Anzahl Kopien }
  622. BEGIN
  623.   Result := 1;
  624.   try
  625.   IF fPrintersInstalled>0 THEN
  626.   BEGIN
  627.     {$IFDEF VER80}
  628.     GetCopies:=1;
  629.     {$ELSE}
  630.     GetCopies:=Printer.Copies;
  631.     {$ENDIF}
  632.   END
  633.   ELSE GetCopies:=1;
  634.   except end;
  635. END;
  636.  
  637. PROCEDURE TXPrint.SetCopies;
  638. { Anzahl Kopien }
  639. BEGIN
  640.   try
  641.   {$IFNDEF VER80}
  642.   // nur IN der 32-Bit-Version unterstⁿtzt
  643.   IF fPrintersInstalled>0 THEN Printer.Copies:=VALUE;
  644.   {$ENDIF}
  645.   except end;
  646. END;
  647.  
  648. FUNCTION TXPrint.GetFonts;
  649. { verfⁿgbare Drucker-Fonts }
  650. BEGIN
  651.   IF fPrintersInstalled>0 THEN
  652.     GetFonts:=Printer.Fonts
  653.   ELSE
  654.     GetFonts:=NIL;
  655. END;
  656.  
  657. FUNCTION TXPrint.GetHandle;
  658. { Drucker-Handle }
  659. BEGIN
  660.   IF fPrintersInstalled>0 THEN
  661.     GetHandle:=Printer.Handle
  662.   ELSE
  663.     GetHandle:=0;
  664. END;
  665.  
  666. FUNCTION TXPrint.GetPageNumber : INTEGER;
  667. { Seitennummer }
  668. BEGIN
  669.   IF fPrintersInstalled>0 THEN
  670.     GetPageNumber:=Printer.PageNumber
  671.   ELSE
  672.     GetPageNumber:=1;
  673. END;
  674.  
  675. FUNCTION TXPrint.GetPrinters;
  676. { verfⁿgbare Drucker }
  677. BEGIN
  678.   IF fPrintersInstalled>0 THEN
  679.     GetPrinters:=Printer.Printers
  680.   ELSE
  681.     GetPrinters:=NIL;
  682. END;
  683.  
  684. FUNCTION TXPrint.GetTitle;
  685. { Druck-Job-Name, erscheint im Druck-Manager }
  686. BEGIN
  687.   IF fPrintersInstalled>0 THEN
  688.     GetTitle:=Printer.Title
  689.   ELSE
  690.     GetTitle:='';
  691. END;
  692.  
  693. PROCEDURE TXPrint.SetTitle;
  694. { Druck-Job-Name, erscheint im Druck-Manager }
  695. BEGIN
  696.   IF fPrintersInstalled>0 THEN
  697.     Printer.Title:=VALUE;
  698. END;
  699.  
  700. FUNCTION TXPrint.GetCurrentPrinter;
  701. { aktueller Drucker }
  702. BEGIN
  703.   IF fPrintersInstalled>0 THEN
  704.     GetCurrentPrinter:=Printer.PrinterIndex
  705.   ELSE
  706.     GetCurrentPrinter:=0;
  707. END;
  708.  
  709. PROCEDURE TXPrint.SetCurrentPrinter;
  710. { aktueller Drucker }
  711. BEGIN
  712.   IF fPrintersInstalled>0 THEN
  713.   BEGIN
  714.     Printer.PrinterIndex:=VALUE;
  715.     DriverParams;   { Druckerparameter ermitteln }
  716.   END;
  717. END;
  718.  
  719. FUNCTION TXPrint.GetOrientation;
  720. { Ausrichtung }
  721. BEGIN
  722.   GetOrientation:=xpoPortrait;
  723.   try
  724.   IF fPrintersInstalled>0 THEN
  725.     GetOrientation:=TXPrinterOrientation(Ord(Printer.Orientation))
  726.   ELSE
  727.     GetOrientation:=xpoPortrait;
  728.   except end;
  729. END;
  730.  
  731. PROCEDURE TXPrint.SetOrientation;
  732. { Ausrichtung }
  733. BEGIN
  734.   IF fPrintersInstalled>0 THEN
  735.     Printer.Orientation:=TPrinterOrientation(Ord(VALUE));
  736. END;
  737.  
  738.  
  739. PROCEDURE Register;
  740. { Registrierung der Komponente }
  741. BEGIN
  742.   RegisterComponents('Toolbox',[TXPrint]);
  743. END;
  744.  
  745. END.
  746.  
  747.