1
2 {*****************************************}
3 { }
4 { FastReport v2.3 }
5 { Printer info }
6 { }
7 { Copyright (c) 1998-99 by Tzyganenko A. }
8 { }
9 {*****************************************}
10
11 {.$define DbgPrinter}
12 {.$define DbgPrinter_detail}
13
14 unit LR_Prntr;
15
16 interface
17
18 {$I LR_Vers.inc}
19
20 uses
21 SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
22 Printers,LCLType,LCLProc,
23
24 LR_Class, LR_Const;
25
26 type
27
28 TlrPaperUnits = (puPoints, puTenthsMM);
29
30 { TfrPrinter }
31
32 TfrPrinter = class
33 private
34 FDevice: PChar;
35 FDocumentUnits: TlrPaperUnits;
36 FDriver: PChar;
37 FPort: PChar;
38 //FDeviceMode: THandle;
39 FPrinter: TPrinter;
40 FPaperNames: TStringList;
41 FPrinters: TStringList;
42 FPrinterIndex: Integer;
43 FDefaultPrinter: Integer;
44 procedure GetSettings(PrinterChanged: boolean = true);
45 procedure SetSettings;
46 procedure SetPrinter(Value: TPrinter);
47 procedure SetPrinterIndex(Value: Integer);
GetPaperNamesnull48 function GetPaperNames: TStringList;
MatchPrinterPapernull49 function MatchPrinterPaper(const aWidth, aHeight: Integer): integer;
GetPaperRectnull50 function GetPaperRect: TPaperRect;
51 public
52 Orientation: TPrinterOrientation;
53 PaperSize: Integer;
54 PaperWidth: Integer;
55 PaperHeight: Integer;
56 PaperSizes: Array[0..255] of Integer; // bumped to integer for more flexibility //Word;
57 PaperSizesNum: Integer;
58 constructor Create;
59 destructor Destroy; override;
60 procedure FillPrnInfo(var p: TfrPrnInfo);
61 procedure SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer;
62 pgOr: TPrinterOrientation);
IsEqualnull63 function IsEqual(pgSize, pgWidth, pgHeight: Integer;
64 pgOr: TPrinterOrientation): Boolean;
GetArrayPosnull65 function GetArrayPos(pgSize: Integer): Integer;
DefaultPaperIndexnull66 function DefaultPaperIndex: Integer;
DefaultPageSizenull67 function DefaultPageSize: Integer;
UseVirtualPrinternull68 function UseVirtualPrinter: boolean;
FillPapersnull69 function FillPapers(list: TStrings; addCustom:boolean=true): Integer;
70 {$IFDEF DbgPrinter}
71 procedure DumpPrinterInfo;
72 {$ENDIF}
73
74 property DocumentUnits: TlrPaperUnits read FDocumentUnits write FDocumentUnits;
75 property PaperNames: TStringList read GetPaperNames;
76 property Printer: TPrinter read FPrinter write SetPrinter;
77 property Printers: TStringList read FPrinters;
78 property PrinterIndex: Integer read FPrinterIndex write SetPrinterIndex;
79 end;
80
Prnnull81 function Prn : TfrPrinter;
82
83 const
84 MAX_TYP_KNOWN = 118;
85
86 implementation
87
88 var
89 GlobalPrn: TfrPrinter = nil;
90
91 type
92 TPaperInfo = record
93 Typ: Integer;
94 Name: String;
95 X, Y: Integer;
96 end;
97
98 const
99 PAPERCOUNT = 117;
100 //OLDPAPERCOUNT = 67; // show only that much paper names when using virtual printer
101
102 PaperInfo: Array[0..PAPERCOUNT - 1] of TPaperInfo = (
103 (Typ:1; Name: ''; X:2159; Y:2794),
104 (Typ:2; Name: ''; X:2159; Y:2794),
105 (Typ:3; Name: ''; X:2794; Y:4318),
106 (Typ:4; Name: ''; X:4318; Y:2794),
107 (Typ:5; Name: ''; X:2159; Y:3556),
108 (Typ:6; Name: ''; X:1397; Y:2159),
109 (Typ:7; Name: ''; X:1842; Y:2667),
110 (Typ:8; Name: ''; X:2970; Y:4200),
111 (Typ:9; Name: ''; X:2100; Y:2970),
112 (Typ:10; Name: ''; X:2100; Y:2970),
113 (Typ:11; Name: ''; X:1480; Y:2100),
114 (Typ:12; Name: ''; X:2570; Y:3640), // Nota 1
115 (Typ:13; Name: ''; X:1820; Y:2570),
116 (Typ:14; Name: ''; X:2159; Y:3302), // Nota 3
117 (Typ:15; Name: ''; X:2150; Y:2750),
118 (Typ:16; Name: ''; X:2540; Y:3556),
119 (Typ:17; Name: ''; X:2794; Y:4318),
120 (Typ:18; Name: ''; X:2159; Y:2794),
121 (Typ:19; Name: ''; X:984; Y:2254),
122 (Typ:20; Name: ''; X:1048; Y:2413),
123 (Typ:21; Name: ''; X:1143; Y:2635),
124 (Typ:22; Name: ''; X:1207; Y:2794),
125 (Typ:23; Name: ''; X:1270; Y:2921),
126 (Typ:24; Name: ''; X:4318; Y:5588),
127 (Typ:25; Name: ''; X:5588; Y:8636),
128 (Typ:26; Name: ''; X:8636; Y:11176),
129 (Typ:27; Name: ''; X:1100; Y:2200),
130 (Typ:28; Name: ''; X:1620; Y:2290),
131 (Typ:29; Name: ''; X:3240; Y:4580),
132 (Typ:30; Name: ''; X:2290; Y:3240),
133 (Typ:31; Name: ''; X:1140; Y:1620),
134 (Typ:32; Name: ''; X:1140; Y:2290),
135 (Typ:33; Name: ''; X:2500; Y:3530),
136 (Typ:34; Name: ''; X:1760; Y:2500),
137 (Typ:35; Name: ''; X:1760; Y:1250),
138 (Typ:36; Name: ''; X:1100; Y:2300),
139 (Typ:37; Name: ''; X:984; Y:1905),
140 (Typ:38; Name: ''; X:920; Y:1651),
141 (Typ:39; Name: ''; X:3778; Y:2794),
142 (Typ:40; Name: ''; X:2159; Y:3048),
143 (Typ:41; Name: ''; X:2159; Y:3302),
144 (Typ:42; Name: ''; X:2500; Y:3530),
145 (Typ:43; Name: ''; X:1000; Y:1480),
146 (Typ:44; Name: ''; X:2286; Y:2794),
147 (Typ:45; Name: ''; X:2540; Y:2794),
148 (Typ:46; Name: ''; X:3810; Y:2794),
149 (Typ:47; Name: ''; X:2200; Y:2200),
150 (Typ:50; Name: ''; X:2355; Y:3048),
151 (Typ:51; Name: ''; X:2355; Y:3810),
152 (Typ:52; Name: ''; X:2969; Y:4572),
153 (Typ:53; Name: ''; X:2354; Y:3223),
154 (Typ:54; Name: ''; X:2101; Y:2794),
155 (Typ:55; Name: ''; X:2100; Y:2970),
156 (Typ:56; Name: ''; X:2355; Y:3048),
157 (Typ:57; Name: ''; X:2270; Y:3560),
158 (Typ:58; Name: ''; X:3050; Y:4870),
159 (Typ:59; Name: ''; X:2159; Y:3223),
160 (Typ:60; Name: ''; X:2100; Y:3300),
161 (Typ:61; Name: ''; X:1480; Y:2100),
162 (Typ:62; Name: ''; X:1820; Y:2570),
163 (Typ:63; Name: ''; X:3220; Y:4450),
164 (Typ:64; Name: ''; X:1740; Y:2350),
165 (Typ:65; Name: ''; X:2010; Y:2760),
166 (Typ:66; Name: ''; X:4200; Y:5940),
167 (Typ:67; Name: ''; X:2970; Y:4200),
168 (Typ:68; Name: ''; X:3220; Y:4450),
169 // Nota 2
170 (Typ:69; Name: ''; X:2000; Y:1480),
171 (Typ:70; Name: ''; X:1050; Y:1480),
172 (Typ:71; Name: ''; X:2400; Y:1320),
173 (Typ:72; Name: ''; X:2160; Y:2770),
174 (Typ:73; Name: ''; X:1200; Y:2350),
175 (Typ:74; Name: ''; X:900; Y:2050),
176 (Typ:75; Name: ''; X:2794; Y:2159),
177 (Typ:76; Name: ''; X:4200; Y:2970),
178 (Typ:77; Name: ''; X:2970; Y:2100),
179 (Typ:78; Name: ''; X:2100; Y:1480),
180 (Typ:79; Name: ''; X:3640; Y:2570),
181 (Typ:80; Name: ''; X:2570; Y:1820),
182 (Typ:81; Name: ''; X:1480; Y:1000),
183 (Typ:82; Name: ''; X:1480; Y:2000),
184 (Typ:83; Name: ''; X:1480; Y:1050),
185 (Typ:84; Name: ''; X:3320; Y:2400),
186 (Typ:85; Name: ''; X:2770; Y:2160),
187 (Typ:86; Name: ''; X:2350; Y:1200),
188 (Typ:87; Name: ''; X:2050; Y:900 ),
189 (Typ:88; Name: ''; X:1280; Y:1820),
190 (Typ:89; Name: ''; X:1820; Y:1280),
191 (Typ:90; Name: ''; X:3048; Y:2794),
192 (Typ:91; Name: ''; X:1050; Y:2350),
193 (Typ:92; Name: ''; X:2350; Y:1050),
194 (Typ:93; Name: ''; X:1460; Y:2150),
195 (Typ:94; Name: ''; X:970; Y:1510),
196 (Typ:95; Name: ''; X:970; Y:1510),
197 (Typ:96; Name: ''; X:1020; Y:1650),
198 (Typ:97; Name: ''; X:1020; Y:1760),
199 (Typ:98; Name: ''; X:1250; Y:1760),
200 (Typ:99; Name: ''; X:1100; Y:2080),
201 (Typ:100; Name: ''; X:1100; Y:2200),
202 (Typ:101; Name: ''; X:1200; Y:2300),
203 (Typ:102; Name: ''; X:1600; Y:2300),
204 (Typ:103; Name: ''; X:1200; Y:3090),
205 (Typ:104; Name: ''; X:2290; Y:3240),
206 (Typ:105; Name: ''; X:3240; Y:4580),
207 (Typ:106; Name: ''; X:2150; Y:1460),
208 (Typ:107; Name: ''; X:1510; Y:970 ),
209 (Typ:108; Name: ''; X:1510; Y:970 ),
210 (Typ:109; Name: ''; X:1650; Y:1020),
211 (Typ:110; Name: ''; X:1760; Y:1020),
212 (Typ:111; Name: ''; X:1760; Y:1250),
213 (Typ:112; Name: ''; X:2080; Y:1100),
214 (Typ:113; Name: ''; X:2200; Y:1100),
215 (Typ:114; Name: ''; X:2300; Y:1200),
216 (Typ:115; Name: ''; X:2300; Y:1600),
217 (Typ:116; Name: ''; X:3090; Y:1200),
218 (Typ:117; Name: ''; X:3240; Y:2290),
219 (Typ:118; Name: ''; X:4580; Y:3240),
220 (Typ:256; Name: ''; X:0; Y:0));
221
222 {$IFNDEF MSWINDOWS}
223 const
224 PPDPaperInfo: Array[0..PAPERCOUNT - 1] of TPaperInfo = (
225 (Typ:1; Name: 'Letter'; X:612; Y:792 ),
226 (Typ:2; Name: 'LetterSmall'; X:612; Y:792 ),
227 (Typ:3; Name: 'Tabloid'; X:792; Y:1224),
228 (Typ:4; Name: 'Ledger'; X:1224; Y:792 ),
229 (Typ:5; Name: 'Legal'; X:612; Y:1008),
230 (Typ:6; Name: 'Statement'; X:396; Y:612 ),
231 (Typ:7; Name: 'Executive'; X:522; Y:756 ),
232 (Typ:8; Name: 'A3'; X:842; Y:1191),
233 (Typ:9; Name: 'A4'; X:595; Y:842 ),
234 (Typ:10; Name: 'A4Small'; X:595; Y:842 ),
235 (Typ:11; Name: 'A5'; X:420; Y:595 ),
236 (Typ:12; Name: 'B4'; X:729; Y:1032),
237 (Typ:13; Name: 'B5'; X:516; Y:729 ),
238 (Typ:14; Name: 'Folio'; X:595; Y:936 ), // note 4
239 (Typ:15; Name: 'Quarto'; X:610; Y:780 ), // note 5
240 (Typ:16; Name: '10x14'; X:720; Y:1008),
241 (Typ:17; Name: '11x17'; X:792; Y:1224), // no ppd name for this
242 (Typ:18; Name: 'Note'; X:612; Y:792 ),
243 (Typ:19; Name: 'Env9'; X:279; Y:639 ),
244 (Typ:20; Name: 'Env10'; X:297; Y:684 ),
245 (Typ:21; Name: 'Env11'; X:324; Y:747 ),
246 (Typ:22; Name: 'Env12'; X:342; Y:792 ),
247 (Typ:23; Name: 'Env14'; X:360; Y:828 ),
248 (Typ:24; Name: 'ARCHC'; X:1296; Y:1728), // note 5, 18"x24"
249 (Typ:25; Name: 'ARCHD'; X:1728; Y:2592), // note 5 24"x36"
250 (Typ:26; Name: 'ARCHE'; X:2592; Y:3456), // note 5 36"x48"
251 (Typ:27; Name: 'EnvDL'; X:312; Y:624 ),
252 (Typ:28; Name: 'EnvC5'; X:459; Y:649 ),
253 (Typ:29; Name: 'EnvC3'; X:918; Y:1298), // sim note 4, 458mm=1298pt not 1296
254 (Typ:30; Name: 'EnvC4'; X:649; Y:918 ),
255 (Typ:31; Name: 'EnvC6'; X:323; Y:459 ),
256 (Typ:32; Name: 'EnvC65'; X:323; Y:649 ), // sim note 4, 229mm=649pt not 648
257 (Typ:33; Name: 'EnvISOB4'; X:708; Y:1001), // note 6
258 (Typ:34; Name: 'EnvISOB5'; X:499; Y:709 ),
259 (Typ:35; Name: 'EnvISOB6'; X:499; Y:354 ),
260 (Typ:36; Name: 'EnvItalian'; X:312; Y:652 ),
261 (Typ:37; Name: 'EnvMonarch'; X:279; Y:540 ),
262 (Typ:38; Name: 'EnvPersonal'; X:261; Y:468 ),
263 (Typ:39; Name: 'FanFoldUS'; X:1071; Y:792 ),
264 (Typ:40; Name: 'FanFoldGerman'; X:612; Y:864 ),
265 (Typ:41; Name: 'FanFoldGermanLegal'; X:612; Y:936 ),
266 (Typ:42; Name: 'ISOB4'; X:709; Y:1001),
267 (Typ:43; Name: 'Postcard'; X:284; Y:419 ), // note 6
268 (Typ:44; Name: '9x11'; X:648; Y:792 ),
269 (Typ:45; Name: '10x11'; X:720; Y:792 ),
270 (Typ:46; Name: '15x11'; X:1080; Y:792 ),
271 (Typ:47; Name: 'EnvInvite'; X:624; Y:624 ),
272 (Typ:50; Name: 'LetterExtra'; X:684; Y:864 ), // note 6
273 (Typ:51; Name: 'LegalExtra'; X:684; Y:1080), // note 6
274 (Typ:52; Name: 'TabloidExtra'; X:842; Y:1296),
275 (Typ:53; Name: 'A4Extra'; X:667; Y:914 ),
276 (Typ:54; Name: 'Letter.Transverse'; X:612; Y:792 ), // note 6
277 (Typ:55; Name: 'A4.Transverse'; X:595; Y:842 ),
278 (Typ:56; Name: 'LetterExtra.Transverse'; X:684; Y:864 ), // note 6
279 (Typ:57; Name: 'SuperA'; X:643; Y:1009),
280 (Typ:58; Name: 'SuperB'; X:864; Y:1380), // note 6
281 (Typ:59; Name: 'LetterPlus'; X:612; Y:914 ), // Y:913.4
282 (Typ:60; Name: 'A4Plus'; X:595; Y:936 ), // note 6
283 (Typ:61; Name: 'A5.Transverse'; X:420; Y:595 ),
284 (Typ:62; Name: 'B5.Transverse'; X:516; Y:729 ),
285 (Typ:63; Name: 'A3Extra'; X:913; Y:1262), // note 6
286 (Typ:64; Name: 'A5Extra'; X:493; Y:668 ), // note 6
287 (Typ:65; Name: 'ISOB5Extra'; X:570; Y:782 ), // X:569.7
288 (Typ:66; Name: 'A2'; X:1191; Y:1684),
289 (Typ:67; Name: 'A3.Transverse'; X:842; Y:1191),
290 (Typ:68; Name: 'A3Extra.Transverse'; X:913; Y:1262), // note 6
291 (Typ:69; Name: 'DoublePostcard'; X:567; Y:420 ), //Y:419.5
292 (Typ:70; Name: 'A6'; X:297; Y:420 ), // note 6
293 (Typ:71; Name: 'EnvKaku2'; X:680; Y:941 ), // note 6
294 (Typ:72; Name: 'EnvKaku3'; X:612; Y:785 ),
295 (Typ:73; Name: 'EnvChou3'; X:340; Y:666 ),
296 (Typ:74; Name: 'EnvChou4'; X:255; Y:581 ),
297 (Typ:75; Name: 'LetterRotated'; X:792; Y:612 ),
298 (Typ:76; Name: 'A3Rotated'; X:1191; Y:842 ),
299 (Typ:77; Name: 'A4Rotated'; X:842; Y:595 ),
300 (Typ:78; Name: 'A5Rotated'; X:595; Y:420 ),
301 (Typ:79; Name: 'B4Rotated'; X:1032; Y:729 ),
302 (Typ:80; Name: 'B5Rotated'; X:729; Y:516 ),
303 (Typ:81; Name: 'PostcardRotated'; X:419; Y:284 ), // note 6
304 (Typ:82; Name: 'DoublePostcardRotated'; X:420; Y:567 ), //X:419.5
305 (Typ:83; Name: 'A6Rotated'; X:420; Y:297 ), // note 6
306 (Typ:84; Name: 'EnvKaku2Rotated'; X:941; Y:680 ),
307 (Typ:85; Name: 'EnvKaku3Rotated'; X:785; Y:612 ),
308 (Typ:86; Name: 'EnvChou3Rotated'; X:666; Y:340 ),
309 (Typ:87; Name: 'EnvChou4Rotated'; X:581; Y:255 ),
310 (Typ:88; Name: 'B6'; X:363; Y:516 ),
311 (Typ:89; Name: 'B6Rotated'; X:516; Y:363 ),
312 (Typ:90; Name: '12x11'; X:864; Y:792 ),
313 (Typ:91; Name: 'EnvYou4'; X:298; Y:666 ),
314 (Typ:92; Name: 'EnvYouRotated'; X:666; Y:298 ),
315 (Typ:93; Name: 'PRC16K'; X:414; Y:610 ), // note 6
316 (Typ:94; Name: 'PRC32K'; X:275; Y:428 ),
317 (Typ:95; Name: 'PRC32KBig'; X:275; Y:428 ),
318 (Typ:96; Name: 'EnvPRC1'; X:289; Y:468 ),
319 (Typ:97; Name: 'EnvPRC2'; X:289; Y:499 ),
320 (Typ:98; Name: 'EnvPRC3'; X:354; Y:499 ),
321 (Typ:99; Name: 'EnvPRC4'; X:312; Y:590 ),
322 (Typ:100; Name: 'EnvPRC5'; X:312; Y:624 ),
323 (Typ:101; Name: 'EnvPRC6'; X:340; Y:652 ),
324 (Typ:102; Name: 'EnvPRC7'; X:454; Y:652 ),
325 (Typ:103; Name: 'EnvPRC8'; X:340; Y:876 ),
326 (Typ:104; Name: 'EnvPRC9'; X:649; Y:918 ),
327 (Typ:105; Name: 'EnvPRC10'; X:918; Y:1298),
328 (Typ:106; Name: 'PRC16KRotated'; X:610; Y:414 ), // note 6
329 (Typ:107; Name: 'PRC32KRotated'; X:428; Y:275 ),
330 (Typ:108; Name: 'PRC32KBigRotated'; X:428; Y:275 ),
331 (Typ:109; Name: 'EnvPRC1Rotated'; X:468; Y:289 ),
332 (Typ:110; Name: 'EnvPRC2Rotated'; X:499; Y:289 ),
333 (Typ:111; Name: 'EnvPRC3Rotated'; X:499; Y:354 ),
334 (Typ:112; Name: 'EnvPRC4Rotated'; X:590; Y:312 ),
335 (Typ:113; Name: 'EnvPRC5Rotated'; X:624; Y:312 ),
336 (Typ:114; Name: 'EnvPRC6Rotated'; X:652; Y:340 ),
337 (Typ:115; Name: 'EnvPRC7Rotated'; X:652; Y:454 ),
338 (Typ:116; Name: 'EnvPRC8Rotated'; X:876; Y:340 ),
339 (Typ:117; Name: 'EnvPRC9Rotated'; X:918; Y:649 ),
340 (Typ:118; Name: 'EnvPRC10Rotated'; X:1298; Y:918 ),
341 (typ:256; Name: ''; X:0; Y:0));
342
343 //
344 // Notes
345 //
346 // 1. Typ12, this is not ISOB4 which is Typ42, moreover, ISOB4 is
347 // 2500x3530 and not 2500x3540
348 //
349 // 2. New paper were added from here, Additional mappings were
350 // obtained from [1] appendix B Table B.1.
351 // Numeric defines were obtained from [2]
352 //
353 // 3. Folio for windows is probably 81/2"x13" (letter wide) while for [1]
354 // it is 8.27"x13" (A4 wide). Here [1] based value will be used but
355 // mapped to corresponding "windows folio" paper number DMPAPER_FOLIO(14)
356 //
357 // 4. [1] folio value gives 594x935 points for 8.27"x13" but 13" are
358 // exactly 936 points, the value 936 will be used though if ppd implementa
359 // tor follows exactly table [1] B.1, it can give unmatched papers
360 //
361 // 5. [1] and Windows doesn't match, same resolution than note 4.
362 //
363 // 6. [1] and Windows doesn't match, [1] value was choosen
364 //
365 // References
366 //
367 // [1] Adobe technote #5003: PPD spec v4.3
368 // http://partners.adobe.com/public/developer/ps/index_specs.html
369 //
370 // [2] Wine Project source code:
371 // http://source.winehq.org/source/include/wingdi.h#L2927
372 //
373 {$ENDIF}
374
375
376
Prnnull377 function Prn: TfrPrinter;
378 begin
379 if Assigned( GlobalPrn ) then
380 Exit( GlobalPrn );
381
382 GlobalPrn := TfrPrinter.Create;
383 try
384 GlobalPrn.Printer:=Printer;
385 except
386 on E: Exception do begin
387 debugln('lazreport: unit lr_prntr: ',E.Message);
388 end;
389 end;
390 Exit( GlobalPrn );
391 end;
392
393
394 {----------------------------------------------------------------------------}
395 constructor TfrPrinter.Create;
396 var
397 i: Integer;
398 begin
399 inherited Create;
400 GetMem(FDevice, 128);
401 GetMem(FDriver, 128);
402 GetMem(FPort, 128);
403 FPaperNames := TStringList.Create;
404 FPrinters := TStringList.Create;
405 i:=0;
406 PaperInfo[i].Name := sPaper1; Inc(i);
407 PaperInfo[i].Name := sPaper2; Inc(i);
408 PaperInfo[i].Name := sPaper3; Inc(i);
409 PaperInfo[i].Name := sPaper4; Inc(i);
410 PaperInfo[i].Name := sPaper5; Inc(i);
411 PaperInfo[i].Name := sPaper6; Inc(i);
412 PaperInfo[i].Name := sPaper7; Inc(i);
413 PaperInfo[i].Name := sPaper8; Inc(i);
414 PaperInfo[i].Name := sPaper9; Inc(i);
415
416 PaperInfo[i].Name := sPaper10; Inc(i);
417 PaperInfo[i].Name := sPaper11; Inc(i);
418 PaperInfo[i].Name := sPaper12; Inc(i);
419 PaperInfo[i].Name := sPaper12; Inc(i);
420 PaperInfo[i].Name := sPaper14; Inc(i);
421 PaperInfo[i].Name := sPaper15; Inc(i);
422 PaperInfo[i].Name := sPaper16; Inc(i);
423 PaperInfo[i].Name := sPaper17; Inc(i);
424 PaperInfo[i].Name := sPaper18; Inc(i);
425 PaperInfo[i].Name := sPaper19; Inc(i);
426
427 PaperInfo[i].Name := sPaper20; Inc(i);
428 PaperInfo[i].Name := sPaper21; Inc(i);
429 PaperInfo[i].Name := sPaper22; Inc(i);
430 PaperInfo[i].Name := sPaper22; Inc(i);
431 PaperInfo[i].Name := sPaper24; Inc(i);
432 PaperInfo[i].Name := sPaper25; Inc(i);
433 PaperInfo[i].Name := sPaper26; Inc(i);
434 PaperInfo[i].Name := sPaper27; Inc(i);
435 PaperInfo[i].Name := sPaper28; Inc(i);
436 PaperInfo[i].Name := sPaper29; Inc(i);
437
438 PaperInfo[i].Name := sPaper30; Inc(i);
439 PaperInfo[i].Name := sPaper31; Inc(i);
440 PaperInfo[i].Name := sPaper32; Inc(i);
441 PaperInfo[i].Name := sPaper32; Inc(i);
442 PaperInfo[i].Name := sPaper34; Inc(i);
443 PaperInfo[i].Name := sPaper35; Inc(i);
444 PaperInfo[i].Name := sPaper36; Inc(i);
445 PaperInfo[i].Name := sPaper37; Inc(i);
446 PaperInfo[i].Name := sPaper38; Inc(i);
447 PaperInfo[i].Name := sPaper39; Inc(i);
448
449 PaperInfo[i].Name := sPaper40; Inc(i);
450 PaperInfo[i].Name := sPaper41; Inc(i);
451 PaperInfo[i].Name := sPaper42; Inc(i);
452 PaperInfo[i].Name := sPaper42; Inc(i);
453 PaperInfo[i].Name := sPaper44; Inc(i);
454 PaperInfo[i].Name := sPaper45; Inc(i);
455 PaperInfo[i].Name := sPaper46; Inc(i);
456 PaperInfo[i].Name := sPaper47; Inc(i);
457
458 PaperInfo[i].Name := sPaper50; Inc(i);
459 PaperInfo[i].Name := sPaper51; Inc(i);
460 PaperInfo[i].Name := sPaper52; Inc(i);
461 PaperInfo[i].Name := sPaper52; Inc(i);
462 PaperInfo[i].Name := sPaper54; Inc(i);
463 PaperInfo[i].Name := sPaper55; Inc(i);
464 PaperInfo[i].Name := sPaper56; Inc(i);
465 PaperInfo[i].Name := sPaper57; Inc(i);
466 PaperInfo[i].Name := sPaper58; Inc(i);
467 PaperInfo[i].Name := sPaper59; Inc(i);
468
469 PaperInfo[i].Name := sPaper60; Inc(i);
470 PaperInfo[i].Name := sPaper61; Inc(i);
471 PaperInfo[i].Name := sPaper62; Inc(i);
472 PaperInfo[i].Name := sPaper62; Inc(i);
473 PaperInfo[i].Name := sPaper64; Inc(i);
474 PaperInfo[i].Name := sPaper65; Inc(i);
475 PaperInfo[i].Name := sPaper66; Inc(i);
476 PaperInfo[i].Name := sPaper67; Inc(i);
477 PaperInfo[i].Name := sPaper68; Inc(i);
478 // new papers
479 PaperInfo[i].Name := sPaper69; Inc(i);
480
481 PaperInfo[i].Name := sPaper70; Inc(i);
482 PaperInfo[i].Name := sPaper71; Inc(i);
483 PaperInfo[i].Name := sPaper72; Inc(i);
484 PaperInfo[i].Name := sPaper72; Inc(i);
485 PaperInfo[i].Name := sPaper74; Inc(i);
486 PaperInfo[i].Name := sPaper75; Inc(i);
487 PaperInfo[i].Name := sPaper76; Inc(i);
488 PaperInfo[i].Name := sPaper77; Inc(i);
489 PaperInfo[i].Name := sPaper78; Inc(i);
490 PaperInfo[i].Name := sPaper79; Inc(i);
491
492 PaperInfo[i].Name := sPaper80; Inc(i);
493 PaperInfo[i].Name := sPaper81; Inc(i);
494 PaperInfo[i].Name := sPaper82; Inc(i);
495 PaperInfo[i].Name := sPaper82; Inc(i);
496 PaperInfo[i].Name := sPaper84; Inc(i);
497 PaperInfo[i].Name := sPaper85; Inc(i);
498 PaperInfo[i].Name := sPaper86; Inc(i);
499 PaperInfo[i].Name := sPaper87; Inc(i);
500 PaperInfo[i].Name := sPaper88; Inc(i);
501 PaperInfo[i].Name := sPaper89; Inc(i);
502
503 PaperInfo[i].Name := sPaper90; Inc(i);
504 PaperInfo[i].Name := sPaper91; Inc(i);
505 PaperInfo[i].Name := sPaper92; Inc(i);
506 PaperInfo[i].Name := sPaper92; Inc(i);
507 PaperInfo[i].Name := sPaper94; Inc(i);
508 PaperInfo[i].Name := sPaper95; Inc(i);
509 PaperInfo[i].Name := sPaper96; Inc(i);
510 PaperInfo[i].Name := sPaper97; Inc(i);
511 PaperInfo[i].Name := sPaper98; Inc(i);
512 PaperInfo[i].Name := sPaper99; Inc(i);
513
514 PaperInfo[i].Name := sPaper100; Inc(i);
515 PaperInfo[i].Name := sPaper101; Inc(i);
516 PaperInfo[i].Name := sPaper102; Inc(i);
517 PaperInfo[i].Name := sPaper103; Inc(i);
518 PaperInfo[i].Name := sPaper104; Inc(i);
519 PaperInfo[i].Name := sPaper105; Inc(i);
520 PaperInfo[i].Name := sPaper106; Inc(i);
521 PaperInfo[i].Name := sPaper107; Inc(i);
522 PaperInfo[i].Name := sPaper108; Inc(i);
523 PaperInfo[i].Name := sPaper109; Inc(i);
524
525 PaperInfo[i].Name := sPaper110; Inc(i);
526 PaperInfo[i].Name := sPaper111; Inc(i);
527 PaperInfo[i].Name := sPaper112; Inc(i);
528 PaperInfo[i].Name := sPaper113; Inc(i);
529 PaperInfo[i].Name := sPaper114; Inc(i);
530 PaperInfo[i].Name := sPaper115; Inc(i);
531 PaperInfo[i].Name := sPaper116; Inc(i);
532 PaperInfo[i].Name := sPaper117; Inc(i);
533 PaperInfo[i].Name := sPaper118; Inc(i);
534 end;
535
536 destructor TfrPrinter.Destroy;
537 begin
538 FreeMem(FDevice, 128);
539 FreeMem(FDriver, 128);
540 FreeMem(FPort, 128);
541 FPaperNames.Free;
542 FPrinters.Free;
543 inherited Destroy;
544 end;
545
546 {$IFNDEF MSWINDOWS}
547 {
548 DMPAPER_LETTER = 1; sPaper1 = 'Letter, 8 1/2 x 11"';
549 DMPAPER_LETTERSMALL = 2; sPaper2 = 'Letter small, 8 1/2 x 11"';
550 DMPAPER_TABLOID = 3; sPaper3 = 'Tabloid, 11 x 17"';
551 DMPAPER_LEDGER = 4; sPaper4 = 'Ledger, 17 x 11"';
552 DMPAPER_LEGAL = 5; sPaper5 = 'Legal, 8 1/2 x 14"';
553 DMPAPER_STATEMENT = 6; sPaper6 = 'Statement, 5 1/2 x 8 1/2"';
554 DMPAPER_EXECUTIVE = 7; sPaper7 = 'Executive, 7 1/4 x 10 1/2"';
555 DMPAPER_A3 = 8; sPaper8 = 'A3 297 x 420 mm';
556 DMPAPER_A4 = 9; sPaper9 = 'A4 210 x 297 mm';
557 DMPAPER_A4SMALL = 10; sPaper10 = 'A4 small sheet, 210 x 297 mm';
558 DMPAPER_A5 = 11; sPaper11 = 'A5 148 x 210 mm';
559 DMPAPER_B4 = 12; sPaper12 = 'B4 250 x 354 mm';
560 DMPAPER_B5 = 13; sPaper13 = 'B5 182 x 257 mm';
561 DMPAPER_FOLIO = 14; sPaper14 = 'Folio, 8 1/2 x 13"';
562 DMPAPER_QUARTO = 15; sPaper15 = 'Quarto Sheet, 215 x 275 mm';
563 DMPAPER_10X14 = 16; sPaper16 = '10 x 14"';
564 DMPAPER_11X17 = 17; sPaper17 = '11 x 17"';
565 DMPAPER_NOTE = 18; sPaper18 = 'Note, 8 1/2 x 11"';
566 DMPAPER_ENV_9 = 19; sPaper19 = '9 Envelope, 3 7/8 x 8 7/8"';
567 DMPAPER_ENV_10 = 20; sPaper20 = '#10 Envelope, 4 1/8 x 9 1/2"';
568
569 DMPAPER_ENV_11 = 21; sPaper21 = '#11 Envelope, 4 1/2 x 10 3/8"';
570 DMPAPER_ENV_12 = 22; sPaper22 = '#12 Envelope, 4 3/4 x 11"';
571 DMPAPER_ENV_14 = 23; sPaper23 = '#14 Envelope, 5 x 11 1/2"';
572 DMPAPER_CSHEET = 24; sPaper24 = 'C Sheet, 17 x 22"';
573 DMPAPER_DSHEET = 25; sPaper25 = 'D Sheet, 22 x 34"';
574 DMPAPER_ESHEET = 26; sPaper26 = 'E Sheet, 34 x 44"';
575 DMPAPER_ENV_DL = 27; sPaper27 = 'DL Envelope, 110 x 220 mm';
576 DMPAPER_ENV_C5 = 28; sPaper28 = 'C5 Envelope, 162 x 229 mm';
577 DMPAPER_ENV_C3 = 29; sPaper29 = 'C3 Envelope, 324 x 458 mm';
578 DMPAPER_ENV_C4 = 30; sPaper30 = 'C4 Envelope, 229 x 324 mm';
579 DMPAPER_ENV_C6 = 31; sPaper31 = 'C6 Envelope, 114 x 162 mm';
580 DMPAPER_ENV_C65 = 32; sPaper32 = 'C65 Envelope, 114 x 229 mm';
581 DMPAPER_ENV_B4 = 33; sPaper33 = 'B4 Envelope, 250 x 353 mm';
582 DMPAPER_ENV_B5 = 34; sPaper34 = 'B5 Envelope, 176 x 250 mm';
583 DMPAPER_ENV_B6 = 35; sPaper35 = 'B6 Envelope, 176 x 125 mm';
584 DMPAPER_ENV_ITALY = 36; sPaper36 = 'Italy Envelope, 110 x 230 mm';
585 DMPAPER_ENV_MONARCH = 37; sPaper37 = 'Monarch Envelope, 3 7/8 x 7 1/2"';
586 DMPAPER_ENV_PERSONAL = 38; sPaper38 = '6 3/4 Envelope, 3 5/8 x 6 1/2"';
587 DMPAPER_FANFOLD_US = 39; sPaper39 = 'US Std Fanfold, 14 7/8 x 11"';
588 DMPAPER_FANFOLD_STD_GERMAN = 40; sPaper40 = 'German Std Fanfold, 8 1/2 x 12"';
589 DMPAPER_FANFOLD_LGL_GERMAN = 41; sPaper41 = 'German Legal Fanfold, 8 1/2 x 13"';
590
591 DMPAPER_ISO_B4 = 42; sPaper42 = 'B4 (ISO) 250 x 353 mm';
592 DMPAPER_JAPANESE_POSTCARD = 43; sPaper43 = 'Japanese Postcard 100 x 148 mm';
593 DMPAPER_9X11 = 44; sPaper44 = '9 x 11"';
594 DMPAPER_10X11 = 45; sPaper45 = '10 x 11"';
595 DMPAPER_15X11 = 46; sPaper46 = '15 x 11"';
596 DMPAPER_ENV_INVITE = 47; sPaper47 = 'Envelope Invite 220 x 220 mm';
597 DMPAPER_RESERVED_48 = 48; sPaper48 = '???? Reservado 48'
598 DMPAPER_RESERVED_49 = 49; sPaper49 = '???? Reservado 49'
599 DMPAPER_LETTER_EXTRA = 50; sPaper50 = 'Letter Extra 9/275 x 12"';
600 DMPAPER_LEGAL_EXTRA = 51; sPaper51 = 'Legal Extra 9/275 x 15"';
601 DMPAPER_TABLOID_EXTRA = 52; sPaper52 = 'Tabloid Extra 11.69 x 18"';
602 DMPAPER_A4_EXTRA = 53; sPaper53 = 'A4 Extra 9.27 x 12.69"';
603 DMPAPER_LETTER_TRANSVERSE = 54; sPaper54 = 'Letter Transverse 8/275 x 11"';
604 DMPAPER_A4_TRANSVERSE = 55; sPaper55 = 'A4 Transverse 210 x 297 mm';
605 DMPAPER_LETTER_EXTRA_TRANSVERSE = 56; sPaper56 = 'Letter Extra Transverse 9/275 x 12"';
606 DMPAPER_A_PLUS = 57; sPaper57 = 'SuperASuperAA4 227 x 356 mm';
607 DMPAPER_B_PLUS = 58; sPaper58 = 'SuperBSuperBA3 305 x 487 mm';
608 DMPAPER_LETTER_PLUS = 59; sPaper59 = 'Letter Plus 8.5 x 12.69"';
609 DMPAPER_A4_PLUS = 60; sPaper60 = 'A4 Plus 210 x 330 mm';
610 DMPAPER_A5_TRANSVERSE = 61; sPaper61 = 'A5 Transverse 148 x 210 mm';
611 DMPAPER_B5_TRANSVERSE = 62; sPaper62 = 'B5 (JIS) Transverse 182 x 257 mm';
612 DMPAPER_A3_EXTRA = 63; sPaper63 = 'A3 Extra 322 x 445 mm';
613 DMPAPER_A5_EXTRA = 64; sPaper64 = 'A5 Extra 174 x 235 mm';
614 DMPAPER_B5_EXTRA = 65; sPaper65 = 'B5 (ISO) Extra 201 x 276 mm';
615 DMPAPER_A2 = 66; sPaper66 = 'A2 420 x 594 mm';
616 DMPAPER_A3_TRANSVERSE = 67; sPaper67 = 'A3 Transverse 297 x 420 mm';
617 DMPAPER_A3_EXTRA_TRANSVERSE = 68; sPaper68 = 'A3 Extra Transverse 322 x 445 mm';
618
619 DMPAPER_DBL_JAPANESE_POSTCARD = 69; // 200x148
620 DMPAPER_A6 = 70; // 105X148
621 DMPAPER_JENV_KAKU2 = 71; // 240X132
622 DMPAPER_JENV_KAKU3 = 72; // 216X277
623 DMPAPER_JENV_CHOU3 = 73; // 120X235
624 DMPAPER_JENV_CHOU4 = 74; // 90X205
625 DMPAPER_LETTER_ROTATED = 75; // 279.4x215.9
626 DMPAPER_A3_ROTATED = 76; // 420x297
627 DMPAPER_A4_ROTATED = 77; // 297X210
628 DMPAPER_A5_ROTATED = 78; // 210X148
629 DMPAPER_B4_JIS_ROTATED = 79; // 364X257
630 DMPAPER_B5_JIS_ROTATED = 80; // 257X182
631 DMPAPER_JAPANESE_POSTCARD_ROTATED = 81; // 148X100
632 DMPAPER_DBL_JAPANESE_POSTCARD_ROTATED = 82; // 148X200
633 DMPAPER_A6_ROTATED = 83; // 148X105
634 DMPAPER_JENV_KAKU2_ROTATED = 84; // 332X240
635 DMPAPER_JENV_KAKU3_ROTATED = 85; // 277X216
636 DMPAPER_JENV_CHOU3_ROTATED = 86; // 235X120
637 DMPAPER_JENV_CHOU4_ROTATED = 87; // 205X90
638 DMPAPER_B6_JIS = 88; // 128X122
639 DMPAPER_B6_JIS_ROTATED = 89; // 182X128
640 DMPAPER_12X11 = 90; // 304.8X279.4
641 DMPAPER_JENV_YOU4 = 91; // 105X235
642 DMPAPER_JENV_YOU4_ROTATED = 92; // 235X105
643 DMPAPER_P16K = 93; // 146X215
644 DMPAPER_P32K = 94; // 97X151
645 DMPAPER_P32KBIG = 95; // 97X151
646 DMPAPER_PENV_1 = 96; // 102X165
647 DMPAPER_PENV_2 = 97; // 102X176
648 DMPAPER_PENV_3 = 98; // 125X176
649 DMPAPER_PENV_4 = 99; // 110X208
650 DMPAPER_PENV_5 = 100; // 110X220
651 DMPAPER_PENV_6 = 101; // 120X230
652 DMPAPER_PENV_7 = 102; // 160X230
653 DMPAPER_PENV_8 = 103; // 120X309
654 DMPAPER_PENV_9 = 104; // 229X324
655 DMPAPER_PENV_10 = 105; // 324X458
656 DMPAPER_P16K_ROTATED = 106; // 215X146
657 DMPAPER_P32K_ROTATED = 107; // 151X97
658 DMPAPER_P32KBIG_ROTATED = 108; // 151X97
659 DMPAPER_PENV_1_ROTATED = 109; // 165X102
660 DMPAPER_PENV_2_ROTATED = 110; // 176X102
661 DMPAPER_PENV_3_ROTATED = 111; // 176X125
662 DMPAPER_PENV_4_ROTATED = 112; // 208X110
663 DMPAPER_PENV_5_ROTATED = 113; // 220X110
664 DMPAPER_PENV_6_ROTATED = 114; // 230X120
665 DMPAPER_PENV_7_ROTATED = 115; // 230X160
666 DMPAPER_PENV_8_ROTATED = 116; // 309X120
667 DMPAPER_PENV_9_ROTATED = 117; // 324X229
668 DMPAPER_PENV_10_ROTATED = 118; // 458X324
669 }
670
MatchWindowsPapernull671 function MatchWindowsPaper(aPaperName: string): integer;
672 var
673 i, aWidth, aHeight, BDeltaW, BDeltaH, BIndex,Cw,Ch: Integer;
674 PaperRect: TPaperRect;
675 ValidSize: Boolean;
676 {$ifdef DbgPrinter_detail}
677 BestDw, BestDh: Integer;
678
dbgspnull679 function dbgsp: string;
680 begin
681 if i>=0 then
682 result := format(' askW=%d askH=%d rspW=%d rspH=%d',
683 [aWidth, aHeight, PPDPaperInfo[i].X, PPDPaperInfo[i].Y]);
684 end;
685 {$endif}
686 begin
687 result := -1;
688
689 ValidSize := true;
690 try
691 PaperRect := prn.Printer.PaperSize.PaperRectOf[aPaperName];
692 aWidth := round((PaperRect.PhysicalRect.Right-PaperRect.PhysicalRect.Left) * 72 / prn.Printer.XDPI);
693 aHeight := round((PaperRect.PhysicalRect.Bottom-PaperRect.PhysicalRect.Top) * 72 / prn.Printer.YDPI);
694 except
695 ValidSize := false;
696 end;
697
698 BIndex := -1;
699 BDeltaW := 2013;
700 BDeltaH := 2013;
701 {$ifdef DbgPrinter_detail}
702 BestDw := BDeltaW;
703 BestDh := BDeltaH;
704 {$endif}
705
706 // name
707 for i:=0 to PAPERCOUNT-1 do
708 with PPDPaperInfo[i] do
709 begin
710 if CompareText(Name, aPaperName)=0 then
711 begin
712 // found
713 {$ifdef DbgPrinter_detail}DebugLn('i=%d Perfect Name Match %s %s',[i, Name, dbgsp]);{$Endif}
714 result := Typ;
715 exit;
716 end;
717 end;
718
719 // size match
720 for i:=0 to PAPERCOUNT-1 do
721 with PPDPaperInfo[i] do
722 begin
723 if ValidSize and (X>=aWidth) and (Y>=aHeight) then
724 begin
725 // only interested on papers that are same or bigger size than match paper
726 Cw := X-aWidth;
727 Ch := Y-aHeight;
728 if (Cw=0) and (Ch=0) then
729 begin
730 // no need to look more, perfect match
731 {$ifdef DbgPrinter_detail}DebugLn('i=%d Perfect Size Match w=%d h=%d "%s"->%s %s',[i,X,Y,aPaperName,Name, dbgsp]);{$Endif}
732 BIndex := i;
733 break;
734 end else
735 begin
736 {$ifdef DbgPrinter_detail}
737 if (Cw<BestDw) and (Ch<BestDh) then begin
738 BestDw := Cw;
739 BestDh := Ch;
740 end;
741 {$endif}
742 if (Cw<6) and (Ch<6) and (Cw<=BDeltaW) and (Cw<=BDeltaH) then
743 begin
744 {$ifdef DbgPrinter_detail}DebugLn('i=%d Close Size cw=%d ch=%d "%s"->%s %s',[i,cw,ch,aPaperName,Name, dbgsp]);{$endif}
745 // we are interested only on differences with searched paper of
746 // about 2 mm or less (1 mm is aprox 3 points)
747 BIndex := i;
748 BDeltaW := Cw;
749 BDeltaH := CH;
750 end
751 {$ifdef DbgPrinter_detail}
752 //else
753 // DebugLn('i=%d Missed cw=%d ch=%d %s',[i, cw, ch, Name])
754 {$endif}
755 end;
756 end;
757 end;
758
759 if bIndex>=0 then
760 begin
761 result := PPDPaperInfo[bIndex].Typ
762 end
763 {$ifdef DbgPrinter_detail}
764 else
765 DebugLn('Matching Paper %s failed BestDw=%d BestDh=%d',[aPaperName, BestDw, BestDh])
766 {$endif}
767 ;
768 end;
769
770 {$ENDIF}
771
772 procedure TfrPrinter.GetSettings(PrinterChanged: boolean = true);
773 var
774 i: Integer;
775 n: Integer;
776 begin
777 {$ifdef DbgPrinter}
778 DebugLnEnter(['TfrPrinter.GetSettings INIT: PrinterChanged: ', PrinterChanged]);
779 {$endif}
780 if fPrinter.Printers.Count>0 then
781 begin
782 if PrinterChanged then begin
783 fPaperNames.Assign(fPrinter.PaperSize.SupportedPapers);
784 PaperSizesNum:=FPaperNames.Count;
785 end;
786 {$ifdef DbgPrinter}
787 DebugLn(['Filling windows paper numbers for ', PaperSizesNum,' papers ....']);
788 {$endif}
789 {$IFNDEF MSWINDOWS}
790 // Under no windows platforms, there is no unique number that indentify
791 // papers, so we have to fill here our own numbers, this should be based
792 // on windows numbers so stored page numbers could be used under any
793 // platform.
794 //
795 // Under cups (ie, using ppd files), ppd file builders can add paper names
796 // not included in ref [1], that difficult the selection of papers
797 if PrinterChanged then
798 for i:=0 to FPaperNames.Count-1 do
799 begin
800
801 n := MatchWindowsPaper(FPaperNames[i]);
802 if n<0 then
803 // it's a non windows standard paper, mark it
804 // as custom size paper but one that we will be
805 // able to recognize later as an index within the
806 // list of papers for current printer
807 n := 1000 + i;
808
809 PaperSizes[i] := n;
810 FPaperNames.Objects[i] := TObject(PtrInt(n)); // this is used under page options
811 // dialog to show if the paper item
812 // is a windows paper or other thing
813 end;
814 {$ELSE}
815 for i:=0 to FPaperNames.Count-1 do
816 PaperSizes[i] := PtrInt(FPaperNames.Objects[i]);
817 {$ENDIF}
818
819 {$IFDEF DbgPrinter_detail}
820 DebugLn(['Dump printer List of papers for ''',fPrinter.PrinterName,''' :']);
821
822 n := FPapernames.IndexOf(FPrinter.PaperSize.PaperName);
823 if n<0 then
824 // try to get the PaperIndex of the default paper
825 n := DefaultPaperIndex();
826
827 // don't update the paper size so custom papersizes as 1000's and 2000's
828 // will be preserved and so, the right paper will be selected when choosing
829 // the same printer.
830 //
831 //PaperSize := PaperSizes[n];
832
833 /// Debug Information
834 for i:=0 to FPaperNames.Count-1 do begin
835 DbgOut('%4d ',[i]);
836 if i=n then
837 DbgOut('*')
838 else
839 DbgOut(' ');
840 DebugLn(' WinNum=%5d Paper=%s', [PaperSizes[i], FPaperNames[i]]);
841 end;
842 {$Endif}
843 {$IFDEF DbgPrinter}
844 DebugLn('Current PaperSize is %d',[PaperSize]);
845 {$ENDIF}
846
847 try
848 // update paper size in std pt units
849 PaperWidth := round(fPrinter.PaperSize.Width * 72 / fPrinter.XDPI);
850 PaperHeight := round(fPrinter.PaperSize.Height * 72 / fPrinter.YDPI);
851 Orientation := fPrinter.Orientation;
852 except
853 PaperWidth:=1;
854 PaperHeight:=1;
855 // let it as it was ....
856 raise
857 end;
858 end;
859 {$ifdef DbgPrinter}
860 DebugLnExit('TfrPrinter.GetSettings DONE: Paper w=%d h=%d or=%d', [PaperWidth, PaperHeight, ord(Orientation)]);
861 {$endif}
862 end;
863
864 procedure TfrPrinter.SetSettings;
865 var
866 i, n: Integer;
867 {$ifdef DbgPrinter}
868 s: string;
869 {$endif}
870 begin
871 {$ifdef DbgPrinter}
872 WriteStr(s, Orientation);
873 DebugLnEnter(['TfrPrinter.SetSettings INIT: PrinterIndex=',FPrinterIndex]);
874 DebugLn(['PaperSize =', PaperSize]);
875 DebugLn(['PaperWidth =', PaperWidth]);
876 DebugLn(['PaperHeight=', PaperHeight]);
877 DebugLn(['Orientation=', s]);
878 {$Endif}
879 // if selected printer is default printer, ie our virtual printer
880 // then select our own set of papers
881 if UseVirtualPrinter then
882 begin
883 (*
884 // a papersize has been selected, maybe from a page recently loaded
885 // or from a previous selected printer, the old PrinterIndex, is not
886 // the new printer index.
887 //
888 // based on the old information, find a suitable paper within our own
889 // custom paper list.
890 *)
891 {$ifdef DbgPrinter}
892 DebugLn('DefaultPrinter, setting up defaultSet of Papers');
893 {$endif}
894 n := -1;
895 FPaperNames.Clear;
896 for i := 0 to PAPERCOUNT - 1 do
897 begin
898 FPaperNames.AddObject(PaperInfo[i].Name, TObject(PtrInt(PaperInfo[i].Typ)));
899 PaperSizes[i] := PaperInfo[i].Typ;
900 if (PaperSize <> $100) and (PaperSize = PaperInfo[i].Typ) then
901 begin
902 {$ifdef DbgPrinter}
903 DebugLn(['DefaultPrinter, PaperSize=',PaperSize,' Corresponds to ', PaperInfo[i].Name]);
904 {$endif}
905 n := i;
906 if Orientation = poLandscape then
907 begin
908 PaperWidth := PaperInfo[i].Y;
909 PaperHeight := PaperInfo[i].X;
910 end else
911 begin
912 PaperWidth := PaperInfo[i].X;
913 PaperHeight := PaperInfo[i].Y;
914 end;
915 break;
916 end;
917 end;
918 PaperSizesNum := PAPERCOUNT;
919 if (n<0) and (FDocumentUnits=puPoints) then
920 begin
921 // Paper units are points and paperSize didn't match any predefined
922 // paper, yet SetFillInfo expects tenths of mm, convert them here.
923 PaperWidth := round(PaperWidth*254/72);
924 PaperHeight := round(PaperHeight*254/72);
925 end;
926 {$IFDEF DbgPrinter}
927 DebugLnExit('TfrPrinter.SetSettings: EXIT (default printer)');
928 {$ENDIF}
929 Exit;
930 end;
931
932 FPrinter.Orientation := Orientation;
933
934 if PaperSize>=1000 then begin
935 // paper sizes above 1000 have an encoded index
936 // in order to use a real paper from the list instead of a custom
937 // paper for not being a standard windows paper
938 //
939 i := PaperSize-1000;
940 if (i>=0)and(i<FPaperNames.Count) then
941 FPrinter.PaperSize.PaperName := FPaperNames[i];
942 {$IFDEF DbgPrinter}
943 DebugLn(['PaperSize (NoWin)CupsPaper requested: PaperSize=', PaperSize,' i=',i,' Paper=',FPrinter.PaperSize.PaperName]);
944 {$ENDIF}
945 end else
946 if PaperSize=256 then begin
947 // todo: real USER custom sized papers are handled here
948 // requested custom paper size currently is not
949 // supported by printer4lazarus
950 {$IFDEF DbgPrinter}
951 DebugLn('PaperSize Setting CustomPaper width=%d height=%d', [paperWidth, paperHeight]);
952 {$ENDIF}
953 FPrinter.PaperSize.PaperRect := GetPaperRect;
954 end else begin
955 // Standard paper sizes are handled here
956 n := -1;
957 for i:=0 to PaperSizesNum-1 do
958 if PaperSizes[i]=PaperSize then begin
959 n:=i;
960 FPrinter.PaperSize.PaperName := PaperNames[i];
961 break;
962 end;
963 if (n<0) and (PaperWidth>1) and (PaperHeight>1) then
964 begin
965 // this standard paperSize was not found by number
966 // try to find a suitable paper size within the list
967 // of printer papers based on Paper's width and height
968 n := MatchPrinterPaper(PaperWidth, PaperHeight);
969 if n>=0 then begin
970 FPrinter.PaperSize.PaperName := FPrinter.PaperSize.SupportedPapers[n];
971 // actually PaperSize is a better choice than PaperSizes[n], Update it
972 PaperSizes[n] := PaperSize;
973 end;
974 end;
975
976 {$IFDEF DbgPrinter}
977 DebugLn(['PaperSize standard requested: PaperSize=', PaperSize,' i=',i,' Paper=', FPrinter.PaperSize.PaperName]);
978 {$ENDIF}
979 end;
980
981 {FPrinter.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
982 try
983 FMode := GlobalLock(FDeviceMode);
984 if PaperSize = $100 then
985 begin
986 FMode.dmFields := FMode.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
987 FMode.dmPaperLength := PaperHeight;
988 FMode.dmPaperWidth := PaperWidth;
989 end;
990
991 if (FMode.dmFields and DM_PAPERSIZE) <> 0 then
992 FMode.dmPaperSize := PaperSize;
993
994 if (FMode.dmFields and DM_ORIENTATION) <> 0 then
995 if Orientation = poPortrait then
996 FMode.dmOrientation := DMORIENT_PORTRAIT else
997 FMode.dmOrientation := DMORIENT_LANDSCAPE;
998
999 if (FMode.dmFields and DM_COPIES) <> 0 then
1000 FMode.dmCopies := 1;
1001
1002 FPrinter.SetPrinter(FDevice, FDriver, FPort, FDeviceMode);
1003 finally
1004 GlobalUnlock(FDeviceMode);
1005 end;
1006 }
1007
1008 GetSettings( False );
1009 {$IFDEF DbgPrinter}
1010 DebugLnExit('TfrPrinter.SetSettings DONE');
1011 {$ENDIF}
1012 end;
1013
1014 procedure TfrPrinter.FillPrnInfo(var p: TfrPrnInfo);
1015 var
1016 kx, ky: Double;
1017 begin
1018 {$ifdef DbgPrinter}
1019 DebugLnEnter('TfrPrinter.FillPrnInfo INIT IsVirtualPrn=%s DocUnits=%d PWidth=%d PHeight=%d',
1020 [dbgs(UseVirtualPrinter), ord(DocumentUnits), PaperWidth, PaperHeight]);
1021 {$endif}
1022
1023 kx := 93 / 1.022;
1024 ky := 93 / 1.015;
1025
1026 if UseVirtualPrinter then
1027 begin
1028 with p do
1029 begin
1030 Pgw := Round(PaperWidth * kx / 254);
1031 Pgh := Round(PaperHeight * ky / 254);
1032 Ofx := Round(50 * kx / 254);
1033 Ofy := Round(50 * ky / 254);
1034 Pw := Pgw - Ofx * 2;
1035 Ph := Pgh - Ofy * 2;
1036
1037 //fix DPI for virtual printer
1038 ResX := 300;
1039 ResY := 300;
1040 end
1041 end
1042 else
1043 begin
1044 with p, FPrinter do
1045 begin
1046 kx := kx / XDPI; //GetDeviceCaps(Handle, LOGPIXELSX);
1047 ky := ky / YDPI; //GetDeviceCaps(Handle, LOGPIXELSY);
1048
1049 // printer sizes
1050 with PaperSize.PaperRect do begin
1051 PPgw := PhysicalRect.Right-PhysicalRect.Left;
1052 Ppgh := PhysicalRect.Bottom-PhysicalRect.Top;
1053 POFx := WorkRect.Left;
1054 POFy := WorkRect.Top;
1055 PPw := WorkRect.Right-WorkRect.Left; // this is the same as PageWidth
1056 PPh := WorkRect.Bottom-WorkRect.Top; // this is the same as PageHeight
1057 end;
1058
1059 // screen sizes
1060 Pgw := round(PPgw * kx);
1061 Pgh := round(PPgh * ky);
1062 Ofx := round(POfx * kx);
1063 Ofy := round(POfy * ky);
1064 Pw := round(PPw * kx);
1065 Ph := round(PPh * ky);
1066
1067 ResX := XDPI;
1068 ResY := YDPI;
1069
1070 {$IFDEF DbgPrinter}
1071 DebugLn(['[prn] PPgw/PPgh=', PPgw,'/',Ppgh,' [scr] Pgw/Pgh=', Pgw,'/',Pgh]);
1072 DebugLn(['[prn] POfx/POfy=', POfx,'/',Pofy,' [scr] Ofx/Ofy=', Ofx,'/',Ofy]);
1073 DebugLn(['[prn] PPw/ PPh=', PPw,'/',PPh, ' [scr] Pw/ Ph=', Pw,'/',Ph]);
1074 {$ENDIF}
1075 end;
1076 end;
1077 {$ifdef DbgPrinter}
1078 DebugLnExit('TfrPrinter.FillPrnInfo END');
1079 {$endif}
1080 end;
1081
TfrPrinter.IsEqualnull1082 function TfrPrinter.IsEqual(pgSize, pgWidth, pgHeight: Integer;
1083 pgOr: TPrinterOrientation): Boolean;
1084 begin
1085 if (PaperSize = pgSize) and (pgSize = $100) then
1086 Result := (PaperSize = pgSize) and (PaperWidth = pgWidth) and
1087 (PaperHeight = pgHeight) and (Orientation = pgOr)
1088 else
1089 Result := (PaperSize = pgSize) and (Orientation = pgOr);
1090 end;
1091
1092 procedure TfrPrinter.SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer;
1093 pgOr: TPrinterOrientation);
1094 begin
1095 {$ifdef DbgPrinter}
1096 DebugLnEnter('TfrPrinter.SetPrinterInfo INIT pgSize=%d pgWidth=%d pgHeight=%d pgOr=%d',
1097 [pgSize, pgWidth, pgHeight, ord(pgOr)]);
1098 {$endif}
1099 if IsEqual(pgSize, pgWidth, pgHeight, pgOr) then
1100 begin
1101 {$ifdef DbgPrinter}
1102 DebugLnExit('TfrPrinter.SetPrinterInfo EXIT: same properties');
1103 {$endif}
1104 Exit;
1105 end;
1106 PaperSize:=PgSize;
1107 PaperWidth:= pgWidth;
1108 PaperHeight:=pgHeight;
1109 Orientation:=pgOr;
1110 SetSettings;
1111 {$ifdef DbgPrinter}
1112 DebugLnExit('TfrPrinter.SetPrinterInfo END');
1113 {$endif}
1114 end;
1115
GetArrayPosnull1116 function TfrPrinter.GetArrayPos(pgSize: Integer): Integer;
1117 var
1118 i: Integer;
1119 begin
1120 Result := PaperSizesNum - 1;
1121 for i := 0 to PaperSizesNum - 1 do
1122 begin
1123 if PaperSizes[i] = pgSize then
1124 begin
1125 Result := i;
1126 break;
1127 end;
1128 end;
1129 end;
1130
TfrPrinter.DefaultPaperIndexnull1131 function TfrPrinter.DefaultPaperIndex: Integer;
1132 begin
1133 Result:= FPaperNames.IndexOf(FPrinter.PaperSize.DefaultPaperName);
1134 if Result<0 then
1135 Result:=0;
1136 end;
1137
DefaultPageSizenull1138 function TfrPrinter.DefaultPageSize: Integer;
1139 var
1140 Indx: Integer;
1141 begin
1142 if FPaperNames.Count>0 then
1143 begin
1144 Indx := DefaultPaperIndex;
1145 result := PaperSizes[Indx];
1146 end else
1147 result := 9;
1148 end;
1149
UseVirtualPrinternull1150 function TfrPrinter.UseVirtualPrinter: boolean;
1151 begin
1152 result := FPrinterIndex = FDefaultPrinter;
1153 end;
1154
TfrPrinter.FillPapersnull1155 function TfrPrinter.FillPapers(list: TStrings; addCustom: boolean): Integer;
1156 var
1157 i, customIndex: Integer;
1158 begin
1159 list.BeginUpdate;
1160 try
1161 list.Clear;
1162 result := FPaperNames.Count;
1163 customIndex := -1;
1164 for i:=0 to result-1 do
1165 begin
1166 if PaperSizes[i]=256 then
1167 customIndex := i;
1168 list.AddObject(FPaperNames[i], TObject(PtrInt(PaperSizes[i])));
1169 end;
1170 if addCustom and (customIndex<0) then
1171 list.AddObject(sPaper256, TObject(PtrInt(256)));
1172 finally
1173 list.EndUpdate;
1174 end;
1175 end;
1176
1177 {$IFDEF DbgPrinter}
1178 procedure TfrPrinter.DumpPrinterInfo;
1179 begin
1180
1181 DbgOut(['PrinterIndex=',FPrinterIndex]);
1182 if FPrinters.Count>0 then begin
1183 if FPrinterIndex>=0 then
1184 DbgOut([' (',FPrinters[FPrinterIndex],')'])
1185 else
1186 DbgOut(' (no printer selected???)');
1187 end else
1188 DbgOut(' (internal list of printers is empty)');
1189 DebugLn([' Is Virtual printer=',UseVirtualPrinter]);
1190 if FPrinter=nil then
1191 DebugLn('SysPrinter is nil')
1192 else
1193 DebugLn(['Sys Printer: Index = ', FPrinter.PrinterIndex,' Name=',FPrinter.PrinterName]);
1194 end;
1195 {$ENDIF}
1196
1197 procedure TfrPrinter.SetPrinterIndex(Value: Integer);
1198 begin
1199 {$IFDEF DbgPrinter}
1200 DebugLnEnter(['TfrPrinter.SetPrinterIndex INIT: Value=',Value,' IsDefaultPrinter=',Value=FDefaultPrinter]);
1201 {$ENDIF}
1202 FPrinterIndex := Value;
1203 if UseVirtualPrinter then
1204 SetSettings
1205 else
1206 if FPrinter.Printers.Count > 0 then
1207 begin
1208 FPrinter.PrinterIndex := Value;
1209 GetSettings;
1210 end;
1211 {$IFDEF DbgPrinter}
1212 DebugLnExit(['TfrPrinter.SetPrinterIndex DONE']);
1213 {$ENDIF}
1214 end;
1215
GetPaperNamesnull1216 function TfrPrinter.GetPaperNames: TStringList;
1217 begin
1218 result := FPaperNames;
1219 end;
1220
MatchPrinterPapernull1221 function TfrPrinter.MatchPrinterPaper(const aWidth, aHeight: Integer): integer;
1222 var
1223 i,dw,dh: Integer;
1224 begin
1225 result := -1;
1226 if FPrinter=nil then
1227 exit;
1228
1229 with FPrinter.PaperSize do
1230 for i:=0 to SupportedPapers.Count-1 do
1231 begin
1232 try
1233 with PaperRectOf[SupportedPapers[i]].PhysicalRect do
1234 begin
1235 dw := round((Right-Left)*72/FPrinter.XDPI) - aWidth;
1236 dh := round((Bottom-Top)*72/FPrinter.YDPI) - aHeight;
1237 if (dw>=0)and(dw<=6) and (dh>=0)and(dh<=6) then begin
1238 result := i;
1239 exit;
1240 end;
1241 end;
1242 except
1243 end;
1244 end;
1245 end;
1246
GetPaperRectnull1247 function TfrPrinter.GetPaperRect: TPaperRect;
1248 begin
1249 result.PhysicalRect.Left := 0;
1250 result.PhysicalRect.Top := 0;
1251 result.PhysicalRect.Width := PaperWidth * FPrinter.XDPI div 72;
1252 result.PhysicalRect.Height := PaperHeight * FPrinter.YDPI div 72;
1253 result.WorkRect := result.PhysicalRect;
1254 end;
1255
1256 procedure TfrPrinter.SetPrinter(Value: TPrinter);
1257 begin
1258 {$ifdef DbgPrinter}
1259 DebugLnEnter('TfrPrinter.SetPrinter: INIT',[]);
1260 DumpPrinterInfo;
1261 DbgOut('New printer ');
1262 if Value=nil then DebugLn('is nil')
1263 else DebugLn('Index=%d ''%s''',[Value.PrinterIndex, Value.PrinterName]);
1264 {$endif}
1265 FPrinters.Clear;
1266 FPrinterIndex := 0;
1267 FPrinter:=Value;
1268 if FPrinter.Printers.Count > 0 then
1269 begin
1270 FPrinters.Assign(FPrinter.Printers);
1271 FPrinterIndex := FPrinter.PrinterIndex;
1272 end;
1273 try
1274 GetSettings;
1275 finally
1276 FPrinters.Add(sDefaultPrinter);
1277 FDefaultPrinter := FPrinters.Count - 1;
1278 end;
1279 {$ifdef DbgPrinter}
1280 DumpPrinterInfo;
1281 DebugLnExit('TfrPrinter.SetPrinter: DONE',[]);
1282 {$endif}
1283 end;
1284
1285 {
1286 procedure ExportLista;
1287 var
1288 i: Integer;
1289 F: TextFile;
1290 begin
1291 AssignFile(F,'Lista.pas');
1292 Rewrite(f);
1293 for i:=0 to PaperCount-2 do begin
1294 WriteLn(F,' (Num:',PaperInfo[i].Typ,'; Name: ''''; X:',round(PPDPaperInfo[i].X*72/254),'; Y:',round(PPDPaperInfo[i].Y*72/254),'),');
1295 end;
1296 Close(f);
1297 end;
1298 }
1299
1300 {----------------------------------------------------------------------------}
1301
1302 initialization
1303
1304 finalization
1305 if Assigned( GlobalPrn ) then
1306 GlobalPrn.Free;
1307
1308 end.
1309