自定义打印纸张演示系统 For Win2000/XP/2003 V0.1 ( 积分: 0 )

[]由于在WinNT/2000/XP/2003下使用自定义纸张特别麻烦，所多朋友都不知道怎样操作，所以整理了一下，写了一个演示系统，供大家参考。下载网址：http://tansoo.cn

不能下载

请注册一下吧，呵呵

{ ***********************************************
自定义打印纸张演示系统 For Win2000/XP/2003 V0.1
探索软件
http://www.tansoo.cn
tansoo.cn@Gmail.com
************************************************}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Printers, StdCtrls, WinSpool, Spin, Shellapi;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Button2: TButton;
Button3: TButton;
PrinterSetupDialog1: TPrinterSetupDialog;
GroupBox1: TGroupBox;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Label4: TLabel;
Label5: TLabel;
Memo1: TMemo;
Label6: TLabel;
Label7: TLabel;
procedure Button1Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ListBox2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Label7Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
FDevice: PChar;
FDriver: PChar;
FPort: PChar;
FDeviceMode: THandle;
FMode: PDeviceMode;
PaperSizes: Array[0..255] of Word;
FPaperNames : TStringList;
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
//增加规格自定义纸张
//PaperName: 自定义纸张名称
//PaperWidth: 纸张的宽度，以0.1mm为单位
//PaperLength: 纸张的高度，以0.1mm为单位
procedure 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 FormInfodo

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 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;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Assign(Printer.Printers);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
Printer.PrinterIndex := ListBox1.ItemIndex;
Printer.PrinterIndex := Printer.PrinterIndex;
// 刷新
Button2Click(Sender);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i : integer;
PaperNames: PChar;
PaperSize, PaperSizesNum : integer;
begin
Printer.PrinterIndex := Printer.PrinterIndex;
// 刷新
Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
// 得到当前打印机参数
FMode := GlobalLock(FDeviceMode);
//PaperSize := FMode.dmPaperSize;
FillChar(PaperSizes, SizeOf(PaperSizes), #0);
PaperSizesNum := DeviceCapabilities(FDevice, FPort, DC_PAPERS, @PaperSizes, FMode);
GetMem(PaperNames, PaperSizesNum * 64);
DeviceCapabilities(FDevice, FPort, DC_PAPERNAMES, PaperNames, FMode);
FPaperNames.Clear;
for i := 0 to PaperSizesNum - 1do
FPaperNames.Add(StrPas(PaperNames + i * 64)+' - '+IntToStr(PaperSizes));
ListBox2.Items.Assign(FPaperNames);
FreeMem(PaperNames, PaperSizesNum * 64);
GlobalUnlock(FDeviceMode);
end;

procedure TForm1.ListBox2Click(Sender: TObject);
begin
Printer.PrinterIndex := Printer.PrinterIndex;
Printer.GetPrinter(FDevice, FDriver, FPort, FDeviceMode);
FMode := GlobalLock(FDeviceMode);
FMode.dmFields := DM_PAPERSIZE;//要修改的项目，这些项目包括在windows.pas的14022行中
FMode.dmPaperSize := PaperSizes[ListBox2.ItemIndex];
//FMode.dmOrientation := ;
//FMode.dmCopies := ;
Printer.SetPrinter(FDevice, FDriver, FPort, FDeviceMode);
GlobalUnlock(FDeviceMode);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
PrinterSetupDialog1.Execute;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
GetMem(FDevice, 128);
GetMem(FDriver, 128);
GetMem(FPort, 128);
FillChar(FDevice^, 128, #0);
FillChar(FDriver^, 128, #0);
FillChar(FPort^, 128, #0);
FPaperNames := TStringList.Create;
Button1Click(Sender);
end;

procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
FreeMem(FDevice, 128);
FreeMem(FDriver, 128);
FreeMem(FPort, 128);
FPaperNames.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
AddCustomPaper(Edit1.Text,SpinEdit1.Value,SpinEdit2.Value);
MessageBox(handle,'创建成功，如果在列表中看不到（重新运行后），'#13#10'说明当前打印机不支持这种纸型。','系统提示',MB_ICONWARNING);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
if ListBox2.ItemIndex = -1 then
begin
MessageBox(handle,'请选择要删除的打印纸！','系统提示',MB_ICONWARNING);
exit;
end;
if MessageBox(handle,'删除后将无法恢复，请确认删除？','系统提示',MB_ICONQUESTION+MB_YESNO )= IDNO then
exit;
DeleteCustomPaper(ListBox2.Items.Strings[ListBox2.ItemIndex]);
Button2Click(Sender);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Label7Click(Sender: TObject);
begin
ShellExecute(0,'Open','http://www.tansoo.cn', nil,nil,SW_RESTORE);
end;

end.

谢谢 楼主的分享。