{$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:=InternalGetResolution(True); end; //Return always 72 because, PostScript it's 72 only function TCUPSPrinter.GetYDPI: Integer; begin Result:=InternalGetResolution(False); end; procedure TCUPSPrinter.DoEnumBins(Lst: TStrings); var choice: Pppd_choice_t; Option: Pppd_option_t; c: Integer; begin Lst.Clear; if CupsPPD<>nil then begin Option := ppdFindOption(CupsPPD, PChar('InputSlot')); if Option<>nil then begin Choice := Option^.choices; c := 0; while (Choice<>nil) and (cnil then begin Option := ppdFindOption(CupsPPD, 'InputSlot'); if Option<>nil then begin choice := PPDOptionChoiceFrom('InputSlot', Option^.defchoice, true); if choice<>nil then result := choice^.text; end; end; end; function TCUPSPrinter.DoGetBinName: string; var Choice: pppd_choice_t; begin result := cupsGetOption('InputSlot'); if result<>'' then begin Choice := PPDOptionChoiceFrom('InputSlot', result, true); if Choice<>nil then result := Choice^.text else result := ''; end; if result='' then result := doGetDefaultBinName end; procedure TCUPSPrinter.DoSetBinName(aName: string); var Choice: pppd_choice_t; begin Choice := PPDOptionChoiceFrom('InputSlot', aName, false); if Choice<>nil then cupsAddOption('InputSlot', choice^.choice) else inherited doSetBinName(aName); // handle input slot not found 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 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 := []; end; procedure TCUPSPrinter.cupsAddOption(aName,aValue: string); begin if not CUPSLibInstalled then Exit; fcupsNumOpts:=cupsdyn.cupsAddOption(PChar(aName),PChar(aValue),fcupsNumOpts, @fcupsOptions); if (AName='PageSize') then begin Exclude(FStates,cpsPaperNameValid); Exclude(FStates,cpsPaperRectValid); end; {$IFDEF DebugCUPS} DebugLn('TCUPSPrinter.cupsAddOption AName=%s AValue=%s',[AName,AValue]); {$ENDIF} 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; function TCUPSPrinter.CopyOptions(out AOptions: Pcups_option_t): Integer; var i: Integer; begin AOptions := nil; Result := 0; for i:=0 to fcupsNumOpts-1 do Result := cupsdyn.cupsAddOption(fcupsOptions[i].name,fcupsOptions[i].value, Result,@AOptions); end; procedure TCUPSPrinter.MergeOptions(const AOptions:Pcups_option_t; const n:Integer); var i: Integer; begin for i:=0 to n-1 do if // always merge some known options (strcomp('job-sheets', AOptions[i].name)=0) or // check if ppd option value is valid IsOptionValueValid(AOptions[i].name, AOptions[i].value) then cupsAddOption(AOptions[i].name, AOptions[i].value); cupsFreeOptions(n, AOptions); end; function TCUPSPrinter.GetResolutionOption: string; var L1,L2: TStringlist; i: Integer; begin Result := Self.cupsGetOption('Resolution'); if Result='' then begin // get resolution from ppd Result := GetPPDAttribute('DefaultResolution'); if Result='' then begin // try grouped options L1 := TStringList.Create; L2 := TStringList.Create; try i := EnumPPDChoice(L1,'Resolution',L2); if i>=0 then Result := L2[i] finally L2.Free; L1.Free; end; end; end; end; procedure TCUPSPrinter.DebugOptions(AOPtions:Pcups_option_t=nil; n:Integer=0); var i: Integer; begin if (Printers.Count>0) and CUPSLibInstalled and (fcupsPrinter<>nil) then begin DebugLn('**************************************************'); if AOptions=nil then begin AOptions:= fcupsOptions; n := fcupsNumOpts; end; DebugLn('Printer "%s" Number of Options %d',[fcupsPrinter^.Name,n]); for i:=0 to n-1 do DebugLn('name="%s" value="%s"',[AOptions[i].name,AOptions[i].value]); DebugLn('**************************************************'); end else DebugLn('DebugOptions: There are no valid printers'); 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; 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; function TCUPSPrinter.InternalGetResolution(ForX: boolean): Integer; procedure ParseResolution(s:string); var a,b: Integer; begin if s<>'' then begin s := uppercase(s); a := pos('X', S); b := pos('D', S); if b=0 then b := Length(S) else dec(b); if a>0 then begin // NNNXMMMDPI (or NNN X MMM DPI) FCachedResolution.x := StrToIntDef(trim(copy(S,1,a-1)), 0); FCAchedResolution.y := StrToIntDef(trim(copy(S,a+1,b)), 0); end else begin // NNNDPI (or NNN DPI); FCachedResolution.x := StrToIntDef(trim(copy(S,1,b)), 0); FCachedResolution.y := FCachedResolution.x; end; end; end; begin if not (cpsResolutionValid in FStates) then begin // check user defined resolution FCachedResolution.x := 0; FCachedResolution.y := 0; ParseResolution(GetResolutionOption); if (FCachedResolution.x=0) or (FCachedResolution.y=0) then begin FCachedResolution.x := 300; FCachedResolution.y := 300; end; include(FStates, cpsResolutionValid); end; if ForX then result := FCachedResolution.X else result := FCachedResolution.Y; end; {$IFDEF DebugCUPS} procedure TCUPSPrinter.DebugPPD; const arruitypes:array[ppd_ui_t] of string[9] = ('boolean','pickone','pickmany'); arrsection:array[ppd_section_t] of string[9] = ('any','document','exit','jcl','page','prolog'); var i,j,k: Integer; AttrRoot : Ppppd_attr_t; Attr : Pppd_attr_t; Group : pppd_group_t; Option : Pppd_option_t; choices : Pppd_choice_t; function markchar(const AMark:char):char; begin if AMark=#1 then result := '*' else result := ' '; end; begin DebugLn; DebugLn('DebugPPD: ppdfile=',fCupsPPDName); if fcupsPPD=nil then begin DebugLn('No valid ppd file found'); exit; end; DebugLn('=== HEADER ==='); DebugLn; DebugLn(' model : %s', [fcupsPPD^.modelname]); DebugLn(' modelNumber : %d', [fcupsPPD^.model_number]); DebugLn(' manufacturer : %s', [fcupsPPD^.manufacturer]); DebugLn(' nickname : %s', [fcupsPPD^.nickname]); DebugLn(' shortnickname : %s', [fcupsPPD^.shortnickname]); DebugLn(' product : %s', [fcupsPPD^.product]); DebugLn(' attributes : %d Current=%d', [fcupsPPD^.num_attrs,fcupsPPD^.cur_attr]); DebugLn(' language_level : %d', [fcupsPPD^.language_level]); DebugLn(' lang_version : %s', [fcupsPPD^.lang_version]); DebugLn(' lang_encoding : %s', [fcupsPPD^.lang_encoding]); DebugLn(' landscape : %d', [fcupsPPD^.landscape]); DebugLn(' UI groups : %d', [fcupsPPD^.num_groups]); DebugLn(' Num Papers : %d', [fcupsPPD^.num_sizes]); DebugLn(' Num Attributes : %d', [fcupsPPD^.num_attrs]); DebugLn(' Num Constrains : %d', [fcupsPPD^.num_consts]); DebugLn; DebugLn('=== CUSTOM PAPER SUPPORT ==='); DebugLn; DebugLn(' Custom Min 0 : %.2f',[fcupsPPD^.custom_min[0]]); DebugLn(' Custom Min 1 : %.2f',[fCupsPPD^.custom_min[1]]); DebugLn(' Custom Max 0 : %.2f',[fcupsPPD^.custom_max[0]]); DebugLn(' Custom Max 1 : %.2f',[fcupsPPD^.custom_max[1]]); with fcupsPPD^ do DebugLn(' Custom Margins : %.2f %.2f %.2f %.2f', [custom_margins[0],custom_margins[1],custom_margins[2],custom_margins[3]]); DebugLn; if fcupsPPD^.num_groups>0 then begin DebugLn('=== GROUPS ==='); i := 0; Group := fCupsPPD^.groups; while (Group<>nil) and (i0 then begin DebugLn('=== Attributes ==='); i := 0; AttrRoot := fCupsPPD^.attrs; while (AttrRoot<>nil) and (inil then DebugLn(' i=%d Name=%s Spec=%s Value=%s',[i,Attr^.Name,Attr^.Spec,Attr^.Value]); inc(i); inc(AttrRoot); end; end; end; {$ENDIF} //Print the file aFileName with a selected printer an options function TCUPSPrinter.PrintFile(aFileName: String): longint; var aPrinterName : 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 aPrinterName:=fcupsPrinter^.Name else aPrinterName:=''; Result:=cupsdyn.cupsPrintFile(PChar(aPrinterName),PChar(aFileName), PChar(Self.Title), fcupsNumOpts,fcupsOptions); end; end; function TCUPSPrinter.IsOptionValueValid(AKeyword, AValue: pchar): boolean; var Option: pppd_option_t; i: Integer; begin result := false; if (fcupsPrinter=nil) or (fcupsppd=nil) then exit; Option := ppdFindOption(fcupsppd, AKeyword); if Option=nil then exit; i:=0; while i0) 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]; 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 choice 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; function TCUPSPrinter.GetPPDAttribute(const aName: string): string; var i : integer; AttrRoot : PPppd_attr_t; Attr : Pppd_attr_t; begin Result:=''; if not CUPSLibInstalled then Exit; if (Printers.Count>0) and (fcupsPrinter<>nil) and (fcupsPPD<>nil) then begin i := 0; AttrRoot := fCupsPPD^.attrs; while (AttrRoot<>nil) and (inil then begin if (StrComp(pchar(AName), Attr^.name)=0) then begin result := attr^.value; break; end; end; inc(i); inc(AttrRoot); 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 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 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; //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'; TFilePrinterCanvas(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 TFilePrinterCanvas(Canvas).OutPutFileName:=''; if not aAborted and FileExistsUTF8(FOutputFileName) then begin {$IFDEF LogPrintoutFile} CopyFile(FOutputFileName, 'printjob'+ExtractFileExt(FOutputFileName)); {$ENDIF} {$IFNDEF DoNotPrint} if Filename<>'' then CopyFile(FOutputFileName, FileName) else PrintFile(FOutputFileName); {$ENDIF} 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); {$IFDEF NOPRINTERS} Lst.Clear; Exit; {$ENDIF} 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 choice: Pppd_choice_t; Option: Pppd_option_t; c: Integer; begin //DebugLn(['TCUPSPrinter.DoEnumPapers ',dbgsName(Self)]); //TODO: note that we are returning here the list of paper "keys" // not the human readable paper names. Modify cups support // to return human readable paper names. Lst.Clear; FCupsDefaultPaper := ''; if CupsPPD<>nil then begin Option := ppdFindOption(CupsPPD, PChar('PageSize')); Choice := Option^.choices; fCupsDefaultPaper := Option^.defchoice; c := 0; while (Choice<>nil) and (c0) 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; {$IFDEF DebugCUPS} DebugPPD; {$ENDIF} 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 if Printers.Count>0 then begin //Default orientation value i:=GetAttributeInteger('orientation-requested-default',3); // check if rotation is automatic or out-of-range if not (i in [3,4,5,6]) then i:=3; // yep, then for us this means portait fCachedOrientation:=TPrinterOrientation(i-3); end; Include(FStates,cpsOrientationValid); end; Result:=fCachedOrientation; {$IFDEF DebugCUPS} DebugLn('DoGetOrientation: result=%d',[ord(Result)]); {$ENDIF} end; procedure TCUPSPrinter.DoSetOrientation(aValue: TPrinterOrientation); begin if aValue=DoGetOrientation then exit; Exclude(FStates,cpsPaperRectValid); inherited DoSetOrientation(aValue); fcachedOrientation := AValue; Include(FStates,cpsOrientationValid); end; function TCUPSPrinter.DoGetDefaultPaperName: string; begin if not (cpsDefaultPaperNameValid in FStates) then begin fCachedGetDefaultPaperName:=''; if not CupsPapersListValid then FCachedGetDefaultPaperName:=PaperSize.DefaultPaperName else begin if FCupsDefaultPaper<>'' then fCachedGetDefaultPaperName:= FCupsDefaultPaper else 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 := PaperSize.PaperName else begin fCachedPaperName := cupsGetOption('PageSize'); {$IFDEF UseCache} Include(FStates,cpsPaperNameValid); {$ENDIF} end; end; Result:=fCachedPaperName; end; procedure TCUPSPrinter.DoSetPaperName(aName: string); begin {$IFDEF UseCache} if aName=DoGetPaperName then exit; Exclude(FStates,cpsPaperNameValid); {$ENDIF} inherited DoSetPaperName(aName); if FCupsPapersCount<=0 then PaperSize.PaperName:=AName 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; Ky,Kx: Double; 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 LANDSCAPE // +-----------------+ +-----------------+ // | t | | t | // | +---------+ | | +---------+ | // | | ( ) | | | | | / | | // | l | --+-- | r | | l |()-+--- | r | // | | / \ | | | | | \ | | // | +---------+ | | +---------+ | // | b | | b | // +-----------------+ +-----------------+ // // REVERSE PORTRAIT REVERSE LANDSCAPE // +-----------------+ +-----------------+ // | t | | t | // | +---------+ | | +---------+ | // | | \ / | | | | \ | | | // | l | --+-- | r | | l | ---+-()| r | // | | ( ) | | | | / | | | // | +---------+ | | +---------+ | // | b | | b | // +-----------------+ +-----------------+ // Kx := Printer.XDPI/72; Ky := Printer.YDPI/72; if Orientation in [poPortrait, poReversePortrait] then begin fCachePaperRect.PhysicalRect.Right:=Round(P^.Width*Kx); fCachePaperRect.PhysicalRect.Bottom:=Round(P^.Length*Ky); fCachePaperRect.WorkRect.Left:=Round(P^.Left*Kx); fCachePaperRect.WorkRect.Right:=Round(P^.Right*Kx); fCachePaperRect.WorkRect.Top:=Round((P^.Length-P^.Top)*Ky); fCachePaperRect.WorkRect.Bottom:=Round((P^.Length-P^.Bottom)*Ky); end else begin FCachePaperRect.PhysicalRect.Right:=Round(P^.Length*Kx); FCachePaperRect.PhysicalRect.Bottom:=Round(P^.Width*Ky); FCachePaperRect.WorkRect.Left:=Round((P^.Length-P^.Top)*Kx); FCachePaperRect.WorkRect.Right:=Round((P^.Length-P^.Bottom)*Kx); FCachePaperRect.WorkRect.Top:=Round((P^.Width-P^.Right)*Ky); FCachePaperRect.WorkRect.Bottom:=Round((p^.width - P^.left)*Ky); end; {$IFDEF DebugCUPS} with P^ do DebugLn('ORG: Width=%f Length=%f Left=%f Right=%f Top=%f Bottom=%f Name=%s', [Width,Length,Left,Right,Top,Bottom,string(Name)]); with FCachePaperRect do DebugLn('NEW: Width=%d Length=%d Left=%d Top=%d Right=%d Bottom=%d ml=%d mt=%d mr=%d mb=%d', [PhysicalRect.Right,PhysicalRect.Bottom,WorkRect.Left,WorkRect.Top,WorkRect.Right,WorkRect.Bottom, WorkRect.Left,WorkRect.Top,PhysicalRect.Right-WorkRect.Right, PhysicalRect.Bottom-WorkRect.Bottom]); {$ENDIF} end; end; if P=nil then begin FCachePaperRect := PaperSize.PaperRectOf[AName]; 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.DoGetDefaultCanvasClass: TPrinterCanvasRef; begin {$IFDEF UseCairo} Result := TCairoPsCanvas; {$ELSE} Result := TPostscriptPrinterCanvas; {$ENDIF} 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.}