Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/kolekce/d6/FRCLX.ZIP/SOURCE/FR_Prntr.pas

Pascal/Delphi Source File | 2001-07-09 | 8.5 KB | 312 lines

{******************************************}
{                                          }
{           FastReport CLX v2.4            }
{           Printer controlling            }
{                                          }
{ Copyright (c) 1998-2001 by Tzyganenko A. }
{                                          }
{******************************************}

unit FR_Prntr;

interface

{$I FR.inc}

uses
  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  QStdCtrls, QPrinters, FR_Class, FR_Const;

type
  TfrPrinter = class
  private
    FPrinter: TPrinter;
    FPaperNames: TStringList;
    FPrinters: TStringList;
    FPrinterIndex: Integer;
    FDefaultPrinter: Integer;
    procedure GetSettings;
    procedure SetSettings;
    procedure SetPrinter(Value: TPrinter);
    procedure SetPrinterIndex(Value: Integer);
  public
    Orientation: TPrinterOrientation;
    PaperSize: Integer;
    PaperWidth: Integer;
    PaperHeight: Integer;
    PaperSizes: Array[0..255] of Word;
    PaperSizesNum: Integer;
    constructor Create;
    destructor Destroy; override;
    procedure Localize;
    procedure FillPrnInfo(var p: TfrPrnInfo);
    procedure SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer;
      pgOr: TPrinterOrientation; SetImmediately: Boolean);
    function IsEqual(pgSize, pgWidth, pgHeight: Integer;
      pgOr: TPrinterOrientation): Boolean;
    function GetSizeIndex(pgSize: Integer): Integer;
    procedure PropertiesDlg;
    procedure Update;
    property PaperNames: TStringList read FPaperNames;
    property Printer: TPrinter read FPrinter write SetPrinter;
    property Printers: TStringList read FPrinters;
    property PrinterIndex: Integer read FPrinterIndex write SetPrinterIndex;
  end;


var
  Prn: TfrPrinter;
  frDefaultPaper: Integer;

implementation

uses FR_Utils;

type
  TPageWidthHeight = record
    Name: String;
    Width: Integer;
    Height: Integer;
  end;

const
  PAPERCOUNT = 30;
  PaperInfo: array[0..PAPERCOUNT - 1] of TPageWidthHeight =
    (
      (Name: SPaper1; Width: 8268; Height: 11693),  // psA4
      (Name: SPaper2; Width: 7165; Height: 10118),  // psB5
      (Name: SPaper3; Width: 8500; Height: 11000),  // psLetter
      (Name: SPaper4; Width: 8500; Height: 14000),  // psLegal
      (Name: SPaper5; Width: 7500; Height: 10000),  // psExecutive
      (Name: SPaper6; Width: 33110; Height: 46811), // psA0
      (Name: SPaper7; Width: 23386; Height: 33110), // psA1
      (Name: SPaper8; Width: 16535; Height: 23386), // psA2
      (Name: SPaper9; Width: 11693; Height: 16535), // psA3
      (Name: SPaper10; Width: 5827; Height: 8268),   // psA5
      (Name: SPaper11; Width: 4134; Height: 5827),   // psA6
      (Name: SPaper12; Width: 2913; Height: 4134),   // psA7
      (Name: SPaper13; Width: 2047; Height: 2913),   // psA8
      (Name: SPaper14; Width: 1457; Height: 2047),   // psA9
      (Name: SPaper15; Width: 40551; Height: 57323), // psB0
      (Name: SPaper16; Width: 28661; Height: 40551), // psB1
      (Name: SPaper17; Width: 1260; Height: 1772),   // psB10
      (Name: SPaper18; Width: 20276; Height: 28661), // psB2
      (Name: SPaper19; Width: 14331; Height: 20276), // psB3
      (Name: SPaper20; Width: 10118; Height: 14331), // psB4
      (Name: SPaper21; Width: 5039; Height: 7165),   // psB6
      (Name: SPaper22; Width: 3583; Height: 5039),   // psB7
      (Name: SPaper23; Width: 2520; Height: 3583),   // psB8
      (Name: SPaper24; Width: 1772; Height: 2520),   // psB9
      (Name: SPaper25; Width: 6417; Height: 9016),   // psC5E
      (Name: SPaper26; Width: 4125; Height: 9500),   // psComm10E
      (Name: SPaper27; Width: 4331; Height: 8661),   // psDLE
      (Name: SPaper28; Width: 8250; Height: 13000),  // psFolio
      (Name: SPaper29; Width: 17000; Height: 11000), // psLedger
      (Name: SPaper30; Width: 11000; Height: 17000)  // psTabloid
    );


{ TfrPrinter }

constructor TfrPrinter.Create;
begin
  inherited Create;
  FPaperNames := TStringList.Create;
  FPrinters := TStringList.Create;
  PaperSize := 0;
  Localize;
end;

destructor TfrPrinter.Destroy;
begin
  FPaperNames.Free;
  FPrinters.Free;
  inherited Destroy;
end;

procedure TfrPrinter.Localize;
begin
  if FPrinters.Count > 0 then
    FPrinters[FPrinters.Count - 1] := SDefaultPrinter;
end;

procedure TfrPrinter.GetSettings;
var
  i: Integer;
