1{%MainUnit ../osprinters.pas} 2{$IFDEF DebugCUPS} 3{$DEFINE LogPrintoutFile} 4{$ENDIF} 5 6{************************************************************** 7Implementation for cupsprinter 8***************************************************************} 9uses 10 {%H-}udlgSelectPrinter, // used to compile it on this target 11 {%H-}udlgpropertiesprinter, // used to compile it on this target 12 FileUtil, LazFileUtils; 13 14const 15 CUPS_CUSTOM_PAPER = 'Custom'; 16 17//Return always 72 because, PostScript it's 72 only 18function TCUPSPrinter.GetXDPI: Integer; 19begin 20 Result:=InternalGetResolution(True); 21end; 22 23//Return always 72 because, PostScript it's 72 only 24function TCUPSPrinter.GetYDPI: Integer; 25begin 26 Result:=InternalGetResolution(False); 27end; 28 29procedure TCUPSPrinter.DoEnumBins(Lst: TStrings); 30var 31 choice: Pppd_choice_t; 32 Option: Pppd_option_t; 33 c: Integer; 34begin 35 Lst.Clear; 36 if CupsPPD<>nil then 37 begin 38 Option := ppdFindOption(CupsPPD, PChar('InputSlot')); 39 if Option<>nil then 40 begin 41 Choice := Option^.choices; 42 c := 0; 43 while (Choice<>nil) and (c<Option^.num_choices) do 44 begin 45 lst.AddObject(Choice^.text, TObject(Choice)); 46 inc(choice); 47 inc(c); 48 end; 49 end; 50 end; 51end; 52 53function TCUPSPrinter.DoGetDefaultBinName: string; 54var 55 Option: Pppd_option_t; 56 Choice: pppd_choice_t; 57begin 58 Result:=inherited DoGetDefaultBinName; 59 60 if CupsPPD<>nil then 61 begin 62 Option := ppdFindOption(CupsPPD, 'InputSlot'); 63 if Option<>nil then 64 begin 65 choice := PPDOptionChoiceFrom('InputSlot', Option^.defchoice, true); 66 if choice<>nil then 67 result := choice^.text; 68 end; 69 end; 70end; 71 72function TCUPSPrinter.DoGetBinName: string; 73var 74 Choice: pppd_choice_t; 75begin 76 result := cupsGetOption('InputSlot'); 77 if result<>'' then 78 begin 79 Choice := PPDOptionChoiceFrom('InputSlot', result, true); 80 if Choice<>nil then 81 result := Choice^.text 82 else 83 result := ''; 84 end; 85 86 if result='' then 87 result := doGetDefaultBinName 88end; 89 90procedure TCUPSPrinter.DoSetBinName(aName: string); 91var 92 Choice: pppd_choice_t; 93begin 94 Choice := PPDOptionChoiceFrom('InputSlot', aName, false); 95 if Choice<>nil then 96 cupsAddOption('InputSlot', choice^.choice) 97 else 98 inherited doSetBinName(aName); // handle input slot not found 99end; 100 101//write count bytes from buffer to raw mode stream 102function TCUPSPrinter.Write(const Buffer; Count: Integer; out Written: Integer 103 ): Boolean; 104begin 105 result := False; 106 CheckRawMode(True); 107 if not Assigned(FRawModeStream) then 108 FRawModeStream := TMemoryStream.Create; 109 Written := FRawModeStream.Write(Buffer, Count); 110 Result := True; 111end; 112 113constructor TCUPSPrinter.Create; 114begin 115 inherited Create; 116 117 fcupsPrinters:=nil; 118 fcupsPrinter :=nil; 119 fcupsHttp :=nil; 120 fcupsPPD :=nil; 121 fcupsOptions :=nil; 122 fcupsNumOpts :=0; 123 124 FRawModeStream := nil; 125 FCupsPapersCount := -1; 126end; 127 128procedure TCUPSPrinter.DoDestroy; 129begin 130 if assigned(fRawModeStream) then 131 fRawModeStream.Free; 132 133 FreeOptions; 134 135 if Assigned(fcupsHttp) then 136 httpClose(fcupsHttp); 137 138 inherited DoDestroy; 139end; 140 141procedure TCUPSPrinter.FreeOptions; 142begin 143 if Assigned(fcupsOptions) then 144 cupsFreeOptions(fcupsNumOpts,fcupsOptions); 145 146 fcupsNumOpts:=0; 147 fcupsOptions:=nil; 148 FStates := []; 149end; 150 151procedure TCUPSPrinter.cupsAddOption(aName,aValue: string); 152begin 153 if not CUPSLibInstalled then Exit; 154 fcupsNumOpts:=cupsdyn.cupsAddOption(PChar(aName),PChar(aValue),fcupsNumOpts, 155 @fcupsOptions); 156 if (AName='PageSize') then 157 begin 158 Exclude(FStates,cpsPaperNameValid); 159 Exclude(FStates,cpsPaperRectValid); 160 end; 161 162 {$IFDEF DebugCUPS} 163 DebugLn('TCUPSPrinter.cupsAddOption AName=%s AValue=%s',[AName,AValue]); 164 {$ENDIF} 165end; 166 167//Return the value of option set for the selected printer 168function TCUPSPrinter.cupsGetOption(aKeyWord: string): String; 169begin 170 Result:=''; 171 if not CUPSLibInstalled then Exit; 172 if (Printers.Count>0) then 173 begin 174 if not Assigned(fcupsOptions) then 175 SetOptionsOfPrinter; 176 177 Result:=cupsdyn.cupsGetOption(PChar(aKeyWord),fcupsNumOpts,fcupsOptions); 178 end; 179end; 180 181function TCUPSPrinter.CopyOptions(out AOptions: Pcups_option_t): Integer; 182var 183 i: Integer; 184begin 185 AOptions := nil; 186 Result := 0; 187 for i:=0 to fcupsNumOpts-1 do 188 Result := cupsdyn.cupsAddOption(fcupsOptions[i].name,fcupsOptions[i].value, 189 Result,@AOptions); 190end; 191 192procedure TCUPSPrinter.MergeOptions(const AOptions:Pcups_option_t; const n:Integer); 193var 194 i: Integer; 195begin 196 for i:=0 to n-1 do 197 if 198 // always merge some known options 199 (strcomp('job-sheets', AOptions[i].name)=0) or 200 // check if ppd option value is valid 201 IsOptionValueValid(AOptions[i].name, AOptions[i].value) 202 then 203 cupsAddOption(AOptions[i].name, AOptions[i].value); 204 cupsFreeOptions(n, AOptions); 205end; 206 207function TCUPSPrinter.GetResolutionOption: string; 208var 209 L1,L2: TStringlist; 210 i: Integer; 211begin 212 Result := Self.cupsGetOption('Resolution'); 213 if Result='' then 214 begin 215 // get resolution from ppd 216 Result := GetPPDAttribute('DefaultResolution'); 217 if Result='' then 218 begin 219 // try grouped options 220 L1 := TStringList.Create; 221 L2 := TStringList.Create; 222 try 223 i := EnumPPDChoice(L1,'Resolution',L2); 224 if i>=0 then 225 Result := L2[i] 226 finally 227 L2.Free; 228 L1.Free; 229 end; 230 end; 231 end; 232end; 233 234procedure TCUPSPrinter.DebugOptions(AOPtions:Pcups_option_t=nil; n:Integer=0); 235var 236 i: Integer; 237begin 238 if (Printers.Count>0) and CUPSLibInstalled and (fcupsPrinter<>nil) then 239 begin 240 DebugLn('**************************************************'); 241 if AOptions=nil then 242 begin 243 AOptions:= fcupsOptions; 244 n := fcupsNumOpts; 245 end; 246 DebugLn('Printer "%s" Number of Options %d',[fcupsPrinter^.Name,n]); 247 for i:=0 to n-1 do 248 DebugLn('name="%s" value="%s"',[AOptions[i].name,AOptions[i].value]); 249 DebugLn('**************************************************'); 250 end else 251 DebugLn('DebugOptions: There are no valid printers'); 252end; 253 254procedure TCUPSPrinter.DoCupsConnect; 255begin 256 if not assigned(fcupsHttp) then 257 begin 258 if not CUPSLibInstalled then Exit; 259 fcupsHttp:=httpConnect(cupsServer(),ippPort()); 260 if not Assigned(fcupsHttp) then 261 raise Exception.Create('Unable to contact server: '+GetLastError); 262 end; 263end; 264 265procedure TCUPSPrinter.DoCustomPaper; 266var 267 aSize: String; 268begin 269 // while the default canvas class is TCairoPsCanvas, this is not 270 // technically necessary, as the canvas setup the page size itself. 271 aSize := format('%s.%dx%d', [ CUPS_CUSTOM_PAPER, round(fCustomPaperWidth), 272 round(fCustomPaperHeight) ]); 273 cupsAddOption('PageSize', aSize); 274 {$IFDEF DebugCUPS} 275 DebugLn('Using CustomPaper ', aSize); 276 {$ENDIF} 277end; 278 279function TCUPSPrinter.CupsPapersListValid: boolean; 280var 281 Lst: TStringlist; 282begin 283 if fCupsPapersCount<=0 then begin 284 // paper list no exists or 285 // paper list is not enumerated yet, try it now. 286 Lst := TStringlist.Create; 287 try 288 DoEnumPapers(Lst); 289 finally 290 Lst.Free; 291 end; 292 end; 293 result := fCupsPapersCount>0; 294end; 295 296function TCUPSPrinter.InternalGetResolution(ForX: boolean): Integer; 297 298 procedure ParseResolution(s:string); 299 var 300 a,b: Integer; 301 begin 302 if s<>'' then begin 303 s := uppercase(s); 304 a := pos('X', S); 305 b := pos('D', S); 306 if b=0 then 307 b := Length(S) 308 else 309 dec(b); 310 if a>0 then begin 311 // NNNXMMMDPI (or NNN X MMM DPI) 312 FCachedResolution.x := StrToIntDef(trim(copy(S,1,a-1)), 0); 313 FCAchedResolution.y := StrToIntDef(trim(copy(S,a+1,b)), 0); 314 end else begin 315 // NNNDPI (or NNN DPI); 316 FCachedResolution.x := StrToIntDef(trim(copy(S,1,b)), 0); 317 FCachedResolution.y := FCachedResolution.x; 318 end; 319 end; 320 end; 321 322begin 323 if not (cpsResolutionValid in FStates) then begin 324 // check user defined resolution 325 FCachedResolution.x := 0; 326 FCachedResolution.y := 0; 327 328 ParseResolution(GetResolutionOption); 329 330 if (FCachedResolution.x=0) or (FCachedResolution.y=0) then 331 begin 332 FCachedResolution.x := 300; 333 FCachedResolution.y := 300; 334 end; 335 336 include(FStates, cpsResolutionValid); 337 end; 338 if ForX then 339 result := FCachedResolution.X 340 else 341 result := FCachedResolution.Y; 342end; 343 344{$IFDEF DebugCUPS} 345procedure TCUPSPrinter.DebugCapabilities; 346var 347 flags: Integer; 348 349 procedure DumpCap(const aFlag: integer; const flagMsg, Desc: string; invert: boolean=false); 350 begin 351 if (invert and (aFlag and Flags=0)) or (not invert and (aFlag and Flags<>0)) then 352 DebugLn(flagMsg, '(',Desc,')'); 353 end; 354begin 355 flags := GetAttributeInteger('printer-type',CUPS_PRINTER_LOCAL); 356 DebugLn('=== CAPABILITIES ==='); 357 DebugLn; 358 DumpCap(CUPS_PRINTER_CLASS or CUPS_PRINTER_REMOTE, 'CUPS_PRINTER_LOCAL ', 'Local printer or class ', true); 359 DumpCap(CUPS_PRINTER_CLASS , 'CUPS_PRINTER_CLASS ', 'Printer class '); 360 DumpCap(CUPS_PRINTER_REMOTE , 'CUPS_PRINTER_REMOTE ', 'Remote printer or class '); 361 DumpCap(CUPS_PRINTER_BW , 'CUPS_PRINTER_BW ', 'Can do B&W printing '); 362 DumpCap(CUPS_PRINTER_COLOR , 'CUPS_PRINTER_COLOR ', 'Can do color printing '); 363 DumpCap(CUPS_PRINTER_DUPLEX , 'CUPS_PRINTER_DUPLEX ', 'Can do duplexing '); 364 DumpCap(CUPS_PRINTER_STAPLE , 'CUPS_PRINTER_STAPLE ', 'Can staple output '); 365 DumpCap(CUPS_PRINTER_COPIES , 'CUPS_PRINTER_COPIES ', 'Can do copies '); 366 DumpCap(CUPS_PRINTER_COLLATE , 'CUPS_PRINTER_COLLATE ', 'Can collage copies '); 367 DumpCap(CUPS_PRINTER_PUNCH , 'CUPS_PRINTER_PUNCH ', 'Can punch output '); 368 DumpCap(CUPS_PRINTER_COVER , 'CUPS_PRINTER_COVER ', 'Can cover output '); 369 DumpCap(CUPS_PRINTER_BIND , 'CUPS_PRINTER_BIND ', 'Can bind output '); 370 DumpCap(CUPS_PRINTER_SORT , 'CUPS_PRINTER_SORT ', 'Can sort output '); 371 DumpCap(CUPS_PRINTER_SMALL , 'CUPS_PRINTER_SMALL ', 'Can do Letter/Legal/A4 '); 372 DumpCap(CUPS_PRINTER_MEDIUM , 'CUPS_PRINTER_MEDIUM ', 'Can do Tabloid/B/C/A3/A2 '); 373 DumpCap(CUPS_PRINTER_LARGE , 'CUPS_PRINTER_LARGE ', 'Can do D/E/A1/A0 '); 374 DumpCap(CUPS_PRINTER_VARIABLE , 'CUPS_PRINTER_VARIABLE ', 'Can do variable sizes '); 375 DumpCap(CUPS_PRINTER_IMPLICIT , 'CUPS_PRINTER_IMPLICIT ', 'Implicit class '); 376 DumpCap(CUPS_PRINTER_DEFAULT , 'CUPS_PRINTER_DEFAULT ', 'Default printer on network'); 377end; 378 379procedure TCUPSPrinter.DebugPPD; 380const 381 arruitypes:array[ppd_ui_t] of string[9] = ('boolean','pickone','pickmany'); 382 arrsection:array[ppd_section_t] of string[9] = ('any','document','exit','jcl','page','prolog'); 383var 384 i,j,k: Integer; 385 AttrRoot : Ppppd_attr_t; 386 Attr : Pppd_attr_t; 387 Group : pppd_group_t; 388 Option : Pppd_option_t; 389 choices : Pppd_choice_t; 390 391 function markchar(const AMark:char):char; 392 begin 393 if AMark=#1 then 394 result := '*' 395 else 396 result := ' '; 397 end; 398begin 399 DebugLn; 400 DebugLn('DebugPPD: ppdfile=',fCupsPPDName); 401 if fcupsPPD=nil then 402 begin 403 DebugLn('No valid ppd file found'); 404 exit; 405 end; 406 407 DebugLn('=== HEADER ==='); 408 DebugLn; 409 DebugLn(' model : %s', [fcupsPPD^.modelname]); 410 DebugLn(' modelNumber : %d', [fcupsPPD^.model_number]); 411 DebugLn(' manufacturer : %s', [fcupsPPD^.manufacturer]); 412 DebugLn(' nickname : %s', [fcupsPPD^.nickname]); 413 DebugLn(' shortnickname : %s', [fcupsPPD^.shortnickname]); 414 DebugLn(' product : %s', [fcupsPPD^.product]); 415 DebugLn(' attributes : %d Current=%d', [fcupsPPD^.num_attrs,fcupsPPD^.cur_attr]); 416 DebugLn(' language_level : %d', [fcupsPPD^.language_level]); 417 DebugLn(' lang_version : %s', [fcupsPPD^.lang_version]); 418 DebugLn(' lang_encoding : %s', [fcupsPPD^.lang_encoding]); 419 DebugLn(' landscape : %d', [fcupsPPD^.landscape]); 420 DebugLn(' UI groups : %d', [fcupsPPD^.num_groups]); 421 DebugLn(' Num Papers : %d', [fcupsPPD^.num_sizes]); 422 DebugLn(' Num Attributes : %d', [fcupsPPD^.num_attrs]); 423 DebugLn(' Num Constrains : %d', [fcupsPPD^.num_consts]); 424 DebugLn; 425 DebugLn('=== CUSTOM PAPER SUPPORT ==='); 426 DebugLn; 427 DebugLn(' Custom Min 0 : %.2f',[fcupsPPD^.custom_min[0]]); 428 DebugLn(' Custom Min 1 : %.2f',[fCupsPPD^.custom_min[1]]); 429 DebugLn(' Custom Max 0 : %.2f',[fcupsPPD^.custom_max[0]]); 430 DebugLn(' Custom Max 1 : %.2f',[fcupsPPD^.custom_max[1]]); 431 432 with fcupsPPD^ do 433 DebugLn(' Custom Margins : %.2f %.2f %.2f %.2f', 434 [custom_margins[0],custom_margins[1],custom_margins[2],custom_margins[3]]); 435 DebugLn; 436 if fcupsPPD^.num_groups>0 then 437 begin 438 DebugLn('=== GROUPS ==='); 439 i := 0; 440 Group := fCupsPPD^.groups; 441 while (Group<>nil) and (i<fcupsPPD^.num_groups) do 442 begin 443 DebugLn('Group %d Name="%s" Text="%s" Options=%d SubGroups=%d', 444 [i,Group^.name,Group^.text,Group^.num_options,Group^.num_subgroups]); 445 j := 0; 446 Option := group^.options; 447 while j< group^.num_options do 448 begin 449 with Option^ do 450 DebugLn(' Option %d Key="%s" Def="%s" Text="%s" UIType="%s" section="%s" Choices=%d', 451 [j,keyword,defchoice,text,arruitypes[ui],arrsection[section],num_choices]); 452 k := 0; 453 Choices := Option^.choices; 454 while k<Option^.num_choices do 455 begin 456 DebugLn(' Choice %2d %s Choice=%-20s Text="%s"', 457 [k,MarkChar(Choices^.marked),Choices^.Choice,Choices^.Text]); 458 inc(Choices); 459 inc(k); 460 end; 461 inc(Option); 462 inc(j); 463 end; 464 inc(Group); 465 inc(i); 466 end; 467 end; 468 469 DebugLn; 470 if fcupsPPD^.num_attrs>0 then 471 begin 472 DebugLn('=== Attributes ==='); 473 i := 0; 474 AttrRoot := fCupsPPD^.attrs; 475 while (AttrRoot<>nil) and (i<fcupsPPD^.num_attrs) do 476 begin 477 Attr := AttrRoot^; 478 if attr<>nil then 479 DebugLn(' i=%d Name=%s Spec=%s Value=%s',[i,Attr^.Name,Attr^.Spec,Attr^.Value]); 480 inc(i); 481 inc(AttrRoot); 482 end; 483 end; 484end; 485{$ENDIF} 486 487//Print the file aFileName with a selected printer and options 488function TCUPSPrinter.PrintFile(aFileName: String): longint; 489var 490 aPrinterName : string; 491begin 492 Result:=-1; 493 //debugln(['TCUPSPrinter.PrintFile START ',aFileName]); 494 if aFileName='' then 495 raise Exception.Create('TCUPSPrinter.PrintFile missing Filename'); 496 if not CUPSLibInstalled then Exit; 497 aFileName:=ExpandFileNameUTF8(aFileName); 498 499 if (Printers.Count>0) then 500 begin 501 if not Assigned(fcupsOptions) then 502 SetOptionsOfPrinter; 503 504 if Assigned(fcupsPrinter) then 505 aPrinterName:=fcupsPrinter^.Name 506 else 507 aPrinterName:=''; 508 509 {$IFDEF DebugCUPS} 510 DebugOptions; 511 debugln(['TCUPSPrinter.PrintFile aPrinterName="',aPrinterName,'" aFileName="',aFileName,'" Size=',FileSizeUtf8(aFileName)]); 512 {$ENDIF} 513 514 Result:=cupsdyn.cupsPrintFile(PChar(aPrinterName),PChar(aFileName), 515 PChar(Self.Title), 516 fcupsNumOpts,fcupsOptions); 517 end; 518end; 519 520function TCUPSPrinter.GetLastError: string; 521begin 522 Result:=ippErrorString(cupsdyn.cupsLastError()); 523end; 524 525function TCUPSPrinter.IsOptionValueValid(AKeyword, AValue: pchar): boolean; 526var 527 Option: pppd_option_t; 528 i: Integer; 529begin 530 result := false; 531 if (fcupsPrinter=nil) or (fcupsppd=nil) then 532 exit; 533 Option := ppdFindOption(fcupsppd, AKeyword); 534 if Option=nil then 535 exit; 536 537 i:=0; 538 while i<Option^.num_choices do 539 begin 540 if strcomp(Option^.choices[i].choice, AValue)=0 then 541 begin 542 result := true; 543 break; 544 end; 545 inc(i); 546 end; 547 548end; 549 550function TCUPSPrinter.PPDOptionChoiceFrom(OptionStr, aKeyOrValue: string; 551 IsKey:boolean): pppd_choice_t; 552var 553 i: Integer; 554 option: pppd_option_t; 555 p: pchar; 556begin 557 result := nil; 558 559 if (fcupsPrinter=nil) or (fcupsppd=nil) then 560 exit; 561 562 option := ppdFindOption(fcupsppd, pchar(OptionStr)); 563 if option=nil then 564 exit; 565 566 for i:=0 to option^.num_choices-1 do 567 begin 568 if IsKey then 569 p := @option^.choices[i].choice 570 else 571 p := @option^.choices[i].text; 572 if strcomp(p, pchar(aKeyOrValue))=0 then 573 begin 574 result := @option^.choices[i]; 575 break; 576 end; 577 end; 578end; 579 580 581//Set State of Job 582procedure TCUPSPrinter.SetJobState(aJobId : LongInt; aOp : ipp_op_t); 583var Request,R : Pipp_t; //IPP Request 584 Language : Pcups_lang_t; //Default Language 585 URI : Array[0..HTTP_MAX_URI] of Char; //Printer URI 586begin 587 if not CUPSLibInstalled then Exit; 588 if (Printers.Count>0) then 589 begin 590 if Assigned(fcupsPrinter) then 591 begin 592 R:=nil; 593 DoCupsConnect; 594 Request:=ippNew(); 595 Language:=cupsLangDefault(); 596 597 ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_CHARSET, 598 'attributes-charset', '', cupsLangEncoding(language)); 599 600 ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_LANGUAGE, 601 'attributes-natural-language', '', Language^.language); 602 603 URI:=Format('http://%s:%d/jobs/%d',[cupsServer,ippPort,aJobId]); 604 605 ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_URI,'job-uri','',URI); 606 ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_NAME,'requesting-user-name','',cupsUser()); 607 608 Request^.request.op.operation_id := aOp; 609 Request^.request.op.request_id := 1; 610 611 //Do the request and get back a response... 612 R:=cupsDoRequest(fcupsHttp, Request, '/jobs/'); 613 if Assigned(R) then 614 begin 615 if (R^.request.status.status_code>IPP_OK_CONFLICT) then 616 ippDelete(R); 617 end; 618 end; 619 end; 620end; 621 622function TCUPSPrinter.GetCupsRequest : Pipp_t; 623var Request : Pipp_t; //IPP Request 624 Language : Pcups_lang_t; //Default Language 625 URI : Array[0..HTTP_MAX_URI] of Char; //Printer URI 626begin 627 Result:=Nil; 628 if not CUPSLibInstalled then Exit; 629 if (Printers.Count>0) then 630 begin 631 if Assigned(fcupsPrinter) then 632 begin 633 DoCupsConnect; 634 Request:=ippNew(); 635 {Build an IPP_GET_PRINTER_ATTRIBUTES request, 636 which requires the following attributes: 637 attributes-charset 638 attributes-natural-language 639 printer-uri} 640 Request^.request.op.operation_id := IPP_GET_PRINTER_ATTRIBUTES; 641 Request^.request.op.request_id := 1; 642 Language:=cupsLangDefault; 643 644 ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_CHARSET, 645 'attributes-charset', '', cupsLangEncoding(language)); 646 647 ippAddString(Request, IPP_TAG_OPERATION, IPP_TAG_LANGUAGE, 648 'attributes-natural-language', '', Language^.language); 649 650 // or this syntax >> 651 //URI:=Format('http://%s:%d/printers/%s',[cupsServer,ippPort,fcupsPrinter^.name]); 652 URI:=Format('ipp://localhost/printers/%s',[fcupsPrinter^.name]); 653 ippAddString(Request,IPP_TAG_OPERATION,IPP_TAG_URI,'printer-uri','',URI); 654 655 //Do the request and get back a response... 656 Result:=cupsDoRequest(fcupsHttp, Request, '/'); 657 if Assigned(Result) then 658 begin 659 if (Result^.request.status.status_code>IPP_OK_CONFLICT) then 660 begin 661 ippDelete(Result); 662 Result:=nil; 663 end; 664 end; 665 end; 666 end; 667end; 668 669//Initialize the options with the default options of selected printer 670procedure TCUPSPrinter.SetOptionsOfPrinter; 671Var Opts : Pcups_option_t; 672 Opt : Pcups_option_t; 673 i : Integer; 674begin 675 //if not CUPSLibInstalled then 676 Exit; 677 if (Printers.Count>0) then 678 begin 679 if Assigned(fcupsPrinter) then 680 begin 681 Opts := fcupsPrinter^.Options; 682 for i:=0 to fcupsPrinter^.num_options-1 do 683 begin 684 Opt:=@Opts[i]; 685 cupsAddOption(Opt^.Name,Opt^.Value); 686 end; 687 end; 688 end; 689end; 690 691//Enum all options associed with aKeyWord 692function TCUPSPrinter.EnumPPDChoice(Lst : TStrings; 693 const aKeyWord : string; OptNames: TStrings = nil) : Integer; 694var i : integer; 695 Option : Pppd_option_t; 696 Choice : Pppd_choice_t; 697begin 698 Result:=-1; 699 if not CUPSLibInstalled then Exit; 700 if not Assigned(Lst) then Exit; 701 Lst.Clear; 702 703 if (Printers.Count>0) then 704 begin 705 if Assigned(fcupsPrinter) then 706 begin 707 if Assigned(fcupsPPD) then 708 begin 709 Option:=nil; 710 Option:=ppdFindOption(fcupsPPD,PChar(aKeyWord)); 711 712 If Assigned(Option) then 713 begin 714 for i:=0 to Option^.num_choices-1 do 715 begin 716 Choice:=@Option^.choices[i]; 717 if Choice^.marked=#1 then 718 Result:=i; 719 720 Lst.Add(Choice^.text); 721 if Assigned(OptNames) then 722 OptNames.Add(Choice^.choice); 723 end; 724 725 //Not marked choice then the choice is default 726 if (Result<0) and (Lst.Count>0) then begin 727 Result:=Lst.IndexOf(OPtion^.defchoice); 728 if (Result<0)and Assigned(OptNames) then 729 Result := OptNames.IndexOf(Option^.DefChoice); 730 end; 731 end; 732 end; 733 end; 734 end; 735end; 736 737function TCUPSPrinter.GetPPDAttribute(const aName: string): string; 738var 739 i : integer; 740 AttrRoot : PPppd_attr_t; 741 Attr : Pppd_attr_t; 742begin 743 Result:=''; 744 if not CUPSLibInstalled then 745 Exit; 746 747 if (Printers.Count>0) and (fcupsPrinter<>nil) and (fcupsPPD<>nil) then 748 begin 749 i := 0; 750 AttrRoot := fCupsPPD^.attrs; 751 while (AttrRoot<>nil) and (i<fcupsPPD^.num_attrs) do 752 begin 753 Attr := AttrRoot^; 754 if attr<>nil then 755 begin 756 if (StrComp(pchar(AName), Attr^.name)=0) then 757 begin 758 result := attr^.value; 759 break; 760 end; 761 end; 762 inc(i); 763 inc(AttrRoot); 764 end; 765 end; 766end; 767 768procedure TCUPSPrinter.GetEnumAttributeString(aName: PChar; Lst: TStrings); 769var 770 Reponse : Pipp_t; //IPP Reponse 771 Attribute : Pipp_attribute_t; //Current attribute 772 i : Integer; 773begin 774 if not assigned(Lst) then 775 raise Exception.Create('Lst must be assigned'); 776 if not CUPSLibInstalled then begin 777 DebugLn(['TCUPSPrinter.GetEnumAttributeString CUPSLibInstalled not installed']); 778 Exit; 779 end; 780 781 Reponse:=GetCupsRequest; 782 if not Assigned(Reponse) then begin 783 DebugLn(['TCUPSPrinter.GetEnumAttributeString no Response']); 784 end else begin 785 try 786 Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO); 787 if Assigned(Attribute) then begin 788 for i:=0 to Attribute^.num_values-1 do 789 begin 790 if Attribute^.value_tag=IPP_TAG_INTEGER then 791 Lst.add(IntToStr(Pipp_value_t(@Attribute^.values)[i].aInteger)) 792 else 793 Lst.add(Pipp_value_t(@Attribute^.values)[i]._string.text); 794 end; 795 end else begin 796 DebugLn(['TCUPSPrinter.GetEnumAttributeString Attribute not found: ',aName]); 797 end; 798 finally 799 ippDelete(Reponse); 800 end; 801 end; 802end; 803 804function TCUPSPrinter.GetAttributeInteger(aName: PChar; DefaultValue : Integer): Integer; 805var 806 Reponse : Pipp_t; //IPP Reponse 807 Attribute : Pipp_attribute_t; //Current attribute 808begin 809 Result:=DefaultValue; 810 if not CUPSLibInstalled then Exit; 811 812 Reponse:=GetCupsRequest; 813 if Assigned(Reponse) then 814 begin 815 try 816 Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO); 817 if Assigned(Attribute) then 818 Result:=Attribute^.values[0].aInteger; 819 finally 820 ippDelete(Reponse); 821 end; 822 end; 823end; 824 825function TCUPSPrinter.GetAttributeString(aName: PChar; 826 const DefaultValue : string): string; 827var 828 Reponse : Pipp_t; //IPP Reponse 829 Attribute : Pipp_attribute_t; //Current attribute 830begin 831 Result:=DefaultValue; 832 if not CUPSLibInstalled then Exit; 833 Reponse:=GetCupsRequest; 834 if Assigned(Reponse) then 835 begin 836 try 837 Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO); 838 if Assigned(Attribute) then 839 Result:=Attribute^.values[0]._string.text 840 else begin 841 DebugLn(['TCUPSPrinter.GetAttributeString failed: aName="',aName,'"']); 842 end; 843 finally 844 ippDelete(Reponse); 845 end; 846 end; 847end; 848 849function TCUPSPrinter.GetAttributeBoolean(aName: PChar; 850 DefaultValue : Boolean): Boolean; 851var 852 Reponse : Pipp_t; //IPP Reponse 853 Attribute : Pipp_attribute_t; //Current attribute 854begin 855 Result:=DefaultValue; 856 if not CUPSLibInstalled then Exit; 857 Reponse:=GetCupsRequest; 858 if Assigned(Reponse) then 859 begin 860 try 861 Attribute:=ippFindAttribute(Reponse,aName, IPP_TAG_ZERO); 862 if Assigned(Attribute) then 863 Result:=(Attribute^.values[0].aBoolean=#1); 864 finally 865 ippDelete(Reponse); 866 end; 867 end; 868end; 869 870//Override this methode for assign an 871//file name at Canvas 872procedure TCUPSPrinter.DoBeginDoc; 873var 874 NewPath: String; 875 fs: TFileStream; 876 877 function TryTemporaryPath(const Path: string): Boolean; 878 var 879 CurPath: String; 880 begin 881 Result:=false; 882 CurPath:=CleanAndExpandDirectory(Path); 883 if CurPath='' then exit(false); 884 if not DirectoryIsWritable(CurPath) then exit; 885 NewPath:=CurPath; 886 Result:=true; 887 end; 888 889begin 890 if FBeginDocCount>0 then 891 raise Exception.Create('TCUPSPrinter.DoBeginDoc already called. Maybe you forgot an EndDoc?'); 892 inherited DoBeginDoc; 893 inc(FBeginDocCount); 894 895 if (not TryTemporaryPath('~/tmp/')) 896 and (not TryTemporaryPath('/tmp/')) 897 and (not TryTemporaryPath('/var/tmp/')) then 898 NewPath:=''; 899 900 FOutputFileName := AppendPathDelim(NewPath)+ 901 'OutPrinter_'+FormatDateTime('yyyymmmddd-hhnnss',Now); 902 903 if RawMode then 904 FOutputFileName := FOutputFileName + '.raw' 905 else begin 906 FOutputFileName := FOutputFileName + '.ps'; 907 TFilePrinterCanvas(Canvas).OutputFileName := FOutputFileName; 908 end; 909 910 // test writing, on error this raises exception showing the user the filename 911 fs:=TFileStream.Create(FOutputFilename,fmCreate); 912 try 913 fs.Write(FOutputFilename[1],1); 914 finally 915 fs.free; 916 end; 917 DeleteFileUTF8(FOutputFilename); 918end; 919 920//If not aborted, send PostScript file to printer. 921//After, delete this file. 922procedure TCUPSPrinter.DoEndDoc(aAborted: Boolean); 923var 924 CupsResult: LongInt; 925begin 926 inherited DoEndDoc(aAborted); 927 dec(FBeginDocCount); 928 Exclude(FStates,cpsPaperRectValid); 929 930 if RawMode then begin 931 932 if not aAborted and (FRawModeStream<>nil) 933 and (FRawModeStream.Size>0) then 934 begin 935 try 936 FRawModeStream.SaveToFile(FOutputFileName); 937 finally 938 FRawModeStream.Clear; 939 end; 940 end; 941 942 end else 943 TFilePrinterCanvas(Canvas).OutputFileName:=''; 944 945 if not aAborted then begin 946 if not FileExistsUTF8(FOutputFileName) then 947 raise Exception.Create('Unable to write to "'+FOutputFileName+'"'); 948 {$IFDEF LogPrintoutFile} 949 CopyFile(FOutputFileName, 'printjob'+ExtractFileExt(FOutputFileName)); 950 {$ENDIF} 951 try 952 {$IFNDEF DoNotPrint} 953 if Filename<>'' then 954 CopyFile(FOutputFileName, FileName) 955 else begin 956 CupsResult:=PrintFile(FOutputFileName); 957 if CupsResult<=0 then 958 raise Exception.Create('CUPS printing: '+GetLastError); 959 end; 960 {$ENDIF} 961 finally 962 DeleteFileUTF8(FOutputFilename); 963 end; 964 end; 965end; 966 967procedure TCUPSPrinter.DoNewPage; 968begin 969 // just to flag that we want the old 'newpage' pagination way 970 // instead of the new 'beginpage/endpage' 971end; 972 973procedure TCUPSPrinter.DoResetPrintersList; 974begin 975 if Assigned(fcupsPPD) then 976 begin 977 ppdClose(fcupsPPD); 978 fcupsPPD:=nil; 979 end; 980 981 if fcupsPPDName<>'' then 982 begin 983 DeleteFileUTF8(fcupsPPDName); 984 fcupsPPDName:=''; 985 end; 986 987 FreeOptions; 988 if Assigned(fcupsPrinters) and CUPSLibInstalled then begin 989 cupsFreeDests(Printers.Count,fcupsPrinters); 990 fCupsPrinter := nil; 991 end; 992 993 inherited DoResetPrintersList; 994end; 995 996procedure TCUPSPrinter.DoEnumPrinters(Lst: TStrings); 997Var i,Num : Integer; 998 P : Pcups_dest_t; 999begin 1000 inherited DoEnumPrinters(Lst); 1001 {$IFDEF NOPRINTERS} 1002 Lst.Clear; 1003 Exit; 1004 {$ENDIF} 1005 if not CUPSLibInstalled then Exit; 1006 1007 Num:=cupsGetDests(@fcupsPrinters); 1008 For i:=0 to Num-1 do 1009 begin 1010 P:=nil; 1011 P:=@fcupsPrinters[i]; 1012 if Assigned(P) then 1013 begin 1014 if P^.is_default<>0 then 1015 Lst.Insert(0,P^.name) 1016 else 1017 Lst.Add(P^.name); 1018 end; 1019 end; 1020end; 1021 1022procedure TCUPSPrinter.DoEnumPapers(Lst: TStrings); 1023var 1024 choice: Pppd_choice_t; 1025 Option: Pppd_option_t; 1026 c: Integer; 1027begin 1028 //DebugLn(['TCUPSPrinter.DoEnumPapers ',dbgsName(Self)]); 1029 1030 //TODO: note that we are returning here the list of paper "keys" 1031 // not the human readable paper names. Modify cups support 1032 // to return human readable paper names. 1033 1034 Lst.Clear; 1035 FCupsDefaultPaper := ''; 1036 if CupsPPD<>nil then 1037 begin 1038 Option := ppdFindOption(CupsPPD, PChar('PageSize')); 1039 Choice := Option^.choices; 1040 fCupsDefaultPaper := Option^.defchoice; 1041 c := 0; 1042 while (Choice<>nil) and (c<Option^.num_choices) do 1043 begin 1044 lst.AddObject(Choice^.Choice, TObject(Choice)); 1045 inc(choice); 1046 inc(c); 1047 end; 1048 end; 1049 1050 fCupsPapersCount := lst.Count; 1051end; 1052 1053function TCUPSPrinter.DoSetPrinter(aName: string): Integer; 1054Var i : Integer; 1055 P : Pcups_dest_t; 1056 Fn : String; 1057begin 1058 //debugln('TCUPSPrinter.DoSetPrinter aName="',aName,'"'); 1059 Result:=inherited DoSetPrinter(aName); 1060 if not CUPSLibInstalled then Exit; 1061 //debugln('TCUPSPrinter.DoSetPrinter B Printers.Count=',dbgs(Printers.Count)); 1062 1063 //Set the current printer. If aName='' then use a default Printer (index 0) 1064 If (Printers.Count>0) then 1065 begin 1066 if (aName<>'') and Assigned(fcupsPPD) then 1067 begin 1068 //Printer changed ? 1069 i:=Printers.IndexOf(aName); 1070 if i=PrinterIndex then 1071 begin 1072 Result:=PrinterIndex; 1073 //debugln('TCUPSPrinter.DoSetPrinter no change'); 1074 Exit; 1075 end; 1076 end; 1077 1078 //Clear all existing options 1079 FreeOptions; 1080 1081 if Assigned(fcupsPPD) then 1082 begin 1083 ppdClose(fcupsPPD); 1084 fcupsPPD:=nil; 1085 1086 if fcupsPPDName<>'' then 1087 begin 1088 DeleteFileUTF8(fcupsPPDName); 1089 fcupsPPDName:=''; 1090 end; 1091 end; 1092 1093 1094 if aName='' then 1095 i:=0 1096 else 1097 i:=Printers.IndexOf(aName); 1098 1099 if i>-1 then 1100 begin 1101 Result:=i; 1102 1103 P:=nil; 1104 P:=cupsGetDest(PChar(aName),nil,Printers.Count,fcupsPrinters); 1105 if not Assigned(P) then 1106 raise Exception.Create(Format('"%s" is not a valid printer.',[aName])); 1107 fcupsPrinter:=P; 1108 1109 //Open linked ppdfile 1110 Fn:=cupsGetPPD(PChar(aName)); 1111 fcupsPPD:=ppdOpenFile(PChar(Fn)); 1112 fcupsPPDName:=Fn; 1113 {$IFDEF DebugCUPS} 1114 DebugPPD; 1115 DebugCapabilities; 1116 {$ENDIF} 1117 end; 1118 end 1119 else 1120 begin 1121 PrinterIndex:=-1; 1122 fcupsPPD:=nil; 1123 end; 1124end; 1125 1126function TCUPSPrinter.DoGetCopies: Integer; 1127begin 1128 if not (cpsCopiesValid in FStates) then begin 1129 fCachedCopies:=inherited DoGetCopies; 1130 1131 //Get default value if defined 1132 fCachedCopies:=GetAttributeInteger('copies-default',fCachedCopies); 1133 //Get Copies in options or return default value 1134 fCachedCopies:=StrToIntdef(cupsGetOption('copies'),fCachedCopies); 1135 {$IFDEF UseCache} 1136 Include(FStates,cpsCopiesValid); 1137 {$ENDIF} 1138 end; 1139 Result:=fCachedCopies; 1140end; 1141 1142procedure TCUPSPrinter.DoSetCopies(aValue: Integer); 1143var i : Integer; 1144begin 1145 {$IFDEF UseCache} 1146 if aValue=DoGetCopies then exit; 1147 Exclude(FStates,cpsCopiesValid); 1148 {$ENDIF} 1149 inherited DoSetCopies(aValue); 1150 1151 if Printers.Count>0 then 1152 begin 1153 if not Assigned(fcupsOptions) then 1154 SetOptionsOfPrinter; 1155 i:=aValue; 1156 if i<1 then i:=1; 1157 cupsAddOption('copies',IntToStr(i)); 1158 end; 1159end; 1160 1161function TCUPSPrinter.DoGetOrientation: TPrinterOrientation; 1162var i : Integer; 1163begin 1164 if not (cpsOrientationValid in FStates) then begin 1165 if Printers.Count>0 then 1166 begin 1167 //Default orientation value 1168 i:=GetAttributeInteger('orientation-requested-default',3); 1169 // check if rotation is automatic or out-of-range 1170 if not (i in [3,4,5,6]) then 1171 i:=3; // yep, then for us this means portait 1172 fCachedOrientation:=TPrinterOrientation(i-3); 1173 end; 1174 Include(FStates,cpsOrientationValid); 1175 end; 1176 Result:=fCachedOrientation; 1177 {$IFDEF DebugCUPS} 1178 DebugLn('DoGetOrientation: result=%d',[ord(Result)]); 1179 {$ENDIF} 1180end; 1181 1182procedure TCUPSPrinter.DoSetOrientation(aValue: TPrinterOrientation); 1183begin 1184 if aValue=DoGetOrientation then 1185 exit; 1186 Exclude(FStates,cpsPaperRectValid); 1187 inherited DoSetOrientation(aValue); 1188 fcachedOrientation := AValue; 1189 Include(FStates,cpsOrientationValid); 1190end; 1191 1192function TCUPSPrinter.DoGetDefaultPaperName: string; 1193begin 1194 if not (cpsDefaultPaperNameValid in FStates) then begin 1195 fCachedGetDefaultPaperName:=''; 1196 if not CupsPapersListValid then 1197 FCachedGetDefaultPaperName:=PaperSize.DefaultPaperName 1198 else begin 1199 if FCupsDefaultPaper<>'' then 1200 fCachedGetDefaultPaperName:= FCupsDefaultPaper 1201 else 1202 fCachedGetDefaultPaperName:= 1203 GetAttributeString('media-default',fCachedGetDefaultPaperName); 1204 {$IFDEF UseCache} 1205 Include(FStates,cpsDefaultPaperNameValid); 1206 {$ENDIF} 1207 end; 1208 end; 1209 Result:=fCachedGetDefaultPaperName; 1210end; 1211 1212function TCUPSPrinter.DoGetPaperName: string; 1213begin 1214 if cpsCustomPaperValid in FStates then begin 1215 result := CUPS_CUSTOM_PAPER; 1216 exit; 1217 end; 1218 if not (cpsPaperNameValid in FStates) then begin 1219 // paper is not yet retrieved for first time 1220 // first try to see if there is a list of papers available 1221 if not CupsPapersListValid then 1222 FCachedPaperName := PaperSize.PaperName 1223 else begin 1224 fCachedPaperName := cupsGetOption('PageSize'); 1225 {$IFDEF UseCache} 1226 Include(FStates,cpsPaperNameValid); 1227 {$ENDIF} 1228 end; 1229 end; 1230 Result:=fCachedPaperName; 1231end; 1232 1233procedure TCUPSPrinter.DoSetPaperName(aName: string); 1234begin 1235 if (aName=CUPS_CUSTOM_PAPER) and (cpsCustomPaperValid in FStates) then begin 1236 DoCustomPaper; 1237 exit; 1238 end; 1239 1240 {$IFDEF UseCache} 1241 if aName=DoGetPaperName then exit; 1242 Exclude(FStates,cpsPaperNameValid); 1243 {$ENDIF} 1244 inherited DoSetPaperName(aName); 1245 1246 if FCupsPapersCount<=0 then 1247 PaperSize.PaperName:=AName 1248 else begin 1249 Exclude(Fstates, cpsCustomPaperValid); 1250 cupsAddOption('PageSize',aName) 1251 end; 1252end; 1253 1254//Initialise aPaperRc with the aName paper rect 1255//Result : -1 no result 1256// 0 aPaperRc.WorkRect is a margins 1257// 1 aPaperRc.WorkRect is really the work rect 1258function TCUPSPrinter.DoGetPaperRect(aName: string; 1259 var aPaperRc: TPaperRect): Integer; 1260 1261var 1262 P : Pppd_size_t; 1263 Ky,Kx: Double; 1264begin 1265 if (aName=CUPS_CUSTOM_PAPER) and (cpsCustomPaperValid in FStates) then begin 1266 aPaperRc.PhysicalRect.Left := 0; 1267 aPaperRc.PhysicalRect.Top := 0; 1268 aPaperRc.PhysicalRect.Right := round(fCustomPaperWidth*Printer.XDPI/72); 1269 aPaperRc.PhysicalRect.Bottom := round(fCustomPaperHeight*Printer.YDPI/72); 1270 aPaperRc.WorkRect := aPaperRc.PhysicalRect; 1271 result := 0; 1272 exit; 1273 end; 1274 1275 if (not (cpsPaperRectValid in FStates)) or 1276 (fCachePaperRectName<>aName) then 1277 begin 1278 fCachePaperRectName:=aName; 1279 FillChar(fCachePaperRect,SizeOf(fCachePaperRect),0); 1280 fCachePaperRectResult:=inherited DoGetPaperRect(aName, aPaperRc); 1281 {$IFDEF UseCache} 1282 Include(FStates,cpsPaperRectValid); 1283 {$ENDIF} 1284 1285 P:=nil; 1286 if CUPSLibInstalled and Assigned(fcupsPPD) then 1287 begin 1288 P:=ppdPageSize(fcupsPPD,PChar(aName)); 1289 if Assigned(P) then 1290 begin 1291 fCachePaperRectResult:=1; //CUPS return margins 1292 1293 // Margins. 1294 // 1295 // Cups gives dimensions based on postcript language 1296 // user space coordinates system which is something like 1297 // 1298 // +y +--> +x 1299 // ^ but our system is | 1300 // | v 1301 // +--> +x +y 1302 // 1303 // so values in x are the same, but we need to invert values in y, 1304 // the given bottom value is the margin size at the bottom, we need 1305 // to re-calc. our bottom offset, and the given top value is offset 1306 // top value of imageable area, we need to re-calc. our top offset, 1307 // which is the margin size at the top of the page. 1308 // 1309 // The current implementation assumes that paper is fed short-edge-first 1310 // either in portrait orientation, or in landscape orientation. 1311 // 1312 // In landscape orientation, printable margins should preserved. 1313 // It's based on a 90 degree counterclock wise paper rotation 1314 // 1315 // FEED DIRECTION FEED DIRECTION 1316 // 1317 // /\ /\ 1318 // / \ / \ 1319 // || || 1320 // || || 1321 // 1322 // PORTRAIT LANDSCAPE 1323 // +-----------------+ +-----------------+ 1324 // | t | | t | 1325 // | +---------+ | | +---------+ | 1326 // | | ( ) | | | | | / | | 1327 // | l | --+-- | r | | l |()-+--- | r | 1328 // | | / \ | | | | | \ | | 1329 // | +---------+ | | +---------+ | 1330 // | b | | b | 1331 // +-----------------+ +-----------------+ 1332 // 1333 // REVERSE PORTRAIT REVERSE LANDSCAPE 1334 // +-----------------+ +-----------------+ 1335 // | t | | t | 1336 // | +---------+ | | +---------+ | 1337 // | | \ / | | | | \ | | | 1338 // | l | --+-- | r | | l | ---+-()| r | 1339 // | | ( ) | | | | / | | | 1340 // | +---------+ | | +---------+ | 1341 // | b | | b | 1342 // +-----------------+ +-----------------+ 1343 // 1344 Kx := Printer.XDPI/72; 1345 Ky := Printer.YDPI/72; 1346 if Orientation in [poPortrait, poReversePortrait] then begin 1347 fCachePaperRect.PhysicalRect.Right:=Round(P^.Width*Kx); 1348 fCachePaperRect.PhysicalRect.Bottom:=Round(P^.Length*Ky); 1349 fCachePaperRect.WorkRect.Left:=Round(P^.Left*Kx); 1350 fCachePaperRect.WorkRect.Right:=Round(P^.Right*Kx); 1351 fCachePaperRect.WorkRect.Top:=Round((P^.Length-P^.Top)*Ky); 1352 fCachePaperRect.WorkRect.Bottom:=Round((P^.Length-P^.Bottom)*Ky); 1353 end else begin 1354 FCachePaperRect.PhysicalRect.Right:=Round(P^.Length*Kx); 1355 FCachePaperRect.PhysicalRect.Bottom:=Round(P^.Width*Ky); 1356 FCachePaperRect.WorkRect.Left:=Round((P^.Length-P^.Top)*Kx); 1357 FCachePaperRect.WorkRect.Right:=Round((P^.Length-P^.Bottom)*Kx); 1358 FCachePaperRect.WorkRect.Top:=Round((P^.Width-P^.Right)*Ky); 1359 FCachePaperRect.WorkRect.Bottom:=Round((p^.width - P^.left)*Ky); 1360 end; 1361 1362 {$IFDEF DebugCUPS} 1363 with P^ do 1364 DebugLn('ORG: Width=%f Length=%f Left=%f Right=%f Top=%f Bottom=%f Name=%s', 1365 [Width,Length,Left,Right,Top,Bottom,string(Name)]); 1366 with FCachePaperRect do 1367 DebugLn('NEW: Width=%d Length=%d Left=%d Top=%d Right=%d Bottom=%d ml=%d mt=%d mr=%d mb=%d', 1368 [PhysicalRect.Right,PhysicalRect.Bottom,WorkRect.Left,WorkRect.Top,WorkRect.Right,WorkRect.Bottom, 1369 WorkRect.Left,WorkRect.Top,PhysicalRect.Right-WorkRect.Right, 1370 PhysicalRect.Bottom-WorkRect.Bottom]); 1371 {$ENDIF} 1372 end; 1373 end; 1374 1375 if P=nil then begin 1376 FCachePaperRect := PaperSize.PaperRectOf[AName]; 1377 fCachePaperRectResult:=1 1378 end; 1379 1380 end; 1381 Result:=fCachePaperRectResult; 1382 aPaperRc:=fCachePaperRect; 1383end; 1384 1385function TCUPSPrinter.DoSetPaperRect(aPaperRc: TPaperRect): boolean; 1386begin 1387 result := CUPSLibInstalled; 1388 if result then 1389 begin 1390 Include(fStates, cpsCustomPaperValid); 1391 fCustomPaperWidth := aPaperRC.PhysicalRect.Width * 72 / Printer.XDPI; 1392 fCustomPaperHeight := aPaperRC.PhysicalRect.Height * 72 / Printer.YDPI; 1393 DoCustomPaper; 1394 {$IFDEF DebugCUPS} 1395 DebugLn('CUPS: custom paper width=%dpx %4.1fpt %3.0fmm height=%dpx %4.1fpt %3.0fmm', 1396 [aPaperRC.PhysicalRect.Width, 1397 fCustomPaperWidth, fCustomPaperWidth*25.4/72, 1398 aPaperRC.PhysicalRect.Height, 1399 fCustomPaperHeight, fCustomPaperHeight*25.4/72 1400 ]); 1401 {$ENDIF} 1402 end; 1403end; 1404 1405function TCUPSPrinter.DoGetPrinterState: TPrinterState; 1406var //Request : Pipp_t; //IPP Request 1407 //Reponse : Pipp_t; //IPP Reponse 1408 //Attribute : Pipp_attribute_t; //Current attribute 1409 //Language : Pcups_lang_t; //Default Language 1410 aState : ipp_pstate_t; //Printer state 1411 //URI : Array[0..HTTP_MAX_URI] of Char; //Printer URI 1412begin 1413 Result:=inherited DoGetPrinterState; 1414 1415 aState:=ipp_pstate_t(GetAttributeInteger('printer-state',0)); 1416 Case aState of 1417 IPP_PRINTER_IDLE : Result:=psReady; 1418 IPP_PRINTER_PROCESSING : Result:=psPrinting; 1419 IPP_PRINTER_STOPPED : Result:=psStopped; 1420 end; 1421end; 1422 1423function TCUPSPrinter.DoGetDefaultCanvasClass: TPrinterCanvasRef; 1424begin 1425 {$IFDEF UseCairo} 1426 Result := TCairoPsCanvas; 1427 {$ELSE} 1428 Result := TPostscriptPrinterCanvas; 1429 {$ENDIF} 1430end; 1431 1432function TCUPSPrinter.GetPrinterType: TPrinterType; 1433Var i : Integer; 1434begin 1435 Result:=inherited GetPrinterType; 1436 i:=GetAttributeInteger('printer-type',CUPS_PRINTER_LOCAL); 1437 If (i and CUPS_PRINTER_REMOTE)=CUPS_PRINTER_REMOTE then 1438 Result:=ptNetWork; 1439end; 1440 1441function TCUPSPrinter.GetCanPrint: Boolean; 1442begin 1443 Result:=inherited GetCanPrint; 1444 Result:=GetAttributeBoolean('printer-is-accepting-jobs',Result) 1445end; 1446 1447initialization 1448 if Assigned(Printer) then 1449 Printer.Free; 1450 1451 Printer:=TCUPSPrinter.Create; 1452 1453FINALIZATION 1454 // Free the printer before unloading library 1455 Printer.Free; 1456 Printer:=nil; 1457 //Unload CUPSLib if loaded 1458 FinalizeCups; 1459 1460END. 1461 1462