新增報表紙張格式的需求
新增報表紙張格式的需求如果公司有用到特別紙張的規格，而作業系統本身並沒有的時候，希望藉由系統的執行時建立系統已知會使用到的紙張格式。在這邊會用到Window API中的AddForm, SetForm, DeleteForm, GetForm, DeviceCapabilities等方法，以下提供給大家作參考。
[code]
interface
uses Windows, Classes;
type
TPaperName = array[0..63] of Char;
TPaperNameArray =
array[1..(High(Word) div Sizeof(TPaperName))] of TPaperName;
PPapernameArray = ^TPaperNameArray;
procedure AddPrinterPaper(const vName: string; vWidth, vLength: integer);
procedure SetPrinterPaper(const vName: string; vWidth, vLength: integer);
procedure GetPrinterPaper(const vName: string; var vWidth, vLength: integer);
procedure DelPrinterPaper(const vName: string);
procedure GetPrinterPapers(vStrs: TStrings);
procedure ReplacePrinterPaper(const vName: string; vWidth, vLength: integer);
function PrinterPaperExists(const vName: string): Boolean;
implementation
uses Printers, WinSpool, SysUtils;
procedure AddPrinterPaper(const vName: string; vWidth, vLength: integer);
var
PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
hDMode: THandle;
hPrinter: THandle;
FormInfo: TFormInfo1;
PaperSize: TSize;
PaperRect: TRect;
errcode: integer;
s: string;
begin
Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
OpenPrinter(PrintDevice, hPrinter, nil);
if (hPrinter = 0) then
begin
raise Exception.Create('Failed to open printer!');
Exit;
end;
FormInfo.Flags := FORM_USER;
FormInfo.pName := PChar(vName);
PaperSize.cx := vWidth * 100;
PaperSize.cy := vLength * 100;
PaperRect.Left := 0;
PaperRect.Top := 0;
PaperRect.Right := vWidth * 100;
PaperRect.Bottom := vLength * 100;
FormInfo.Size := PaperSize;
FormInfo.ImageableArea := PaperRect;
if (not AddForm(hPrinter, 1, @FormInfo)) then
begin
errcode := GetLastError;
if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
begin
case errcode of
ERROR_ACCESS_DENIED: s := 'Access is denied';
ERROR_INVALID_HANDLE: s := 'The handle is invalid';
ERROR_NOT_READY: s := 'The device is not ready';
ERROR_CALL_NOT_IMPLEMENTED:
s := 'Function "AddForm" is not supported on this system';
else
s := 'Failed to add a Form (paper) name!';
end;
raise Exception.Create(s);
end;
end;
ClosePrinter(hPrinter);
end;
procedure SetPrinterPaper(const vName: string; vWidth, vLength: integer);
var
PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
hDMode: THandle;
hPrinter: THandle;
FormInfo: TFormInfo1;
PaperSize: TSize;
PaperRect: TRect;
errcode: integer;
s: string;
begin
Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
OpenPrinter(PrintDevice, hPrinter, nil);
if (hPrinter = 0) then
begin
raise Exception.Create('Failed to open printer!');
Exit;
end;
FormInfo.Flags := FORM_USER;
FormInfo.pName := PChar(vName);
PaperSize.cx := vWidth * 100;
PaperSize.cy := vLength * 100;
PaperRect.Left := 0;
PaperRect.Top := 0;
PaperRect.Right := vWidth * 100;
PaperRect.Bottom := vLength * 100;
FormInfo.Size := PaperSize;
FormInfo.ImageableArea := PaperRect;
if not SetForm(hPrinter, PChar(vName), 1, @FormInfo) then
begin
errcode := GetLastError;
if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
begin
case errcode of
ERROR_ACCESS_DENIED: s := 'Access is denied';
ERROR_INVALID_HANDLE: s := 'The handle is invalid';
ERROR_NOT_READY: s := 'The device is not ready';
ERROR_CALL_NOT_IMPLEMENTED:
s := 'Function "SetForm" is not supported on this system';
else
s := 'Failed to set a Form (paper) name!';
end;
raise Exception.Create(s);
end;
end;
ClosePrinter(hPrinter);
end;
procedure GetPrinterPaper(const vName: string; var vWidth, vLength: integer);
var
PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
hDMode: THandle;
hPrinter: THandle;
FormInfo: TFormInfo1;
PaperSize: TSize;
errcode: integer;
s: string;
cbBuf: DWORD;
pcbNeeded: DWORD;
begin
Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
OpenPrinter(PrintDevice, hPrinter, nil);
if (hPrinter = 0) then
begin
raise Exception.Create('Failed to open printer!');
Exit;
end;
cbBuf := sizeof(TPaperName);
cbBuf := cbBuf + sizeof(TFormInfo1);
if GetForm(hPrinter, PChar(vName), 1, @FormInfo, cbBuf, pcbNeeded) then
begin
PaperSize := FormInfo.Size;
vWidth := Trunc(PaperSize.cx / 100);
vLength := Trunc(PaperSize.cy / 100);
end
else
begin
errcode := GetLastError;
if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
begin
case errcode of
ERROR_ACCESS_DENIED: s := 'Access is denied';
ERROR_INVALID_HANDLE: s := 'The handle is invalid';
ERROR_NOT_READY: s := 'The device is not ready';
ERROR_CALL_NOT_IMPLEMENTED:
s := 'Function "GetForm" is not supported on this system';
ERROR_INSUFFICIENT_BUFFER:
s := 'The data area passed to a system call is too small.';
else
s := 'Failed to get a Form (paper) name!';
end;
raise Exception.Create(s);
end;
end;
ClosePrinter(hPrinter);
end;
procedure DelPrinterPaper(const vName: string);
var
PrintDevice, PrintDriver, PrintPort: array[0..255] of Char;
hDMode: THandle;
hPrinter: THandle;
FormName: string;
errcode: integer;
s: string;
begin
Printer.GetPrinter(PrintDevice, PrintDriver, PrintPort, hDMode);
OpenPrinter(PrintDevice, hPrinter, nil);
if (hPrinter = 0) then
begin
raise Exception.Create('Failed to open printer!');
Exit;
end; //if...end!!
if not DeleteForm(hPrinter, PChar(vName)) then
begin
errcode := GetLastError;
if (errcode <> ERROR_FILE_EXISTS) then // Form name exists?
begin
case errcode of
ERROR_ACCESS_DENIED: s := 'Access is denied';
ERROR_INVALID_HANDLE: s := 'The handle is invalid';
ERROR_NOT_READY: s := 'The device is not ready';
ERROR_CALL_NOT_IMPLEMENTED:
s := 'Function "GetForm" is not supported on this system';
else
s := 'Failed to get a Form (paper) name!';
end; //case...end!!
raise Exception.Create(s);
end; //if...end!!
end;
ClosePrinter(hPrinter);
end;
procedure GetPrinterPapers(vStrs: TStrings);
var
Device, Driver, Port: array[0..255] of Char;
hDevMode: THandle;
j, numPaperformats: Integer;
pPaperFormats: PPapernameArray;
vPrinter: TPrinter;
begin
vPrinter := TPrinter.Create;
vPrinter.PrinterIndex := -1;
vPrinter.GetPrinter(Device, Driver, Port, hDevmode);
numPaperformats :=
WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, nil, nil);
if numPaperformats > 0 then
begin
GetMem(pPaperformats,
numPaperformats * Sizeof(TPapername));
vStrs.clear;
try
WinSpool.DeviceCapabilities
(Device, Port, DC_PAPERNAMES,
Pchar(pPaperFormats), nil);
for j := 1 to numPaperformats do
vStrs.add(pPaperformats^[j]);
finally
FreeMem(pPaperformats);
end;
end;
end;
procedure ReplacePrinterPaper(const vName: string; vWidth, vLength: integer);
begin
if PrinterPaperExists(vName) then
SetPrinterPaper(vName, vWidth, vLength)
else
AddPrinterPaper(vName, vWidth, vLength)
end;
function PrinterPaperExists(const vName: string): Boolean;
var
vStrs: TStrings;
begin
vStrs := TStringList.Create;
GetPrinterPapers(vStrs);
Result := (vStrs.IndexOf(vName) >= 0);
vStrs.Free;
end;
end.
[/code]
來源：http://jasper-dale.spaces.msn.com/ 請教...若要在 Win98 的平台下操作該如何實現？
因上述的 API 並無法運作於 Win98 的環境上，該如何在 Win98 上動態指定 自訂 格式的 Form 呢？
謝謝 ~~~
頁:
[1]