home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_Prntr.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-09  |  9KB  |  312 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {           Printer controlling            }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_Prntr;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  19.   QStdCtrls, QPrinters, FR_Class, FR_Const;
  20.  
  21. type
  22.   TfrPrinter = class
  23.   private
  24.     FPrinter: TPrinter;
  25.     FPaperNames: TStringList;
  26.     FPrinters: TStringList;
  27.     FPrinterIndex: Integer;
  28.     FDefaultPrinter: Integer;
  29.     procedure GetSettings;
  30.     procedure SetSettings;
  31.     procedure SetPrinter(Value: TPrinter);
  32.     procedure SetPrinterIndex(Value: Integer);
  33.   public
  34.     Orientation: TPrinterOrientation;
  35.     PaperSize: Integer;
  36.     PaperWidth: Integer;
  37.     PaperHeight: Integer;
  38.     PaperSizes: Array[0..255] of Word;
  39.     PaperSizesNum: Integer;
  40.     constructor Create;
  41.     destructor Destroy; override;
  42.     procedure Localize;
  43.     procedure FillPrnInfo(var p: TfrPrnInfo);
  44.     procedure SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer;
  45.       pgOr: TPrinterOrientation; SetImmediately: Boolean);
  46.     function IsEqual(pgSize, pgWidth, pgHeight: Integer;
  47.       pgOr: TPrinterOrientation): Boolean;
  48.     function GetSizeIndex(pgSize: Integer): Integer;
  49.     procedure PropertiesDlg;
  50.     procedure Update;
  51.     property PaperNames: TStringList read FPaperNames;
  52.     property Printer: TPrinter read FPrinter write SetPrinter;
  53.     property Printers: TStringList read FPrinters;
  54.     property PrinterIndex: Integer read FPrinterIndex write SetPrinterIndex;
  55.   end;
  56.  
  57.  
  58. var
  59.   Prn: TfrPrinter;
  60.   frDefaultPaper: Integer;
  61.  
  62. implementation
  63.  
  64. uses FR_Utils;
  65.  
  66. type
  67.   TPageWidthHeight = record
  68.     Name: String;
  69.     Width: Integer;
  70.     Height: Integer;
  71.   end;
  72.  
  73. const
  74.   PAPERCOUNT = 30;
  75.   PaperInfo: array[0..PAPERCOUNT - 1] of TPageWidthHeight =
  76.     (
  77.       (Name: SPaper1; Width: 8268; Height: 11693),  // psA4
  78.       (Name: SPaper2; Width: 7165; Height: 10118),  // psB5
  79.       (Name: SPaper3; Width: 8500; Height: 11000),  // psLetter
  80.       (Name: SPaper4; Width: 8500; Height: 14000),  // psLegal
  81.       (Name: SPaper5; Width: 7500; Height: 10000),  // psExecutive
  82.       (Name: SPaper6; Width: 33110; Height: 46811), // psA0
  83.       (Name: SPaper7; Width: 23386; Height: 33110), // psA1
  84.       (Name: SPaper8; Width: 16535; Height: 23386), // psA2
  85.       (Name: SPaper9; Width: 11693; Height: 16535), // psA3
  86.       (Name: SPaper10; Width: 5827; Height: 8268),   // psA5
  87.       (Name: SPaper11; Width: 4134; Height: 5827),   // psA6
  88.       (Name: SPaper12; Width: 2913; Height: 4134),   // psA7
  89.       (Name: SPaper13; Width: 2047; Height: 2913),   // psA8
  90.       (Name: SPaper14; Width: 1457; Height: 2047),   // psA9
  91.       (Name: SPaper15; Width: 40551; Height: 57323), // psB0
  92.       (Name: SPaper16; Width: 28661; Height: 40551), // psB1
  93.       (Name: SPaper17; Width: 1260; Height: 1772),   // psB10
  94.       (Name: SPaper18; Width: 20276; Height: 28661), // psB2
  95.       (Name: SPaper19; Width: 14331; Height: 20276), // psB3
  96.       (Name: SPaper20; Width: 10118; Height: 14331), // psB4
  97.       (Name: SPaper21; Width: 5039; Height: 7165),   // psB6
  98.       (Name: SPaper22; Width: 3583; Height: 5039),   // psB7
  99.       (Name: SPaper23; Width: 2520; Height: 3583),   // psB8
  100.       (Name: SPaper24; Width: 1772; Height: 2520),   // psB9
  101.       (Name: SPaper25; Width: 6417; Height: 9016),   // psC5E
  102.       (Name: SPaper26; Width: 4125; Height: 9500),   // psComm10E
  103.       (Name: SPaper27; Width: 4331; Height: 8661),   // psDLE
  104.       (Name: SPaper28; Width: 8250; Height: 13000),  // psFolio
  105.       (Name: SPaper29; Width: 17000; Height: 11000), // psLedger
  106.       (Name: SPaper30; Width: 11000; Height: 17000)  // psTabloid
  107.     );
  108.  
  109.  
  110. { TfrPrinter }
  111.  
  112. constructor TfrPrinter.Create;
  113. begin
  114.   inherited Create;
  115.   FPaperNames := TStringList.Create;
  116.   FPrinters := TStringList.Create;
  117.   PaperSize := 0;
  118.   Localize;
  119. end;
  120.  
  121. destructor TfrPrinter.Destroy;
  122. begin
  123.   FPaperNames.Free;
  124.   FPrinters.Free;
  125.   inherited Destroy;
  126. end;
  127.  
  128. procedure TfrPrinter.Localize;
  129. begin
  130.   if FPrinters.Count > 0 then
  131.     FPrinters[FPrinters.Count - 1] := SDefaultPrinter;
  132. end;
  133.  
  134. procedure TfrPrinter.GetSettings;
  135. var
  136.   i: Integer;
  137. begin
  138.   PaperSize := Integer(FPrinter.PrintAdapter.PageSize);
  139.   PaperWidth := Round(PaperInfo[PaperSize].Width / 3.937);
  140.   PaperHeight := Round(PaperInfo[PaperSize].Height / 3.937);
  141.  
  142.   PaperSizesNum := PAPERCOUNT;
  143.  
  144.   FPaperNames.Clear;
  145.   for i := 0 to PaperSizesNum - 1 do
  146.   begin
  147.     FPaperNames.Add(PaperInfo[i].Name);
  148.     PaperSizes[i] := i;
  149.   end;
  150.  
  151.   Orientation := FPrinter.Orientation;
  152. end;
  153.  
  154. procedure TfrPrinter.SetSettings;
  155. var
  156.   i, n: Integer;
  157. begin
  158.   if FPrinterIndex = FDefaultPrinter then
  159.   begin
  160.     FPaperNames.Clear;
  161.     for i := 0 to PAPERCOUNT - 1 do
  162.     begin
  163.       FPaperNames.Add(PaperInfo[i].Name);
  164.       PaperSizes[i] := i;
  165.       if (PaperSize <> $100) and (PaperSize = i) then
  166.       begin
  167.         PaperWidth := Round(PaperInfo[i].Width / 3.937);
  168.         PaperHeight := Round(PaperInfo[i].Height / 3.937);
  169.         if Orientation = poLandscape then
  170.         begin
  171.           n := PaperWidth; PaperWidth := PaperHeight; PaperHeight := n;
  172.         end;
  173.       end;
  174.     end;
  175.     PaperSizesNum := PAPERCOUNT;
  176.     Exit;
  177.   end;
  178.  
  179.   FPrinter.PrintAdapter.PageSize := TPageSize(PaperSize);
  180.   FPrinter.Orientation := Orientation;
  181.   GetSettings;
  182. end;
  183.  
  184. procedure TfrPrinter.FillPrnInfo(var p: TfrPrnInfo);
  185. var
  186.   kx, ky: Double;
  187. begin
  188.   kx := 93 / 1.015;
  189.   ky := 93 / 1.015;
  190.   if FPrinterIndex = FDefaultPrinter then
  191.     with p do
  192.     begin
  193.       Pgw := Round(PaperWidth * kx / 254);
  194.       Pgh := Round(PaperHeight * ky / 254);
  195.       Ofx := Round(50 * kx / 254);
  196.       Ofy := Round(50 * ky / 254);
  197.       Pw := Pgw - Ofx * 2;
  198.       Ph := Pgh - Ofy * 2;
  199.     end
  200.   else
  201.     with p, FPrinter do
  202.     begin
  203.       kx := kx / XDPI;
  204.       ky := ky / YDPI;
  205.       PPgw := PageWidth; Pgw := Round(PPgw * kx);
  206.       PPgh := PageHeight; Pgh := Round(PPgh * ky);
  207.       POfx := Margins.cx; Ofx := Round(POfx * kx);
  208.       POfy := Margins.cy; Ofy := Round(POfy * ky);
  209.       PPw := PPgw - POfx * 2; Pw := Round(PPw * kx);
  210.       PPh := PPgh - POfy * 2; Ph := Round(PPh * ky);
  211.     end;
  212. end;
  213.  
  214. function TfrPrinter.IsEqual(pgSize, pgWidth, pgHeight: Integer;
  215.   pgOr: TPrinterOrientation): Boolean;
  216. begin
  217.   if (PaperSize = pgSize) and (pgSize = $100) then
  218.   begin
  219.     Result := False;
  220.     if (PaperSize = pgSize) then
  221.       if abs(PaperWidth - pgWidth) <= 1 then
  222.         if abs(PaperHeight - pgHeight) <= 1 then
  223.           if (Orientation = pgOr) then
  224.             Result := True;
  225.   end
  226.   else
  227.     Result := (PaperSize = pgSize) and (Orientation = pgOr);
  228. end;
  229.  
  230. procedure TfrPrinter.SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer;
  231.   pgOr: TPrinterOrientation; SetImmediately: Boolean);
  232. begin
  233.   if FPrinter.Printing then Exit;
  234.   if not SetImmediately then
  235.     if IsEqual(pgSize, pgWidth, pgHeight, pgOr) then Exit;
  236.   PaperSize := pgSize;
  237.   PaperWidth := pgWidth;
  238.   PaperHeight := pgHeight;
  239.   Orientation := pgOr;
  240.   SetSettings;
  241. end;
  242.  
  243. procedure TfrPrinter.PropertiesDlg;
  244. begin
  245.   FPrinter.ExecuteSetup;
  246. end;
  247.  
  248. function TfrPrinter.GetSizeIndex(pgSize: Integer): Integer;
  249. var
  250.   i: Integer;
  251. begin
  252.   Result := PaperSizesNum - 1;
  253.   for i := 0 to PaperSizesNum - 1 do
  254.     if PaperSizes[i] = pgSize then
  255.     begin
  256.       Result := i;
  257.       break;
  258.     end;
  259. end;
  260.  
  261. procedure TfrPrinter.SetPrinterIndex(Value: Integer);
  262. begin
  263.   FPrinterIndex := Value;
  264.   if Value = FDefaultPrinter then
  265.     SetSettings
  266.   else if FPrinter.Printers.Count > 0 then
  267.   begin
  268. //    FPrinter.PrinterIndex := Value;
  269.     FPrinter.SetPrinter(FPrinter.Printers[Value]);
  270.     GetSettings;
  271.   end;
  272. end;
  273.  
  274. procedure TfrPrinter.SetPrinter(Value: TPrinter);
  275. begin
  276.   FPrinters.Clear;
  277.   FPrinterIndex := 0;
  278.   FPrinter := Value;
  279.   if FPrinter.Printers.Count > 0 then
  280.   begin
  281.     FPrinters.Assign(FPrinter.Printers);
  282. //    FPrinterIndex := FPrinter.PrinterIndex;
  283.   end;
  284.   FPrinters.Add(SDefaultPrinter);
  285.   FDefaultPrinter := FPrinters.Count - 1;
  286.  
  287.   if FPrinter.Printers.Count > 0 then
  288.     GetSettings else
  289.     SetSettings;
  290. end;
  291.  
  292. procedure TfrPrinter.Update;
  293. begin
  294.   GetSettings;
  295. end;
  296.  
  297.  
  298. initialization
  299.   Prn := TfrPrinter.Create;
  300.   try
  301.     Prn.Printer := Printer;
  302.     frDefaultPaper := Prn.PaperSize;
  303.   except;
  304.   end;
  305.   frThreadDone := True;
  306.  
  307. finalization
  308.   Prn.Free;
  309.  
  310. end.
  311.  
  312.