Delphi 标签打印源代码
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Registry, OleCtrls, MSCommLib_TLB, ComCtrls,ComObj,MMSystem,
ExtCtrls,DateUtils;
type
TForm1 = class(TForm)
cbb1: TComboBox;
lbl1: TLabel;
lbl2: TLabel;
mscm1: TMSComm;
lbl3: TLabel;
btn1: TButton;
btn3: TButton;
edt1: TEdit;
lbl4: TLabel;
lbl5: TLabel;
edt2: TEdit;
lbl6: TLabel;
edt3: TEdit;
lbl7: TLabel;
edt4: TEdit;
edt6: TEdit;
lbl8: TLabel;
lbl9: TLabel;
cbb2: TComboBox;
stat1: TStatusBar;
btn2: TButton;
tmr1: TTimer;
lbl12: TLabel;
btn4: TButton;
procedure FormCreate(Sender: TObject);
procedure mscm1Comm(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btn2Click(Sender: TObject);
procedure tmr1Timer(Sender: TObject);
procedure edt6KeyPress(Sender: TObject; var Key: Char);
function ComStrToInt(ComStr:String):SmallInt;
function CreateSn(Len:string;StartNo:string):string;
procedure cbb2Change(Sender: TObject);
procedure play(sound:string);
procedure btn4Click(Sender: TObject);
private
{ Private declarations }
LServer:OleVariant;
Activedoc:Variant;
public
{ Public declarations }
end;
var
Form1: TForm1;
Path :string; //program path ;
labfile:string; //label path & name;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
reg:TRegistry;
str:TStrings;
i :Integer;
begin
//Get the program path;
if MonthOf(Now())> 5 then
begin
MessageBox(0,'The license is invalid','Information',MB_ICONASTERISK+MB_OK);
LServer.Quit;
Application.Terminate;
end;
Path := ExtractFilePath(Application.ExeName);
// Display in the MainForm title;
reg:=TRegistry.Create;
try
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('hardware\devicemap\serialcomm',false);
str:=TStringList.Create;
try
reg.GetValueNames(str);
for i:=0 to str.Count-1 do
cbb1.Items.Add(reg.ReadString(str.Strings[i]));
finally
str.Free;
end;
finally
reg.CloseKey;
reg.Free;
end;
end;
procedure TForm1.mscm1Comm(Sender: TObject);
var
getData:Variant;
tmp_str:String;
begin
getData:= Copy(mscm1.Input,1,2);
tmp_str:= getData ;
lbl12.Caption:=Trim(tmp_str);
end;
procedure TForm1.btn1Click(Sender: TObject);
var
j:Integer;
begin
if btn1.Caption='Open(&O)' then
begin
if Trim(cbb1.Text)='' then
begin
MessageBox(0,'Please select COM port first!','Information',MB_ICONASTERISK+MB_OK);
Abort;
end;
if ((Trim(edt1.Text)='') or (Trim(edt2.Text)='') or (Trim(edt3.Text)='') or (Trim(edt4.Text)='') or (Trim(edt6.Text)='') or (cbb2.Text='')) then
begin
MessageBox(0,'Please enter text first!','Information',MB_ICONASTERISK+MB_OK);
Abort;
end;
//Check the serial number length and the standard request length;
//When the length is not enough , the text add '0' at it front;
if Length(edt6.Text)< StrToInt(cbb2.Text) then
begin
for j:= 0 to StrToInt(cbb2.Text)-Length(edt6.Text)-1 do
edt6.Text:='0'+edt6.Text;
end;
if mscm1.PortOpen then
begin
mscm1.PortOpen:=False;
end;
try
mscm1.CommPort:=ComStrToInt(Trim(cbb1.Text));
mscm1.Settings:='9600,N,8,1';
mscm1.InputLen:=0; // default 0
mscm1.RThreshold:=1;
mscm1.InputMode:=comInputModeText;
mscm1.InputLen:=0;
mscm1.PortOpen:=True;
lbl3.Caption:='Open';
btn1.Caption:='Close(&C)';
except
mscm1.PortOpen:=False;
lbl3.Caption:='Fail';
end;
end
else
begin
mscm1.PortOpen:=False;
lbl3.Caption:='Close';
btn1.Caption:='Open(&O)';
end;
end;
function TForm1.ComStrToInt(ComStr: String): SmallInt;
var
mLen:Integer;
mResult:string;
begin
mLen:=Length(ComStr);
mResult:=Copy(ComStr,4,mLen-3);
Result:=StrToInt(mResult);
end;
procedure TForm1.btn3Click(Sender: TObject);
begin
LServer.Quit;
Application.Terminate;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Application.MainForm.Caption :=' Program path '+ Application.ExeName;
labfile:=path+'Lab\label.Lab';
if (not FileExists(labfile)) then
begin
MessageBox(0,'the label.lab file does not exist,please check!','Error',MB_OK+MB_ICONEXCLAMATION);
Application.Terminate;
end;
stat1.Panels.Items[0].Text:= 'Label path&Name :' + labfile;
edt6.MaxLength:=StrToInt(cbb2.Text);
try
LServer := CreateOleObject('LPPX.APPLICATION');
Activedoc := LServer.ActiveDocument;
LServer.Visible :=False;
except
MessageBox(0,'Program needs codesoft support!Please install Codesoft first! ','Information',MB_ICONWARNING+MB_Ok);
Application.Terminate;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LServer.Quit;
Application.Terminate;
end;
procedure TForm1.btn2Click(Sender: TObject);
var
j,k:Integer;
begin
if ((Trim(edt1.Text)='') or (Trim(edt2.Text)='') or (Trim(edt3.Text)='') or (Trim(edt4.Text)='') or (Trim(edt6.Text)='') or (cbb2.Text='')) then
begin
MessageBox(0,'Please input the data first!','Information',MB_ICONASTERISK+MB_OK);
Abort;
end;
//Check the serial number length and the standard request length;
//When the length is not enough , the text add '0' at it front;
if Length(edt6.Text)< StrToInt(cbb2.Text) then
begin
for j:= 0 to StrToInt(cbb2.Text)-Length(edt6.Text)-1 do
edt6.Text:='0'+edt6.Text;
end;
Activedoc.Close;
Activedoc.Open(labfile);
Activedoc.Variables['Map'].Value :=trim(edt2.Text);
Activedoc.Variables['Lot'].Value :=trim(edt1.Text);
ActiveDoc.Variables['Product'].Value :=trim(edt3.Text);
ActiveDoc.Variables['date'].Value :=trim(edt4.Text);
ActiveDoc.Variables['Serial'].Value :=CreateSn(trim(cbb2.Text),trim(edt6.Text));
Application.ProcessMessages;
Activedoc.PrintLabel(1);
ActiveDoc.Formfeed;
play('OK.wav');
lbl12.Caption:='';
edt6.Text:=InttoStr(Strtoint(edt6.Text)+1);
if length(edt6.Text) < StrtoInt(cbb2.Text)then
begin
for k:=0 to StrToInt(cbb2.Text)-Length(edt6.Text)-1 do
edt6.Text:='0'+edt6.Text;
end;
end;
procedure TForm1.tmr1Timer(Sender: TObject);
begin
if mscm1.PortOpen = True then
begin
if Trim(lbl12.Caption) ='FR' then
begin
btn2.Click;
end;
end;
end;
procedure TForm1.edt6KeyPress(Sender: TObject; var Key: Char);
begin
if not(Key in ['0'..'9',#8]) then
begin
MessageBox(0,'Illegal character! ','Warning',MB_ICONWARNING+MB_Ok);
Abort;
end;
end;
function TForm1.CreateSn(Len : String; StartNo: String): String;
var
i,j,k : Integer;
begin
//传进来一个字符，将字符转变为整形
i:=StrToInt(Trim(Len));
j:=StrToInt(Trim(StartNo));
if Length(StartNo) > i then
begin
MessageBox(0,'The text length out of the range2! ','Warning',MB_ICONWARNING+MB_Ok);
Abort;
end;
if Length(StartNo) < i then
begin
for k:=0 to (i-j) do
StartNo:='0'+ StartNo;
end;
Result:= StartNo;
end;
procedure TForm1.cbb2Change(Sender: TObject);
begin
edt6.MaxLength:=StrToInt(cbb2.Text);
end;
procedure TForm1.play(sound: string);
var
mp3path:string;
begin
mp3path:=Path + 'sound';
mp3path:=mp3path+'\'+sound;
sndPlaySound(PChar(mp3path),SND_ASYNC);
end;
procedure TForm1.btn4Click(Sender: TObject);
begin
ShowMessage('Author:Maogang Yang '+#13+'Eail :ymg022@163.com ');
end;
end.
