用Cell电子表格组件写的程序转换到用Ejun电子表格
var
addi : integer;
ftype : Smallint;
stn,stc: array[1..10000] of String;
function get_st(sl:string):string;
var i : integer;
begin
for i:=length(sl) downto 1 do
if (sl[i]<#32) or (sl[i]=#39) or (sl[i]=';') then delete(sl,i,1);
result:=sl;
end;
function tri(sl,st:string):string;
//F1Book1.sheets[pagei].Cells[yy1-1,i].asstring
//F1Book1.getcellstring(yy1-1,i,pagei);
var
i,k,l,p,h: integer;
s0,s1,s2 : string;
begin
result:=sl;
h:=pos('TCELL5',sl);
if h>0 then
begin
delete(sl,h,6);
insert('TEjunsheetControl',sl,h);
result:=sl;
exit;
end;
h:=pos('GETCURSHEET',sl);
if h>0 then
begin
delete(sl,h,11);
insert('ActiveSheetIndex',sl,h);
result:=sl;
exit;
end;
h:=pos('CELL50LIB_TLB',sl);
if h>0 then
begin
delete(sl,h,13);
insert('ZJGrid, ZcDataGrid,ZcSheetControl, ZcGridUnRedo, ZcGridPrints,ZcUniClass',sl,h);
result:=sl;
exit;
end;
end;
// if FB.sheets[pg].Cells[i,j].IsNumberValue then
function trp(sl,st:string):string;
//F1Book1.sheets[pagei].Cells[yy1-1,i].asstring
//F1Book1.getcellstring(yy1-1,i,pagei);
var
i,k,l,p,h,h1,h2: integer;
s0,s1,s2,s3,s4 : string;
begin
h:=pos('CELLDOUBLE',sl);
h1:=pos('CELLSTRING',sl);
h2:=pos('CELLDATATYPE',sl);
if h+h1+h2<1 then exit;
p:=pos('.'+st+'(',sl);
s0:=copy(sl,1,p);
delete(sl,1,p+length(st)+1);
p:=pos(',',sl);
s1:=copy(sl,1,p-1);
delete(sl,1,p);
p:=pos(',',sl);
s2:=copy(sl,1,p-1);
delete(sl,1,p);
p:=pos(')',sl);
s3:=copy(sl,1,p-1);
delete(sl,1,p);
s4:=sl;
if h>0 then s0:=s0+'sheets['+s3+'].cells['+s1+','+s2+'].AsFloat'+s4;
if h1>0 then s0:=s0+'sheets['+s3+'].cells['+s1+','+s2+'].AsString'+s4;
if h2>0 then s0:=s0+'sheets['+s3+'].cells['+s1+','+s2+'].IsNumberValue'+s4;
result:=s0;
end;
function trp4(sl,st:string):string;
//F1Book1.sheets[pagei].Cells[yy1-1,i].asstring
//F1Book1.getcellstring(yy1-1,i,pagei);
var
i,k,l,p,h,h1 : integer;
s0,s1,s2,s3,s4 : string;
begin
h:=pos('CELLDOUBLE',sl);
h1:=pos('CELLSTRING',sl);
if h+h1<1 then exit;
p:=pos('.'+st+'(',sl);
s0:=copy(sl,1,p);
delete(sl,1,p+length(st)+1);
p:=pos(',',sl);
s1:=copy(sl,1,p-1);
delete(sl,1,p);
p:=pos(',',sl);
s2:=copy(sl,1,p-1);
delete(sl,1,p);
p:=pos(',',sl);
s3:=copy(sl,1,p-1);
delete(sl,1,p);
p:=pos(')',sl);
s4:=copy(sl,1,p-1);
delete(sl,1,p);
result:=s0+'sheets['+s3+'].cells['+s1+','+s2+'].valuet:='+s4+sl;
end;
procedure TForm1.Button6Click(Sender: TObject);
var
fl,fn,i,j,l,n,p0: integer;
sline,sl,fname : string;
fi,fo : textfile;
begin
memo1.Visible:=true;
fn:=FileListBox1.Items.Count;
fl:=0;
n:=0;
while fl<fn do
begin
fname:=FileListBox1.Items[fl];
fl:=fl+1;
fname:=ExtractFileName(FName);
l:=length(fname)-3;
fname:=copy(fname,1,l)+'pas';
if not FileExists(fname) then continue;
assignfile(fi,fname);
reset(fi);
assignfile(fo,'e:\dps2008x\'+fname);
rewrite(fo);
while not eof(fi) do
begin
readln(fi,sline);
sl:=uppercase(sline);
if pos('END.',sl)=1 then
begin
writeln(fo,sline);
break;
end;
p0:=pos('TCELL5',sl)
+pos('CELL50LIB_TLB',sl)
+pos('GETCELLDOUBLE',sl)
+pos('GETCELLSTRING',sl)
+pos('SETCELLDOUBLE',sl)
+pos('SETCELLSTRING',sl)
+pos('GETCURSHEET',sl)
+pos('GETCELLDATATYPE',sl);
if p0<1 then //空行或没有表示字符串存在的引号
begin
writeln(fo,sline);
continue;
end;
sl:=tri(sl,'TCELL5');
sl:=tri(sl,'GETCURSHEET');
sl:=tri(sl,'CELL50LIB_TLB');
if pos('GETCELLDOUBLE',sl)>0 then sl:=trp(sl,'GETCELLDOUBLE');
if pos('GETCELLSTRING',sl)>0 then sl:=trp(sl,'GETCELLSTRING');
if pos('SETCELLDOUBLE',sl)>0 then sl:=trp4(sl,'SETCELLDOUBLE');
if pos('SETCELLSTRING',sl)>0 then sl:=trp4(sl,'SETCELLSTRING');
if pos('GETCELLDATATYPE',sl)>0 then sl:=trp(sl,'GETCELLDATATYPE');
n:=n+1;
memo1.Lines.Add(inttostr(n)+#9+sl);
writeln(fo,sl);
end;
closefile(fi);
closefile(fo);
end;
end;
