liujianjun/tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

tsl

Browse Source 
整体更新
This commit is contained in:
liujianjun
2024-03-22 16:44:34 +08:00
parent e8c5223f00
commit 33ba905e99
31 changed files with 1108 additions and 411 deletions
Download Patch File Download Diff File Expand all files Collapse all files
funcext/tvclib/utslvclauxiliary.tsf
+431 -2
View File
@@ -27,8 +27,9 @@ function pointinrect(p,rec);
function intersectrect(rec1,rec2,irec);
function bitcombination(s,v,f);
function IsTextUTF8(str);
function istextascii(s); //ansi编码
function isTextGBK(str);
function IsTextUTF8(str);
function exportjsonformat(d,tbw,ct);
function get_resource_by_name(n,full);
//****************************
@@ -50,6 +51,8 @@ function TS_ExecPath():string;
function TS_GetAppPath():string;
function TS_GetIniPath(t:integer;iname:string):string;
function gettslexefullpath();
//function tsl_str_head_at(s,n);
function get_tsl_mem_ptr(s,n);
type tuiglobaldata=class() //全局对象存储
static UIData;
class Function uisetdata(n,d);
@@ -2889,6 +2892,380 @@ type t_ini_format_operator=class()
ft;
end
end
type t_gbk_text_finder = class() //查找对象
function create();
begin
ffindstr:="";
fstr := "";
Fismline := true;
findflag := false;
FisReg := false;
fiswrap := false;
fiscase := false;
fiscycle := true;
fisprev := false;
frc := array(1,1);
end
function set_text(s); //文本
begin
if fstr<>s then
begin
fstr := s;
ftextrows := text_2_array(fstr);
findflag := true;
end
end
function set_replace_str(s);
begin
if frstr<>s then
begin
frstr := s;
frstrflag := true;
end
end
function set_find_str(s);
begin
if ffindstr <> s then
begin
ffindstr := s;
findflag := true;
end
end
function set_rc(rc); //设置当前行列 1,1 为初始位置
begin
if ifarray(rc) and rc[0]>0 and rc[1]>0 then
begin
frc := rc;
end
end
function find_one(); //查找下一个
begin
if fisprev then return find_prev();
return find_next();
end
function format_rep_Str(info); //构造替换
begin
ms :=get_rep_str_info();
if ifarray(ms) then
begin
fr :=frstr;
for j := length(ms)-1 downto 0 do
begin
si := fmachs[i,ms[j,3],0];
if not ifstring(si) then return false;
fr[ms[j,1]:ms[j,2]] := si;
end
return fr;
end
return ms;
end
function find_all(); //全部查找
begin
do_find();
r := array();
for i,v in fmachs do
begin
//array(vj,p,pe,array(r1,c1),array(r2,c2),row_text(r1))
r[i] := format_find_return(v);
end
return r; //返回信息
end
function replace_all(var r);//全部替换,为变参返回,返回结果是行列信息
begin
do_find();
if not fmachs then return 0;
ms := get_rep_str_info();
r := fstr;
rinfo := array();
for i := length(fmachs)-1 downto 0 do
begin
info := fmachs[i];
rs := format_rep_Str(info);
if rs=0 then return false;
p1 := info[0,1] ;
p2 := info[0,2];
r[p1:p2] := rs;
rinfo[i] := format_find_return(info);
end
if r=fstr then return 0;
return rinfo;
end
function find_next();//下一个
begin
do_find();
label findtwo;
for i,v in fmachs do
begin
if frc[0]<v[0,3,0] or(frc[0]=v[0,3,0] and frc[1]<=v[0,3,1]) then
begin
frc := v[0,4];
return v;
end
end
if not fiscycle then return array();
if two then return array();
two := true;
frc := array(1,1);
goto findtwo;
end
function find_prev();//上一个
begin
do_find();
label findtwo;
for i:= length(fmachs)-1 downto 0 do
begin
v := fmachs[i];
if frc[0]>v[0,3,0] or(frc[0]=v[0,3,0] and frc[1]>=v[0,4,1]) then
begin
frc := v[0,3];
return v;
end
end
if not fiscycle then return array();
if two then return array();
two := true;
ls := length(ftextrows);
frc := array(ftextrows[ls-1,0],ftextrows[ls-1,1]);
goto findtwo;
end
property isReg read FisReg write set_reg;//正则
property iscase read fiscase write set_case;//大小写
property iswrap read fiswrap write set_wrap;//全词匹配
property iscycle read fiscycle write set_cycle;//循环查找
property isprev read fisprev write set_prev;//朝前
property ismline read Fismline write set_mline;//朝前
private
function set_mline(v);
begin
nv := v?true:false;
if nv<>Fismline then
begin
Fismline := nv;
findflag := true;
end
end
function set_prev(v);
begin
nv := v?true:false;
if nv<>fisprev then
begin
fisprev := nv;
end
end
function set_cycle(v);
begin
nv := v?true:false;
if nv<>fiscycle then
begin
fiscycle := nv;
end
end
function set_reg(v);
begin
nv := v?true:false;
if nv<>fisreg then
begin
fisreg := nv;
findflag := true;
frstrflag := true;
end
end
function set_case(v);
begin
nv := v?true:false;
if nv<>fiscase then
begin
fiscase := nv;
findflag := true;
end
end
function set_wrap(v);
begin
nv := v?true:false;
if nv<>fiswrap then
begin
fiswrap := nv;
findflag := true;
end
end
function row_text(i);//获得行文本
begin
return ftextrows[i-1,2];
end
function p_to_rc(p,r,c);//位置到行列
begin
r := -1;
c := -1;
for i,v in ftextrows do
begin
if p>=v[0] and p<=(v[1]) then
begin
r := i+1;c := p-v[0]+1;
return ;
end
end
end
function fmt_unreg_ctl(tg,rg,wr);//正则控制串
begin
if not tg then return "";
ctl := tg;
if not rg then
begin
ctl := "";
ltg := length(tg);
for i := 1 to length(tg) do
begin
vi := tg[i];
cvi := ord(vi);
if cvi>=9 and cvi<=13 then
begin
ctl +="\\s";
if i=1 then wrp :=1;
if i=ltg then wrp .|= 2;
end else
if (cvi>=0x21 and cvi<=0x2f) or
(cvi>=0x3a and cvi<=0x40) or
(cvi>=0x5b and cvi<=0x60) or
(cvi>=0x7b and cvi<=0x7e) then
begin
ctl +="\\"+vi;
if i=1 then wrp :=1;
if i=ltg then wrp .|= 2;
end else
begin
ctl+=vi;
end
end
if wr then
begin
if not((wrp .& 1) >0) and not((ord(ctl[1]) .& 0x80 )>0) then ctl := "\\b"+ctl;
if not((wrp .& 2) >0) and not((ord(ctl[length(ctl)]) .& 0x80 )>0) then ctl := ctl+"\\b";
end
end
return ctl;
end
function text_2_array(s); //获得行位置
begin
r := array();
fgf := "\n";
if pos("\r\n",s) or pos("\n",s) then
begin
fgf := "\n";
end else
if pos("\r",s) then
fgf := "\r";
r[0,0] := 1;
idx := 0;
for i := 1 to length(s)-1 do
begin
vi := s[i];
if vi=fgf then
begin
r[idx,1]:=i;
r[idx,2]:=s[r[idx,0]:(i-1)];
idx++;
r[idx,0] := i+1;
end
end
r[idx,1]:=length(s)+1;
r[idx,2]:=s[r[idx,0]:];
return r;
end
function do_find();//查找
begin
if not findflag then return ;
findflag := false;
fs := fmt_unreg_ctl(ffindstr,FisReg,fiswrap);
ctl2 := "";
if Fismline then ctl2 += "m";
if fiscase then ctl2+="i";
fmachs := array();
frows := array();
if 1= ParseRegExpr(fs,fstr,ctl2,m,mp,ml) then
begin
for i ,v in m do
begin
for j,vj in v do
begin
p := mp[i,j];
pe := p+ml[i,j]-1;
p_to_rc(p,r1,c1);
p_to_rc(pe+1,r2,c2);
if j=0 and not(frows[r1]) then
begin
frows[r1] := true;
fmachs[i,j] := array(vj,p,pe,array(r1,c1),array(r2,c2),row_text(r1));
end else fmachs[i,j] := array(vj,p,pe,array(r1,c1),array(r2,c2));
end
end
end
end
function get_rep_str_info(); //替换字符串信息
begin
if frstrflag then
begin
frstrflag := false;
if frstr then //
begin
if FisReg then //正则表达式
begin
if 1= ParseRegExpr("\\$(\\d+)",frstr,"",m,mp,ml) then //占位符计算
begin
ms := array();
for i:= 0 to length(m)-1 do
begin
ms[i,0] := m[i,0];
ms[i,1] := mp[i,0];
ms[i,2] := mp[i,0]+ml[i,0]-1;
ms[i,3] := strtointdef(m[i,1],0);
end
end else
begin
ms := frstr;
end
end else
begin
ms := frstr;
end
end else
begin
ms := "";
end
freginfo := ms;
end else
begin
ms := freginfo;
end
return ms;
end
function format_find_return(v); //格式化一个匹配结果
begin
r := array();
r[0] := v[0,0];//匹配结果
r[1] := v[0,3];//配合开始的行列
r[2] := v[0,4];//截止的行列
r[3] := v[0,5];//行内容
return r;
end
private
frstr;
ffindstr;
fstr;
Fismline;
findflag;
frstrflag;
freginfo;
fisprev;
fiscycle;
FisReg;
fiscase;
fiswrap;
ftextrows;
fmachs;
frc;
end
implementation
function iffuncptr(fn);
begin
@@ -3617,6 +3994,22 @@ function TS_ModulePath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$
function TS_ExecPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath";
function TS_GetAppPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetAppPath";
function TS_GetIniPath(t:integer;iname:string):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetIniPath";
function istextascii(s); //ansi编码
begin
len := length(s);
//m := new TMemoryStream();
//dp := get_tsl_mem_ptr(s);
//m.setmemory(dp,len);
//ci := 0;
i := 1;
for i:= 1 to len do
begin
ci := ord(s[i]);
//m.read(ci,1);
if((ci .& 0x80)<> 0) then return false;
end
return true;
end
function isTextGBK(data) //gbk编码
begin
if not ifstring(data) then return 0;
@@ -3843,7 +4236,7 @@ begin
if n=2 then return g_w_tfm_resource_withdir;
if n=3 then return (g_w_tfm_resource union g_w_tfm_resource_withdir);
if n=4 then return g_w_tfm_resource_names;
p := filesize("","d:\\test\\get_source.txt");
//p := filesize("","d:\\test\\get_source.txt");
r := g_w_tfm_resource[n];
if r then return r;
@@ -3894,7 +4287,43 @@ begin
end
except
end
end
function get_tsl_mem_ptr(s,n);
begin
ptr := static makeinstance(thisfunction(get_tsl_ptr_drift));
if ifstring(s) then
begin
_f_ := static function(var v:string;n:integer):pointer;cdecl;external ptr;
end else
if ifint(s) then
begin
_f_ := static function(var v:integer;n:integer):pointer;cdecl;external ptr;
end else
if ifint64(s) then
begin
_f_ := static function(var v:int64;n:integer):pointer;cdecl;external ptr;
end else
if ifnumber(s) then
begin
_f_ := static function(var v:double;n:integer):pointer;cdecl;external ptr;
end else
if ifobj(s) then
begin
_f_ := static function(var v:TObject;n:integer):pointer;cdecl;external ptr;
end
return call(_f_,s,((n>0)?n:0));
end
{function tsl_str_head_at(s,n);
begin
_f_ := static function(var v:string;n:integer):string;cdecl;external makeinstance(thisfunction(get_tsl_ptr_drift));
return ##_f_(s,n);
end }
function get_tsl_ptr_drift(v:pointer;n:integer):pointer;cdecl;
begin
if n>0 then return v+n;
return v;
end
initialization
uinit();
end.
funcext/tvclib/utvclgraphics.tsf
+23 -7
View File
@@ -307,18 +307,22 @@ type tfm = class(tvcform)
begin
inherited;
caption := "pie";
width := 800;
Height := 800;
fg := new tg_WinControl(self);
fg.Caption := "hello1";
fg.parent := self;
fg.Align := alClient;
//////////设置坐标轴属性////////////////////////
axs := new tg_axes();
axs.box := true;
axs.figure := fg.figure;
axs.title.text := "hello pie ";
axs.axises(1).tics_color := 0x0000ff;
axs.axises(1).fontinfo.size := 8;
axs.data_bounds(0) := array(-0.1,2.1);
axs.data_bounds(1) := array(-0.1,2.1);
axs.data_bounds(2) := array(-0.5,0.5);
args := array(
(pi()/4,pi()/3,0x0000ff),
(pi()/3,pi()/2,0x00ff00),
@@ -326,32 +330,44 @@ type tfm = class(tvcform)
(pi()*3/2,pi()*9/4,0xff00ff)
);
prominentidx := 0; //凸显的块
prominentrate := 0.1; //凸显的块
for i,v in args do
begin
line := new tg_Polyline();
line.polyline_style := line.tgc_LS_filled;
line.closed := true;
line.graph_data := 1+get_pie_lines(v[0],v[1]);
c := (i=2)?1.1:1;
line.graph_data := 1+get_pie_lines(v[0],v[1],i=prominentidx,prominentrate);
line.lineinfo.bkcolor := v[2];
line.parent := axs;
end
end
function get_pie_lines(arg1,arg2);
function get_pie_lines(arg1,arg2,prominent,prominentrate);
begin
stp := pi()/180;
d := 1;
r := array((0,0));
r := array();
r[0] := array(0,0);
idx := 1;
for i:= arg1 to arg2 step stp do
for i:= arg1+(prominent?stp:0) to arg2-(prominent?stp:0) step stp do
begin
r[idx++] := array(sin(i),cos(i));
r[idx++] := array(sin(i),cos(i));
end
r[idx] :=array(0,0);
if prominent then
begin
rx := r[integer(idx/2)]*prominentrate;
for i := 0 to idx do
begin
r[i]+=rx;
end
end
r[length(r)] :=array(0,0);
return r;
end
fg;
end
}
type tg_WinControl = class(tcustomcontrol,tg_const) //绘图窗口
function create(AOwner);