begin
  PaperSize := Integer(FPrinter.PrintAdapter.PageSize);
  PaperWidth := Round(PaperInfo[PaperSize].Width / 3.937);
  PaperHeight := Round(PaperInfo[PaperSize].Height / 3.937);

  PaperSizesNum := PAPERCOUNT;

  FPaperNames.Clear;
  for i := 0 to PaperSizesNum - 1 do
  begin
    FPaperNames.Add(PaperInfo[i].Name);
    PaperSizes[i] := i;
  end;

  Orientation := FPrinter.Orientation;
end;

procedure TfrPrinter.SetSettings;
var
  i, n: Integer;
begin
  if FPrinterIndex = FDefaultPrinter then
  begin
    FPaperNames.Clear;
    for i := 0 to PAPERCOUNT - 1 do
    begin
      FPaperNames.Add(PaperInfo[i].Name);
      PaperSizes[i] := i;
      if (PaperSize <> $100) and (PaperSize = i) then
      begin
        PaperWidth := Round(PaperInfo[i].Width / 3.937);
        PaperHeight := Round(PaperInfo[i].Height / 3.937);
        if Orientation = poLandscape then
        begin
          n := PaperWidth; PaperWidth := PaperHeight; PaperHeight := n;
        end;
      end;
    end;
    PaperSizesNum := PAPERCOUNT;
    Exit;
  end;

  FPrinter.PrintAdapter.PageSize := TPageSize(PaperSize);
  FPrinter.Orientation := Orientation;
  GetSettings;
end;

procedure TfrPrinter.FillPrnInfo(var p: TfrPrnInfo);
var
  kx, ky: Double;
begin
  kx := 93 / 1.015;
  ky := 93 / 1.015;
  if FPrinterIndex = FDefaultPrinter then
    with p do
    begin
      Pgw := Round(PaperWidth * kx / 254);
      Pgh := Round(PaperHeight * ky / 254);
      Ofx := Round(50 * kx / 254);
      Ofy := Round(50 * ky / 254);
      Pw := Pgw - Ofx * 2;
      Ph := Pgh - Ofy * 2;
    end
  else
    with p, FPrinter do
    begin
      kx := kx / XDPI;
      ky := ky / YDPI;
      PPgw := PageWidth; Pgw := Round(PPgw * kx);
      PPgh := PageHeight; Pgh := Round(PPgh * ky);
      POfx := Margins.cx; Ofx := Round(POfx * kx);
      POfy := Margins.cy; Ofy := Round(POfy * ky);
      PPw := PPgw - POfx * 2; Pw := Round(PPw * kx);
      PPh := PPgh - POfy * 2; Ph := Round(PPh * ky);
    end;
end;

function TfrPrinter.IsEqual(pgSize, pgWidth, pgHeight: Integer;
  pgOr: TPrinterOrientation): Boolean;
begin
  if (PaperSize = pgSize) and (pgSize = $100) then
  begin
    Result := False;
    if (PaperSize = pgSize) then
      if abs(PaperWidth - pgWidth) <= 1 then
        if abs(PaperHeight - pgHeight) <= 1 then
          if (Orientation = pgOr) then
            Result := True;
  end
  else
    Result := (PaperSize = pgSize) and (Orientation = pgOr);
end;

procedure TfrPrinter.SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer;
  pgOr: TPrinterOrientation; SetImmediately: Boolean);
begin
  if FPrinter.Printing then Exit;
  if not SetImmediately then
    if IsEqual(pgSize, pgWidth, pgHeight, pgOr) then Exit;
  PaperSize := pgSize;
  PaperWidth := pgWidth;
  PaperHeight := pgHeight;
  Orientation := pgOr;
  SetSettings;
end;

procedure TfrPrinter.PropertiesDlg;
begin
  FPrinter.ExecuteSetup;
end;

function TfrPrinter.GetSizeIndex(pgSize: Integer): Integer;
var
  i: Integer;
begin
  Result := PaperSizesNum - 1;
  for i := 0 to PaperSizesNum - 1 do
    if PaperSizes[i] = pgSize then
    begin
      Result := i;
      break;
    end;
end;

procedure TfrPrinter.SetPrinterIndex(Value: Integer);
begin
  FPrinterIndex := Value;
  if Value = FDefaultPrinter then
    SetSettings
  else if FPrinter.Printers.Count > 0 then
  begin
//    FPrinter.PrinterIndex := Value;
    FPrinter.SetPrinter(FPrinter.Printers[Value]);
    GetSettings;
  end;
end;

procedure TfrPrinter.SetPrinter(Value: TPrinter);
begin
  FPrinters.Clear;
  FPrinterIndex := 0;
  FPrinter := Value;
  if FPrinter.Printers.Count > 0 then
  begin
    FPrinters.Assign(FPrinter.Printers);
//    FPrinterIndex := FPrinter.PrinterIndex;
  end;
  FPrinters.Add(SDefaultPrinter);
  FDefaultPrinter := FPrinters.Count - 1;

  if FPrinter.Printers.Count > 0 then
    GetSettings else
    SetSettings;
end;

procedure TfrPrinter.Update;
begin
  GetSettings;
end;


initialization
  Prn := TfrPrinter.Create;
  try
    Prn.Printer := Printer;
    frDefaultPaper := Prn.PaperSize;
  except;
  end;
  frThreadDone := True;

finalization
  Prn.Free;

end.