出错保护省略了。
var
Form1: TForm1;
hP : THandle;
implementation
{$R *.DFM}
function AddCustomForm(Printer : THandle;
FormName : string;FormSize : TPoint) : Boolean;
var
FormInfo : TFormInfo1;
begin
Result := False;
FormInfo.Flags := 0;
FormInfo.pName := Pchar(FormName);
FormInfo.Size := TSize(FormSize);
FormInfo.ImageableArea := Rect(0,0,FormSize.X,FormSize.Y);
if AddForm(Printer,1,@FormInfo) then
Result := True;
end;
function SetCustomForm(Printer : THandle;
FormName : string;FormSize : TPoint) : Boolean;
var
FormInfo : TFormInfo1;
begin
Result := False;
FormInfo.Flags := 0;
FormInfo.Size := TSize(FormSize);
FormInfo.ImageableArea := Rect(0,0,FormSize.X,FormSize.Y);
if SetForm(Printer,Pchar(FormName),1,@FormInfo) then
Result := True;
end;
procedure TForm1.OpenPrinterClick(Sender: TObject);
var
PrintName : string;
pPDef : PPrinterDefaults;
begin
GetMem(pPDef,SizeOf(_PRINTER_DEFAULTSA));
pPDef^.pDatatype := nil;
pPDef^.pDevMode := nil;
pPDef^.DesiredAccess := PRINTER_ALL_ACCESS;
PrintName := Printer.Printers[0];
if WinSpool.OpenPrinter(PChar(PrintName),hP,pPDef) then
SHowMessage('Printer Open');
FreeMem(pPdef);
end;
procedure TForm1.AddFormClick(Sender: TObject);
begin
if AddCustomForm(hP,'UserDefine1',Point(200000,200000)) then
ShowMessage('CustomPaper Add');
end;
procedure TForm1.SetFormClick(Sender: TObject);
begin
if SetCustomForm(hP,'UserDefine1',Point(100000,100000)) then
SHowMessage('Paper Updte');
end;
procedure TForm1.closePrinterClick(Sender: TObject);
begin
WinSpool.ClosePrinter(hp);
ShowMessage('Printer Close');
end;
procedure TForm1.SetPrinterClick(Sender: TObject);
var
PInfo2 : Pointer;
Need : DWORD;
begin
WinSpool.GetPrinter(hP,2,nil,0,@Need);
if Need>0 then
begin
GetMem(PInfo2,Need);
if WinSpool.GetPrinter(hP,2,PInfo2,Need,@Need) then
begin
TPrinterInfo2(PInfo2^).pDevMode.dmFields := DM_FORMNAME ;
TPrinterInfo2(PInfo2^).pDevMode.dmFormName := 'UserDefine1';
if WinSpool.SetPrinter(hP,2,PInfo2,0) then
ShowMessage('Printer SetPaper');
end
else
ShowMessage(IntToStr(GetLastError()));
FreeMem(PInfo2);
end;
end;