请realLearning进来一下,一个关于在2000下自定义纸大小的问题(50分)

  • 主题发起人 主题发起人 am2001
  • 开始时间 开始时间
A

am2001

Unregistered / Unconfirmed
GUEST, unregistred user!
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1862502上的代码有没有完合点可以运行的?
 
关注中,win2000值得考虑的
 
http://www.epson.com.cn/tech_support/faq/top_ten2.asp
 
这设置是都知道,关键是用代码
 
谢谢 hfghfghfg
提供
可以试一试,正常后,将给分的。
 
出错保护省略了。
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;
 
今天我试也刚好试出来了,我是这样的,一定要uses WinSpool, Printers
var
pName: PChar;
pWidth, pHeight, pTop, pLeft, pBottom, pRight: Integer;
pForm : PFormInfo1;
PrinterName: String;
hPrinter: THandle;
begin
pName := '测试纸';
pWidth := 210000;
pHeight := 210000;
pTop := 10000;
pLeft := 10000;
pRight := 200000;
pBottom := 200000;
PrinterName := Printer.Printers.Strings[Printer.PrinterIndex];
hPrinter := 0;
if not OpenPrinter(PChar(PrinterName), hPrinter, nil) then
Exit;
New(pForm);
pForm^.Flags := FORM_USER;
pForm^.pName := pName;
pForm^.Size.cx := pWidth;
pForm^.Size.cy := pHeight;
pForm^.ImageableArea.Top := pTop;
pForm^.ImageableArea.Left := pLeft;
pForm^.ImageableArea.Bottom := pBottom;
pForm^.ImageableArea.Right := pRight;
AddForm(hPrinter, 1, pForm);
FreeMem(pForm);
end;
 
接受答案了.
 

Similar threads

后退
顶部