1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
{
*****************************************************************************
This file is part of the Printer4Lazarus package
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
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.
|
