⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 acesetup.pas

📁 suite component ace report
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit AceSetup;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}

uses AceTypes, classes, AcePSet
  {$ifdef WIN32} , winspool, windows
  {$else} ,WinProcs, WinTypes, Print
  {$endif};

const
  ACEPAPER_USECURRENT  = 9999;

type

{ TAcePrinterSetup }
  TAcePrinterSetup = class(TObject)
  private
    FOrientation: Integer;
    FPaperSize: Integer;
    FLength: Double;
    FWidth: Double;
    FScale: Integer;
    FCopies: Integer;
    FSource: Integer;
    FPrintQuality: Integer;
    FColor: Integer;
    FDuplex: Integer;
    FYResolution: Integer;
    FTTOption: Integer;
    FCollatedCopies: Boolean;
    FFormName: String;

    FLeftPrintArea, FRightPrintArea: Double;
    FTopPrintArea, FBottomPrintArea: Double;
    FPrinterSettings: TAcePrinterSettings;

    FPrintSet: array[0..13] of Boolean;
  protected
    function GetPrinterCount: Integer;
    function GetXPixels: Integer;
    function GetYPixels: Integer;

    procedure SetOrientation(Value: Integer);
    procedure SetPaperSize(Value: Integer);
    procedure SetLength(Value: Double);
    procedure SetWidth(Value: Double);
    procedure SetScale(Value: Integer);
    procedure SetCopies(Value: Integer);
    procedure SetSource(Value: Integer);
    procedure SetPrintQuality(Value: Integer);
    procedure SetColor(Value: Integer);
    procedure SetDuplex(Value: Integer);
    procedure SetYResolution(Value: Integer);
    procedure SetTTOption(Value: Integer);
    procedure SetCollatedCopies(Value: Boolean);

    procedure SetFormName(Value: String);

  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Assign( Source: TObject); virtual;
    procedure CopyToPrinterSettings;
    procedure CopyFromPrinterSettings;

    procedure ClearSettings;

    procedure SetPrintInfo( pinfo: TAceFilePrinterInfo );
    procedure GetPrintInfo( var pinfo: TAceFilePrinterInfo );

    function ReadFromAceFile(af: TObject): Boolean;
    function ReadFromStream(Stream: TStream): Boolean;
    procedure WriteToAceFile(af: TObject);
    procedure WriteToStream(Stream: TStream);

    procedure SetData;
    procedure GetData;

    property PrinterCount: Integer read GetPrinterCount;
    property PixelsPerInchX: Integer read GetXPixels;
    property PixelsPerInchY: Integer read GetYPixels;

    property LeftPrintArea: Double read FLeftPrintArea;
    property TopPrintArea: Double read FTopPrintArea;
    property RightPrintArea: Double read FRightPrintArea;
    property BottomPrintArea: Double read FBottomPrintArea;

    property Orientation: Integer read FOrientation write SetOrientation;
    property PaperSize: Integer read FPaperSize write SetPaperSize;
    property Length: Double read FLength write SetLength;
    property Width: Double read FWidth write SetWidth;
    property Scale: Integer read FScale write SetScale;
    property Copies: Integer read FCopies write SetCopies;
    property Source: Integer read FSource write SetSource;
    property PrintQuality: Integer read FPrintQuality write SetPrintQuality;
    property Color: Integer read FColor write SetColor;
    property Duplex: Integer read FDuplex write SetDuplex;
    property YResolution: Integer read FYResolution write SetYResolution;
    property TTOption: Integer read FTTOption write SetTTOption;
    property CollatedCopies: Boolean read FCollatedCopies write SetCollatedCopies;
    property FormName: String read FFormName write SetFormName;

    function IsEqual(ps: TAcePrinterSetup): Boolean;
    function IsRunningEqual(ps: TAcePrinterSetup): Boolean;
  end;


implementation

uses printers, aceutil, sysutils, acefile;

constructor TAcePrinterSetup.Create;
var
  Spot: Integer;
begin
  inherited Create;
  FOrientation := DMORIENT_PORTRAIT;
  FPaperSize := DMPAPER_LETTER;
  FLength := 11;
  FWidth := 8.5;
  FScale := 100;
  FCopies := 1;
  FSource := DMBIN_UPPER;
  FPrintQuality := Integer(DMRES_HIGH);
  FColor := DMCOLOR_COLOR;
  FDuplex := DMDUP_SIMPLEX;
  FYResolution := 0;
  FTTOption := DMTT_DOWNLOAD;
  FCollatedCopies := True;
  FPrinterSettings := TAcePrinterSettings.Create;
  FFormName := '';

  for Spot := 0 to 13 do FPrintSet[Spot] := False;

