原来用 QUICK REPORT 的时候也有这个问题 ，自己封装了一个单元，现在不用了，可以公开了。
unit ZM_print ;
interface
uses
Classes, Graphics, Printers, SysUtils, StdCtrls, IniFiles,
Windows, WinSpool,
WinProcs, WinTypes, Messages;
{see the WinTypes (Delphi 1.0) or Windows (Delphi 2.0) unit}
{for constant declarations such as}
{dmPaper_Letter, dmbin_Upper, etc}
const
CCHBinName = 24;
{Size of bin name (should have been in PRINT.PAS)}
CCHPaperName = 64;
{Size of paper name (should have been in WINDOWS.PAS)}
CBinMax = 256;
{Maximum number of bin sources}
CPaperNames = 256;
{Maximum number of paper sizes}
type
TWordArray = array[0..255] of Word;
PWordArray = ^TWordArray;
TPrintSet = class(TComponent)
Private
{ Private declarations }
FDevice: PChar;
FDriver: PChar;
FPort: PChar;
FHandle: THandle;
FDeviceMode: PDeviceModeA;
FPrinter: integer;
{same as Printer.PrinterIndex}
FBinArray: PWordArray;
{array of bin sources}
FNumBins: byte;
{number of bins}
FPaperArray: PWordArray;
{array of paper sizes}
FNumPapers: byte;
{number of paper sizes}
FdpiX: integer;
{dots per inch horizontally}
FdpiY: integer;
{dots per inch vertically}
FGetOrientation: integer;
FGetPaperSize: integer;
FGetPaperLength: integer;
FGetPaperWidth: integer;
FGetScale: integer;
FGetCopies: integer;
FGetBin: integer;
FGetPrintQuality: integer;
FGetColor: integer;
FGetDuplex: integer;
FGetYResolution: integer;
FGetTTOption: integer;
FGetPrinterName: string;
FGetPrinterPort: string;
FGetPrinterDriver: string;
FGetBinIndex: byte;
FGetPaperIndex: byte;
procedure CheckPrinter;
{-checks to see if the printer has changed and calls SetDeviceMode if it has}
procedure SetBinArray;
{-sets the bin array}
procedure SetPaperArray;
{-sets the paper array}
function DefaultPaperName (PaperID: word): String;
{-returns the default name for the specified paper}
// protected
{ Protected declarations }
procedure SetOrientation (Orientation: integer);
{-sets/gets the paper orientation}
procedure SetPaperSize (Size: integer);
{-sets/gets the paper size}
procedure SetPaperLength (Length: integer);
{-sets/gets the paper length}
procedure SetPaperWidth (Width: integer);
{-sets/gets the paper width}
procedure SetScale (Scale: integer);
{-sets/gets the printer scale (whatever that is)}
procedure SetCopies (Copies: integer);
{-sets/gets the number of copies}
procedure SetBin (Bin: integer);
{-sets/gets the paper bin}
procedure SetPrintQuality (Quality: integer);
{-sets/gets the print quality}
procedure SetColor (Color: integer);
{-sets/gets the color (monochrome or color)}
procedure SetDuplex (Duplex: integer);
{-sets/gets the duplex setting}
procedure SetYResolution (YRes: integer);
{-sets/gets the y-resolution of the printer}
procedure SetTTOption (Option: integer);
{-sets/gets the TrueType option}
{-returns the name of the current printer}
{-returns the port of the current printer}
{-returns the printer driver name of the current printer}
procedure SetBinFromList (BinNum: byte);
{-sets the bin for the current item from the bin source list}
{-returns the current bin from the bin list}
procedure SetPaperFromList (PaperNum: byte);
{-sets the paper for the current item from the paper list}
{-returns the current paper size from the paper list}
procedure SetPort (APort: String);
{-sets the printer port}
protected
public
{ Public declarations }
constructor Create (AOwner: TComponent);
override;
{-initializes object}
destructor Destroy;
override;
{-destroys class}
function GetBinSourceList: TStringList;
{-returns the current list of bins}
function GetPaperList: TStringList;
{-returns the current list of paper sizes}
procedure SetDeviceMode (Creating: Boolean);
{-sets the internal pointer to the printers TDevMode structure}
procedure UpdateDeviceMode;
{-updates the printers TDevMode structure}
procedure SaveToDefaults;
{-updates the default settings for the current printer}
procedure SavePrinterAsDefault;
{-saves the current printer as the Window's default}
procedure ResetPrinterDialogs;
{-resets the printer dialogs to insure they come up}
function InchesDown (Inches:do
uble): integer;
{-returns the number ofdo
ts to movedo
wn}
function InchesOver (Inches:do
uble): integer;
{-returns the number ofdo
ts to move left}
procedure TextOut (X, Y:do
uble;
St: String);
{-prints the specified string at the desired location (in inches)}
procedure CustomPageSetup (Width, Height:do
uble);
{-sets up a custom page}
procedure SaveToIniFile (IniFileName, Section: String);
{-saves the current printer info to the specified file name}
function ReadFromIniFile (IniFileName, Section: String): Boolean;
{-reads the current printer info from the specified file name}
{-returns TRUE if the printer in the INI file is still in the user's setup}
{ Property declarations }
published
property Orientation: integer read FGetOrientation
write SetOrientation;
property PaperSize: integer read FGetPaperSize
write SetPaperSize;
property PaperLength: integer read FGetPaperLength
write SetPaperLength;
property PaperWidth: integer read FGetPaperWidth
write SetPaperWidth;
property Scale: integer read FGetScale
write SetScale;
property Copies: integer read FGetCopies
write SetCopies;
property DefaultSource: integer read FGetBin
write SetBin;
property PrintQuality: integer read FGetPrintQuality
write SetPrintQuality;
property Color: integer read FGetColor
write SetColor;
property Duplex: integer read FGetDuplex
write SetDuplex;
property YResolution: integer read FGetYResolution
write SetYResolution;
property TTOption: integer read FGetTTOption
write SetTTOption;
property PrinterName: String read FGetPrinterName;
property PrinterPort: String read FGetPrinterPort
write SetPort;
property PrinterDriver: String read FGetPrinterDriver;
property BinIndex: byte read FGetBinIndex
write SetBinFromList;
property PaperIndex: byte read FGetPaperIndex
write SetPaperFromList;
property dpiX: integer read FDpiX
write FDpiX;
property dpiY: integer read FDpiY
write FDpiY;
end;
{ TPrintSet }
procedure CanvasTextOutAngle (OutputCanvas: TCanvas;
X,Y: integer;
Angle: Word;
St: string);
{-prints text at the desired angle}
{-current font must be TrueType!}
procedure SetPixelsPerInch;
{-insures that PixelsPerInch is set so that text print at the desired size}
function GetResolution: TPoint;
{-returns the resolution of the printer}
procedure PrintMemo (TheMemo: TMemo;
Rect: TRect);
{-prints the desired memo within the specified rectangle}
function DeviceCapabilitiesA(pDevice, pPort: PAnsiChar;
fwCapability: Word;
pOutput: PAnsiChar;
DevMode: PDeviceModeA): Integer;
stdcall;
function DeviceCapabilitiesW(pDevice, pPort: PWideChar;
fwCapability: Word;
pOutput: PWideChar;
DevMode: PDeviceModeW): Integer;
stdcall;
function DeviceCapabilities(pDevice, pPort: PChar;
fwCapability: Word;
pOutput: PChar;
DevMode: PDeviceMode): Integer;
stdcall;
procedure Register;
{-registers the printset component}
implementation
function DeviceCapabilitiesA;
external winspl name 'DeviceCapabilitiesA';
function DeviceCapabilitiesW;
external winspl name 'DeviceCapabilitiesW';
function DeviceCapabilities;
external winspl name 'DeviceCapabilitiesA';
constructor TPrintSet.Create (AOwner: TComponent);
{-initializes object}
var
PrintDevMode: PDeviceModeA;
i: byte;
begin
inherited Create (AOwner);
FBinArray := nil;
FPaperArray := nil;
FPrinter := -99;
if not (csDesigning in ComponentState) then
begin
GetMem (FDevice, 255);
GetMem (FDriver, 255);
GetMem (FPort, 255);
SetDeviceMode (TRUE);
end {:} else
begin
FDevice := nil;
FDriver := nil;
FPort := nil;
GetMem (FDevice, 255);
GetMem (FDriver, 255);
GetMem (FPort, 255);
SetDeviceMode (TRUE);
end;
{ if... }
CheckPrinter ;
FGetOrientation := FDeviceMode^.dmOrientation;
FGetPaperSize := FDeviceMode^.dmPaperSize;
FGetPaperLength := FDeviceMode^.dmPaperLength;
FGetPaperWidth := FDeviceMode^.dmPaperWidth;
FGetScale := FDeviceMode^.dmScale;
FGetCopies := FDeviceMode^.dmCopies;
FGetBin := FDeviceMode^.dmDefaultSource;
FGetPrintQuality := FDeviceMode^.dmPrintQuality;
FGetColor := FDeviceMode^.dmColor;
FGetDuplex := FDeviceMode^.dmDuplex;
PrintDevMode := @FDeviceMode^;
FGetYResolution := PrintDevMode^.dmYResolution;
FGetTTOption := PrintDevMode^.dmTTOption;
FGetPrinterName := StrPas (FDevice);
FGetPrinterPort := StrPas (FPort);
FGetPrinterDriver := StrPas (FDriver);
FGetBinIndex := 0;
for i := 0 to FNumBinsdo
if FBinArray^ = FDeviceMode^.dmDefaultSource then
begin
FGetBinIndex := i;
Break;
end;
FGetPaperIndex := 0;
for i := 0 to FNumPapersdo
if FPaperArray^ = FDeviceMode^.dmPaperSize then
begin
FGetPaperIndex := i;
Break;
end;
end;
{ TPrintSet.Create }
procedure TPrintSet.CheckPrinter;
{-checks to see if the printer has changed and calls SetDeviceMode if it has}
begin
if FPrinter <> Printer.PrinterIndex then
begin
Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
Printer.SetPrinter (FDevice, FDriver, FPort, FHandle);
SetDeviceMode (FALSE);
end;
{ if... }
end;
{ CheckPrinter }
procedure TPrintSet.SetBinArray;
{-sets the bin array}
var
NumBinsRec: Longint;
{number of bins received}
DevCaps: TFarProc;
DrvHandle: THandle;
DriverName: String;
procedure LoadBinArray;
begin
FNumBins := DeviceCapabilities (FDevice, FPort, DC_Bins,
nil, FDeviceMode);
if FNumBins > 0 then
begin
GetMem (FBinArray, FNumBins * SizeOf (Word));
NumBinsRec := DeviceCapabilities (FDevice, FPort, DC_Bins,
PChar (FBinArray), FDeviceMode);
if NumBinsRec <> FNumBins then
begin
{raise an exception}
Raise EPrinter.Create ('Error retrieving Bin Source Info');
end;
{ if... }
end {:} else
FBinArray := nil;
end;
{ LoadBinArray }
begin
if FBinArray <> nil then
FreeMem (FBinArray, FNumBins * SizeOf (Word));
LoadBinArray;
end;
{ TPrintSet.SetBinArray }
procedure TPrintSet.SetPaperArray;
{-sets the paper array}
var
NumPapersRec: Longint;
{number of papers received}
DevCaps: TFarProc;
DrvHandle: THandle;
DriverName: String;
procedure LoadPaperArray;
begin
FNumPapers:= DeviceCapabilities (FDevice, FPort, DC_Papers,
nil, FDeviceMode);
if FNumPapers > 0 then
begin
GetMem (FPaperArray, FNumPapers * SizeOf (Word));
NumPapersRec := DeviceCapabilities (FDevice, FPort, DC_Papers,
PChar (FPaperArray), FDeviceMode);
if NumPapersRec <> FNumPapers then
begin
{raise an exception}
Raise EPrinter.Create ('Error retrieving Paper Source Info');
end;
{ if... }
end {:} else
FPaperArray := nil;
end;
{ LoadPaperArray }
begin
if FPaperArray <> nil then
FreeMem (FPaperArray, FNumPapers * SizeOf (Word));
LoadPaperArray;
end;
{ TPrintSet.SetPaperArray }
function TPrintSet.DefaultPaperName (PaperID: word): String;
{-returns the default name for the specified paper}
begin
{these constants are taken straight from WinTypes.INT}
case PaperID of
dmpaper_Letter : Result := 'Letter 8 1/2 x 11 in';
dmpaper_LetterSmall : Result := 'Letter Small 8 1/2 x 11 in';
dmpaper_Tabloid : Result := 'Tabloid 11 x 17 in';
dmpaper_Ledger : Result := 'Ledger 17 x 11 in';
dmpaper_Legal : Result := 'Legal 8 1/2 x 14 in';
dmpaper_Statement : Result := 'Statement 5 1/2 x 8 1/2 in';
dmpaper_Executive : Result := 'Executive 7 1/2 x 10 in';
dmpaper_A3 : Result := 'A3 297 x 420 mm';
dmpaper_A4 : Result := 'A4 210 x 297 mm';
dmpaper_A4Small : Result := 'A4 Small 210 x 297 mm';
dmpaper_A5 : Result := 'A5 148 x 210 mm';
dmpaper_B4 : Result := 'B4 250 x 354';
dmpaper_B5 : Result := 'B5 182 x 257 mm';
dmpaper_Folio : Result := 'Folio 8 1/2 x 13 in';
dmpaper_Quarto : Result := 'Quarto 215 x 275 mm';
dmpaper_10X14 : Result := '10x14 in';
dmpaper_11X17 : Result := '11x17 in';
dmpaper_Note : Result := 'Note 8 1/2 x 11 in';
dmpaper_Env_9 : Result := 'Envelope #9 3 7/8 x 8 7/8 in';
dmpaper_Env_10 : Result := 'Envelope #10 4 1/8 x 9 1/2 in';
dmpaper_Env_11 : Result := 'Envelope #11 4 1/2 x 10 3/8 in';
dmpaper_Env_12 : Result := 'Envelope #12 4 /276 x 11 in';
dmpaper_Env_14 : Result := 'Envelope #14 5 x 11 1/2 in';
dmpaper_CSheet : Result := 'C size sheet';
dmpaper_DSheet : Result := 'D size sheet';
dmpaper_ESheet : Result := 'E size sheet';
dmpaper_User : Result := 'User Defined Size';
else
Result := 'Unknown Paper Size';
end;
{ case }
end;
{ TPrintSet.DefaultPaperName }
function TPrintSet.GetBinSourceList: TStringList;
{-returns the current list of bins (returns nil for none)}
type
TcchBinName = array[0..CCHBinName-1] of Char;
TBinArray = array[1..cBinMax] of TcchBinName;
PBinArray = ^TBinArray;
var
NumBinsRec: Longint;
{number of bins received}
BinArray: PBinArray;
BinList: TStringList;
BinStr: String;
DevCaps: TFarProc;
DrvHandle: THandle;
DriverName: String;
procedure LoadBinSourceList;
var
i: Longint;
begin
GetMem (BinArray, FNumBins * SizeOf (TcchBinName));
NumBinsRec := DeviceCapabilities (FDevice, FPort, DC_BinNames,
PChar (BinArray), FDeviceMode);
if NumBinsRec <> FNumBins then
begin
{raise an exception}
Raise EPrinter.Create ('Error retrieving Bin Source Info');
end;
{ if... }
{now convert to TStringList}
BinList := TStringList.Create;
for i := 1 to NumBinsRecdo
begin
BinStr := StrPas (BinArray^);
BinList.Add (BinStr);
end;
{ next i }
Result := BinList;
end;
{ LoadBinSourceList }
begin
CheckPrinter;
Result := nil;
BinArray := nil;
if FNumBins = 0 then
Exit;
try
LoadBinSourceList;
finally
if BinArray <> nil then
FreeMem (BinArray, FNumBins * SizeOf (TcchBinName));
end;
{ try }
end;
{ TPrintSet.GetBinSourceList }
function TPrintSet.GetPaperList: TStringList;
{-returns the current list of paper sizes (returns nil for none)}
type
TcchPaperName = array[0..CCHPaperName-1] of Char;
TPaperArray = array[1..cPaperNames] of TcchPaperName;
PPaperArray = ^TPaperArray;
var
NumPaperRec: Longint;
{number of paper types received}
PaperArray: PPaperArray;
PaperList: TStringList;
PaperStr: String;
DevCaps: TFarProc;
DrvHandle: THandle;
DriverName: String;
procedure LoadPaperList;
var
i: Longint;
begin
GetMem (PaperArray, FNumPapers * SizeOf (TcchPaperName));
NumPaperRec := DeviceCapabilities (FDevice, FPort, DC_PaperNames,
PChar (PaperArray), FDeviceMode);
if NumPaperRec <> FNumPapers then
begin
{construct the list as best we can}
PaperList := TStringList.Create;
for i := 1 to FNumPapersdo
begin
PaperStr := DefaultPaperName (FPaperArray^[i - 1]);
PaperList.Add (PaperStr);
end;
{ next i }
end {:} else
begin
{now convert to TStringList}
PaperList := TStringList.Create;
for i := 1 to NumPaperRecdo
begin
PaperStr := StrPas (PaperArray^);
PaperList.Add (PaperStr);
end;
{ next i }
end;
{ if... }
Result := PaperList;
end;
{ LoadPaperList }
begin
CheckPrinter;
Result := nil;
PaperArray := nil;
if FNumPapers = 0 then
Exit;
try
LoadPaperList;
finally
if PaperArray <> nil then
FreeMem (PaperArray, FNumPapers * SizeOf (TcchPaperName));
end;
{ try }
end;
{ TPrintSet.GetPaperList }
procedure TPrintSet.SetDeviceMode (Creating: Boolean);
var
Res: TPoint;
begin
Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
if FHandle = 0 then
begin
{driver not loaded}
Printer.PrinterIndex := Printer.PrinterIndex;
{-forces Printer object to load driver}
Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
end;
{ if... }
if FHandle<>0 then
begin
FDeviceMode := GlobalLock(FHandle);
{-PDeviceMode now points to Printer.DeviceMode}
FPrinter := Printer.PrinterIndex;
FDeviceMode^.dmFields := dm_Orientation or dm_PaperSize or
dm_PaperLength or dm_PaperWidth or
dm_Scale or dm_Copies or
dm_DefaultSource or dm_PrintQuality or
dm_Color or dm_Duplex or
dm_YResolution or dm_TTOption;
UpdateDeviceMode;
FDeviceMode^.dmFields := 0;
SetBinArray;
SetPaperArray;
end {:} else
begin
FDeviceMode := nil;
{the next line should've worked but didn't}
{if not (csCreating in ComponentState) then
}
if not Creating then
Raise EPrinter.Create ('Error retrieving DeviceMode');
FPrinter := -99;
end;
{ if... }
Res := GetResolution;
dpiX := Res.X;
dpiY := Res.Y;
if FHandle<>0 then
GlobalUnLock(FHandle);
end;
{ TPrintSet.SetDeviceMode }
procedure TPrintSet.UpdateDeviceMode;
{-updates the loaded TDevMode structure}
var
DrvHandle: THandle;
ExtDevCaps: TFarProc;
DriverName: String;
ExtDevCode: Integer;
procedure ModDevMode;
begin
FDeviceMode^.dmFields := dm_Orientation or dm_PaperSize or
dm_PaperLength or dm_PaperWidth or
dm_Scale or dm_Copies or
dm_DefaultSource or dm_PrintQuality or
dm_Color or dm_Duplex or
dm_YResolution or dm_TTOption;
ExtDevCode :=do
cumentProperties (0, DrvHandle, FDevice,
FDeviceMode^, FDeviceMode^,
DM_IN_BUFFER or DM_OUT_BUFFER);
if ExtDevCode <> IDOK then
begin
{raise an exception}
raise EPrinter.Create ('Error updating printer driver.');
end;
{ if... }
end;
{ ModDevMode }
begin
CheckPrinter;
OpenPrinter(FDevice, DrvHandle, nil);
ModDevMode;
ClosePrinter (DrvHandle);
end;
{ TPrintSet.UpdateDeviceMode }
procedure TPrintSet.SaveToDefaults;
{-updates the default settings for the current printer}
var
DrvHandle: THandle;
ExtDevCaps: TFarProc;
DriverName: String;
ExtDevCode: Integer;
procedure ModDefaults;
begin
ExtDevCode :=do
cumentProperties (0, DrvHandle, FDevice,
FDeviceMode^, FDeviceMode^,
DM_IN_BUFFER or DM_UPDATE);
if ExtDevCode <> IDOK then
begin
{raise an exception}
raise EPrinter.Create ('Error updating printer driver.');
end {:} else
SendMessage ($FFFF, WM_WININICHANGE, 0, 0);
end;
{ ModDefaults }
begin
CheckPrinter;
OpenPrinter(FDevice, DrvHandle, nil);
ModDefaults;
ClosePrinter (DrvHandle);
end;
{ TPrintSet.SaveToDefaults }
procedure TPrintSet.SavePrinterAsDefault;
{-saves the current printer as the Window's default}
var
DeviceStr: String;
begin
CheckPrinter;
{make sure new printer is loaded}
{set the new device setting in the WIN.INI file}
DeviceStr := StrPas (FDevice) + ',' + StrPas (FDriver) + ',' + StrPas (FPort) + #0;
WriteProfileString ('windows', 'device', @DeviceStr[1]);
{force write to WIN.INI}
WriteProfileString (nil, nil, nil);
{broadcast to everyone that WIN.INI changed}
SendMessage ($FFFF, WM_WININICHANGE, 0, 0);
end;
{ TPrintSet.SavePrinterAsDefault }
procedure TPrintSet.ResetPrinterDialogs;
{-resets the printer dialogs to insure they come up}
begin
Printer.GetPrinter (FDevice, FDriver, FPort, FHandle);
Printer.SetPrinter (FDevice, FDriver, FPort, FHandle);
SetDeviceMode (FALSE);
end;
{ TPrintSet.ResetPrinterDialogs }
function TPrintSet.InchesDown (Inches:do
uble): integer;
{-returns the number ofdo
ts to movedo
wn}
begin
Result := Trunc (dpiY * Inches);
end;
{ TPrintSet.InchesDown }
function TPrintSet.InchesOver (Inches:do
uble): integer;
{-returns the number ofdo
ts to move left}
begin
Result := Trunc (dpiX * Inches);
end;
{ TPrintSet.InchesOver }
procedure TPrintSet.TextOut (X, Y:do
uble;
St: String);
{-prints the specified string at the desired location (in inches)}
begin
Printer.Canvas.TextOut (InchesOver (X), InchesDown (Y), St);
end;
{ TPrintSet.TextOut }
procedure TPrintSet.CustomPageSetup (Width, Height:do
uble);
{-sets up a custom page}
begin
PaperSize := dmPaper_User;
PaperLength := Trunc (254 * Height);
YResolution := Trunc (dpiY * Height);
PaperWidth := Trunc (254 * Width);
end;
{ TPrintSet.CustomPageSetup }
procedure TPrintSet.SaveToIniFile (IniFileName, Section: String);
{-saves the current printer info to the specified file name}
var
PrIniFile: TIniFile;
CurrentName: String;
begin
PrIniFile := TIniFile.Create (IniFileName);
CurrentName := Printer.Printers [Printer.PrinterIndex];
PrIniFile.WriteString (Section, 'PrinterName', CurrentName);
PrIniFile.WriteString (Section, 'PrinterPort', PrinterPort);
PrIniFile.WriteInteger (Section, 'Orientation', Orientation);
PrIniFile.WriteInteger (Section, 'PaperSize', PaperSize);
PrIniFile.WriteInteger (Section, 'PaperLength', PaperLength);
PrIniFile.WriteInteger (Section, 'PaperWidth', PaperWidth);
PrIniFile.WriteInteger (Section, 'Scale', Scale);
PrIniFile.WriteInteger (Section, 'Copies', Copies);
PrIniFile.WriteInteger (Section, 'DefaultSource', DefaultSource);
PrIniFile.WriteInteger (Section, 'PrintQuality', PrintQuality);
PrIniFile.WriteInteger (Section, 'Color', Color);
PrIniFile.WriteInteger (Section, 'Duplex', Duplex);
PrIniFile.WriteInteger (Section, 'YResolution', YResolution);
PrIniFile.WriteInteger (Section, 'TTOption', TTOption);
PrIniFile.Free;
end;
{ TPrintSet.SaveToIniFile }
function TPrintSet.ReadFromIniFile (IniFileName, Section: String): Boolean;
{-reads the current printer info from the specified file name}
{-returns TRUE if the printer in the INI file is still in the user's setup}
var
PrIniFile: TIniFile;
SavedName: String;
NewIndex: integer;
begin
PrIniFile := TIniFile.Create (IniFileName);
SavedName := PrIniFile.ReadString (Section, 'PrinterName', PrinterName);
if PrinterName <> SavedName then
begin
{printer is different than current printer}
{set the current printer to the one specified in INI file}
NewIndex := Printer.Printers.IndexOf (SavedName);
if NewIndex <> -1 then
begin
Result := TRUE;
{printer was found in user's printer list}
Printer.PrinterIndex := NewIndex;
{now fill the TDevMode structure as it was filled before}
PrinterPort := PrIniFile.ReadString (Section, 'PrinterPort', PrinterPort);
Orientation := PrIniFile.ReadInteger (Section, 'Orientation', Orientation);
PaperSize := PrIniFile.ReadInteger (Section, 'PaperSize', PaperSize);
PaperLength := PrIniFile.ReadInteger (Section, 'PaperLength', PaperLength);
PaperWidth := PrIniFile.ReadInteger (Section, 'PaperWidth', PaperWidth);
Scale := PrIniFile.ReadInteger (Section, 'Scale', Scale);
Copies := PrIniFile.ReadInteger (Section, 'Copies', Copies);
DefaultSource := PrIniFile.ReadInteger (Section, 'DefaultSource', DefaultSource);
PrintQuality := PrIniFile.ReadInteger (Section, 'PrintQuality', PrintQuality);
Color := PrIniFile.ReadInteger (Section, 'Color', Color);
Duplex := PrIniFile.ReadInteger (Section, 'Duplex', Duplex);
YResolution := PrIniFile.ReadInteger (Section, 'YResolution', YResolution);
TTOption := PrIniFile.ReadInteger (Section, 'TTOption', TTOption);
end {:} else
Result := FALSE;
{printer was not found in user's current setup}
end;
{ if... }
PrIniFile.Free;
end;
{ TPrintSet.ReadFromIniFile }
procedure TPrintSet.SetOrientation (Orientation: integer);
{-sets the paper orientation}
begin
CheckPrinter;
FDeviceMode^.dmOrientation := Orientation;
Printer.Orientation := TPrinterOrientation (Orientation - 1);
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION;
if Orientation <> FGetOrientation then
begin
FGetOrientation := Orientation ;
end ;
end;
{ TPrintSet.SetOrientation }
procedure TPrintSet.SetPaperSize (Size: integer);
{-sets the paper size}
begin
CheckPrinter;
FDeviceMode^.dmPaperSize := Size;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERSIZE;
if Size <> FGetPaperSize then
begin
FGetPaperSize := size ;
end ;
end;
{ TPrintSet.SetPaperSize }
procedure TPrintSet.SetPaperLength (Length: integer);
{-sets the paper length}
begin
CheckPrinter;
FDeviceMode^.dmPaperLength := Length;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERLENGTH;
if Length <> FGetPaperLength then
begin
FGetPaperLength := Length ;
end ;
end;
{ TPrintSet.SetPaperLength }
procedure TPrintSet.SetPaperWidth (Width: integer);
{-sets the paper width}
begin
CheckPrinter;
FDeviceMode^.dmPaperWidth := Width;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PAPERWIDTH;
if Width <> FGetPaperWidth then
begin
FGetPaperWidth := Width ;
end ;
end;
{ TPrintSet.SetPaperWidth }
procedure TPrintSet.SetScale (Scale: integer);
{-sets the printer scale (whatever that is)}
begin
CheckPrinter;
FDeviceMode^.dmScale := Scale;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_SCALE;
if Scale <> FGetScale then
begin
FGetScale := Scale ;
end ;
end;
{ TPrintSet.SetScale }
procedure TPrintSet.SetCopies (Copies: integer);
{-sets the number of copies}
begin
CheckPrinter;
FDeviceMode^.dmCopies := Copies;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_COPIES;
if Copies <> FGetCopies then
begin
FGetCopies := Copies ;
end ;
end;
{ TPrintSet.SetCopies }
procedure TPrintSet.SetBin (Bin: integer);
{-sets the paper bin}
begin
CheckPrinter;
FDeviceMode^.dmDefaultSource := Bin;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_DEFAULTSOURCE;
if Bin <> FGetBin then
begin
FGetBin := Bin ;
end ;
end;
{ TPrintSet.SetBin }
procedure TPrintSet.SetPrintQuality (Quality: integer);
{-sets the print quality}
begin
CheckPrinter;
FDeviceMode^.dmPrintQuality := Quality;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_PRINTQUALITY;
if Quality <> FGetPrintQuality then
begin
FGetPrintQuality := Quality ;
end ;
end;
{ TPrintSet.SetPrintQuality }
procedure TPrintSet.SetColor (Color: integer);
{-sets the color (monochrome or color)}
begin
CheckPrinter;
FDeviceMode^.dmColor := Color;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_ORIENTATION;
if Color <> FGetColor then
begin
FGetColor := Color ;
end ;
end;
{ TPrintSet.SetColor }
procedure TPrintSet.SetDuplex (Duplex: integer);
{-sets the duplex setting}
begin
CheckPrinter;
FDeviceMode^.dmDuplex := Duplex;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_DUPLEX;
if Duplex <> FGetDuplex then
begin
FGetDuplex := Duplex ;
end ;
end;
{ TPrintSet.SetDuplex }
procedure TPrintSet.SetYResolution (YRes: integer);
{-sets the y-resolution of the printer}
var
PrintDevMode: PDeviceModeA;
begin
CheckPrinter;
PrintDevMode := @FDeviceMode^;
PrintDevMode^.dmYResolution := YRes;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_YRESOLUTION;
if YRes <> FGetYResolution then
begin
FGetYResolution := YRes ;
end ;
end;
{ TPrintSet.SetYResolution }
procedure TPrintSet.SetTTOption (Option: integer);
{-sets the TrueType option}
var
PrintDevMode: PDeviceModeA;
begin
CheckPrinter;
PrintDevMode := @FDeviceMode^;
PrintDevMode^.dmTTOption := Option;
FDeviceMode^.dmFields := FDeviceMode^.dmFields or DM_TTOPTION;
if Option <> FGetTTOption then
begin
FGetTTOption := Option ;
end ;
end;
{ TPrintSet.SetTTOption }
procedure TPrintSet.SetBinFromList (BinNum: byte);
{-sets the bin for the current item from the bin source list}
begin
CheckPrinter;
if FNumBins = 0 then
Exit;
if BinNum > FNumBins then
Raise EPrinter.Create ('Index out of range setting bin.')
else
DefaultSource := FBinArray^[BinNum];
if BinNum <> FGetBinIndex then
begin
FGetBinIndex := BinNum ;
end ;
end;
{ TPrintSet.SetBinFromList }
procedure TPrintSet.SetPaperFromList (PaperNum: byte);
{-sets the paper for the current item from the paper list}
begin
CheckPrinter;
if FNumPapers = 0 then
Exit;
if PaperNum > FNumPapers then
Raise EPrinter.Create ('Index out of range setting paper.')
else
PaperSize := FPaperArray^[PaperNum];
if PaperNum <> FGetPaperIndex then
begin
FGetPaperIndex := PaperNum ;
end ;
end;
{ TPrintSet.SetPaperFromList }
procedure TPrintSet.SetPort (APort: String);
{-sets the printer port}
begin
CheckPrinter;
APort := APort + #0;
Move (APort[1], FPort^, Length (APort));
Printer.SetPrinter (FDevice, FDriver, FPort, FHandle);
if APort <> FGetPrinterPort then
begin
FGetPrinterPort := APort ;
end ;
end;
{ TPrintSet.SetPort }
destructor TPrintSet.Destroy;
{-destroys class}
begin
if FBinArray <> nil then
FreeMem (FBinArray, FNumBins * SizeOf (Word));
if FPaperArray <> nil then
FreeMem (FPaperArray, FNumPapers * SizeOf (Word));
if FDevice <> nil then
FreeMem (FDevice, 255);
if FDriver <> nil then
FreeMem (FDriver, 255);
if FPort <> nil then
FreeMem (FPort, 255);
inherited Destroy;
end;
{ TPrintSet.Destroy }
procedure CanvasTextOutAngle (OutputCanvas: TCanvas;
X,Y: integer;
Angle: Word;
St: string);
{-prints text at the desired angle}
{-current font must be TrueType!}
var
LogRec: TLogFont;
NewFontHandle: HFont;
OldFontHandle: HFont;
begin
GetObject (OutputCanvas.Font.Handle, SizeOf (LogRec), Addr (LogRec));
LogRec.lfEscapement := Angle;
NewFontHandle := CreateFontIndirect (LogRec);
OldFontHandle := SelectObject (OutputCanvas.Handle, NewFontHandle);
OutputCanvas.TextOut (x, y, St);
NewFontHandle := SelectObject (OutputCanvas.Handle, OldFontHandle);
DeleteObject (NewFontHandle);
end;
{ CanvasTextOutAngle }
procedure SetPixelsPerInch;
{-insures that PixelsPerInch is set so that text print at the desired size}
var
FontSize: integer;
begin
FontSize := Printer.Canvas.Font.Size;
Printer.Canvas.Font.PixelsPerInch := GetDeviceCaps (Printer.Handle, LOGPIXELSY );
Printer.Canvas.Font.Size := FontSize;
end;
{ SetPixelsPerInch }
function GetResolution: TPoint;
{-returns the resolution of the printer}
begin
Result.X := GetDeviceCaps(Printer.Handle, LogPixelsX);
Result.Y := GetDeviceCaps(Printer.Handle, LogPixelsY);
end;
{ GetResolution }
procedure PrintMemo (TheMemo: TMemo;
Rect: TRect);
{-prints the desired memo within the specified rectangle}
var
TextSize: Longint;
Text: PChar;
Test: Integer;
begin
TextSize := TheMemo.GetTextLen;
try
GetMem (Text, TextSize);
TheMemo.GetTextBuf (Text, TextSize);
Test := DrawText (Printer.Canvas.Handle, Text, TextSize, Rect,
DT_Left or DT_ExpandTabs or DT_WordBreak);
finally
FreeMem (Text, TextSize);
end;
{ try }
end;
{ PrintMemo }
procedure Register;
{-registers the printset component}
begin
RegisterComponents('MSTAR', [TPrintSet]);
end;
{ Register }
end .
DeviceMode;