frxprinter.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Printer }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}

unit frxPrinter;

interface

{$I frx.inc}

uses
  Windows, SysUtils, Classes, Graphics, Forms, Printers
{$IFDEF Delphi6}
, Variants
{$ENDIF};

type
  TfrxPrinterCanvas = class;

  TfrxCustomPrinter = class(TObject)
  private
    FBin:Integer;
    FBins:TStrings;
    FCanvas:TfrxPrinterCanvas;
    FDefOrientation:TPrinterOrientation;
    FDefPaper:Integer;
    FDefPaperHeight:Extended;
    FDefPaperWidth:Extended;
    FDPI:TPoint;
    FFileName:String;
    FInitialized:Boolean;
    FName:String;
    FPaper:Integer;
    FPapers:TStrings;
    FPaperHeight:Extended;
    FPaperWidth:Extended;
    FLeftMargin:Extended;
    FTopMargin:Extended;
    FRightMargin:Extended;
    FBottomMargin:Extended;
    FOrientation:TPrinterOrientation;
    FPort:String;
    FPrinting:Boolean;
    FTitle:String;
  public
    constructor Create(const AName, APort:String); virtual;
    destructor Destroy; override;
    procedure Init; virtual; abstract;
    procedure Abort; virtual; abstract;
    procedure BeginDoc; virtual; abstract;
    procedure BeginPage; virtual; abstract;
    procedure BeginRAWDoc; virtual; abstract;
    procedure EndDoc; virtual; abstract;
    procedure EndPage; virtual; abstract;
    procedure EndRAWDoc; virtual; abstract;
    procedure WriteRAWDoc(const buf:String); virtual; abstract;

    function BinIndex(ABin:Integer):Integer;
    function PaperIndex(APaper:Integer):Integer;
    function BinNameToNumber(const ABin:String):Integer;
    function PaperNameToNumber(const APaper:String):Integer;
    procedure SetViewParams(APaperSize:Integer;
      APaperWidth, APaperHeight:Extended;
      AOrientation:TPrinterOrientation); virtual; abstract;
    procedure SetPrintParams(APaperSize:Integer;
      APaperWidth, APaperHeight:Extended; AOrientation:TPrinterOrientation;
      ABin, ACopies, ADuplex:Integer); virtual; abstract;
    procedure PropertiesDlg; virtual; abstract;

    property Bin:Integer read FBin;
    property Bins:TStrings read FBins;
    property Canvas:TfrxPrinterCanvas read FCanvas;
    property DefOrientation:TPrinterOrientation read FDefOrientation;
    property DefPaper:Integer read FDefPaper;
    property DefPaperHeight:Extended read FDefPaperHeight;
    property DefPaperWidth:Extended read FDefPaperWidth;
    property DPI:TPoint read FDPI;
    property FileName:String read FFileName write FFileName;
    property Name:String read FName;
    property Paper:Integer read FPaper;
    property Papers:TStrings read FPapers;
    property PaperHeight:Extended read FPaperHeight;
    property PaperWidth:Extended read FPaperWidth;
    property LeftMargin:Extended read FLeftMargin;
    property TopMargin:Extended read FTopMargin;
    property RightMargin:Extended read FRightMargin;
    property BottomMargin:Extended read FBottomMargin;
    property Orientation:TPrinterOrientation read FOrientation;
    property Port:String read FPort;
    property Title:String read FTitle write FTitle;
  end;

  TfrxVirtualPrinter = class(TfrxCustomPrinter)
  public
    procedure Init; override;
    procedure Abort; override;
    procedure BeginDoc; override;
    procedure BeginPage; override;
    procedure BeginRAWDoc; override;
    procedure EndDoc; override;
    procedure EndPage; override;
    procedure EndRAWDoc; override;
    procedure WriteRAWDoc(const buf:String); override;
    procedure SetViewParams(APaperSize:Integer;
      APaperWidth, APaperHeight:Extended;
      AOrientation:TPrinterOrientation); override;
    procedure SetPrintParams(APaperSize:Integer;
      APaperWidth, APaperHeight:Extended; AOrientation:TPrinterOrientation;
      ABin, ACopies, ADuplex:Integer); override;
    procedure PropertiesDlg; override;
  end;

  TfrxPrinter = class(TfrxCustomPrinter)
  private
    FDeviceMode:THandle;
    FDC:HDC;
    FDriver:String;
    FHandle:THandle;
    FMode:PDeviceMode;
    procedure CreateDevMode;
    procedure FreeDevMode;
    procedure GetDC;
    procedure RecreateDC;
    procedure UpdateDeviceCaps;
  public
    destructor Destroy; override;
    procedure Init; override;
    procedure Abort; override;
    procedure BeginDoc; override;
    procedure BeginPage; override;
    procedure BeginRAWDoc; override;
    procedure EndDoc; override;
    procedure EndPage; override;
    procedure EndRAWDoc; override;
    procedure WriteRAWDoc(const buf:String); override;
    procedure SetViewParams(APaperSize:Integer;
      APaperWidth, APaperHeight:Extended;
      AOrientation:TPrinterOrientation); override;
    procedure SetPrintParams(APaperSize:Integer;
      APaperWidth, APaperHeight:Extended; AOrientation:TPrinterOrientation;
      ABin, ACopies, ADuplex:Integer); override;
    procedure PropertiesDlg; override;
    property Handle:THandle read FHandle;
  end;

  TfrxPrinters = class(TObject)
  private
    FHasPhysicalPrinters:Boolean;
    FPrinters:TStrings;
    FPrinterIndex:Integer;
    FPrinterList:TList;
    function GetDefaultPrinter:String;
    function GetItem(Index:Integer):TfrxCustomPrinter;
    function GetCurrentPrinter:TfrxCustomPrinter;
    procedure SetPrinterIndex(Value:Integer);
  public
    constructor Create;
    destructor Destroy; override;
    function IndexOf(AName:String):Integer;
    procedure Clear;
    procedure FillPrinters;
    property Items[Index:Integer]:TfrxCustomPrinter read GetItem; default;
    property HasPhysicalPrinters:Boolean read FHasPhysicalPrinters;
    property Printer:TfrxCustomPrinter read GetCurrentPrinter;
    property PrinterIndex:Integer read FPrinterIndex write SetPrinterIndex;
    property Printers:TStrings read FPrinters;
  end;

  TfrxPrinterCanvas = class(TCanvas)
  private
    FPrinter:TfrxCustomPrinter;
    procedure UpdateFont;
  public
    procedure Changing; override;
  end;

