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 + -
显示快捷键?