paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-11 10:35:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

Printers, Carbon, support for printing at higher resolution, issue #23339

Browse Source 
git-svn-id: trunk@43141 -
This commit is contained in:
jesus 2013-10-07 05:18:28 +00:00
parent 91bd6f356b
commit 2e9280a334
2 changed files with 32 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
components/printers/carbon/carbonprinters.inc
View File

@ -153,7 +153,7 @@ begin
// translate the context from his paper (0,0) origin
// to our working imageable area
if PMGetAdjustedPaperRect(PageFormat, PaperRect)=noErr then
if PMGetAdjustedPaperRect(PageFormat, PaperRect{%H-})=noErr then
CGContextTranslateCTM(FPrinterContext.CGContext, -PaperRect.left, -PaperRect.top);
if Assigned(Canvas) then
@ -319,22 +319,43 @@ end;
procedure TCarbonPrinter.UpdatePrinter;
var
s: string;
Res: PMResolution;
begin
s := GetCurrentPrinterName;
if trim(s) = '' then // Observed if Default printer set to "Use last printer", and no printing done
s := '*'; // so select lcl default
SetPrinter(s);
// set the page format resolution
Res := GetOutputResolution;
PMSetResolution(PageFormat, Res);
Validate;
end;
function TCarbonPrinter.GetXDPI: Integer;
function TCarbonPrinter.GetOutputResolution: PMResolution;
var
res: OSStatus;
begin
Result := 72;
res := PMPrinterGetOutputResolution(GetCurrentPrinter, PrintSettings, Result{%H-});
if res<>noErr then begin
Result.vRes:=72;
Result.hRes:=72;
end;
end;
function TCarbonPrinter.GetXDPI: Integer;
var
dpi: PMResolution;
begin
dpi := GetOutputResolution;
result := round(dpi.hRes);
end;
function TCarbonPrinter.GetYDPI: Integer;
var
dpi: PMResolution;
begin
Result := 72;
dpi := GetOutputResolution;
result := round(dpi.hRes);
end;
procedure TCarbonPrinter.DoBeginDoc;
@ -447,6 +468,7 @@ var
PaperRect, PageRect: PMRect;
S: Double;
O: PMOrientation;
Res: PMResolution;
const
SName = 'DoGetPaperRect';
begin
@ -463,6 +485,10 @@ begin
O:=CleanPMOrientation;
OSError(PMGetOrientation(PageFormat, O), Self, SName, 'PMGetOrientation');
OSError(PMSetOrientation(T, O, False), Self, SName, 'PMSetOrientation');
// copy resolution
Res := GetOutputResolution;
OSError(PMSetResolution(T, Res), self, SName, 'PMSetResolution');
// update
OSError(PMSessionValidatePageFormat(PrintSession, T, nil),

2
components/printers/carbon/carbonprinters_h.inc
View File

@ -46,6 +46,8 @@ type
procedure EndEnumPrinters;
procedure BeginEnumPapers(Lst: TStrings);
procedure EndEnumPapers;
function GetOutputResolution: PMResolution;
protected
procedure DoBeginDoc; override;
procedure DoNewPage; override;