function frxPrinters:TfrxPrinters;
procedure frxGetPaperDimensions(PaperSize:Integer; var Width, Height:Extended);

implementation

uses frxUtils, WinSpool, Dialogs, frxRes;

type
  TPaperInfo = packed record
    Typ:Integer;
    Name:String;
    X, Y:Integer;
  end;

const
  PAPERCOUNT = 66;
  PaperInfo:array[0..PAPERCOUNT-1] of TPaperInfo = (
    (Typ:1; Name:''; X:2159; Y:2794),
    (Typ:2; Name:''; X:2159; Y:2794),
    (Typ:3; Name:''; X:2794; Y:4318),
    (Typ:4; Name:''; X:4318; Y:2794),
    (Typ:5; Name:''; X:2159; Y:3556),
    (Typ:6; Name:''; X:1397; Y:2159),
    (Typ:7; Name:''; X:1842; Y:2667),
    (Typ:8; Name:''; X:2970; Y:4200),
    (Typ:9; Name:''; X:2100; Y:2970),
    (Typ:10; Name:''; X:2100; Y:2970),
    (Typ:11; Name:''; X:1480; Y:2100),
    (Typ:12; Name:''; X:2500; Y:3540),
    (Typ:13; Name:''; X:1820; Y:2570),
    (Typ:14; Name:''; X:2159; Y:3302),
    (Typ:15; Name:''; X:2150; Y:2750),
    (Typ:16; Name:''; X:2540; Y:3556),
    (Typ:17; Name:''; X:2794; Y:4318),
    (Typ:18; Name:''; X:2159; Y:2794),
    (Typ:19; Name:''; X:984; Y:2254),
    (Typ:20; Name:''; X:1048; Y:2413),
    (Typ:21; Name:''; X:1143; Y:2635),
    (Typ:22; Name:''; X:1207; Y:2794),
    (Typ:23; Name:''; X:1270; Y:2921),
    (Typ:24; Name:''; X:4318; Y:5588),
    (Typ:25; Name:''; X:5588; Y:8636),
    (Typ:26; Name:''; X:8636; Y:11176),
    (Typ:27; Name:''; X:1100; Y:2200),
    (Typ:28; Name:''; X:1620; Y:2290),
    (Typ:29; Name:''; X:3240; Y:4580),
    (Typ:30; Name:''; X:2290; Y:3240),
    (Typ:31; Name:''; X:1140; Y:1620),
    (Typ:32; Name:''; X:1140; Y:2290),
    (Typ:33; Name:''; X:2500; Y:3530),
    (Typ:34; Name:''; X:1760; Y:2500),
    (Typ:35; Name:''; X:1760; Y:1250),
    (Typ:36; Name:''; X:1100; Y:2300),
    (Typ:37; Name:''; X:984; Y:1905),
    (Typ:38; Name:''; X:920; Y:1651),
    (Typ:39; Name:''; X:3778; Y:2794),
    (Typ:40; Name:''; X:2159; Y:3048),
    (Typ:41; Name:''; X:2159; Y:3302),
    (Typ:42; Name:''; X:2500; Y:3530),
    (Typ:43; Name:''; X:1000; Y:1480),
    (Typ:44; Name:''; X:2286; Y:2794),
    (Typ:45; Name:''; X:2540; Y:2794),
    (Typ:46; Name:''; X:3810; Y:2794),
    (Typ:47; Name:''; X:2200; Y:2200),
    (Typ:50; Name:''; X:2355; Y:3048),
    (Typ:51; Name:''; X:2355; Y:3810),
    (Typ:52; Name:''; X:2969; Y:4572),
    (Typ:53; Name:''; X:2354; Y:3223),
    (Typ:54; Name:''; X:2101; Y:2794),
    (Typ:55; Name:''; X:2100; Y:2970),
    (Typ:56; Name:''; X:2355; Y:3048),
    (Typ:57; Name:''; X:2270; Y:3560),
    (Typ:58; Name:''; X:3050; Y:4870),
    (Typ:59; Name:''; X:2159; Y:3223),
    (Typ:60; Name:''; X:2100; Y:3300),
    (Typ:61; Name:''; X:1480; Y:2100),
    (Typ:62; Name:''; X:1820; Y:2570),
    (Typ:63; Name:''; X:3220; Y:4450),
    (Typ:64; Name:''; X:1740; Y:2350),
    (Typ:65; Name:''; X:2010; Y:2760),
    (Typ:66; Name:''; X:4200; Y:5940),
    (Typ:67; Name:''; X:2970; Y:4200),
    (Typ:68; Name:''; X:3220; Y:4450));

