lazarus/components/printers/unix/cupsprinters.inc
mattias 9032caa4fd UTF-8: added ExpandFilenameUTF8
git-svn-id: trunk@16272 -
2008-08-27 11:25:01 +00:00

1009 lines
28 KiB
PHP

{$IFDEF DebugCUPS}
{$DEFINE LogPrintoutFile}
{$ENDIF}
{**************************************************************
Implementation for cupsprinter
***************************************************************}
uses udlgSelectPrinter,udlgpropertiesprinter, FileUtil;
//Return always 72 because, PostScript it's 72 only
function TCUPSPrinter.GetXDPI: Integer;
begin
Result:=72;
end;
//Return always 72 because, PostScript it's 72 only
function TCUPSPrinter.GetYDPI: Integer;
begin
Result:=72;
end;
//write count bytes from buffer to raw mode stream
function TCUPSPrinter.Write(const Buffer; Count: Integer; var Written: Integer
): Boolean;
begin
result := False;
CheckRawMode(True);
if not Assigned(FRawModeStream) then
FRawModeStream := TMemoryStream.Create;
Written := FRawModeStream.Write(Buffer, Count);
Result := True;
end;
constructor TCUPSPrinter.Create;
begin
inherited Create;
fcupsPrinters:=nil;
fcupsPrinter :=nil;
fcupsHttp :=nil;
fcupsPPD :=nil;
fcupsOptions :=nil;
fcupsNumOpts :=0;
FRawModeStream := nil;
FCupsPapersCount := -1;
end;
destructor TCUPSPrinter.destroy;
begin
SetLength(FPapers, 0);
if assigned(fRawModeStream) then
fRawModeStream.Free;
FreeOptions;
if Assigned(fcupsHttp) then
httpClose(fcupsHttp);
inherited destroy;
end;
procedure TCUPSPrinter.FreeOptions;
begin
if Assigned(fcupsOptions) then
cupsFreeOptions(fcupsNumOpts,fcupsOptions);
fcupsNumOpts:=0;
fcupsOptions:=nil;
FStates:=FStates-[cpsDefaultPaperNameValid,cpsOrientationValid,
cpsPaperNameValid,cpsCopiesValid];
end;
procedure TCUPSPrinter.cupsAddOption(aName,aValue: string);
begin
if not CUPSLibInstalled then Exit;
fcupsNumOpts:=cupsdyn.cupsAddOption(PChar(aName),PChar(aValue),fcupsNumOpts,@fcupsOptions);
end;
//Return the value of option set for the selected printer
function TCUPSPrinter.cupsGetOption(aKeyWord: string): String;
begin
Result:='';
if not CUPSLibInstalled then Exit;
if (Printers.Count>0) then
begin
if not Assigned(fcupsOptions) then
SetOptionsOfPrinter;
Result:=cupsdyn.cupsGetOption(PChar(aKeyWord),fcupsNumOpts,fcupsOptions);
end;
end;
procedure TCUPSPrinter.GetDebugOptions(Lst : TStrings);
Var Opts : Pcups_option_t;
Opt : Pcups_option_t;
i : Integer;
begin
if Assigned(Lst) and (Printers.Count>0) then
begin
Lst.Clear;
if not CUPSLibInstalled then Exit;
Lst.Add('**************************************************');
if Assigned(fcupsPrinter) then
begin
Opts:=fcupsOptions; // fcupsPrinter^.options;
Lst.Add(Format('Printer "%s" Number of Options %d',[fcupsPrinter^.Name,fcupsNumOpts{fcupsPrinter^.num_options}]));
for i:=0 to {fcupsPrinter^.num_options}fcupsNumOpts-1 do
begin
Opt:=@Opts[i];
Lst.Add(Opt^.name+'="'+Opt^.value+'"');
end;
end
else Lst.Add('fcupsPrinter is not assigned');
Lst.Add('**************************************************');
end;
end;
procedure TCUPSPrinter.DoCupsConnect;
begin
if not assigned(fcupsHttp) then
begin
if not CUPSLibInstalled then Exit;
fcupsHttp:=httpConnect(cupsServer(),ippPort());
if not Assigned(fcupsHttp) then
raise Exception.Create('Unable to contact server!');
end;
end;
// adds a list of known papers
procedure TCUPSPrinter.CreatePapers;
procedure add(AnIndex:Integer; aname:string; aPhysRect,aWrkRect:TRect);
begin
with fPapers[AnIndex] do begin
PaperName := aName;
PhysicalRect := aPhysRect;
WorkRect := aWrkRect;
WinCode:= 0;
end;
end;
begin
SetLength(fPapers, 3);
add(0, 'Letter', Rect(0, 0, 612, 792 ), Rect(0, 0, 612, 792 ));
add(1, 'A4', Rect(0, 0, 595, 892 ), Rect(0, 0, 595, 892 ));
add(2, 'Legal', Rect(0, 0, 612, 1008), Rect(0, 0, 612, 1008));
end;
function TCUPSPrinter.IndexOfPaper(aPaperName: string): integer;
var
i: Integer;
begin
result := -1;
for i:=0 to Length(fPapers)-1 do
if CompareText(fPapers[i].PaperName, aPapername)=0 then begin
result := i;
break;
end;
end;
function TCUPSPrinter.InternalGetDefPaperName: string;
begin
if Length(Fpapers)=0 then
CreatePapers;
result := fPapers[0].PaperName;
end;
function TCUPSPrinter.InternalGetCurPaperName: string;
begin
if Length(fPapers)=0 then
CreatePapers;
result := fPapers[fCurrentPaper].PaperName;
end;
procedure TCUPSPrinter.InternalGetPaperRect(aPaperName:string;
var PaperRect:TPaperRect);
var
i: LongInt;
begin
if Length(fPapers)=0 then
CreatePapers;
i := IndexOfPaper(aPaperName);
if i<0 then
i := FCurrentPaper;
with fPapers[i] do
if orientation in [poPortrait, poReversePortrait] then begin
PaperRect.PhysicalRect := PhysicalRect;
PaperRect.WorkRect := WorkRect;
end else begin
PaperRect.PhysicalRect.Right := PhysicalRect.Bottom;
PaperRect.Physicalrect.Bottom := PhysicalRect.Right;
PaperRect.WorkRect.Left := WorkRect.Top;
PaperRect.WorkRect.Top := PhysicalRect.Right-WorkRect.Right;
PaperRect.WorkRect.Right := WorkRect.Bottom;
PaperRect.WorkRect.Bottom := PhysicalRect.Right-Workrect.Left;
end;
end;
function TCUPSPrinter.CupsPapersListValid: boolean;
var
Lst: TStringlist;
begin
if fCupsPapersCount<=0 then begin
// paper list no exists or
// paper list is not enumerated yet, try it now.
Lst := TStringlist.Create;
try
DoEnumPapers(Lst);
finally
Lst.Free;
end;
end;
result := fCupsPapersCount>0;
end;
//Print the file aFileName with a selected printer an options
function TCUPSPrinter.PrintFile(aFileName: String): longint;
var PrinterName : string;
begin
Result:=-1;
if not CUPSLibInstalled then Exit;
aFileName:=ExpandFileNameUTF8(aFileName);
if (Printers.Count>0) then
begin
if not Assigned(fcupsOptions) then
SetOptionsOfPrinter;
if Assigned(fcupsPrinter) then
PrinterName:=fcupsPrinter^.Name
else
PrinterName:='';
Result:=cupsdyn.cupsPrintFile(PChar(PrinterName),PChar(aFileName),
PChar(Self.Title),
fcupsNumOpts,fcupsOptions);
end;
end;
//Set State of Job
procedure TCUPSPrinter.SetJobState(aJobId : LongInt; aOp : ipp_op_t);
var Request,R : Pipp_t; //IPP Request
Language : Pcups_lang_t; //Default Language
URI : Array[0..HTTP_MAX_URI] of Char; //Printer URI
begin
if not CUPSLibInstalled then Exit;
if (Printers.Count>0) then
begin
if Assigned(fcupsPrinter) then
begin
R:=nil;
DoCupsConnect;
Request:=ippNew();
Language:=cupsLangDefault();
ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_CHARSET,
'attributes-charset', '', cupsLangEncoding(language));
ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_LANGUAGE,
'attributes-natural-language', '', Language^.language);
URI:=Format('http://%s:%d/jobs/%d',[cupsServer,ippPort,aJobId]);
ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_URI,'job-uri','',URI);
ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_NAME,'requesting-user-name','',cupsUser());
Request^.request.op.operation_id := aOp;
Request^.request.op.request_id := 1;
//Do the request and get back a response...
R:=cupsDoRequest(fcupsHttp, Request, '/jobs/');
if Assigned(R) then
begin
if (R^.request.status.status_code>IPP_OK_CONFLICT) then
ippDelete(R);
end;
end;
end;
end;
function TCUPSPrinter.GetCupsRequest : Pipp_t;
var Request : Pipp_t; //IPP Request
Language : Pcups_lang_t; //Default Language
URI : Array[0..HTTP_MAX_URI] of Char; //Printer URI
begin
Result:=Nil;
if not CUPSLibInstalled then Exit;
if (Printers.Count>0) then
begin
if Assigned(fcupsPrinter) then
begin
DoCupsConnect;
Request:=ippNew();
{Build an IPP_GET_PRINTER_ATTRIBUTES request,
which requires the following attributes:
attributes-charset
attributes-natural-language
printer-uri}
Request^.request.op.operation_id := IPP_GET_PRINTER_ATTRIBUTES;
Request^.request.op.request_id := 1;
Language:=cupsLangDefault;
ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_CHARSET,
'attributes-charset', '', cupsLangEncoding(language));
ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_LANGUAGE,
'attributes-natural-language', '', Language^.language);
// or this syntax >>
//URI:=Format('http://%s:%d/printers/%s',[cupsServer,ippPort,fcupsPrinter^.name]);
URI:=Format('ipp://localhost/printers/%s',[fcupsPrinter^.name]);
ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_URI,'printer-uri','',URI);
//Do the request and get back a response...
Result:=cupsDoRequest(fcupsHttp, Request, '/');
if Assigned(Result) then
begin
if (Result^.request.status.status_code>IPP_OK_CONFLICT) then
begin
ippDelete(Result);
Result:=nil;
end;
end;
end;
end;
end;
//Initialize the options with the default options of selected printer
procedure TCUPSPrinter.SetOptionsOfPrinter;
Var Opts : Pcups_option_t;
Opt : Pcups_option_t;
i : Integer;
begin
if not CUPSLibInstalled then Exit;
if (Printers.Count>0) then
begin
if Assigned(fcupsPrinter) then
begin
Opts := fcupsPrinter^.Options;
for i:=0 to fcupsPrinter^.num_options-1 do
begin
Opt:=@Opts[i];
self.cupsAddOption(Opt^.Name,Opt^.Value);
end;
end;
end;
end;
//Enum all options associed with aKeyWord
function TCUPSPrinter.EnumPPDChoice(Lst : TStrings;
const aKeyWord : string; OptNames: TStrings = nil) : Integer;
var i : integer;
Option : Pppd_option_t;
Choice : Pppd_choice_t;
begin
Result:=-1;
if not CUPSLibInstalled then Exit;
if not Assigned(Lst) then Exit;
Lst.Clear;
if (Printers.Count>0) then
begin
if Assigned(fcupsPrinter) then
begin
if Assigned(fcupsPPD) then
begin
Option:=nil;
Option:=ppdFindOption(fcupsPPD,PChar(aKeyWord));
If Assigned(Option) then
begin
for i:=0 to Option^.num_choices-1 do
begin
Choice:=@Option^.choices[i];
if Choice^.marked=#1 then
Result:=i;
Lst.Add(Choice^.text);
if Assigned(OptNames) then
OptNames.Add(Choice^.choice);
end;
//Not marked choise then the choice is default
if (Result<0) and (Lst.Count>0) then begin
Result:=Lst.IndexOf(OPtion^.defchoice);
if (Result<0)and Assigned(OptNames) then
Result := OptNames.IndexOf(Option^.DefChoice);
end;
end;
end;
end;
end;
end;
procedure TCUPSPrinter.GetEnumAttributeString(aName: PChar; Lst: TStrings);
var
Reponse : Pipp_t; //IPP Reponse
Attribute : Pipp_attribute_t; //Current attribute
i : Integer;
begin
//DebugLn(['TCUPSPrinter.GetEnumAttributeString START aName="',aName,'"']);
if not assigned(Lst) then
raise Exception.Create('Lst must be assigned');
if not CUPSLibInstalled then begin
DebugLn(['TCUPSPrinter.GetEnumAttributeString CUPSLibInstalled not installed']);
Exit;
end;
Reponse:=GetCupsRequest;
if not Assigned(Reponse) then begin
DebugLn(['TCUPSPrinter.GetEnumAttributeString no Reponse']);
end else begin
try
Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
if Assigned(Attribute) then begin
//DebugLn(['TCUPSPrinter.GetEnumAttributeString Attribute^.num_values=',Attribute^.num_values]);
for i:=0 to Attribute^.num_values-1 do
begin
if Attribute^.value_tag=IPP_TAG_INTEGER then
Lst.add(IntToStr(Pipp_value_t(@Attribute^.values)[i].aInteger))
else
Lst.add(Pipp_value_t(@Attribute^.values)[i]._string.text);
end;
end else begin
DebugLn(['TCUPSPrinter.GetEnumAttributeString Attribute not found: ',aName]);
end;
finally
ippDelete(Reponse);
end;
end;
end;
function TCUPSPrinter.GetAttributeInteger(aName: PChar; DefaultValue : Integer): Integer;
var
Reponse : Pipp_t; //IPP Reponse
Attribute : Pipp_attribute_t; //Current attribute
begin
Result:=DefaultValue;
if not CUPSLibInstalled then Exit;
Reponse:=GetCupsRequest;
if Assigned(Reponse) then
begin
try
Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
if Assigned(Attribute) then
Result:=Attribute^.values[0].aInteger;
finally
ippDelete(Reponse);
end;
end;
end;
function TCUPSPrinter.GetAttributeString(aName: PChar;
const DefaultValue : string): string;
var
Reponse : Pipp_t; //IPP Reponse
Attribute : Pipp_attribute_t; //Current attribute
begin
Result:=DefaultValue;
if not CUPSLibInstalled then Exit;
Reponse:=GetCupsRequest;
if Assigned(Reponse) then
begin
try
Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
if Assigned(Attribute) then
Result:=Attribute^.values[0]._string.text
else begin
DebugLn(['TCUPSPrinter.GetAttributeString failed: aName="',aName,'"']);
end;
finally
ippDelete(Reponse);
end;
end;
end;
function TCUPSPrinter.GetAttributeBoolean(aName: PChar;
DefaultValue : Boolean): Boolean;
var
Reponse : Pipp_t; //IPP Reponse
Attribute : Pipp_attribute_t; //Current attribute
begin
Result:=DefaultValue;
if not CUPSLibInstalled then Exit;
Reponse:=GetCupsRequest;
if Assigned(Reponse) then
begin
try
Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO);
if Assigned(Attribute) then
Result:=(Attribute^.values[0].aBoolean=#1);
finally
ippDelete(Reponse);
end;
end;
end;
function TCUPSPrinter.GetCanvasRef: TPrinterCanvasRef;
begin
Result:=TPostscriptPrinterCanvas;
end;
//Override this methode for assign an
//file name at Canvas
procedure TCUPSPrinter.DoBeginDoc;
var
NewPath: String;
function TryTemporaryPath(const Path: string): Boolean;
var
CurPath: String;
begin
CurPath:=CleanAndExpandDirectory(Path);
Result:=DirPathExists(CurPath);
if Result then NewPath:=CurPath;
end;
begin
if FBeginDocCount>0 then
raise Exception.Create('TCUPSPrinter.DoBeginDoc already called. Maybe you forgot an EndDoc?');
inherited DoBeginDoc;
inc(FBeginDocCount);
if (not TryTemporaryPath('~/tmp/'))
and (not TryTemporaryPath('/tmp/'))
and (not TryTemporaryPath('/var/tmp/')) then
NewPath:='';
FOutputFileName := AppendPathDelim(NewPath)+
'OutPrinter_'+FormatDateTime('yyyymmmddd-hhnnss',Now);
if RawMode then
FOutputFileName := FOutputFileName + '.raw'
else begin
FOutputFileName := FOutputFileName + '.ps';
TPostscriptPrinterCanvas(Canvas).OutputFileName := FOutputFileName;
end;
end;
//If not aborted, send PostScript file to printer.
//After, delete this file.
procedure TCUPSPrinter.DoEndDoc(aAborted: Boolean);
begin
inherited DoEndDoc(aAborted);
dec(FBeginDocCount);
Exclude(FStates,cpsPaperRectValid);
if RawMode then begin
if not aAborted and (FRawModeStream<>nil)
and (FRawModeStream.Size>0) then
begin
try
FRawModeStream.SaveToFile(FOutputFileName);
finally
FRawModeStream.Clear;
end;
end;
end else
TPostscriptPrinterCanvas(Canvas).OutPutFileName:='';
if not aAborted and FileExistsUTF8(FOutputFileName) then begin
{$IFDEF LogPrintoutFile}
CopyFile(FOutputFileName, 'printjob'+ExtractFileExt(FOutputFileName));
{$ENDIF}
PrintFile(FOutputFileName);
DeleteFileUTF8(FOutputFilename);
end;
end;
procedure TCUPSPrinter.DoResetPrintersList;
begin
if Assigned(fcupsPPD) then
begin
ppdClose(fcupsPPD);
fcupsPPD:=nil;
end;
if fcupsPPDName<>'' then
begin
DeleteFileUTF8(fcupsPPDName);
fcupsPPDName:='';
end;
FreeOptions;
if Assigned(fcupsPrinters) and CUPSLibInstalled then begin
cupsFreeDests(Printers.Count,fcupsPrinters);
fCupsPrinter := nil;
end;
inherited DoResetPrintersList;
end;
procedure TCUPSPrinter.DoEnumPrinters(Lst: TStrings);
Var i,Num : Integer;
P : Pcups_dest_t;
begin
inherited DoEnumPrinters(Lst);
if not CUPSLibInstalled then Exit;
Num:=cupsGetDests(@fcupsPrinters);
For i:=0 to Num-1 do
begin
P:=nil;
P:=@fcupsPrinters[i];
if Assigned(P) then
begin
if P^.is_default<>0 then
Lst.Insert(0,P^.name)
else
Lst.Add(P^.name);
end;
end;
end;
procedure TCUPSPrinter.DoEnumPapers(Lst: TStrings);
var
i: Integer;
begin
//DebugLn(['TCUPSPrinter.DoEnumPapers ',dbgsName(Self)]);
inherited DoEnumPapers(Lst);
GetEnumAttributeString('media-supported',Lst);
fCupsPapersCount := lst.Count;
if FCupsPapersCount=0 then begin
// printer doesn't support attribute media-supported, return
// our printer list
if Length(FPapers)=0 then
CreatePapers;
for i:=0 to Length(fPapers)-1 do
lst.Add(fPapers[i].PaperName);
fCurrentPaper := 0;
end;
end;
function TCUPSPrinter.DoSetPrinter(aName: string): Integer;
Var i : Integer;
P : Pcups_dest_t;
Fn : String;
begin
//debugln('TCUPSPrinter.DoSetPrinter aName="',aName,'"');
Result:=inherited DoSetPrinter(aName);
if not CUPSLibInstalled then Exit;
//debugln('TCUPSPrinter.DoSetPrinter B Printers.Count=',dbgs(Printers.Count));
//Set the current printer. If aName='' then use a default Printer (index 0)
If (Printers.Count>0) then
begin
if (aName<>'') and Assigned(fcupsPPD) then
begin
//Printer changed ?
i:=Printers.IndexOf(aName);
if i=PrinterIndex then
begin
Result:=PrinterIndex;
//debugln('TCUPSPrinter.DoSetPrinter no change');
Exit;
end;
end;
//Clear all existing options
FreeOptions;
if Assigned(fcupsPPD) then
begin
ppdClose(fcupsPPD);
fcupsPPD:=nil;
if fcupsPPDName<>'' then
begin
DeleteFileUTF8(fcupsPPDName);
fcupsPPDName:='';
end;
end;
if aName='' then
i:=0
else
i:=Printers.IndexOf(aName);
if i>-1 then
begin
Result:=i;
P:=nil;
P:=cupsGetDest(PChar(aName),nil,Printers.Count,fcupsPrinters);
if not Assigned(P) then
raise Exception.Create(Format('"%s" is not a valid printer.',[aName]));
fcupsPrinter:=P;
//Open linked ppdfile
Fn:=cupsGetPPD(PChar(aName));
fcupsPPD:=ppdOpenFile(PChar(Fn));
fcupsPPDName:=Fn;
end;
end
else
begin
PrinterIndex:=-1;
fcupsPPD:=nil;
end;
end;
function TCUPSPrinter.DoGetCopies: Integer;
begin
if not (cpsCopiesValid in FStates) then begin
fCachedCopies:=inherited DoGetCopies;
//Get default value if defined
fCachedCopies:=GetAttributeInteger('copies-default',fCachedCopies);
//Get Copies in options or return default value
fCachedCopies:=StrToIntdef(cupsGetOption('copies'),fCachedCopies);
{$IFDEF UseCache}
Include(FStates,cpsCopiesValid);
{$ENDIF}
end;
Result:=fCachedCopies;
end;
procedure TCUPSPrinter.DoSetCopies(aValue: Integer);
var i : Integer;
begin
{$IFDEF UseCache}
if aValue=DoGetCopies then exit;
Exclude(FStates,cpsCopiesValid);
{$ENDIF}
inherited DoSetCopies(aValue);
if Printers.Count>0 then
begin
if not Assigned(fcupsOptions) then
SetOptionsOfPrinter;
i:=aValue;
if i<1 then i:=1;
cupsAddOption('copies',IntToStr(i));
end;
end;
function TCUPSPrinter.DoGetOrientation: TPrinterOrientation;
var i : Integer;
begin
if not (cpsOrientationValid in FStates) then begin
fCachedOrientation:=inherited DoGetOrientation;
if Printers.Count>0 then
begin
//Default orientation value
i:=GetAttributeInteger('orientation-requested-default',3);
//Get selected orientation or Default if not defined
i:=StrToIntDef(cupsGetOption('orientation-requested'),i);
//Calc result
fCachedOrientation:=TPrinterOrientation(i-3);
end;
{$IFDEF UseCache}
Include(FStates,cpsOrientationValid);
{$ENDIF}
end;
Result:=fCachedOrientation;
{$IFDEF DebugCUPS}
DebugLn('DoGetOrientation: result=%d',[ord(Result)]);
{$ENDIF}
end;
procedure TCUPSPrinter.DoSetOrientation(aValue: TPrinterOrientation);
var St : String;
begin
{$IFDEF UseCache}
if aValue=DoGetOrientation then exit;
Exclude(FStates,cpsOrientationValid);
Exclude(FStates,cpsPaperRectValid);
{$ENDIF}
inherited DoSetOrientation(aValue);
if Printers.Count>0 then
begin
if not Assigned(fcupsOptions) then
SetOptionsOfPrinter;
St:=IntToStr(Ord(aValue)+3);
{$IFDEF DebugCUPS}
DebugLn('Orientation-Requested=%s',[st]);
{$ENDIF}
cupsAddOption('orientation-requested',St);
end;
end;
function TCUPSPrinter.DoGetDefaultPaperName: string;
begin
if not (cpsDefaultPaperNameValid in FStates) then begin
fCachedGetDefaultPaperName:=inherited DoGetDefaultPaperName;
if not CupsPapersListValid then
FCachedGetDefaultPaperName:=InternalGetDefPaperName
else begin
fCachedGetDefaultPaperName:=
GetAttributeString('media-default',fCachedGetDefaultPaperName);
{$IFDEF UseCache}
Include(FStates,cpsDefaultPaperNameValid);
{$ENDIF}
end;
end;
Result:=fCachedGetDefaultPaperName;
end;
function TCUPSPrinter.DoGetPaperName: string;
begin
if not (cpsPaperNameValid in FStates) then begin
// paper is not yet retrieved for first time
// first try to see if there is a list of papers available
if not CupsPapersListValid then
fCachedPaperName := InternalGetCurPaperName
else begin
fCachedPaperName := cupsGetOption('PageSize');
{$IFDEF UseCache}
Include(FStates,cpsPaperNameValid);
{$ENDIF}
end;
end;
Result:=fCachedPaperName;
end;
procedure TCUPSPrinter.DoSetPaperName(aName: string);
var
i: Integer;
begin
{$IFDEF UseCache}
if aName=DoGetPaperName then exit;
Exclude(FStates,cpsPaperNameValid);
{$ENDIF}
inherited DoSetPaperName(aName);
if FCupsPapersCount<=0 then begin
i := IndexOfPaper(aName);
if i>=0 then
fCurrentPaper := i;
end else
cupsAddOption('PageSize',aName)
end;
//Initialise aPaperRc with the aName paper rect
//Result : -1 no result
// 0 aPaperRc.WorkRect is a margins
// 1 aPaperRc.WorkRect is really the work rect
function TCUPSPrinter.DoGetPaperRect(aName: string;
var aPaperRc: TPaperRect): Integer;
var
P : Pppd_size_t;
begin
if (not (cpsPaperRectValid in FStates))
or (fCachePaperRectName<>aName) then begin
fCachePaperRectName:=aName;
FillChar(fCachePaperRect,SizeOf(fCachePaperRect),0);
fCachePaperRectResult:=inherited DoGetPaperRect(aName, aPaperRc);
{$IFDEF UseCache}
Include(FStates,cpsPaperRectValid);
{$ENDIF}
P:=nil;
if CUPSLibInstalled and Assigned(fcupsPPD) then
begin
P:=ppdPageSize(fcupsPPD,PChar(aName));
if Assigned(P) then
begin
fCachePaperRectResult:=1; //CUPS return margins
// Margins.
//
// Cups gives dimensions based on postcript language
// user space coordinates system which is something like
//
// +y +--> +x
// ^ but our system is |
// | v
// +--> +x +y
//
// so values in x are the same, but we need to invert values in y,
// the given bottom value is the margin size at the bottom, we need
// to re-calc. our bottom offset, and the given top value is offset
// top value of imageable area, we need to re-calc. our top offset,
// which is the margin size at the top of the page.
//
// The current implementation assumes that paper is fed short-edge-first
// either in portrait orientation, or in landscape orientation.
//
// In landscape orientation, printable margins should preserved.
// It's based on a 90 degree counterclock wise paper rotation
//
// FEED DIRECTION FEED DIRECTION
//
// /\ /\
// / \ / \
// || ||
// || ||
//
// PORTRAIT ORIENTATION LANDSCAPE ORIENTATION
//
// +-----------------+ +-----------------+
// | t | | t |
// | +---------+ | | +---------+ |
// | | | | | | | |
// | | ( ) | | | | v | |
// | | | | | | |\ | | |
// | l | >--+--< | r | | l | ---+-() | r |
// | | | | | | |/ | | |
// | | / \ | | | | ^ | |
// | | / \ | | | | | |
// | +---------+ | | +---------+ |
// | | | |
// | b | | b |
// +-----------------+ +-----------------+
//
// todo: check meaning of poReverseXXXXX
//
if Orientation in [poPortrait, poReversePortrait] then begin
fCachePaperRect.PhysicalRect.Right:=Longint(Trunc(P^.Width));
fCachePaperRect.PhysicalRect.Bottom:=Longint(Trunc(P^.Length));
fCachePaperRect.WorkRect.Left:=LongInt(Trunc(P^.Left));
fCachePaperRect.WorkRect.Right:=Longint(Trunc(P^.Right));
fCachePaperRect.WorkRect.Top:=LongInt(Trunc(P^.Length-P^.Top));
fCachePaperRect.WorkRect.Bottom:=LongInt(Trunc(P^.Length-P^.Bottom));
end else begin
FCachePaperRect.PhysicalRect.Right:=Longint(Trunc(P^.Length));
FCachePaperRect.PhysicalRect.Bottom:=Longint(Trunc(P^.Width));
FCachePaperRect.WorkRect.Left:=Longint(Trunc(P^.Length-P^.Top));
FCachePaperRect.WorkRect.Right:=longint(Trunc(P^.Length-P^.Bottom));
FCachePaperRect.WorkRect.Top:=Longint(Trunc(P^.Width-P^.Right));
FCachePaperRect.WorkRect.Bottom:=Longint(Trunc(p^.width - P^.left));
end;
//debugln('TCUPSPrinter.DoGetPaperRect PhysicalRect=',dbgs(fCachePaperRect.PhysicalRect),' WorkRect=',dbgs(fCachePaperRect.WorkRect));
end;
end;
if P=nil then begin
// FCachePaperRect couldn't be determined, use our internal list
InternalGetPaperRect(aName, FCachePaperRect);
fCachePaperRectResult:=1
end;
end;
Result:=fCachePaperRectResult;
aPaperRc:=fCachePaperRect;
end;
function TCUPSPrinter.DoGetPrinterState: TPrinterState;
var //Request : Pipp_t; //IPP Request
//Reponse : Pipp_t; //IPP Reponse
//Attribute : Pipp_attribute_t; //Current attribute
//Language : Pcups_lang_t; //Default Language
aState : ipp_pstate_t; //Printer state
//URI : Array[0..HTTP_MAX_URI] of Char; //Printer URI
begin
Result:=inherited DoGetPrinterState;
aState:=ipp_pstate_t(GetAttributeInteger('printer-state',0));
Case aState of
IPP_PRINTER_IDLE : Result:=psReady;
IPP_PRINTER_PROCESSING : Result:=psPrinting;
IPP_PRINTER_STOPPED : Result:=psStopped;
end;
end;
function TCUPSPrinter.GetPrinterType: TPrinterType;
Var i : Integer;
begin
Result:=inherited GetPrinterType;
i:=GetAttributeInteger('printer-type',CUPS_PRINTER_LOCAL);
If (i and CUPS_PRINTER_REMOTE)=CUPS_PRINTER_REMOTE then
Result:=ptNetWork;
end;
function TCUPSPrinter.GetCanPrint: Boolean;
begin
Result:=inherited GetCanPrint;
Result:=GetAttributeBoolean('printer-is-accepting-jobs',Result)
end;
initialization
if Assigned(Printer) then
Printer.Free;
Printer:=TCUPSPrinter.Create;
FINALIZATION
// Free the printer before unloading library
Printer.Free;
Printer:=nil;
//Unload CUPSLib if loaded
FinalizeCups;
{END.}