📄 acesetup.pas
字号:
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 + -