{$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; //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 := []; 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; // 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; function PRRect(const ALeft,ATop,ARight,ABottom: Integer): TRect; begin Result.Left := ALeft; Result.Top := ATop; Result.Right := round(ARight * Printer.XDPI / 72); Result.Bottom := round(ABottom * Printer.XDPI / 72); end; begin SetLength(fPapers, 3); add(0, 'Letter', PRRect(0, 0, 612, 792 ), PRRect(0, 0, 612, 792 )); add(1, 'A4', PRRect(0, 0, 595, 892 ), PRRect(0, 0, 595, 892 )); add(2, 'Legal', PRRect(0, 0, 612, 1008), PRRect(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; 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 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; 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 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; 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; 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} {$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); 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; {$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:=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; 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 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.}