没有出错,能打印也能调用,但是就是纸张类型没有设置成功 代码如下
library setprintdll;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,Windows,
Classes, printers,winspool;
{$R *.res}
procedure DLLEntryPoint(dwReason: DWord);
begin
case dwReason of
DLL_PROCESS_ATTACH : MessageBeep(0);
DLL_PROCESS_DETACH : MessageBeep(0);
DLL_THREAD_ATTACH : MessageBeep(0);
DLL_THREAD_DETACH : MessageBeep(0);
end;
end;
function Init_Print(FormName
Char;Height:Integer;Width:Integer):Integer;stdcall;
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 := FormName;
PaperSize.cx := Width;
PaperSize.cy := Height;
PaperRect.Left := 0;
PaperRect.Top := 0;
PaperRect.Right := Width;
PaperRect.Bottom := Height;
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);
Result :=1;
end;
function Reset_Print():Integer;stdcall;
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);
// 强制重新加载 DEVMODE
Printer.SetPrinter(Device, Driver, Port, 0) ;
// 得到 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
dmPaperSize:=DMPAPER_A4;
dmFields := dmFields or DM_PAPERSIZE;
end;
finally
GlobalUnlock( Devmode );
// unlock devmode handle.
end;
end;
Result :=1;
end;
function GetPrnPaperSize(const sPrinterName, sFormName: PChar;
iPaperSize: Integer): Boolean;stdcall;
var
hPrinter: THandle;
pData: PChar;
i, iShift: Integer;
dwNeed, dwReturn: DWORD;
pForm: PFormInfo1A;
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(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 := PFormInfo1A(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;
Result :=true;
end;
function Set_Print(pName
Char;Height:Integer;Width:Integer):Integer;stdcall;
var
Device, Driver, Port: array[0..80] of Char;
DevMode: THandle;
pDevmode: PDeviceMode;
iPaperSize : integer;
begin
// Get printer device name etc.
Printer.GetPrinter(Device, Driver, Port, DevMode);
// 强制重新加载 DEVMODE
Printer.SetPrinter(Device, Driver, Port, 0) ;
// 得到 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
// 装载进要使用的纸张格式
StrLCopy( dmFormName, pName, CCHFORMNAME-1 );
// 指定打印机的应确定的长宽
dmPaperWidth := Width;
dmPaperLength := Height;
dmFields := dmFields or DM_FORMNAME or DM_PAPERWIDTH or DM_PAPERLENGTH;
// if GetPrnPaperSize(Device, pName, 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;
with Printerdo
begin
begin
Doc;
Canvas.TextOut(10,10,'Hello, My Friend!');
EndDoc;
end;
Result :=1;
end;
exports
Init_Print,Reset_Print,GetPrnPaperSize,Set_Print;
begin
DLLProc := @DLLEntryPoint;
DLLEntryPoint(DLL_PROCESS_ATTACH);
end.
InitPrint用来初始化设置
执行文件中
InitPrint(Pchar(edit3.Text),StrToInt(edit2.Text),StrToInt(edit1.Text));
SetPrint(PChar(edit3.Text),StrToInt(edit2.Text),StrToInt(edit1.Text));
with Printerdo
begin
begin
Doc;
Canvas.TextOut(10,10,'Hello, My Friend!');
EndDoc;
end;
打印可以但是纸张大小不变 ,还有就是setprint initprint 都是我在测试程序中通过的
但换成dll为什么不能实现呢