1{%MainUnit ../osprinters.pas} 2{************************************************************** 3Implementation for carbonprinter 4***************************************************************} 5Uses InterfaceBase, LCLIntf, CarbonProc, LCLProc, dl; 6 7 8{ TCarbonPrinterContext } 9 10function TCarbonPrinterContext.GetSize: TPoint; 11var 12 R: PMRect; 13begin 14 Result.X := 0; 15 Result.Y := 0; 16 17 if Printer = nil then Exit; 18 R:=CleanPMRect; 19 if OSError(PMGetAdjustedPaperRect((Printer as TCarbonPrinter).PageFormat, R), 20 Self, 'GetSize', 'PMGetUnadjustedPaperRect') then Exit; 21 22 Result.X := Round(R.right - R.left); 23 Result.Y := Round(R.bottom - R.top); 24end; 25 26procedure TCarbonPrinterContext.Release; 27begin 28 // redirect drawing to dummy context when not able printing page 29 CGContext := DefaultContext.CGContext; 30end; 31 32procedure TCarbonPrinterContext.Reset; 33begin 34 inherited Reset; 35 36 if CGContext <> nil then 37 begin 38 // flip and offset CTM from lower to upper left corner 39 CGContextTranslateCTM(CGContext, 0, GetSize.Y); 40 CGContextScaleCTM(CGContext, 1, -1); 41 end; 42end; 43 44{ TCarbonPrinter } 45 46procedure TCarbonPrinter.CreatePrintSession; 47begin 48 if OSError(PMCreateSession(FPrintSession), Self, 'GetPrintSession', 'PMCreateSession') then 49 raise EPrinter.Create('Error initializing printing for Carbon: Unable to create print session!'); 50end; 51 52procedure TCarbonPrinter.CreatePrintSettings; 53const 54 SName = 'CreatePrintSettings'; 55begin 56 if OSError(PMCreatePrintSettings(FPrintSettings), Self, SName, 'PMCreatePrintSettings') then 57 raise EPrinter.Create('Error initializing printing for Carbon: Unable to create print settings!'); 58 59 OSError(PMSessionDefaultPrintSettings(PrintSession, FPrintSettings), Self, SName, 'PMSessionDefaultPrintSettings'); 60end; 61 62function TCarbonPrinter.CreatePageFormat(APaper: String): PMPageFormat; 63var 64 I: Integer; 65 S: TStringList; 66const 67 SName = 'CreatePageFormat'; 68begin 69 if APaper = '' then 70 begin 71 I := -1; 72 S := nil; 73 end 74 else 75 begin 76 S := TStringList.Create; 77 BeginEnumPapers(S); 78 I := S.IndexOf(APaper); 79 end; 80 81 try 82 if I < 0 then 83 begin 84 Result:=nil; 85 if OSError(PMCreatePageFormat(Result), Self, SName, 'PMCreatePageFormat') then 86 raise EPrinter.Create('Error initializing printing for Carbon: Unable to create page format!'); 87 88 OSError(PMSessionDefaultPageFormat(PrintSession, Result), Self, SName, 'PMSessionDefaultPageFormat'); 89 end 90 else 91 begin 92 OSError(PMCreatePageFormatWithPMPaper(Result, 93 PMPaper(CFArrayGetValueAtIndex(FPaperArray, I))), 94 Self, SName, 'PMCreatePageFormatWithPMPaper'); 95 96 end; 97 finally 98 if S <> nil then 99 begin 100 EndEnumPapers; 101 S.Free; 102 end; 103 end; 104end; 105 106function TCarbonPrinter.ValidatePageFormat: Boolean; 107begin 108 Result := False; 109 OSError(PMSessionValidatePageFormat(PrintSession, PageFormat, @Result), 110 Self, 'ValidatePageFormat', 'PMSessionValidatePageFormat'); 111end; 112 113function TCarbonPrinter.ValidatePrintSettings: Boolean; 114begin 115 Result := False; 116 OSError(PMSessionValidatePrintSettings(PrintSession, PrintSettings, @Result), 117 Self, 'ValidatePrintSettings', 'PMSessionValidatePrintSettings'); 118end; 119 120function TCarbonPrinter.GetCurrentPrinter: PMPrinter; 121begin 122 Result:=nil; 123 OSError(PMSessionGetCurrentPrinter(PrintSession, Result), Self, 'GetCurrentPrinter', 'PMSessionGetCurrentPrinter'); 124end; 125 126function TCarbonPrinter.GetCurrentPrinterName: String; 127var 128 P: PMPrinter; 129begin 130 Result := ''; 131 P := GetCurrentPrinter; 132 if P <> nil then 133 Result := CFStringToStr(PMPrinterGetName(P)); 134 if Trim(Result) = '' then 135 Result := ''; 136end; 137 138procedure TCarbonPrinter.BeginPage; 139var 140 PaperRect: PMRect; 141begin 142 if FBeginDocumentStatus = noErr then 143 begin 144 FNewPageStatus := PMSessionBeginPage(PrintSession, nil, nil); 145 OSError(FNewPageStatus, Self, 'BeginPage', 'PMSessionBeginPage', '', kPMCancel); 146 147 // update printer context 148 if OSError(PMSessionGetCGGraphicsContext(PrintSession, FPrinterContext.CGContext), 149 Self, 'BeginPage', 'PMSessionGetCGGraphicsContext') then 150 FPrinterContext.Release 151 else 152 FPrinterContext.Reset; 153 154 // translate the context from his paper (0,0) origin 155 // to our working imageable area 156 if PMGetAdjustedPaperRect(PageFormat, PaperRect{%H-})=noErr then 157 CGContextTranslateCTM(FPrinterContext.CGContext, -PaperRect.left, -PaperRect.top); 158 159 if Assigned(Canvas) then 160 Canvas.Handle := HDC(FPrinterContext); 161 end; 162end; 163 164procedure TCarbonPrinter.EndPage; 165begin 166 FPrinterContext.Release; 167 if Assigned(Canvas) then Canvas.Handle := 0; 168 169 if FBeginDocumentStatus = noErr then 170 begin 171 if FNewPageStatus = noErr then 172 OSError(PMSessionEndPage(PrintSession), Self, 'EndPage', 'PMSessionEndPage', '', kPMCancel); 173 end; 174end; 175 176procedure TCarbonPrinter.FindDefaultPrinter; 177var 178 P: PMPrinter; 179 I, C: CFIndex; 180 pa: CFArrayRef; 181begin 182 pa:=nil; 183 if OSError(PMServerCreatePrinterList(kPMServerLocal, pa), 184 Self, 'DoEnumPrinters', 'PMServerCreatePrinterList') then Exit; 185 186 if not Assigned(pa) then Exit; 187 188 C := CFArrayGetCount(pa); 189 for I := 0 to C - 1 do 190 begin 191 P := CFArrayGetValueAtIndex(pa, I); 192 193 if PMPrinterIsDefault(P) then 194 begin 195 FDefaultPrinter := CFStringToStr(PMPrinterGetName(P)); 196 Break; 197 end; 198 end; 199 CFRelease(pa); 200end; 201 202procedure TCarbonPrinter.BeginEnumPrinters(Lst: TStrings); 203var 204 P: PMPrinter; 205 I, C: CFIndex; 206 NewPrinterName: String; 207begin 208 FPrinterArray := nil; 209 if OSError(PMServerCreatePrinterList(kPMServerLocal, FPrinterArray), 210 Self, 'DoEnumPrinters', 'PMServerCreatePrinterList') then Exit; 211 212 C := CFArrayGetCount(FPrinterArray); 213 for I := 0 to C - 1 do 214 begin 215 P := CFArrayGetValueAtIndex(FPrinterArray, I); 216 NewPrinterName := CFStringToStr(PMPrinterGetName(P)); 217 218 //DebugLn(DbgS(I) + ' ' + PrinterName); 219 if NewPrinterName = FDefaultPrinter then 220 Lst.InsertObject(0, NewPrinterName, TObject(I)) 221 else 222 Lst.AddObject(NewPrinterName, TObject(I)); 223 end; 224end; 225 226procedure TCarbonPrinter.EndEnumPrinters; 227begin 228 if FPrinterArray<>nil then 229 CFRelease(FPrinterArray); 230end; 231 232procedure TCarbonPrinter.BeginEnumPapers(Lst: TStrings); 233var 234 P: PMPaper; 235 I, C: CFIndex; 236 CFString: CFStringRef; 237 PaperName: String; 238const 239 SName = 'DoEnumPapers'; 240begin 241 FPaperArray := nil; 242 if OSError(PMPrinterGetPaperList(GetCurrentPrinter, FPaperArray), 243 Self, SName, 'PMPrinterGetPaperList') then Exit; 244 FPaperArray := CFRetain(FPaperArray); 245 246 C := CFArrayGetCount(FPaperArray); 247 for I := 0 to C - 1 do 248 begin 249 P := CFArrayGetValueAtIndex(FPaperArray, I); 250 CFString:=nil; 251 if OSError(PMPaperGetName(P, CFString), Self, SName, 'PMPaperGetName') then Continue; 252 PaperName := CFStringToStr(CFString); 253 //MacOSX 10.4 returns wrong paper name in case of US Letter. 254 //In system we can choose US Letter, but here it returns Letter.Issue #17698 255 if PaperName = 'Letter' then 256 PaperName := 'US Letter' 257 else 258 if PaperName = 'Legal' then 259 PaperName := 'US Legal'; 260 Lst.Add(PaperName); 261 end; 262end; 263 264procedure TCarbonPrinter.EndEnumPapers; 265begin 266 if FPaperArray<>nil then 267 CFRelease(FPaperArray); 268end; 269 270constructor TCarbonPrinter.Create; 271begin 272 inherited Create; 273 274 CreatePrintSession; 275 CreatePrintSettings; 276 FPageFormat := CreatePageFormat(''); 277 FPrinterContext := TCarbonPrinterContext.Create; 278 279 FindDefaultPrinter; 280 UpdatePrinter; 281 //DebugLn('Current ' + GetCurrentPrinterName); 282 //DebugLn('Default ' + FDefaultPrinter); 283end; 284 285procedure TCarbonPrinter.DoDestroy; 286begin 287 FPrinterContext.Free; 288 289 if FPrintSettings <> nil then PMRelease(PMObject(FPrintSettings)); 290 if FPageFormat <> nil then PMRelease(PMObject(FPageFormat)); 291 if FPrintSession <> nil then PMRelease(PMObject(FPrintSession)); 292 293 inherited DoDestroy; 294end; 295 296function TCarbonPrinter.Write(const Buffer; Count: Integer; out Written: Integer): Boolean; 297begin 298 Result := False; 299 CheckRawMode(True); 300 Written := 0; 301 DebugLn('TCarbonPrinter.Write Error: Raw mode is not supported for Carbon!'); 302end; 303 304procedure TCarbonPrinter.RawModeChanging; 305begin 306 // 307end; 308 309procedure TCarbonPrinter.Validate; 310var 311 P: String; 312begin 313 ValidatePrintSettings; 314 ValidatePageFormat; 315 316 // if target paper is not supported, use the default 317 P := DoGetPaperName; 318 if PaperSize.SupportedPapers.IndexOf(P) = -1 then 319 DoSetPaperName(DoGetDefaultPaperName); 320end; 321 322procedure TCarbonPrinter.UpdatePrinter; 323var 324 s: string; 325 Res: PMResolution; 326begin 327 s := GetCurrentPrinterName; 328 if trim(s) = '' then // Observed if Default printer set to "Use last printer", and no printing done 329 s := '*'; // so select lcl default 330 SetPrinter(s); 331 // set the page format resolution 332 Res := GetOutputResolution; 333 PMSetResolution(PageFormat, Res); 334 Validate; 335end; 336 337type 338 TPMPrinterGetOutputResolution = function( printer: PMPrinter; 339 printSettings: PMPrintSettings; 340 var resolutionP: PMResolution ): OSStatus; cdecl; 341 342var 343 _PMPrinterGetOutputResolution: TPMPrinterGetOutputResolution = nil; 344 _PMPrinterGetOutputResolutionLoaded: Boolean; 345 346function TCarbonPrinter.GetOutputResolution: PMResolution; 347var 348 res: OSStatus; 349 r : PMresolution; 350 prn: PMPrinter; 351 cnt: UInt32; 352 i : Integer; 353begin 354 prn := GetCurrentPrinter; 355 356 if not _PMPrinterGetOutputResolutionLoaded then 357 begin 358 // loading in run-time, because the function isn't available on OSX 10.4 359 _PMPrinterGetOutputResolutionLoaded := true; 360 _PMPrinterGetOutputResolution := TPMPrinterGetOutputResolution(dlsym(RTLD_DEFAULT,'PMPrinterGetOutputResolution')); 361 end; 362 if Assigned(_PMPrinterGetOutputResolution) then begin 363 // the function might return kPMKeyNotFound, see function description in MacOSAll 364 res := _PMPrinterGetOutputResolution(prn, PrintSettings, Result{%H-}); 365 if (res=kPMKeyNotFound) and (FDefaultResolution.Valid) then begin 366 res := noErr; 367 Result.hRes := fDefaultResolution.HorzRes; 368 Result.vRes := fDefaultResolution.VertRes; 369 end; 370 end 371 else 372 res := noErr+1; 373 374 if res <> noErr then 375 begin 376 res := PMPrinterGetPrinterResolutionCount(prn, cnt{%H-}); 377 if res = noErr then 378 begin 379 PMPrinterGetIndexedPrinterResolution(prn, 1, Result); 380 for i := 2 to cnt do 381 begin 382 if PMPrinterGetIndexedPrinterResolution(prn, i, r{%H-}) = noErr then 383 if (r.hRes > Result.hRes) and (r.vRes > Result.vRes) then 384 Result := r; 385 end; 386 end; 387 end; 388 389 if res<>noErr then 390 begin 391 Result.vRes:=72; 392 Result.hRes:=72; 393 end; 394end; 395 396function TCarbonPrinter.GetXDPI: Integer; 397var 398 dpi: PMResolution; 399begin 400 dpi := GetOutputResolution; 401 result := round(dpi.hRes); 402end; 403 404function TCarbonPrinter.GetYDPI: Integer; 405var 406 dpi: PMResolution; 407begin 408 dpi := GetOutputResolution; 409 result := round(dpi.hRes); 410end; 411 412procedure TCarbonPrinter.DoBeginDoc; 413begin 414 inherited DoBeginDoc; 415 416 //DebugLn('TCarbonPrinter.DoBeginDoc ' + DbgS(Printing)); 417 Validate; 418 419 FBeginDocumentStatus := PMSessionBeginCGDocument(PrintSession, PrintSettings, PageFormat); 420 OSError(FBeginDocumentStatus, Self, 'DoBeginDoc', 'PMSessionBeginCGDocument', '', kPMCancel); 421 422 FNewPageStatus := kPMCancel; 423 424 BeginPage; 425end; 426 427procedure TCarbonPrinter.DoNewPage; 428begin 429 inherited DoNewPage; 430 431 EndPage; 432 BeginPage; 433end; 434 435procedure TCarbonPrinter.DoEndDoc(aAborted: Boolean); 436begin 437 inherited DoEndDoc(aAborted); 438 439 EndPage; 440 if FBeginDocumentStatus = noErr then 441 OSError(PMSessionEndDocument(PrintSession), Self, 'DoEndDoc', 'PMSessionEndDocument', '', kPMCancel); 442end; 443 444procedure TCarbonPrinter.DoAbort; 445begin 446 inherited DoAbort; 447 448 OSError(PMSessionSetError(PrintSession, kPMCancel), Self, 'DoAbort', 'PMSessionSetError'); 449end; 450 451//Enum all defined printers. First printer it's default 452procedure TCarbonPrinter.DoEnumPrinters(Lst: TStrings); 453begin 454 BeginEnumPrinters(Lst); 455 EndEnumPrinters; 456end; 457 458procedure TCarbonPrinter.DoResetPrintersList; 459begin 460 inherited DoResetPrintersList; 461end; 462 463procedure TCarbonPrinter.DoEnumPapers(Lst: TStrings); 464begin 465 BeginEnumPapers(Lst); 466 EndEnumPapers; 467end; 468 469function TCarbonPrinter.DoGetPaperName: string; 470var 471 P: PMPaper; 472 CFString: CFStringRef; 473const 474 SName = 'DoGetPaperName'; 475begin 476 Result := ''; 477 478 P:=nil; 479 if OSError(PMGetPageFormatPaper(PageFormat, P), Self, SName, 'PMGetPageFormatPaper') then Exit; 480 CFString:=nil; 481 if OSError(PMPaperGetName(P, CFString), Self, SName, 'PMPaperGetName') then Exit; 482 483 Result := CFStringToStr(CFString); 484end; 485 486function TCarbonPrinter.DoGetDefaultPaperName: string; 487var 488 T: PMPageFormat; 489begin 490 Result := ''; 491 492 T := FPageFormat; 493 FPageFormat := CreatePageFormat(''); 494 495 Result := DoGetPaperName; 496 if T <> nil then 497 begin 498 PMRelease(PMObject(FPageFormat)); 499 FPageFormat := T; 500 end; 501end; 502 503procedure TCarbonPrinter.DoSetPaperName(AName: string); 504var 505 O: TPrinterOrientation; 506begin 507 O := DoGetOrientation; 508 if FPageFormat <> nil then PMRelease(PMObject(FPageFormat)); 509 510 FPageFormat := CreatePageFormat(AName); 511 DoSetOrientation(O); 512 513 ValidatePageFormat; 514end; 515 516function TCarbonPrinter.DoGetPaperRect(AName: string; var APaperRc: TPaperRect): Integer; 517var 518 T: PMPageFormat; 519 PaperRect, PageRect: PMRect; 520 S: Double; 521 O: PMOrientation; 522 Res: PMResolution; 523const 524 SName = 'DoGetPaperRect'; 525begin 526 Result := -1; 527 528 T := CreatePageFormat(AName); 529 try 530 // copy scale 531 S:=0.0; 532 OSError(PMGetScale(PageFormat, S), Self, SName, 'PMGetScale'); 533 OSError(PMSetScale(T, S), Self, SName, 'PMSetScale'); 534 535 // copy orientation 536 O:=CleanPMOrientation; 537 OSError(PMGetOrientation(PageFormat, O), Self, SName, 'PMGetOrientation'); 538 OSError(PMSetOrientation(T, O, False), Self, SName, 'PMSetOrientation'); 539 540 // copy resolution 541 Res := GetOutputResolution; 542 OSError(PMSetResolution(T, Res), self, SName, 'PMSetResolution'); 543 544 // update 545 OSError(PMSessionValidatePageFormat(PrintSession, T, nil), 546 Self, SName, 'PMSessionValidatePageFormat'); 547 548 PaperRect:=CleanPMRect; 549 OSError(PMGetAdjustedPaperRect(T, PaperRect), Self, SName, 'PMGetAdjustedPaperRect'); 550 PageRect:=CleanPMRect; 551 OSError(PMGetAdjustedPageRect(T, PageRect), Self, SName, 'PMGetAdjustedPageRect'); 552 finally 553 PMRelease(PMObject(T)); 554 end; 555 556 ValidatePageFormat; 557 558 APaperRc.PhysicalRect.Left := 0; 559 APaperRc.PhysicalRect.Top := 0; 560 APaperRc.PhysicalRect.Right := Round(PaperRect.right - PaperRect.left); 561 APaperRc.PhysicalRect.Bottom := Round(PaperRect.bottom - PaperRect.top); 562 563 APaperRc.WorkRect.Left := Round(-PaperRect.left); 564 APaperRc.WorkRect.Top := Round(-PaperRect.top); 565 APaperRc.WorkRect.Right := Round(PageRect.right - PageRect.left - PaperRect.left); 566 APaperRc.WorkRect.Bottom := Round(PageRect.bottom - PageRect.top - PaperRect.top); 567 568 Result := 1; 569end; 570 571function TCarbonPrinter.DoSetPrinter(aName: string): Integer; 572var 573 S: TStringList; 574 P: PMPrinter; 575 ResCount: UInt32; 576begin 577 S := TStringList.Create; 578 BeginEnumPrinters(S); 579 try 580 Result := S.IndexOf(AName); 581 if Result >= 0 then 582 begin 583 //DebugLn('DoSetPrinter ' + DbgS(Result)); 584 //DebugLn('TCarbonPrinter.DoSetPrinter ' + AName + ' ' + DbgS(PrintSession) + ' ' + DbgS(Printers.Objects[Result])); 585 P := PMPrinter(CFArrayGetValueAtIndex(FPrinterArray, Integer(S.Objects[Result]))); 586 PMRetain(PMObject(P)); 587 if OSError(PMSessionSetCurrentPMPrinter(PrintSession, P), 588 Self, 'DoSetPrinter', 'PMSessionSetCurrentPMPrinter') then 589 raise EPrinter.CreateFmt('The system is unable to select printer "%s"!', [AName]); 590 // 591 with FDefaultResolution do 592 begin 593 ResCount := 0; 594 Valid := (PMPrinterGetPrinterResolutionCount(P, ResCount)=noErr) and (ResCount>1); 595 if Valid then 596 Valid := GetDefaultPPDResolution(P, HorzRes, VertRes); 597 end; 598 end; 599 finally 600 EndEnumPrinters; 601 S.Free; 602 end; 603end; 604 605function TCarbonPrinter.DoGetCopies: Integer; 606var 607 C: UInt32; 608begin 609 Result := inherited DoGetCopies; 610 C:=0; 611 if OSError(PMGetCopies(PrintSettings, C), Self, 'DoGetCopies', 'PMGetCopies') then Exit; 612 Result := C; 613end; 614 615procedure TCarbonPrinter.DoSetCopies(AValue: Integer); 616begin 617 inherited DoSetCopies(AValue); 618 OSError(PMSetCopies(PrintSettings, AValue, False), Self, 'DoSetCopies', 'PMSetCopies'); 619 620 ValidatePrintSettings; 621end; 622 623function TCarbonPrinter.DoGetOrientation: TPrinterOrientation; 624var 625 O: PMOrientation; 626begin 627 Result := inherited DoGetOrientation; 628 O:=CleanPMOrientation; 629 if OSError(PMGetOrientation(PageFormat, O), Self, 'DoGetOrientation', 'PMGetOrientation') then Exit; 630 631 case O of 632 kPMPortrait: Result := poPortrait; 633 kPMLandscape: Result := poLandscape; 634 kPMReversePortrait: Result := poReversePortrait; 635 kPMReverseLandscape: Result := poReverseLandscape; 636 end; 637end; 638 639procedure TCarbonPrinter.DoSetOrientation(AValue: TPrinterOrientation); 640var 641 O: PMOrientation; 642begin 643 inherited DoSetOrientation(aValue); 644 645 case AValue of 646 poPortrait: O := kPMPortrait; 647 poLandscape: O := kPMLandscape; 648 poReversePortrait: O := kPMReversePortrait; 649 poReverseLandscape: O := kPMReverseLandscape; 650 end; 651 652 OSError(PMSetOrientation(PageFormat, O, kPMUnlocked), Self, 'DoSetOrientation', 'PMSetOrientation'); 653 ValidatePageFormat; 654end; 655 656function TCarbonPrinter.GetPrinterType: TPrinterType; 657var 658 IsRemote: Boolean; 659begin 660 Result := ptLocal; 661 IsRemote:=false; 662 OSError(PMPrinterIsRemote(GetCurrentPrinter,IsRemote), Self, 'GetPrinterType', 'PMPrinterIsRemote'); 663 if IsRemote then Result := ptNetwork 664end; 665 666 667function TCarbonPrinter.DoGetPrinterState: TPrinterState; 668var 669 State: PMPrinterState; 670begin 671 Result := psNoDefine; 672 673 State:=0; 674 if OSError(PMPrinterGetState(GetCurrentPrinter, State), Self, 'DoGetPrinterState', 'PMPrinterGetState') then Exit; 675 676 case State of 677 kPMPrinterIdle: Result := psReady; 678 kPMPrinterProcessing: Result := psPrinting; 679 kPMPrinterStopped: Result := psStopped; 680 end; 681end; 682 683function TCarbonPrinter.GetCanPrint: Boolean; 684begin 685 Result := (DoGetPrinterState <> psStopped); 686end; 687 688function TCarbonPrinter.GetCanRenderCopies: Boolean; 689begin 690 Result := True; 691end; 692 693initialization 694 695 Printer := TCarbonPrinter.Create; 696 697finalization 698 699 FreeAndNil(Printer); 700