新增報表紙張格式的需求

bestlong

From http://jasper-dale.spaces.live.c ... E92E2726C!244.entry

如果公司有用到特別紙張的規格，而作業系統本身並沒有的時候，希望藉由系統的執行時建立系統已知會使用到的紙張格式。在這邊會用到Window API中的AddForm, SetForm, DeleteForm, GetForm, DeviceCapabilities等方法，以下提供給大家作參考。

1. interface
   
2. 
   
3. uses Windows, Classes;
   
4. 
   
5. type
   
6.   TPaperName = array[0..63] of Char;
   
7.   TPaperNameArray =
   
8.     array[1..(High(Word) div Sizeof(TPaperName))] of TPaperName;
   
9.   PPapernameArray = ^TPaperNameArray;
   
10. 
    
11. procedure AddPrinterPaper(const vName: string; vWidth, vLength: integer);
    
12. procedure SetPrinterPaper(const vName: string; vWidth, vLength: integer);
    
13. procedure GetPrinterPaper(const vName: string; var vWidth, vLength: integer);
    
14. procedure DelPrinterPaper(const vName: string);
    
15. procedure GetPrinterPapers(vStrs: TStrings);
    
16. procedure ReplacePrinterPaper(const vName: string; vWidth, vLength: integer);
    
17. function PrinterPaperExists(const vName: string): Boolean;
    
18. 
    
19. implementation
    
20. 
    
21. uses Printers, WinSpool, SysUtils;
    
22. 
    
23. procedure AddPrinterPaper(const vName: string; vWidth, vLength: integer);
    
24. var
    
25.   PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
    
26.   hDMode: THandle;
    
27.   hPrinter: THandle;
    
28.   FormInfo: TFormInfo1;
    
29.   PaperSize: TSize;
    
30.   PaperRect: TRect;
    
31.   errcode: integer;
    
32.   s: string;
    
33. begin
    
34.   Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
    
35.   OpenPrinter(PrintDevice, hPrinter, nil);
    
36.   if (hPrinter = 0) then
    
37.   begin
    
38.     raise Exception.Create('Failed to open printer!');
    
39.     Exit;
    
40.   end;
    
41.   FormInfo.Flags := FORM_USER;
    
42.   FormInfo.pName := PChar(vName);
    
43.   PaperSize.cx := vWidth * 100;
    
44.   PaperSize.cy := vLength * 100;
    
45.   PaperRect.Left := 0;
    
46.   PaperRect.Top := 0;
    
47.   PaperRect.Right := vWidth * 100;
    
48.   PaperRect.Bottom := vLength * 100;
    
49.   FormInfo.Size := PaperSize;
    
50.   FormInfo.ImageableArea := PaperRect;
    
51.   if (not AddForm(hPrinter, 1, @FormInfo)) then
    
52.   begin
    
53.     errcode := GetLastError;
    
54.     if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
    
55.     begin
    
56.       case errcode of
    
57.         ERROR_ACCESS_DENIED: s := 'Access is denied';
    
58.         ERROR_INVALID_HANDLE: s := 'The handle is invalid';
    
59.         ERROR_NOT_READY: s := 'The device is not ready';
    
60.         ERROR_CALL_NOT_IMPLEMENTED:
    
61.           s := 'Function "AddForm" is not supported on this system';
    
62.       else
    
63.         s := 'Failed to add a Form (paper) name!';
    
64.       end;
    
65.       raise Exception.Create(s);
    
66.     end;
    
67.   end;
    
68.   ClosePrinter(hPrinter);
    
69. end;
    
70. 
    
71. procedure SetPrinterPaper(const vName: string; vWidth, vLength: integer);
    
72. var
    
73.   PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
    
74.   hDMode: THandle;
    
75.   hPrinter: THandle;
    
76.   FormInfo: TFormInfo1;
    
77.   PaperSize: TSize;
    
78.   PaperRect: TRect;
    
79.   errcode: integer;
    
80.   s: string;
    
81. begin
    
82.   Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
    
83.   OpenPrinter(PrintDevice, hPrinter, nil);
    
84.   if (hPrinter = 0) then
    
85.   begin
    
86.     raise Exception.Create('Failed to open printer!');
    
87.     Exit;
    
88.   end;
    
89.   FormInfo.Flags := FORM_USER;
    
90.   FormInfo.pName := PChar(vName);
    
91.   PaperSize.cx := vWidth * 100;
    
92.   PaperSize.cy := vLength * 100;
    
93.   PaperRect.Left := 0;
    
94.   PaperRect.Top := 0;
    
95.   PaperRect.Right := vWidth * 100;
    
96.   PaperRect.Bottom := vLength * 100;
    
97.   FormInfo.Size := PaperSize;
    
98.   FormInfo.ImageableArea := PaperRect;
    
99.   if not SetForm(hPrinter, PChar(vName), 1, @FormInfo) then
    
100.   begin
     
101.     errcode := GetLastError;
     
102.     if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
     
103.     begin
     
104.       case errcode of
     
105.         ERROR_ACCESS_DENIED: s := 'Access is denied';
     
106.         ERROR_INVALID_HANDLE: s := 'The handle is invalid';
     
107.         ERROR_NOT_READY: s := 'The device is not ready';
     
108.         ERROR_CALL_NOT_IMPLEMENTED:
     
109.           s := 'Function "SetForm" is not supported on this system';
     
110.       else
     
111.         s := 'Failed to set a Form (paper) name!';
     
112.       end;
     
113.       raise Exception.Create(s);
     
114.     end;
     
115.   end;
     
116.   ClosePrinter(hPrinter);
     
