unit GetAndSetPrinterSettings; // Only for Windows
{$mode objfpc}{$H+}
interface
uses
Printers;
function SetPrinterOption(prn: tPrinter; FieldToChange: longint; ValueToSet: longint): longint;
function GetPrinterOption(prn: tPrinter; FieldToGet: longint): longint;
implementation
uses
Classes, SysUtils, Windows, WinUtilPrn;
Function SetPrinter(hPrinter:Handle;Level:DWORD;pPrinter:PByte;Command:DWord):LongBool; StdCall; External
libWinSpool name 'SetPrinterA';
function GetDevModeField(pDM: PDEVMODE; Field: longint): longint;
// Only for fields whose value type and range is integer >=0
// Result >= 0 ==> succeeded
// Result < 0 ==> failed
begin
if (pDM^.dmFields and Field)=0 then
Result := -1 // Field not supported
else
case Field of
DM_ORIENTATION: Result := pDM^.dmOrientation;
DM_PAPERSIZE: Result := pDM^.dmPaperSize;
DM_PAPERLENGTH: Result := pDM^.dmPaperLength;
DM_PAPERWIDTH: Result := pDM^.dmPaperWidth;
DM_SCALE: Result := pDM^.dmScale;
// DM_POSITION: Result:=pDM^.dmPosition;
DM_COPIES: Result := pDM^.dmCopies;
DM_DEFAULTSOURCE: Result := pDM^.dmDefaultSource;
DM_PRINTQUALITY: Result := pDM^.dmPrintQuality;
DM_COLOR: Result := pDM^.dmColor;
DM_DUPLEX: Result := pDM^.dmDuplex;
DM_YRESOLUTION: Result := pDM^.dmYResolution;
DM_TTOPTION: Result := pDM^.dmTTOption;
DM_COLLATE: Result := pDM^.dmCollate;
// DM_FORMNAME: Result:=pDM^.dmFormName;
DM_LOGPIXELS: Result := pDM^.dmLogPixels;
DM_ICMMETHOD: Result := pDM^.dmICMMethod;
DM_ICMINTENT: Result := pDM^.dmICMIntent;
DM_MEDIATYPE: Result := pDM^.dmMediaType;
DM_DITHERTYPE: Result := pDM^.dmDitherType;
else
Result := -1; // Field not supported
end;
end;
function SetDevModeField(pDM: PDEVMODE; Field: longint; Value: longint):longint;
// Only for fields whose value type and range is integer >=0
// Result >= 0 ==> change succeeded; result = previous value (maybe we want to restore it later)
// Result < 0 ==> change failed
begin
if (pDM^.dmFields and Field)=0 then
Result := -1 // Field not supported
else
begin
Result := GetDevModeField(pDM,Field);
case Field of
DM_ORIENTATION: pDM^.dmOrientation := Value;
DM_PAPERSIZE: pDM^.dmPaperSize := Value;
DM_PAPERLENGTH: pDM^.dmPaperLength := Value;
DM_PAPERWIDTH: pDM^.dmPaperWidth := Value;
DM_SCALE: pDM^.dmScale := Value;
// DM_POSITION: pDM^.dmPosition := Value;
DM_COPIES: pDM^.dmCopies := Value;
DM_DEFAULTSOURCE: pDM^.dmDefaultSource := Value;
DM_PRINTQUALITY: pDM^.dmPrintQuality := Value;
DM_COLOR: pDM^.dmColor := Value;
DM_DUPLEX: pDM^.dmDuplex := Value;
DM_YRESOLUTION: pDM^.dmYResolution := Value;
DM_TTOPTION: pDM^.dmTTOption := Value;
DM_COLLATE: pDM^.dmCollate := Value;
// DM_FORMNAME: pDM^.dmFormName := Value;
DM_LOGPIXELS: pDM^.dmLogPixels := Value;
DM_ICMMETHOD: pDM^.dmICMMethod := Value;
DM_ICMINTENT: pDM^.dmICMIntent := Value;
DM_MEDIATYPE: pDM^.dmMediaType := Value;
DM_DITHERTYPE: pDM^.dmDitherType := Value;
else
Result := -1; // Field not supported
end;
end;
end;
function SetPrinterOption(prn: tPrinter; FieldToChange: longint; ValueToSet: longint): longint;
// Only for fields whose value type and range is integer >=0
// Result > 0 ==> change succeeded; result = previous value (maybe we want to restore it later)
// Result < 0 ==> change failed
label
exit_with_error;
const
LEVEL_2 = 2;
var
hPrinter: tHandle;
pPrnInFo: pPRINTER_INFO_2;
pDev:PDevMode;
datasize: integer;
PrinterNameW: WideString;
begin
pPrnInfo:=nil;
PrinterNameW := prn.PrinterName;
if not OpenPrinterW(PWideChar(PrinterNameW),@hPrinter, nil) then //Open printer;
goto exit_with_error;
// Get Size needed for Info_2; GetPrinter returns false but it works ¿?
GetPrinter(hPrinter, LEVEL_2, Nil, 0, @datasize);
GetMem(pPrnInfo, datasize);
if pPrnInfo = nil then
goto exit_with_error;
// get config data; GetPrinter returns false but it works ¿?
GetPrinter(hPrinter, LEVEL_2 ,PByte(pPRNInFo), datasize ,@datasize);
pDev := pPRNInfo^.pDevMode;
result:= SetDevModeField(pDev, FieldToChange, ValueToSet);
if result>=0 then
SetPrinter(hPrinter, LEVEL_2, PByte(pPrnInFo), 0); // set new config data
// clean and exit
FreeMem(pPrnInfo); // Free allocated memory
ClosePrinter(hPrinter); // Close printer
exit;
// ----------------- ERROR ----------------------
exit_with_error:
Result := -1;
if pPrnInfo<>nil then // Free memory if allocated
freeMem(pPrnInfo);
if (hPrinter <> 0) then // Close printer if opened
ClosePrinter(hPrinter);
end;
function GetPrinterOption(prn: tPrinter; FieldToGet: longint): longint;
// Only for fields whose value type and range is integer >=0
// Result >= 0 ==> succeeded
// Result < 0 ==> failed
label
exit_with_error;
const
LEVEL_2 = 2;
var
hPrinter: tHandle;
pPrnInFo: pPRINTER_INFO_2;
pDev:PDevMode;
datasize: integer;
PrinterNameW: WideString;
begin
pPrnInfo:=nil;
PrinterNameW := prn.PrinterName;
if not OpenPrinterW(PWideChar(PrinterNameW),@hPrinter, nil) then // Open printer;
goto exit_with_error;
// Get Size needed for Info_2; GetPrinter returns false but it works ¿?
GetPrinter(hPrinter, LEVEL_2, Nil, 0, @datasize);
GetMem(pPrnInfo, datasize);
if pPrnInfo = nil then
goto exit_with_error;
// get config data; GetPrinter returns false but it works ¿?
GetPrinter(hPrinter, LEVEL_2 ,PByte(pPRNInFo), datasize ,@datasize);
pDev := pPRNInfo^.pDevMode;
result:= GetDevModeField(pDev, FieldToGet);
// clean and exit
FreeMem(pPrnInfo); // Free allocated memory
ClosePrinter(hPrinter); // Close printer
exit;
// ----------------- ERROR ----------------------
exit_with_error:
Result := -1;
if pPrnInfo<>nil then // Free memory if allocated
freeMem(pPrnInfo);
if (hPrinter <> 0) then // Close printer if opened
ClosePrinter(hPrinter);
end;
end.