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