117. end;
     
118. 
     
119. procedure GetPrinterPaper(const vName: string; var vWidth, vLength: integer);
     
120. var
     
121.   PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
     
122.   hDMode: THandle;
     
123.   hPrinter: THandle;
     
124.   FormInfo: TFormInfo1;
     
125.   PaperSize: TSize;
     
126.   errcode: integer;
     
127.   s: string;
     
128.   cbBuf: DWORD;
     
129.   pcbNeeded: DWORD;
     
130. begin
     
131.   Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
     
132.   OpenPrinter(PrintDevice, hPrinter, nil);
     
133.   if (hPrinter = 0) then
     
134.   begin
     
135.     raise Exception.Create('Failed to open printer!');
     
136.     Exit;
     
137.   end;
     
138.   cbBuf := sizeof(TPaperName);
     
139.   cbBuf := cbBuf + sizeof(TFormInfo1);
     
140.   if GetForm(hPrinter, PChar(vName), 1, @FormInfo, cbBuf, pcbNeeded) then
     
141.   begin
     
142.     PaperSize := FormInfo.Size;
     
143.     vWidth := Trunc(PaperSize.cx / 100);
     
144.     vLength := Trunc(PaperSize.cy / 100);
     
145.   end
     
146.   else
     
147.   begin
     
148.     errcode := GetLastError;
     
149.     if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
     
150.     begin
     
151.       case errcode of
     
152.         ERROR_ACCESS_DENIED: s := 'Access is denied';
     
153.         ERROR_INVALID_HANDLE: s := 'The handle is invalid';
     
154.         ERROR_NOT_READY: s := 'The device is not ready';
     
155.         ERROR_CALL_NOT_IMPLEMENTED:
     
156.           s := 'Function "GetForm" is not supported on this system';
     
157.         ERROR_INSUFFICIENT_BUFFER:
     
158.           s := 'The data area passed to a system call is too small.';
     
159.       else
     
160.         s := 'Failed to get a Form (paper) name!';
     
161.       end;
     
162.       raise Exception.Create(s);
     
163.     end;
     
164.   end;
     
165.   ClosePrinter(hPrinter);
     
166. end;
     
167. 
     
168. procedure DelPrinterPaper(const vName: string);
     
169. var
     
170.   PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
     
171.   hDMode: THandle;
     
172.   hPrinter: THandle;
     
173.   FormName: string;
     
174.   errcode: integer;
     
175.   s: string;
     
176. begin
     
177.   Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
     
178.   OpenPrinter(PrintDevice, hPrinter, nil);
     
179.   if (hPrinter = 0) then
     
180.   begin
     
181.     raise Exception.Create('Failed to open printer!');
     
182.     Exit;
     
183.   end; //if...end!!
     
184.   if not DeleteForm(hPrinter, PChar(vName)) then
     
185.   begin
     
186.     errcode := GetLastError;
     
187.     if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
     
188.     begin
     
189.       case errcode of
     
190.         ERROR_ACCESS_DENIED: s := 'Access is denied';
     
191.         ERROR_INVALID_HANDLE: s := 'The handle is invalid';
     
192.         ERROR_NOT_READY: s := 'The device is not ready';
     
193.         ERROR_CALL_NOT_IMPLEMENTED:
     
194.           s := 'Function "GetForm" is not supported on this system';
     
195.       else
     
196.         s := 'Failed to get a Form (paper) name!';
     
197.       end; //case...end!!
     
198.       raise Exception.Create(s);
     
199.     end; //if...end!!
     
200.   end;
     
201.   ClosePrinter(hPrinter);
     
202. end;
     
203. 
     
204. procedure GetPrinterPapers(vStrs: TStrings);
     
205. var
     
206.   Device, Driver, Port: array[0..255] of Char;
     
207.   hDevMode: THandle;
     
208.   j, numPaperformats: Integer;
     
209.   pPaperFormats: PPapernameArray;
     
210.   vPrinter: TPrinter;
     
211. begin
     
212.   vPrinter := TPrinter.Create;
     
213.   vPrinter.PrinterIndex := -1;
     
214.   vPrinter.GetPrinter(Device, Driver, Port, hDevmode);
     
215.   numPaperformats :=
     
216.     WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, nil, nil);
     
217.   if numPaperformats > 0 then
     
218.   begin
     
219.     GetMem(pPaperformats,
     
220.       numPaperformats * Sizeof(TPapername));
     
221.     vStrs.clear;
     
222.     try
     
223.       WinSpool.DeviceCapabilities
     
224.         (Device, Port, DC_PAPERNAMES,
     
225.         Pchar(pPaperFormats), nil);
     
226.       for j := 1 to numPaperformats do
     
227.         vStrs.add(pPaperformats^[j]);
     
228.     finally
     
229.       FreeMem(pPaperformats);
     
230.     end;
     
231.   end;
     
232. end;
     
233. 
     
234. procedure ReplacePrinterPaper(const vName: string; vWidth, vLength: integer);
     
235. begin
     
236.   if PrinterPaperExists(vName) then
     
237.     SetPrinterPaper(vName, vWidth, vLength)
     
238.   else
     
239.     AddPrinterPaper(vName, vWidth, vLength)
     
240. end;
     
241. 
     
242. function PrinterPaperExists(const vName: string): Boolean;
     
243. var
     
244.   vStrs: TStrings;
     
245. begin
     
246.   vStrs := TStringList.Create;
     
247.   GetPrinterPapers(vStrs);
     
248.   Result := (vStrs.IndexOf(vName) >= 0);
     
249.   vStrs.Free;
     
250. end;
     
251. end.

複製代碼