var
  FPrinters:TfrxPrinters = nil;

procedure frxGetPaperDimensions(PaperSize:Integer; var Width, Height:Extended);
var
  i:Integer;
begin
  for i:= 0 to PAPERCOUNT-1 do
    if PaperInfo[i].Typ = PaperSize then
    begin
      Width:= PaperInfo[i].X / 10;
      Height:= PaperInfo[i].Y / 10;
      break;
    end;
end;

{ TfrxPrinterCanvas }

procedure TfrxPrinterCanvas.Changing;
begin
  inherited;
  UpdateFont;
end;

procedure TfrxPrinterCanvas.UpdateFont;
var
  FontSize:Integer;
begin
  if FPrinter.DPI.Y<>Font.PixelsPerInch then
  begin
    FontSize:= Font.Size;
    Font.PixelsPerInch:= FPrinter.DPI.Y;
    Font.Size:= FontSize;
  end;
end;

{ TfrxCustomPrinter }

constructor TfrxCustomPrinter.Create(const AName, APort:String);
begin
  FName:= AName;
  FPort:= APort;

  FBins:= TStringList.Create;
  FBins.AddObject(frxResources.Get('prDefault'), Pointer(DMBIN_AUTO));

  FPapers:= TStringList.Create;
  FPapers.AddObject(frxResources.Get('prCustom'), Pointer(256));

  FCanvas:= TfrxPrinterCanvas.Create;
  FCanvas.FPrinter:= Self;
