From d7fbbecdb3fca37f728169d42e560e1c2fed8ab8 Mon Sep 17 00:00:00 2001 From: jesus Date: Mon, 30 Mar 2015 17:14:55 +0000 Subject: [PATCH] Printers,carbon: implements getting default printer resolution from PPD data git-svn-id: trunk@48542 - --- .gitattributes | 1 + components/printers/carbon/carbonprinters.inc | 18 +- .../printers/carbon/carbonprinters_h.inc | 8 +- components/printers/carbon/ppdresolution.pas | 185 ++++++++++++++++++ components/printers/printer4lazarus.lpk | 6 +- components/printers/printer4lazarus.pas | 12 +- 6 files changed, 220 insertions(+), 10 deletions(-) create mode 100644 components/printers/carbon/ppdresolution.pas diff --git a/.gitattributes b/.gitattributes index f96d8a478c..030def7e8f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3006,6 +3006,7 @@ components/printers/carbon/carbonprinters_h.inc svneol=native#text/pascal components/printers/carbon/carbonprinting.pas svneol=native#text/pascal components/printers/carbon/carbonprndialogs.inc svneol=native#text/pascal components/printers/carbon/issues.xml svneol=native#text/xml +components/printers/carbon/ppdresolution.pas svneol=native#text/pascal components/printers/cocoa/cocoaprinters.inc svneol=native#text/plain components/printers/cocoa/cocoaprinters_h.inc svneol=native#text/plain components/printers/cocoa/cocoaprndialogs.inc svneol=native#text/plain diff --git a/components/printers/carbon/carbonprinters.inc b/components/printers/carbon/carbonprinters.inc index f635751898..ea39663cad 100644 --- a/components/printers/carbon/carbonprinters.inc +++ b/components/printers/carbon/carbonprinters.inc @@ -360,9 +360,15 @@ begin _PMPrinterGetOutputResolutionLoaded := true; _PMPrinterGetOutputResolution := TPMPrinterGetOutputResolution(dlsym(RTLD_DEFAULT,'PMPrinterGetOutputResolution')); end; - if Assigned(_PMPrinterGetOutputResolution) then + if Assigned(_PMPrinterGetOutputResolution) then begin // the function might return kPMKeyNotFound, see function description in MacOSAll - res := _PMPrinterGetOutputResolution(prn, PrintSettings, Result{%H-}) + res := _PMPrinterGetOutputResolution(prn, PrintSettings, Result{%H-}); + if (res=kPMKeyNotFound) and (FDefaultResolution.Valid) then begin + res := noErr; + Result.hRes := fDefaultResolution.HorzRes; + Result.vRes := fDefaultResolution.VertRes; + end; + end else res := noErr+1; @@ -567,6 +573,7 @@ function TCarbonPrinter.DoSetPrinter(aName: string): Integer; var S: TStringList; P: PMPrinter; + ResCount: UInt32; begin S := TStringList.Create; BeginEnumPrinters(S); @@ -581,6 +588,13 @@ begin if OSError(PMSessionSetCurrentPMPrinter(PrintSession, P), Self, 'DoSetPrinter', 'PMSessionSetCurrentPMPrinter') then raise EPrinter.CreateFmt('The system is unable to select printer "%s"!', [AName]); + // + with FDefaultResolution do + begin + Valid := (PMPrinterGetPrinterResolutionCount(P, ResCount)=noErr) and (ResCount>1); + if Valid then + Valid := GetDefaultPPDResolution(P, HorzRes, VertRes); + end; end; finally EndEnumPrinters; diff --git a/components/printers/carbon/carbonprinters_h.inc b/components/printers/carbon/carbonprinters_h.inc index 30f9fe0e3f..c1de033160 100644 --- a/components/printers/carbon/carbonprinters_h.inc +++ b/components/printers/carbon/carbonprinters_h.inc @@ -1,7 +1,7 @@ {%MainUnit ../osprinters.pas} uses MacOSAll, - Classes, SysUtils, Printers, LCLType, CarbonCanvas, CarbonPrinting; + Classes, SysUtils, Printers, LCLType, CarbonCanvas, CarbonPrinting, ppdresolution; type { TCarbonPrinterContext } @@ -14,6 +14,11 @@ type procedure Reset; override; end; + TPrinterResolution = record + Valid: boolean; + HorzRes, VertRes: Integer; + end; + { TCarbonPrinter } TCarbonPrinter = class(TPrinter) @@ -27,6 +32,7 @@ type FPrinterArray: CFArrayRef; FPaperArray: CFArrayRef; FDefaultPrinter: String; + FDefaultResolution: TPrinterResolution; procedure CreatePrintSession; procedure CreatePrintSettings; diff --git a/components/printers/carbon/ppdresolution.pas b/components/printers/carbon/ppdresolution.pas new file mode 100644 index 0000000000..fdebe89da5 --- /dev/null +++ b/components/printers/carbon/ppdresolution.pas @@ -0,0 +1,185 @@ +unit ppdresolution; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, MacOSAll, CarbonProc; + + function GetDefaultPPDResolution(aPrinter: PMPrinter; out HorzRes, VertRes: Integer): boolean; + +implementation + + +function StrPasP(A,B: pchar): ansistring; +begin + SetLength(Result, B-A); + system.Move(A^, Result[1], B-A); +end; + +procedure SkipBlanks(var A: pchar); +begin + while A^ in [' ', #9] do + Inc(A); // skip white space +end; + +function GetNumber(var B: pchar; var Number: Integer): boolean; +var + A: pchar; + Code: Integer; +begin + Number := 0; + result := false; + A := B; + while B^ in ['0'..'9'] do Inc(B); + if A=B then + exit; + + Val(StrPasP(A, B), Number, Code); + result := Code=0; +end; + +function ParseDefaultResolution(A:Pchar; out ResTag: ansistring; out HorzRes, VertRes: Integer): boolean; +var + B: PChar; +begin + + result := false; + HorzRes := 300; + VertRes := 300; + if A=nil then + exit; + + inc(A, 19); // skip *DefaultResolution: + SkipBlanks(A); + B := A; + while not (B^ in [' ', #9, #10, #13]) do inc(B); + if A=B then + exit; + + ResTag := StrPasP(A, B); + A := @ResTag[1]; + + // get first number + B := A; + result := GetNumber(B, HorzRes); + if not result then + exit; + + if B^='d' then begin // start of dpi, we are done + VertRes := HorzRes; + result := true; + exit; + end; + if B^<>'x' then // unexpected res format, expected NNNxMMMdpi + exit; + + // get second number + inc(B); + A := B; + result := GetNumber(B, VertRes); +end; + +function GetDefaultResolutionFromPtr(Buf: PChar; + var HorzRes, VertRes:Integer): boolean; +var + A, B: PChar; + ResTag: ansistring; +begin + + result := false; + A := strpos(Buf, '*DefaultResolution:'); + if A=nil then + exit; + + result := ParseDefaultResolution(A, ResTag, HorzRes, VertRes); + if not result then + exit; + + // now check for *OpenUI: *Resolution, maybe ResTag is just a tag + A := strpos(Buf, '*OpenUI *Resolution'); + if A=nil then begin + // not found, assume ResTag is a valid value + exit; + end; + + // restrict ourselves to this block + B := strpos(A, '*CloseUI: *Resolution'); + if B=nil then + exit; // something is wrong but we have a standalone default resolution + // we take it + B^ := #0; + + result := false; + repeat + // find default resolution entry + B := strpos(A, #10'*Resolution'); + if B<>nil then begin + inc(B, 12); + SkipBlanks(B); + // is this the one we are looking for? + if strlcomp(B, @ResTag[1], Length(ResTag))=0 then begin + // it is, look for /HWResolution + A := strpos(B, '/HWResolution'); + if A<>nil then begin + // found + inc(A, 13); + SkipBlanks(A); + // we are not a postscript interpreter, only look for + // resolution values like NNN or [NNN MMM] + if A^='[' then begin + Inc(A); + SkipBlanks(A); + Result := GetNumber(A, HorzRes); + if Result then begin + SkipBlanks(A); + Result := GetNumber(A, VertRes); + end; + end else begin + result := GetNumber(A, HorzRes); + VertRes := HorzRes; + end; + end else + // /HWResolution not found, assume ResTag was in valid format + result := true; + + break; + end; + A := B; + end; + until B=nil; +end; + +function GetDefaultPPDResolution(aPrinter: PMPrinter; out HorzRes, VertRes: Integer + ): boolean; +var + PPD: ansistring; + Name: CFStringRef; + aURL: CFURLRef = nil; + Range: CFRange; + Data: CFDataRef = nil; +begin + VertRes := 0; + HorzRes := 0; + + CreateCFString('PMPPDDescriptionType', Name); + Result := PMPrinterCopyDescriptionURL(aPrinter, Name, aURL)=noErr; + FreeCFString(Name); + if Result then begin + PMCopyPPDData(aURL, Data); + FreeCFString(aURL); + if Data<>nil then begin + Range.length := CFDataGetLength(Data); + Range.location := 0; + SetLength(PPD, Range.length); + CFDataGetBytes(Data, Range, @PPD[1]); + CFRelease(Data); + result := GetDefaultResolutionFromPtr(@PPD[1], HorzRes, VertRes); + end; + end; + +end; + +end. + diff --git a/components/printers/printer4lazarus.lpk b/components/printers/printer4lazarus.lpk index d435c1e1b9..6935376e7a 100644 --- a/components/printers/printer4lazarus.lpk +++ b/components/printers/printer4lazarus.lpk @@ -30,7 +30,7 @@ - + @@ -186,6 +186,10 @@ + + + + diff --git a/components/printers/printer4lazarus.pas b/components/printers/printer4lazarus.pas index 8ac04620d2..b20ba90f2b 100644 --- a/components/printers/printer4lazarus.pas +++ b/components/printers/printer4lazarus.pas @@ -2,20 +2,20 @@ This source is only used to compile and install the package. } -unit Printer4Lazarus; +unit Printer4Lazarus; interface uses - PrintersDlgs, OSPrinters, LazarusPackageIntf; + PrintersDlgs, OSPrinters, ppdresolution, LazarusPackageIntf; implementation -procedure Register; +procedure Register; begin - RegisterUnit('PrintersDlgs', @PrintersDlgs.Register); -end; + RegisterUnit('PrintersDlgs', @PrintersDlgs.Register); +end; initialization - RegisterPackage('Printer4Lazarus', @Register); + RegisterPackage('Printer4Lazarus', @Register); end.