end;

destructor TAcePrinterSetup.destroy;
begin
  if FPrinterSettings <> nil then FPrinterSettings.Free;
  inherited destroy;
end;

procedure TAcePrinterSetup.Assign( Source: TObject );
var
  ps: TAcePrinterSetup;
  Spot: Integer;
begin
  if Source is TAcePrinterSetup then
  begin
    ps := TAcePrinterSetup( Source );
    FOrientation := ps.FOrientation;
    FPaperSize := ps.FPaperSize;
    FLength := ps.FLength;
    FWidth := ps.FWidth;
    FScale := ps.FScale;
    FCopies := ps.FCopies;
    FSource := ps.FSource;
    FPrintQuality := ps.FPrintQuality;
    FColor := ps.FColor;
    FDuplex := ps.FDuplex;
    FYResolution := ps.FYResolution;
    FTTOption := ps.FTTOption;
    FCollatedCopies := ps.FCollatedCopies;
    FFormName := ps.FFormName;
    for Spot := 0 to 13 do FPrintSet[Spot] := ps.FPrintSet[Spot];
    FPrinterSettings.Assign(ps.FPrinterSettings);
  end;
end;

procedure TAcePrinterSetup.SetPrintInfo( pinfo: TAceFilePrinterInfo );
var
  Spot: Integer;
begin
  FOrientation := pinfo.Orientation;
  FPaperSize := pinfo.PaperSize;
  FLength := pinfo.Length;
  FWidth := pinfo.Width;
  FScale := pinfo.Scale;
  FCopies := pinfo.Copies;
  FSource := pinfo.Source;
  FPrintQuality := pinfo.PrintQuality;
  FColor := pinfo.Color;
  FDuplex := pinfo.Duplex;
  FYResolution := pinfo.YResolution;
  FTTOption := pinfo.TTOption;
  FCollatedCopies := pinfo.CollatedCopies;

  for Spot := 0 to 13 do FPrintSet[Spot] := True;
end;

procedure TAcePrinterSetup.ClearSettings;
var
  Spot: Integer;
begin
  for Spot := 0 to 13 do FPrintSet[Spot] := False;
end;

procedure TAcePrinterSetup.GetPrintInfo( var pinfo: TAceFilePrinterInfo );
begin
  with pinfo do
  begin
    Orientation := FOrientation;
    PaperSize := FPaperSize;
    Length := FLength;
    Width := FWidth;
    Scale := FScale;
    Copies := FCopies;
    Source := FSource;
    PrintQuality := FPrintQuality;
    Color := FColor;
    Duplex := FDuplex;
    YResolution := FYResolution;
    TTOption := FTTOption;
    CollatedCopies := FCollatedCopies;
  end;
end;
function TAcePrinterSetup.IsEqual(ps: TAcePrinterSetup): Boolean;
begin
  Result := True;
  if FOrientation <> ps.Orientation then Result := False;
  if FPaperSize <> ps.PaperSize then Result := False;
  if FLength <> ps.Length then Result := False;
  if FWidth <> ps.Width then Result := False;
  if FScale <> ps.Scale then Result := False;
  if FCopies <> ps.Copies then Result := False;
  if FSource <> ps.Source then Result := False;
  if FPrintQuality <> ps.PrintQuality then Result := False;
  if FColor <> ps.Color then Result := False;
  if FDuplex <> ps.Duplex then Result := False;
  if FYResolution <> ps.YResolution then Result := False;
  if FTTOption <> ps.TTOption then Result := False;
  if FCollatedCopies <> ps.CollatedCopies then Result := False;
  if FFormName <> ps.FormName then Result := False;
end;

function TAcePrinterSetup.IsRunningEqual(ps: TAcePrinterSetup): Boolean;
begin
  Result := True;
  if FOrientation <> ps.Orientation then Result := False;
  if FPaperSize <> ps.PaperSize then Result := False;
  if FLength <> ps.Length then Result := False;
  if FWidth <> ps.Width then Result := False;
  if FCopies <> ps.Copies then Result := False;
  if FSource <> ps.Source then Result := False;
  if FDuplex <> ps.Duplex then Result := False;
  if FCollatedCopies <> ps.CollatedCopies then Result := False;
  if FFormName <> ps.FormName then Result := False;