end;

destructor TfrxCustomPrinter.Destroy;
begin
  FBins.Free;
  FPapers.Free;
  FCanvas.Free;
  inherited;
end;

function TfrxCustomPrinter.BinIndex(ABin:Integer):Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:= 0 to FBins.Count-1 do
    if Integer(FBins.Objects[i]) = ABin then
    begin
      Result:= i;
      break;
    end;
end;

function TfrxCustomPrinter.PaperIndex(APaper:Integer):Integer;
var
  i:Integer;
begin
  Result:=-1;
  for i:= 0 to FPapers.Count-1 do
    if Integer(FPapers.Objects[i]) = APaper then
    begin
      Result:= i;
      break;
    end;
end;

function TfrxCustomPrinter.BinNameToNumber(const ABin:String):Integer;
var
  i:Integer;
begin
  i:= FBins.IndexOf(ABin);
  if i =-1 then
    i:= 0;
  Result:= Integer(FBins.Objects[i]);
end;

function TfrxCustomPrinter.PaperNameToNumber(const APaper:String):Integer;
var
  i:Integer;
begin
  i:= FPapers.IndexOf(APaper);
  if i =-1 then
    i:= 0;
  Result:= Integer(FPapers.Objects[i]);
end;

{ TfrxVirtualPrinter }

procedure TfrxVirtualPrinter.Init;
var
  i:Integer;
begin
  if FInitialized then Exit;

  FDPI:= Point(600, 600);
  FDefPaper:= DMPAPER_A4;
  FDefOrientation:= poPortrait;
  FDefPaperWidth:= 210;
  FDefPaperHeight:= 297;

  for i:= 0 to PAPERCOUNT-1 do
    FPapers.AddObject(PaperInfo[i].Name, Pointer(PaperInfo[i].Typ));

  FBin:=-1;
  FInitialized:= True;
end;

procedure TfrxVirtualPrinter.Abort;
begin
end;

procedure TfrxVirtualPrinter.BeginDoc;
begin
end;

procedure TfrxVirtualPrinter.BeginPage;
begin
end;

procedure TfrxVirtualPrinter.EndDoc;
begin
end;

procedure TfrxVirtualPrinter.EndPage;
begin
end;

procedure TfrxVirtualPrinter.BeginRAWDoc;
begin
end;

procedure TfrxVirtualPrinter.EndRAWDoc;
begin
end;

procedure TfrxVirtualPrinter.WriteRAWDoc(const buf:String);
begin
end;

procedure TfrxVirtualPrinter.SetViewParams(APaperSize:Integer;
  APaperWidth, APaperHeight:Extended; AOrientation:TPrinterOrientation);
var
  i:Integer;
  Found:Boolean;
begin
  Found:= False;
  if APaperSize<>256 then
    for i:= 0 to PAPERCOUNT-1 do
      if PaperInfo[i].Typ = APaperSize then
      begin
        if AOrientation = poPortrait then
        begin
          APaperWidth:= PaperInfo[i].X / 10;
          APaperHeight:= PaperInfo[i].Y / 10;
        end
        else
        begin
          APaperWidth:= PaperInfo[i].Y / 10;
          APaperHeight:= PaperInfo[i].X / 10;
        end;
        Found:= True;
        break;
      end;

  if not Found then
    APaperSize:= 256;

  FOrientation:= AOrientation;
  FPaper:= APaperSize;
  FPaperWidth:= APaperWidth;
  FPaperHeight:= APaperHeight;