1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Buttons,System.Win.ComObj;
  8 
  9 type
 10   TForm1 = class(TForm)
 11     BitBtn1: TBitBtn;
 
 12     BitBtn2: TBitBtn;
 13     Edit1: TEdit;
 14     Label1: TLabel;
 15     procedure BitBtn2Click(Sender: TObject);
 16     procedure BitBtn1Click(Sender: TObject);
 17     procedure FormDestroy(Sender: TObject);
 18     procedure FormCreate(Sender: TObject);
 19   private
 20     FCSApp,FBarApp:Variant;
 
 21     const
 22       VARID=‘RID‘;
 23     { Private declarations }
 24     procedure PrintCS(ACopys:Integer=1);
 25     procedure PrintBar(ACopys:Integer=1);
 26     function VarIsExists(const Vars:Variant;AVarName : string):Boolean;
 27     function GetBarObj:Variant;
 28     function GetCSObj:variant;
 
 29   public
 30     { Public declarations }
 31   end;
 32 
 33 var
 34   Form1: TForm1;
 35 
 36 implementation
 37 
 38 {$R *.dfm}
 39 
 40 procedure TForm1.BitBtn1Click(Sender: TObject);
 41 begin
 42   PrintCS(StrToIntDef(Edit1.Text,1));
 43 end;
 44 
 45 procedure TForm1.BitBtn2Click(Sender: TObject);
 46 begin
 47   PrintBar(StrToIntDef(Edit1.Text,1));
 48 end;
 49 
 50 procedure TForm1.FormCreate(Sender: TObject);
 51 begin
 52  GetBarObj;
 53  GetCSObj;
 54 end;
 55 
 56 procedure TForm1.FormDestroy(Sender: TObject);
 57 begin
 58   if not VarIsEmpty(FBarApp) then
 59   try
 60     FBarApp.quit(1);
 61   except
 62     FBarApp := Unassigned;
 63   end;
 64   if not VarIsEmpty(FCSApp) then
 65   try
 66     FCSApp.quit;
 67   except on E: Exception do
 68     FCSApp := Unassigned;
 69   end;
 70 end;
 71 
 72 function TForm1.GetBarObj: Variant;
 73 begin
 74   try
 75     result := GetActiveOleObject(‘BarTender.Application‘);
 76   except on E: Exception do
 77     try
 78       result := CreateOleObject(‘BarTender.Application‘);
 79     except on E: Exception do
 80       result := varEmpty;
 81     end;
 82   end;
 83 end;
 84 
 85 function TForm1.GetCSObj: variant;
 86 begin
 87   try
 88     result := GetActiveOleObject(‘Lppx.Application‘);
 89   except on E: Exception do
 90     try
 91       result := CreateOleObject(‘Lppx.Application‘);
 92     except on E: Exception do
 93       result := varEmpty;
 94     end;
 95   end;
 96 end;
 97 
 98 procedure TForm1.PrintBar(ACopys: Integer);
 99 var
100   btFormat,Vars:Variant;
101   i:integer;
102   sFile:string;
103 begin
104 //  try
105 //    FBarApp := CreateOleObject(‘BarTender.Application‘);
106 //  except
107 //    raise Exception.Create(‘BarTender not installed?‘);
108 //  end;
109   sFile := ExtractFilePath(Application.ExeName)+‘RID.btw‘;
110   if not FileExists(sFile) then
111   begin
112     ShowMessage(‘模板文件(RID.btw)在當前目錄下不存在!‘);
113     Exit;
114   end;
115   FBarApp := GetBarObj;
116   if VarIsEmpty(FBarApp) then Exit;
117 
118   FBarApp.Visible := False;
119   try
120     btFormat := FBarApp.formats.Open(sFile,true,‘‘);
121     Vars := btFormat.NamedSubStrings;
122     for i := 1 to ACopys do
123     begin
124       if VarIsExists(Vars,VARID) then
125       begin
126         btFormat.SetNamedSubStringValue(VARID,Concat(VARID,i.ToString));
127         btFormat.PrintOut(False,False);
128       end;
129     end;
130   finally
131     btFormat.Close(1);
132   //  FBarApp.Quit(1);
133   end;
134 end;
135 
136 procedure TForm1.PrintCS(ACopys: Integer);
137 var
138   Docs,Vars:Variant;
139   i:integer;
140   sFile:string;
141 begin
142 //  try
143 //    FCsApp := CreateOleObject(‘lppx.Application‘);
144 //  except
145 //    raise Exception.Create(‘Codesoft not installed?‘);
146 //  end;
147   sFile := ExtractFilePath(Application.ExeName)+‘RID.lab‘;
148   if not FileExists(sFile) then
149   begin
150     ShowMessage(‘模板文件(RID.lab)在當前目錄下不存在!‘);
151     Exit;
152   end;
153 
154   FCSApp := GetCSObj;
155   if VarIsEmpty(FCSApp) then Exit;
156   FCsApp.Visible := False;
157   try
158     Docs := FCSApp.ActiveDocument;
159     Docs.Open(sFile,false);
160     Vars := Docs.Variables;
161     for i := 1 to ACopys do
162     begin
163       if VarIsExists(Vars,VARID) then
164       begin
165         Vars.Item[VARID].value := Concat(VARID,i.ToString);
166 
167       end;
168       Docs.PrintLabel(1);
169     end;
170     Docs.FormFeed;
171   finally
172     Docs.Close;
173   //  Docs:=Unassigned;
174 //    FCsApp.Quit;
175 //    FCSApp := Unassigned;
176   end;
177 end;
178 
179 function TForm1.VarIsExists(const Vars: Variant; AVarName: string): Boolean;
180 var
181  i:integer;
182 begin
183   Result := False;
184   if VarIsNull(Vars) or VarIsEmpty(Vars) then exit;
185   for i := 1 to Vars.Count do
186   begin
187     Result := SameText(Vars.Item[i].Name,AVarName);
188     if Result then Break;
189   end;
190 end;
191 
192 end.

註：CodeSoft 6在測試時正常，其它版本會自動把lppa.exe 終結，可能是環境的原因。　在窗體創建時建立lppa.exe,關閉時退出。這樣可以提高打印速度。

CodeSoft和BarTender打印的調用