end;



function TAcePrinterSetup.GetPrinterCount: Integer;
var
  DefaultPrinter: array[0..79] of Char;
begin
  result := Printers.Printer.Printers.Count;
  { under win95 there was some unknown printer always coming
    up when there really was none.  I made the asumption that
    if there isn't a default printer then there are no printers
    defined.  This wasn't tested under NT or win3.1 so I don't
    know if it was needed under that. }
  GetProfileString('windows', 'device', '', DefaultPrinter,
    SizeOf(DefaultPrinter) - 1);
  if DefaultPrinter[0] = #0 then result := 0;
end;

function TAcePrinterSetup.GetXPixels: Integer;
begin
  result := GetDeviceCaps(Printers.Printer.handle, LOGPIXELSX);
end;

function TAcePrinterSetup.GetYPixels: Integer;
begin
  result := GetDeviceCaps(Printers.Printer.handle, LOGPIXELSY);
end;

procedure TAcePrinterSetup.CopyFromPrinterSettings;
begin
  FOrientation  := FPrinterSettings.Orientation;
  FPaperSize    := FPrinterSettings.PaperSize;
  FLength       := FPrinterSettings.PaperLength / 254;
  FWidth        := FPrinterSettings.PaperWidth / 254;
  if (FLength <= 0) or (FWidth <= 0) then
  begin
    FLength := 11;
    FWidth := 8.5;
  end;
  FScale        := FPrinterSettings.Scale;
  FCopies       := FPrinterSettings.Copies;
  FSource       := FPrinterSettings.DefaultSource;
  FPrintQuality := FPrinterSettings.PrintQuality;
  FColor        := FPrinterSettings.Color;
  FDuplex       := FPrinterSettings.Duplex;
  FYResolution  := FPrinterSettings.YResolution;
  FTTOption     := FPrinterSettings.TTOption;
{    FCollatedCopies := FPrinterSettings.FCollatedCopies;}
  FFormName := FPrinterSettings.FormName;
end;

procedure TAcePrinterSetup.CopyToPrinterSettings;
begin
  if FPrintSet[0] then FPrinterSettings.Orientation    := FOrientation;
  if FPrintSet[1] then FPrinterSettings.PaperSize      := FPaperSize;
  if FPrintSet[2] then FPrinterSettings.PaperLength    := Round(FLength * 254);
  if FPrintSet[3] then FPrinterSettings.PaperWidth     := Round(FWidth * 254);
  if FPrintSet[4] then FPrinterSettings.Scale          := FScale;
  if FPrintSet[5] then FPrinterSettings.Copies         := FCopies;
  if FPrintSet[6] then FPrinterSettings.DefaultSource  := FSource;
  if FPrintSet[7] then FPrinterSettings.PrintQuality   := FPrintQuality;
  if FPrintSet[8] then FPrinterSettings.Color          := FColor;
  if FPrintSet[9] then FPrinterSettings.Duplex         := FDuplex;
  if FPrintSet[10] then FPrinterSettings.YResolution   := FYResolution;
  if FPrintSet[11] then FPrinterSettings.TTOption      := FTTOption;
{    FCollatedCopies := FPrinterSettings.FCollatedCopies;}
  if FPrintSet[13] then FPrinterSettings.FormName      := FFormName;
end;

procedure TAcePrinterSetup.SetData;
begin
  CopyToPrinterSettings;
  if AceGetPrinterCount > 0 Then
  begin
    FPrinterSettings.SetValues;
  end;
  GetData;
end;

procedure TAcePrinterSetup.GetData;
var
{  POffset: TPoint;
  hres, vres: Integer;
  W,L: Double;}
  PRect: TRect;
  Size, Res: TPoint;
begin
  if AceGetPrinterCount > 0 Then
  begin
{$ifdef commentout}
    FPrinterSettings.GetValues;
    CopyFromPrinterSettings;

    Escape(Printers.Printer.handle, GETPRINTINGOFFSET, 0, nil, @POffset);
    hres := GetDeviceCaps(Printers.Printer.handle, HorzRes);
    vres := GetDeviceCaps(Printers.Printer.handle, VertRes);

{$ifndef WIN32}
    L := round(GetDeviceCaps(Printers.Printer.handle, VERTSIZE) / 25.4);
    W := round(GetDeviceCaps(Printers.Printer.handle, HORZSIZE) / 25.4);
{$else}

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -