/Source/FR_PRNTR.PAS

  1
  2{*****************************************}
  3{                                         }
  4{             FastReport v2.3             }
  5{              Printer info               }
  6{                                         }
  7{  Copyright (c) 1998-99 by Tzyganenko A. }
  8{                                         }
  9{*****************************************}
 10
 11unit FR_Prntr;
 12
 13interface
 14
 15{$I FR.inc}
 16
 17uses
 18  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 19  StdCtrls, Printers, WinSpool, FR_Class, FR_Const;
 20
 21type
 22  TfrPrinter = class
 23  private
 24    FDevice: PChar;
 25    FDriver: PChar;
 26    FPort: PChar;
 27    FDeviceMode: THandle;
 28    FMode: PDeviceMode;
 29    FPrinter: TPrinter;
 30    FPaperNames: TStringList;
 31    FPrinters: TStringList;
 32    FPrinterIndex: Integer;
 33    FDefaultPrinter: Integer;
 34    procedure GetSettings;
 35    procedure SetSettings;
 36    procedure SetPrinter(Value: TPrinter);
 37    procedure SetPrinterIndex(Value: Integer);
 38  public
 39    Orientation: TPrinterOrientation;
 40    PaperSize: Integer;
 41    PaperWidth: Integer;
 42    PaperHeight: Integer;
 43    PaperSizes: Array[0..255] of Word;
 44    PaperSizesNum: Integer;
 45    constructor Create;
 46    destructor Destroy; override;
 47    procedure FillPrnInfo(var p: TfrPrnInfo);
 48    procedure SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer;
 49      pgOr: TPrinterOrientation);
 50    function IsEqual(pgSize, pgWidth, pgHeight: Integer;
 51      pgOr: TPrinterOrientation): Boolean;
 52    function GetArrayPos(pgSize: Integer): Integer;
 53    property PaperNames: TStringList read FPaperNames;
 54    property Printer: TPrinter read FPrinter write SetPrinter;
 55    property Printers: TStringList read FPrinters;
 56    property PrinterIndex: Integer read FPrinterIndex write SetPrinterIndex;
 57  end;
 58
 59
 60var
 61  Prn: TfrPrinter;
 62
 63implementation
 64
 65type
 66  TPaperInfo = record
 67    Typ: Integer;
 68    Name: String;
 69    X, Y: Integer;
 70  end;
 71
 72const
 73  PAPERCOUNT = 67;
 74  PaperInfo: Array[0..PAPERCOUNT - 1] of TPaperInfo = (
 75    (Typ:1;  Name: ''; X:2159; Y:2794),
 76    (Typ:2;  Name: ''; X:2159; Y:2794),
 77    (Typ:3;  Name: ''; X:2794; Y:4318),
 78    (Typ:4;  Name: ''; X:4318; Y:2794),
 79    (Typ:5;  Name: ''; X:2159; Y:3556),
 80    (Typ:6;  Name: ''; X:1397; Y:2159),
 81    (Typ:7;  Name: ''; X:1842; Y:2667),
 82    (Typ:8;  Name: ''; X:2970; Y:4200),
 83    (Typ:9;  Name: ''; X:2100; Y:2970),
 84    (Typ:10; Name: ''; X:2100; Y:2970),
 85    (Typ:11; Name: ''; X:1480; Y:2100),
 86    (Typ:12; Name: ''; X:2500; Y:3540),
 87    (Typ:13; Name: ''; X:1820; Y:2570),
 88    (Typ:14; Name: ''; X:2159; Y:3302),
 89    (Typ:15; Name: ''; X:2150; Y:2750),
 90    (Typ:16; Name: ''; X:2540; Y:3556),
 91    (Typ:17; Name: ''; X:2794; Y:4318),
 92    (Typ:18; Name: ''; X:2159; Y:2794),
 93    (Typ:19; Name: ''; X:984;  Y:2254),
 94    (Typ:20; Name: ''; X:1048; Y:2413),
 95    (Typ:21; Name: ''; X:1143; Y:2635),
 96    (Typ:22; Name: ''; X:1207; Y:2794),
 97    (Typ:23; Name: ''; X:1270; Y:2921),
 98    (Typ:24; Name: ''; X:4318; Y:5588),
 99    (Typ:25; Name: ''; X:5588; Y:8636),
100    (Typ:26; Name: ''; X:8636; Y:11176),
101    (Typ:27; Name: ''; X:1100; Y:2200),
102    (Typ:28; Name: ''; X:1620; Y:2290),
103    (Typ:29; Name: ''; X:3240; Y:4580),
104    (Typ:30; Name: ''; X:2290; Y:3240),
105    (Typ:31; Name: ''; X:1140; Y:1620),
106    (Typ:32; Name: ''; X:1140; Y:2290),
107    (Typ:33; Name: ''; X:2500; Y:3530),
108    (Typ:34; Name: ''; X:1760; Y:2500),
109    (Typ:35; Name: ''; X:1760; Y:1250),
110    (Typ:36; Name: ''; X:1100; Y:2300),
111    (Typ:37; Name: ''; X:984;  Y:1905),
112    (Typ:38; Name: ''; X:920;  Y:1651),
113    (Typ:39; Name: ''; X:3778; Y:2794),
114    (Typ:40; Name: ''; X:2159; Y:3048),
115    (Typ:41; Name: ''; X:2159; Y:3302),
116    (Typ:42; Name: ''; X:2500; Y:3530),
117    (Typ:43; Name: ''; X:1000; Y:1480),
118    (Typ:44; Name: ''; X:2286; Y:2794),
119    (Typ:45; Name: ''; X:2540; Y:2794),
120    (Typ:46; Name: ''; X:3810; Y:2794),
121    (Typ:47; Name: ''; X:2200; Y:2200),
122    (Typ:50; Name: ''; X:2355; Y:3048),
123    (Typ:51; Name: ''; X:2355; Y:3810),
124    (Typ:52; Name: ''; X:2969; Y:4572),
125    (Typ:53; Name: ''; X:2354; Y:3223),
126    (Typ:54; Name: ''; X:2101; Y:2794),
127    (Typ:55; Name: ''; X:2100; Y:2970),
128    (Typ:56; Name: ''; X:2355; Y:3048),
129    (Typ:57; Name: ''; X:2270; Y:3560),
130    (Typ:58; Name: ''; X:3050; Y:4870),
131    (Typ:59; Name: ''; X:2159; Y:3223),
132    (Typ:60; Name: ''; X:2100; Y:3300),
133    (Typ:61; Name: ''; X:1480; Y:2100),
134    (Typ:62; Name: ''; X:1820; Y:2570),
135    (Typ:63; Name: ''; X:3220; Y:4450),
136    (Typ:64; Name: ''; X:1740; Y:2350),
137    (Typ:65; Name: ''; X:2010; Y:2760),
138    (Typ:66; Name: ''; X:4200; Y:5940),
139    (Typ:67; Name: ''; X:2970; Y:4200),
140    (Typ:68; Name: ''; X:3220; Y:4450),
141    (Typ:256;Name: ''; X:0;    Y:0));
142
143
144function DeviceCapabilities(pDevice, pPort: PChar; fwCapability: Word; pOutput: PChar;
145  DevMode: PDeviceMode): Integer; stdcall; external winspl name 'DeviceCapabilitiesA';
146
147{----------------------------------------------------------------------------}
148constructor TfrPrinter.Create;
149var
150  i: Integer;
151begin
152  inherited Create;
153  GetMem(FDevice, 128);
154  GetMem(FDriver, 128);
155  GetMem(FPort, 128);
156  FPaperNames := TStringList.Create;
157  FPrinters := TStringList.Create;
158  for i := 0 to PAPERCOUNT - 1 do
159    PaperInfo[i].Name := LoadStr(SPaper1 + i);
160end;
161
162destructor TfrPrinter.Destroy;
163begin
164  FreeMem(FDevice, 128);
165  FreeMem(FDriver, 128);
166  FreeMem(FPort, 128);
167  FPaperNames.Free;
168  FPrinters.Free;
169  inherited Destroy;
170end;
171
172procedure TfrPrinter.GetSettings;
173var
174  i: Integer;
175  PaperNames: PChar;
176  Size: TPoint;
177begin
178  FPrinter.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
179  try
180    FMode := GlobalLock(FDeviceMode);
181
182    PaperSize := FMode.dmPaperSize;
183
184    Escape(FPrinter.Handle, GetPhysPageSize, 0, nil, @Size);
185    PaperWidth := Round(Size.X / GetDeviceCaps(FPrinter.Handle, LOGPIXELSX) * 254);
186    PaperHeight := Round(Size.Y / GetDeviceCaps(FPrinter.Handle, LOGPIXELSY) * 254);
187
188    FillChar(PaperSizes, SizeOf(PaperSizes), 0);
189    PaperSizesNum := DeviceCapabilities(FDevice, FPort, DC_PAPERS, @PaperSizes, FMode);
190
191    GetMem(PaperNames, PaperSizesNum * 64);
192    DeviceCapabilities(FDevice, FPort, DC_PAPERNAMES, PaperNames, FMode);
193    FPaperNames.Clear;
194    for i := 0 to PaperSizesNum - 1 do
195      FPaperNames.Add(StrPas(PaperNames + i * 64));
196    FreeMem(PaperNames, PaperSizesNum * 64);
197  finally
198    GlobalUnlock(FDeviceMode);
199  end;
200end;
201
202procedure TfrPrinter.SetSettings;
203var
204  i, n: Integer;
205begin
206  if FPrinterIndex = FDefaultPrinter then
207  begin
208    FPaperNames.Clear;
209    for i := 0 to PAPERCOUNT - 1 do
210    begin
211      FPaperNames.Add(PaperInfo[i].Name);
212      PaperSizes[i] := PaperInfo[i].Typ;
213      if (PaperSize <> $100) and (PaperSize = PaperInfo[i].Typ) then
214      begin
215        PaperWidth := PaperInfo[i].X;
216        PaperHeight := PaperInfo[i].Y;
217        if Orientation = poLandscape then
218        begin
219          n := PaperWidth; PaperWidth := PaperHeight; PaperHeight := n;
220        end;
221      end;
222    end;
223    PaperSizesNum := PAPERCOUNT;
224    Exit;
225  end;
226
227  FPrinter.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
228  try
229    FMode := GlobalLock(FDeviceMode);
230    if PaperSize = $100 then
231    begin
232      FMode.dmFields := FMode.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
233      FMode.dmPaperLength := PaperHeight;
234      FMode.dmPaperWidth := PaperWidth;
235    end;
236
237    if (FMode.dmFields and DM_PAPERSIZE) <> 0 then
238      FMode.dmPaperSize := PaperSize;
239
240    if (FMode.dmFields and DM_ORIENTATION) <> 0 then
241      if Orientation = poPortrait then
242        FMode.dmOrientation := DMORIENT_PORTRAIT else
243        FMode.dmOrientation := DMORIENT_LANDSCAPE;
244
245    if (FMode.dmFields and DM_COPIES) <> 0 then
246      FMode.dmCopies := 1;
247
248    FPrinter.SetPrinter(FDevice, FDriver, FPort, FDeviceMode);
249  finally
250    GlobalUnlock(FDeviceMode);
251  end;
252  GetSettings;
253end;
254
255procedure TfrPrinter.FillPrnInfo(var p: TfrPrnInfo);
256var
257  kx, ky: Double;
258begin
259  kx := 93 / 1.022;
260  ky := 93 / 1.015;
261  if FPrinterIndex = FDefaultPrinter then
262    with p do
263    begin
264      Pgw := Round(PaperWidth * kx / 254);
265      Pgh := Round(PaperHeight * ky / 254);
266      Ofx := Round(50 * kx / 254);
267      Ofy := Round(50 * ky / 254);
268      Pw := Pgw - Ofx * 2;
269      Ph := Pgh - Ofy * 2;
270    end
271  else
272    with p, FPrinter do
273    begin
274      kx := kx / GetDeviceCaps(Handle, LOGPIXELSX);
275      ky := ky / GetDeviceCaps(Handle, LOGPIXELSY);
276      PPgw := GetDeviceCaps(Handle, PHYSICALWIDTH); Pgw := Round(PPgw * kx);
277      PPgh := GetDeviceCaps(Handle, PHYSICALHEIGHT); Pgh := Round(PPgh * ky);
278      POfx := GetDeviceCaps(Handle, PHYSICALOFFSETX); Ofx := Round(POfx * kx);
279      POfy := GetDeviceCaps(Handle, PHYSICALOFFSETY); Ofy := Round(POfy * ky);
280      PPw := PageWidth; Pw := Round(PPw * kx);
281      PPh := PageHeight; Ph := Round(PPh * ky);
282    end;
283end;
284
285function TfrPrinter.IsEqual(pgSize, pgWidth, pgHeight: Integer;
286  pgOr: TPrinterOrientation): Boolean;
287begin
288  if (PaperSize = pgSize) and (pgSize = $100) then
289    Result := (PaperSize = pgSize) and (PaperWidth = pgWidth) and
290     (PaperHeight = pgHeight) and (Orientation = pgOr)
291  else
292    Result := (PaperSize = pgSize) and (Orientation = pgOr);
293end;
294
295procedure TfrPrinter.SetPrinterInfo(pgSize, pgWidth, pgHeight: Integer;
296  pgOr: TPrinterOrientation);
297begin
298  if IsEqual(pgSize, pgWidth, pgHeight, pgOr) then Exit;
299  PaperSize := pgSize;
300  PaperWidth := pgWidth;
301  PaperHeight := pgHeight;
302  Orientation := pgOr;
303  SetSettings;
304end;
305
306function TfrPrinter.GetArrayPos(pgSize: Integer): Integer;
307var
308  i: Integer;
309begin
310  Result := PaperSizesNum - 1;
311  for i := 0 to PaperSizesNum - 1 do
312    if PaperSizes[i] = pgSize then
313    begin
314      Result := i;
315      break;
316    end;
317end;
318
319procedure TfrPrinter.SetPrinterIndex(Value: Integer);
320begin
321  FPrinterIndex := Value;
322  if Value = FDefaultPrinter then
323    SetSettings
324  else if FPrinter.Printers.Count > 0 then
325  begin
326    FPrinter.PrinterIndex := Value;
327    GetSettings;
328  end;
329end;
330
331procedure TfrPrinter.SetPrinter(Value: TPrinter);
332begin
333  FPrinters.Clear;
334  FPrinterIndex := 0;
335  FPrinter := Value;
336  if FPrinter.Printers.Count > 0 then
337  begin
338    FPrinters.Assign(FPrinter.Printers);
339    FPrinterIndex := FPrinter.PrinterIndex;
340    GetSettings;
341  end;
342  FPrinters.Add(LoadStr(SDefaultPrinter));
343  FDefaultPrinter := FPrinters.Count - 1;
344end;
345
346
347{----------------------------------------------------------------------------}
348
349initialization
350  Prn := TfrPrinter.Create;
351  Prn.Printer := Printer;
352
353finalization
354  Prn.Free;
355
356end.