utoprint.pas
来自「delphi2007开发的汽车配件进销存系统.实用级的源码.」· PAS 代码 · 共 219 行
PAS
219 行
unit SplPrint;
interface
uses
Windows, Messages, Classes, WinSpool, SysUtils;
procedure EnumPrt(st: TStrings;var Def: integer);
procedure StartPrint(PrtName, DocName, ToFile: string; Copies: integer);
function ToPrnFrmC(FrmStr: string; const Args: array of const): boolean;
function ToPrnFrm(FrmStr: string; const Args: array of const): boolean;
function ToPrnLn(S: string): boolean;
function ToPrn(S: string): boolean;
procedure CancelPrint;
procedure EndPrint;
var
ph: THandle;
DevMode: TDeviceModeA;
PrJob: dword;
implementation
function ReplaceStr(const S, Srch, Replace: string): string;
var
I: Integer;
Source: string;
begin
Source := S;
Result := '';
repeat
I := Pos(Srch, Source);
if I > 0 then begin
Result := Result + Copy(Source, 1, I - 1) + Replace;
Source := Copy(Source, I + Length(Srch), MaxInt);
end
else Result := Result + Source;
until I <= 0;
end;
function ToDos(const AnsiStr: String):String;
begin
SetLength(Result, Length(AnsiStr));
if Length(Result) > 0 then
AnsiToOem(PChar(AnsiStr), PChar(Result));
Result:=ReplaceStr(Result,chr(253),chr(15));
end;
function ToWin(str: String):String;
begin
if str='' then begin
Result:='';
System.Exit;
end;
OemToAnsi(PChar(str),PChar(str));
Result:=str;
end;
procedure EnumPrt(st: TStrings;var Def: integer);
type
PPrInfoArr = ^TPrInfoArr;
TPrInfoArr = array [0..0] of TPRINTERINFO2;
var
i,Indx,Level: integer;
buf: pointer;
Need,Returned: dword;
PrInfoArr: PPrInfoArr;
begin
st.Clear;
Def:=0; Level:=2;
EnumPrinters(PRINTER_ENUM_LOCAL,nil,Level,nil,0,Need,Returned);
GetMem(buf,Need);
try
EnumPrinters(PRINTER_ENUM_LOCAL,nil,Level,PByte(buf),Need,Need,Returned);
PrInfoArr:=buf;
{$RANGECHECKS OFF}
for i:=0 to Returned-1 do begin
Indx:=st.Add(PrInfoArr[i].pPrinterName);
if (PrInfoArr[i].Attributes AND PRINTER_ATTRIBUTE_DEFAULT)>0 then Def:=Indx;
end;
{$RANGECHECKS ON}
finally
FreeMem(buf);
end;
end;
procedure StartPrint(PrtName, DocName, ToFile: string; Copies: integer);
var
pdi: PDocInfo1;
pd: TPrinterDefaults;
begin
DevMode.dmCopies:=Copies;
DevMode.dmFields:=DM_COPIES;
pd.pDatatype:='RAW';
pd.pDevMode:=@DevMode;
pd.DesiredAccess:=PRINTER_ACCESS_USE;
if Win32Check(OpenPrinter(PChar(PrtName),ph,@pd)) then begin
new(pdi);
with pdi^ do begin
pDocName:=PChar(DocName);
if ToFile='' then pOutputFile:=nil
else pOutputFile:=PChar(ToFile);
pDatatype:='RAW';
end;
PrJob:=StartDocPrinter(ph,1,pdi);
if PrJob=0 then Win32Check(false);
end;
end;
function ToPrnFrm(FrmStr: string; const Args: array of const): boolean;
begin
Result:=ToPrnLn(Format(FrmStr,Args));
end;
function ToPrnFrmC(FrmStr: string; const Args: array of const): boolean;
begin
Result:=ToPrnLn(ToDos(Format(FrmStr,Args)));
end;
function ToPrnLn(S: string): boolean;
begin Result:=ToPrn(S+#13#10); end;
function ToPrn(S: string): boolean;
var cp: dword;
begin
Win32Check(WritePrinter(ph,PChar(S),length(S),cp));
Result:=true;
end;
procedure EndPrint;
begin
Win32Check(EndDocPrinter(ph));
// Win32Check(EndDoc(ph)>0);
end;
procedure CancelPrint;
begin
Win32Check(SetJob(ph,PrJob,0,nil,JOB_CONTROL_CANCEL));
end;
initialization
end.
{
////演示单元
//unit Main;
//
//interface
//
//uses
//Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
//StdCtrls, ExtCtrls;
//
//type
//TfPrinter_Test = class(TForm)
//Memo1: TMemo;
//Panel1: TPanel;
//cbPrinters: TComboBox;
//bnPrint: TButton;
//procedure FormCreate(Sender: TObject);
//procedure bnPrintClick(Sender: TObject);
//private
//{ Private declarations }
//public
//{ Public declarations }
//end;
//
//var
//fPrinter_Test: TfPrinter_Test;
//
//implementation
//
//uses SplPrint;
//
//{$R *.DFM}
//
//procedure TfPrinter_Test.FormCreate(Sender: TObject);
//var
//DefaultPrinterId: integer;
//begin
//EnumPrt(cbPrinters.Items, DefaultPrinterId);
//cbPrinters.ItemIndex := DefaultPrinterId;
//end;
//
//procedure TfPrinter_Test.bnPrintClick(Sender: TObject);
//begin
//StartPrint(cbPrinters.Items[cbPrinters.ItemIndex], 'test doc', '', 1);
//try
//ToPrnFrmC(Memo1.Text, []);
//finally
//EndPrint();
//end;
//end;
//
//end.
}
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?