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.