不知道能不能解决QRPT走纸问题!(0分)

M

mci

Unregistered / Unconfirmed
GUEST, unregistred user!

在 WindowsNT/200 环境下要自定义纸张尺寸所使用的方法与 Win9x 不同,
你必须先为目前的打印机定义一个自定义的 "Form"(API: AddForm,
此 API 声明于WinSpool 中),然后把这个 Form 的名称设给
DEVMODES 结构中的 dmFormName 字段。以下的函数可以直接使用:
//-----------------------------------------------------------------------------
uses Windows, WinSpool, Printers;
(*------------------------------------------------------
Define a new Form (WinNT/2000 only).
If FormName already exists,do
nothing and return.
If failed, an exception will be raised.
------------------------------------------------------*)
procedure PrnAddForm(const FormName: string;
PaperWidth, PaperLength: 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
raise Exception.Create('Failed to open printer!');
FormInfo.Flags := FORM_USER;
FormInfo.pName := PChar(FormName);
PaperSize.cx := PaperWidth;
PaperSize.cy := PaperLength;
PaperRect.Left := 0;
PaperRect.Top := 0;
PaperRect.Right := PaperWidth;
PaperRect.Bottom := PaperLength;
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;

//-------------------------------------------------------------------------------------
(*
Set custom paper size for WinNT/2000.
Make sure FormName is supported by current printer,
You can call PrnAddForm to define a new Form.
*)
procedure PrnSetPaperSizeNT(FormName: string;
PaperWidth, PaperLength: integer);
var
Device, Driver, Port: array[0..80] of Char;
DevMode: THandle;
pDevmode: PDeviceMode;
begin
// Get printer device name etc.
Printer.GetPrinter(Device, Driver, Port, DevMode);
// force reload of DEVMODE
Printer.SetPrinter(Device, Driver, Port, 0) ;
// get DEVMODE handle
Printer.GetPrinter(Device, Driver, Port, DevMode);
if DevMode <> 0 then
begin
// lock it to get pointer to DEVMODE record
pDevMode := GlobalLock( DevMode );
if pDevmode <> nil then
try
with pDevmode^do
begin
// modify form
StrLCopy( dmFormName, PChar(FormName), CCHFORMNAME-1 );
// tell printer driver that dmFormname field contains
// data it needs to inspect.
dmPaperWidth := PaperWidth;
dmPaperLength := PaperLength;
dmFields := dmFields or DM_FORMNAME or DM_PAPERWIDTH or DM_PAPERLENGTH;
////////////////////////////////
if GetPrnPaperSize(Device, FormName, iPaperSize) then
dmPaperSize := iPaperSize;
dmFields := dmFields or DM_FORMNAME or DM_PAPERWIDTH or DM_PAPERLENGTH or
DM_PAPERSIZE;
////////////////////////
end;
finally
GlobalUnlock( Devmode );
// unlock devmode handle.
end;
end;
{ If }
end;



//-----------------------------------------------------------------------------
function GetPrnPaperSize(const sPrinterName, sFormName: String;
var iPaperSize: Integer
): Boolean;
var
hPrinter: THandle;
pData: PChar;
i, iShift: Integer;
dwNeed, dwReturn: DWORD;
pForm: PFORM_INFO_1;
dwVersion: DWORD;
begin
Result := false;
dwNeed := 0;
dwReturn := 0;
pData := nil;
////////////////////////////////////////////////
//NT 误差校正
dwVersion := GetVersion();
//非 WIN NT 系列
if (dwVersion > $80000000) then
Exit;
dwVersion := dwVersion and $000000FF;
if dwVersion = 4 then
//Win NT
iShift := 2
else
//Win 2000
iShift := 0;
////////////////////////////////////////////////
if not OpenPrinter(PChar(sPrinterName), hPrinter, nil) then
Exit;
try
EnumForms(hPrinter, 1, nil, 0, dwNeed, dwReturn);
pData := AllocMem(dwNeed);
EnumForms(hPrinter, 1, pData, dwNeed, dwNeed, dwReturn);
for i:=0 to dwReturn-1do
begin
pForm := PFORM_INFO_1(Integer(pData) + i*SizeOf(FORM_INFO_1));
if pForm.pName = sFormName then
begin
iPaperSize := i+1 + iShift;
Result := true;
Exit;
end;
end;
finally
if pData <> nil then
FreeMem(pData);
ClosePrinter(hPrinter);
end;
end;
//-----------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
PrnAddForm(
edFormName.Text,
StrToInt(edPaperWidth.Text),
StrToInt(edPaperLength.Text)
);
PrnSetPaperSizeNT(
edFormName.Text,
StrToInt(edPaperWidth.Text),
StrToInt(edPaperLength.Text)
);
Printer.begin
Doc;
Printer.Canvas.TextOut(10, 10, 'Printer test!');
Printer.EndDoc;
end;

这个是我按照别人的帖子批凑的,不知道有没有用
看到各位老大都这么急,贴出来这个探讨一下。
 
[:)][:(][:)][:(][:)][:(][:)][:(][:)]
 
顶部