/Source/FR_PRNTR.PAS

http://github.com/FastReports/FreeReport · Pascal · 356 lines · 308 code · 37 blank · 11 comment · 20 complexity · 44097ca54beaac694dd3f9857f3f42cb MD5 · raw file

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