在WIN2000/XP下添加自定义纸张的Delphi源代码

////////////////////////////
//  武汉探索电脑工作室    //
//  http://tansuo.51.net  //
////////////////////////////

//增加规格自定义纸张
//papername: 自定义纸张名称
//paperwidth: 纸张的宽度，以0.1mm为单位
//paperlength: 纸张的高度，以0.1mm为单位
procedure tdm.addcustompaper(const papername: string; paperwidth, paperlength:integer);
var
printdevice, printdriver, printport : array[0..255] of char;
hdmode   : thandle;
hprinter : thandle;
forminfo : tforminfo1;
begin
printer.getprinter(printdevice, printdriver, printport, hdmode);
openprinter(printdevice, hprinter, nil);
if hprinter = 0 then
raise exception.create('联接打印机失败!');

with forminfo do
begin
flags := form_user;
pname := pchar(papername);
size.cx := paperwidth*100;
size.cy := paperlength*100;
imageablearea.left := 0;
imageablearea.top := 0;
imageablearea.right := paperwidth*100;
imageablearea.bottom := paperlength*100;
end;

//修改纸型，如果没有就新增
if not setform(hprinter, pchar(papername), 1, @forminfo) then
addform(hprinter, 1, @forminfo);

closeprinter(hprinter);
end;

//删除自定义规格纸张
//papername: 自定义纸张名称
procedure tdm.deletecustompaper(const papername: string);
var
printdevice, printdriver, printport : array[0..255] of char;
hdmode   : thandle;
hprinter : thandle;
begin
printer.getprinter(printdevice, printdriver, printport, hdmode);
openprinter(printdevice, hprinter, nil);
if hprinter = 0 then
raise exception.create('联接打印机失败!');
deleteform(hprinter, pchar(papername));
closeprinter(hprinter);
end;