JianjunLiu
parent
df9c3b8dbc
commit
8cd45006e2
|
|
@ -0,0 +1,2 @@
|
|||
|
||||
FunCache.ini
|
||||
|
|
@ -22,6 +22,6 @@ array(
|
|||
),
|
||||
"mainform":"e_actionmain",
|
||||
"entryscript":"e_action",
|
||||
"time":"2022-04-08 14:37:00",
|
||||
"commandline":"\"$(TSL_EXE)\" \"$(FULL_CURRENT_PATH)\" -libpath \"$(SEARCH_PATH)\\;\""
|
||||
"time":"2022-04-24 17:32:45",
|
||||
"commandline":"\"$(TSL_EXE)\" \"$(FULL_CURRENT_PATH)\" -libpath \"$(SEARCH_PATH)\""
|
||||
)
|
||||
|
|
@ -14,6 +14,18 @@ type E_Actionmain=class(tdcreateform)
|
|||
begin
|
||||
inherited;
|
||||
end
|
||||
|
||||
|
||||
function action1_onexecute(o;e);
|
||||
begin
|
||||
{**
|
||||
@explan(说明) onexecute消息回调 %
|
||||
@param(e)(tuievent) 消息对象 %
|
||||
@param(o)(tcomponent) 组件 %
|
||||
**}
|
||||
echo "\r\naction do ";
|
||||
end
|
||||
|
||||
function btn5_clk(o;e);virtual; //ÐÞ¸Äcaption
|
||||
begin
|
||||
action1.caption := datetimetostr(now());
|
||||
|
|
|
|||
|
|
@ -18,9 +18,12 @@ object e_actionmain1:e_actionmain
|
|||
object actionlist1:tactionlist
|
||||
left=225
|
||||
top=189
|
||||
height=30
|
||||
width=30
|
||||
object action1:taction
|
||||
caption="绑定action的控件"
|
||||
enabled=true
|
||||
onexecute=action1_onexecute
|
||||
end
|
||||
end
|
||||
object btn2:tbtn
|
||||
|
|
@ -59,6 +62,8 @@ object e_actionmain1:e_actionmain
|
|||
object popupmenu1:tpopupmenu
|
||||
left=162
|
||||
top=329
|
||||
height=30
|
||||
width=30
|
||||
caption="popupmenu1"
|
||||
object menu1:tmenu
|
||||
action=action1
|
||||
|
|
|
|||
|
|
@ -6,8 +6,13 @@ ops := "";
|
|||
GLobal G_OpenHostory;
|
||||
G_OpenHostory := true; //默认打开历史进程
|
||||
hasinstance := true; //单独进程
|
||||
isdebug := false;
|
||||
for i:= 0 to sysparamcount() do
|
||||
begin
|
||||
if ("-DEBUGSERVER" = sysparamstr(i)) then
|
||||
begin
|
||||
isdebug := true;
|
||||
end else
|
||||
if (i<sysparamcount())and ("-f" = sysparamstr(i) ) then //打开文件
|
||||
begin
|
||||
ops := sysparamstr(i+1) ;
|
||||
|
|
@ -63,7 +68,7 @@ begin
|
|||
end
|
||||
end
|
||||
end
|
||||
if hasinstance then //实现一个编辑器进程
|
||||
if not(isdebug) and hasinstance then //实现一个编辑器进程
|
||||
begin
|
||||
//判断
|
||||
h := FindWindowA("tslediter_a_a_1",nil);
|
||||
|
|
|
|||
|
|
@ -3,8 +3,17 @@
|
|||
}
|
||||
uses tslvcl,tslvclDesigner;
|
||||
deletefuncacheini();
|
||||
isdebug := false;
|
||||
for i:= 0 to sysparamcount() do
|
||||
begin
|
||||
if ("-DEBUGSERVER" = sysparamstr(i)) then
|
||||
begin
|
||||
isdebug := true;
|
||||
break;
|
||||
end
|
||||
end
|
||||
h := FindWindowA("tsluidesigner_a_a_1",nil); //查找唯一窗口
|
||||
if h then
|
||||
if not(isdebug) and h then
|
||||
begin
|
||||
return PostMessageA(h,0x400,303,10);
|
||||
end
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,6 +1,10 @@
|
|||
Unit UDesignerProject;
|
||||
interface
|
||||
uses utslvclauxiliary,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,tslvclDesigner,UtslCodeEditor;
|
||||
{**
|
||||
@param(说明) 设计器工程相关工具,包括历史工程,工程目录管理,代码编辑器 %%
|
||||
@date(20220518)
|
||||
**}
|
||||
uses utslvclauxiliary,tslvcl,utslmemo,UTslSynMemo,UVCPropertyTypesPersistence,UtslCodeEditor,utslvclsyntaxparser;
|
||||
function SetWndPostWithMouse(wnd,lft);
|
||||
type TProjectManagerForm = class(TVCForm) //工程管理 TCustomControl
|
||||
function Create(AOwner);override;
|
||||
|
|
@ -361,7 +365,7 @@ type TProjectView = class(TVCForm) //
|
|||
end
|
||||
//FTslEditer.Parent := AOwner;
|
||||
FTmfParser := new TTmfParser();
|
||||
FTslParser := new tslparser();
|
||||
FTslParser := new ttslscripparser();
|
||||
FTreeTool := new TMyToolBar(self);
|
||||
FTreeTool.parent := self;
|
||||
imgs := New TControlImageList(self);
|
||||
|
|
@ -648,6 +652,14 @@ type TProjectView = class(TVCForm) //
|
|||
FTslEditer.Addfiled(FOpendFormTSFfilename,n);
|
||||
end
|
||||
end
|
||||
function adduses(lbs); //添加成员
|
||||
begin
|
||||
if (lbs) and FCurrentOpend and(FCurrentOpend["type"] in array("form","panel"))then
|
||||
begin
|
||||
FTslEditer.adduses(FOpendFormTSFfilename,lbs);
|
||||
end
|
||||
end
|
||||
|
||||
function DeleteAFiled(n,nn); //删除成员
|
||||
begin
|
||||
if ifstring(n) and FCurrentOpend and (FCurrentOpend["type"]in array("form","panel"))then
|
||||
|
|
@ -665,7 +677,7 @@ type TProjectView = class(TVCForm) //
|
|||
return r;
|
||||
end
|
||||
end
|
||||
function GoToAFunction(n);
|
||||
function GoToAFunction(n); //跳转到函数
|
||||
begin
|
||||
r := FTslEditer.GoToFunction(FOpendFormTSFfilename,n);
|
||||
ShowEditor();
|
||||
|
|
@ -1241,7 +1253,7 @@ type TProjectView = class(TVCForm) //
|
|||
//FTslEditer.CloseEditor();
|
||||
FDesigner.caption := "TVCL界面设计器 "+FprojName;
|
||||
FDesigner.UnLoadTreeNode();
|
||||
class(TDComponent).TemporaryNotName := array();
|
||||
//class(TDComponent).TemporaryNotName := array();
|
||||
FCurrentOpend := nil;
|
||||
FOpendFormTSFfilename := nil;
|
||||
FOpendScriptFileName := nil;
|
||||
|
|
@ -1577,6 +1589,14 @@ BD141CA912494F502D48D224F45050274A21E03806FF2C7CA7516022D7D000000
|
|||
it.AddFiled(n);
|
||||
end
|
||||
end
|
||||
function Adduses(fn,lbs);
|
||||
begin
|
||||
it := OpenAndGotoFileByName(fn);
|
||||
if it then
|
||||
begin
|
||||
it.adduses(lbs);
|
||||
end
|
||||
end
|
||||
function Delfiled(n,fld,nn);//删除成员变量
|
||||
begin
|
||||
it := OpenAndGotoFileByName(n);
|
||||
|
|
@ -1605,718 +1625,6 @@ BD141CA912494F502D48D224F45050274A21E03806FF2C7CA7516022D7D000000
|
|||
end
|
||||
end
|
||||
|
||||
type tsltoken = class(tslparserbase)
|
||||
{**
|
||||
@explan(说明) tsl语言分词 %%
|
||||
**}
|
||||
private
|
||||
FTSLstr;
|
||||
FTokens;
|
||||
function SetTslStr(v);
|
||||
begin
|
||||
if v <> FTSLstr then
|
||||
begin
|
||||
FTSLstr := v;
|
||||
FTokens := nil;
|
||||
end
|
||||
end
|
||||
public
|
||||
function create();
|
||||
begin
|
||||
inherited;
|
||||
end
|
||||
function tokens();
|
||||
begin
|
||||
if FTokens then return FTokens;
|
||||
if not ifstring(FTSLstr)then return array();
|
||||
str := binary(FTSLstr);
|
||||
pos :=-1;
|
||||
len := length(str);
|
||||
FTokens := array();
|
||||
nk := 0;
|
||||
vs := "";
|
||||
hh := 0;
|
||||
while true do
|
||||
begin
|
||||
pos++;
|
||||
if pos >= len then break;
|
||||
v := str[pos];
|
||||
if v="%" then
|
||||
begin
|
||||
kk := 1;
|
||||
v1 := str[pos+kk];
|
||||
if v1="%" then
|
||||
begin
|
||||
pls := "%%";
|
||||
while true do
|
||||
begin
|
||||
kk++;
|
||||
if pos+kk >= len then break;
|
||||
if str[pos+kk]in array(" ","\t","\r","\n")then
|
||||
begin
|
||||
if str[pos+kk]="\n" then hh++;
|
||||
break;
|
||||
end else
|
||||
pls += str[pos+kk];
|
||||
end
|
||||
pos += kk;
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv2(str,pls,len,pos,hh);
|
||||
//vs := findstringv(str,pls,len,pos,nil,hh); //str,f,len,pos,zy,hh
|
||||
setdata(FTokens,nk,vs,"字符串",pos,hh);
|
||||
vf := 0;
|
||||
continue;
|
||||
end
|
||||
end
|
||||
if v='"' then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,'"',len,pos,1,hh);
|
||||
setdata(FTokens,nk,vs,"字符串",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
if v="'" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,"'",len,pos,1,hh);
|
||||
setdata(FTokens,nk,vs,"字符串",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
if v='{' then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,'}',len,pos,nil,hh);
|
||||
lvs := length(vs);
|
||||
flvs := true;
|
||||
if lvs>5 then
|
||||
begin
|
||||
if vs[1:2]="**" and(vs[3]in array(" ","\t","\r","\n"))and vs[lvs-1:lvs]="**" and(vs[lvs-2]in array(" ","\t","\r","\n"))then
|
||||
begin
|
||||
flvs := false;
|
||||
vv := trim(vs[3:lvs-2]);
|
||||
if vs[3]="\n" then hh++;
|
||||
setdata(FTokens,nk,vv,"说明",pos,hh);
|
||||
if vs[lvs-2]="\n" then hh++;
|
||||
vs := "";
|
||||
end
|
||||
end
|
||||
if flvs then setdata(FTokens,nk,vs,"说明0",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
if v="#" then
|
||||
begin
|
||||
pos++;
|
||||
vi := str[pos];
|
||||
if vi="!" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,'\n',len,pos,nil,hh);
|
||||
setdata(FTokens,nk,vs,"说明2",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
begin
|
||||
pos--;
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
setdata(FTokens,nk,v,"分割",pos,hh);
|
||||
vf := 0;
|
||||
end
|
||||
end else
|
||||
if v="/" then
|
||||
begin
|
||||
pos++;
|
||||
vi := str[pos];
|
||||
if vi="/" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,'\n',len,pos,nil,hh);
|
||||
setdata(FTokens,nk,vs,"说明2",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
begin
|
||||
vs += v;
|
||||
pos--;
|
||||
end
|
||||
end else
|
||||
if v='(' then
|
||||
begin
|
||||
pos++;
|
||||
vi := str[pos];
|
||||
if vi="*" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
pos++;
|
||||
while pos <= len do
|
||||
begin
|
||||
vi := str[pos];
|
||||
if vi="\n" then hh++;
|
||||
if pos<len and vi="*" and str[pos+1]=")" then
|
||||
begin
|
||||
pos += 1;
|
||||
break;
|
||||
end else
|
||||
vs += vi;
|
||||
pos++;
|
||||
end
|
||||
//*******************************************************
|
||||
lvs := length(vs);
|
||||
flvs := true;
|
||||
if lvs>3 then
|
||||
begin
|
||||
if vs[1]="*" and(vs[2]in array(" ","\t","\r","\n"))and vs[lvs]="*" and(vs[lvs-1]in array(" ","\t","\r","\n"))then
|
||||
begin
|
||||
flvs := false;
|
||||
vv := trim(vs[2:lvs-1]);
|
||||
if vs[2]="\n" then hh++;
|
||||
setdata(FTokens,nk,vv,"说明",pos,hh);
|
||||
if vs[lvs-1]="\n" then hh++;
|
||||
vs := "";
|
||||
end
|
||||
end
|
||||
if flvs then setdata(FTokens,nk,vs,"说明1",pos,hh);
|
||||
//*********************************************************
|
||||
vf := 0;
|
||||
end else
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos-1,hh);
|
||||
setdata(FTokens,nk,v,"前括号",pos,hh);
|
||||
pos--;
|
||||
continue;
|
||||
end
|
||||
end else
|
||||
if v=")" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
setdata(FTokens,nk,v,"后括号",pos,hh);
|
||||
end else
|
||||
if v="\t" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
if vf then continue;
|
||||
vf := 1;
|
||||
setdata(FTokens,nk,v,"空格",pos,hh);
|
||||
end else
|
||||
if v=" " then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
if vf then continue;
|
||||
vf := 1;
|
||||
setdata(FTokens,nk,v,"空格",pos,hh);
|
||||
end else
|
||||
if v='\n' then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
hh++;
|
||||
if vf then continue;
|
||||
vf := 1;
|
||||
setdata(FTokens,nk,v,"换行",pos,hh);
|
||||
end else
|
||||
if v='\r' then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
if vf then continue;
|
||||
vf := 1;
|
||||
setdata(FTokens,nk,v,"回车",pos,hh);
|
||||
end else
|
||||
if v in array(",",";",".","]","[",":","=","!")then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
setdata(FTokens,nk,v,"分割",pos,hh);
|
||||
end else
|
||||
begin
|
||||
vs += v;
|
||||
end
|
||||
end
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
return FTokens;
|
||||
end
|
||||
property tslstr read FTSLstr write SetTSLstr;
|
||||
end
|
||||
type tslparser = class(tslparserbase)
|
||||
{**
|
||||
@explan(说明) 解析tsl 类 %%
|
||||
**}
|
||||
private
|
||||
FTokener;
|
||||
FTokens;
|
||||
FCurrentPos;
|
||||
FTokenLen;
|
||||
FScriptPath;
|
||||
function SetScriptPath(v);
|
||||
begin
|
||||
size := filesize("",v); //获取文件大小
|
||||
readFile(rwraw(),"",v,0,size,data);
|
||||
SetScript(data);
|
||||
end
|
||||
function SetScript(v);
|
||||
begin
|
||||
if FTokener.tslstr <> v then
|
||||
begin
|
||||
FTokener.tslstr := v;
|
||||
FTokens := FTokener.tokens();
|
||||
if FTokens then FTokenLen := length(FTokens)-1;
|
||||
FTokenLen :=-1;
|
||||
end
|
||||
end
|
||||
function tkopok();
|
||||
begin
|
||||
return FCurrentPos>0 and FCurrentPos<FTokenLen;
|
||||
end
|
||||
function getTokenPos(ps);
|
||||
begin
|
||||
return FTokens[ps,2]+1;
|
||||
end
|
||||
function getTokenRow(ps);
|
||||
begin
|
||||
return FTokens[ps,3];
|
||||
end
|
||||
function ctoken(tk,tp,pos,r);
|
||||
begin
|
||||
if not FTokens then return 0;
|
||||
r := tkopok(pos);
|
||||
tk := FTokens[FCurrentPos,0];
|
||||
tp := FTokens[FCurrentPos,1];
|
||||
pos := FTokens[FCurrentPos,2]+1;
|
||||
r := FTokens[FCurrentPos,3];
|
||||
FCurrentPos++;
|
||||
return tk;
|
||||
end
|
||||
function bpos(n);
|
||||
begin
|
||||
if n >= 0 then FCurrentPos -= n;
|
||||
else FCurrentPos--;
|
||||
end
|
||||
function btoken(tk,tp,pos,n);
|
||||
begin
|
||||
bpos(n);
|
||||
r := ctoken(tk,tp,pos);
|
||||
return r;
|
||||
end
|
||||
function GetScript();
|
||||
begin
|
||||
return FTokener.tslstr;
|
||||
end
|
||||
public
|
||||
function create();
|
||||
begin
|
||||
inherited;
|
||||
FTokener := new tsltoken();
|
||||
end
|
||||
//type beg end name
|
||||
function GetClassAbstract();
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 获得class 的基本信息 %%
|
||||
@return(array) 包括"name","inherited","uses" 等信息 %%
|
||||
**}
|
||||
if not Tokens then array();
|
||||
FCurrentPos := 0;
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then return array();
|
||||
if tk="type" and tp <> TT_STR then
|
||||
begin
|
||||
r := array();
|
||||
ctoken(tk,tp,pos);
|
||||
if tp=TT_IDE then
|
||||
begin
|
||||
r["name"]:= tk;
|
||||
ctoken(tk,tp,pos);
|
||||
if tk <> "=" then return 0;
|
||||
ctoken(tk,tp,pos);
|
||||
if tk <> "class" then return 0;
|
||||
ctoken(tk,tp,pos);
|
||||
inh := array();
|
||||
if tk="(" then
|
||||
begin
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then break;
|
||||
if tk=")" then break;
|
||||
if tk="," then continue;
|
||||
else inh[length(inh)]:= tk;
|
||||
end
|
||||
r["inherited"]:= inh;
|
||||
end
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then break;
|
||||
if tk="uses" and tp <> TT_STR then
|
||||
begin
|
||||
ru := array();
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then break;
|
||||
if tk="," then continue;
|
||||
if tk=";" then break;
|
||||
ru[length(ru)]:= tk;
|
||||
end
|
||||
r["uses"]:= ru;
|
||||
break;
|
||||
end
|
||||
end
|
||||
return r;
|
||||
end
|
||||
end else
|
||||
return array();
|
||||
end
|
||||
end
|
||||
function GetClassInfo(fi);
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 获得class的详细信息 %%
|
||||
@param(fi)(bool) 是否获得class成员的位置信息 %%
|
||||
**}
|
||||
r := array();
|
||||
if not Tokens then return r;
|
||||
FCurrentPos := 0;
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then exit;
|
||||
if tk="type" and tp <> TT_STR then break;
|
||||
end
|
||||
if tk="type" and tp <> TT_STR then
|
||||
begin
|
||||
r["beg"]:= pos;
|
||||
tr := parserclass(fi);
|
||||
if ifarray(tr)then r union=tr;
|
||||
r["end"]:= CurrentPos;
|
||||
return r;
|
||||
end
|
||||
return r;
|
||||
end
|
||||
function parserclass(fi);
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 获得class详细 %%
|
||||
@param(fi)(bool) 是否获得函数的信息 %%
|
||||
**}
|
||||
ctoken(tk,tp,pos);
|
||||
r := array();
|
||||
if tp=TT_IDE then
|
||||
begin
|
||||
r["name"]:= tk;
|
||||
ctoken(tk,tp,pos);
|
||||
if tk <> "=" then raise "解析错误";
|
||||
ctoken(tk,tp,pos);
|
||||
if tk <> "class" then raise "解析错误";
|
||||
ctoken(tk,tp,pos);
|
||||
if tk="(" then
|
||||
begin
|
||||
pa := array();
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=")" then break;
|
||||
if tk <> "," then pa[length(pa)]:= tk;
|
||||
end
|
||||
r["inherited"]:= pa;
|
||||
end else
|
||||
begin
|
||||
bpos();
|
||||
end
|
||||
props := array();
|
||||
funcs := array();
|
||||
funcsinfo := array();
|
||||
filed := array();
|
||||
priv := "public";
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos,row);
|
||||
if ifnil(tk)then break;
|
||||
if tk in array("private","public","protected")then
|
||||
begin
|
||||
priv := tk;
|
||||
continue;
|
||||
end
|
||||
if tk="uses" and tp=TT_IDE then
|
||||
begin
|
||||
usb := pos;
|
||||
pu := array();
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if tp=TT_IDE then
|
||||
begin
|
||||
pu[length(pu)]:= tk;
|
||||
end else
|
||||
if tk=";" then break;
|
||||
end
|
||||
r["uses"]:= array("row":row,"beg":usb,"end":pos,"info":pu);
|
||||
end else
|
||||
if tk="static" and tp=TT_IDE then
|
||||
begin
|
||||
if not r["filed"]then r["filed"]:= array();
|
||||
sf := parserfiled();
|
||||
for i := 0 to length(sf)-1 do
|
||||
begin
|
||||
sf[i]["static"]:= true;
|
||||
sf[i]["staticpos"]:= pos;
|
||||
sf[i]["priv"]:= priv;
|
||||
end
|
||||
filed union=sf;
|
||||
end else
|
||||
if tk="function" or tk="procedure" then
|
||||
begin
|
||||
bpos();
|
||||
bfpos := CurrentPos;
|
||||
lenf := length(funcsinfo);
|
||||
tfn := parserfunction();
|
||||
if priv="public" then funcs[length(funcs)]:= tfn;
|
||||
if fi then
|
||||
begin
|
||||
funcsinfo[lenf]["name"]:= tfn;
|
||||
funcsinfo[lenf]["startpos"]:= getTokenPos(bfpos);
|
||||
funcsinfo[lenf]["endpos"]:= getTokenPos(self.CurrentPos)-1;
|
||||
funcsinfo[lenf]["row"]:= row;
|
||||
end
|
||||
end else
|
||||
if tk="property" then
|
||||
begin
|
||||
props[length(props)]:= parserproperty();
|
||||
end else
|
||||
if tk="class" and tp=TT_IDE then
|
||||
begin
|
||||
if priv="public" then funcs[length(funcs)]:= parserfunction();
|
||||
end else
|
||||
if tk=";" then continue;
|
||||
else if tk="end" and tp=TT_IDE then break;
|
||||
else if tk="type" then
|
||||
begin
|
||||
cr := array();
|
||||
cr["type"]:= "class";
|
||||
cr["beg"]:= pos;
|
||||
cr["info"]:= parserclass(fi);
|
||||
cr["end"]:= CurrentPos;
|
||||
end else
|
||||
if tk="type" then break;
|
||||
else
|
||||
begin
|
||||
bpos();
|
||||
filed union=parserfiled(priv);
|
||||
end
|
||||
end
|
||||
end
|
||||
r["prop"]:= props;
|
||||
r["funcs"]:= funcs;
|
||||
r["filed"]:= filed;
|
||||
r["funcsinfo"]:= funcsinfo;
|
||||
prn := array();
|
||||
if filed then prn := filed[:,"name"];
|
||||
r["members"]:=(prn union2 funcs)union2 props;
|
||||
return r;
|
||||
end
|
||||
function parsertype();
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
tarray := "";
|
||||
if tk="array" then
|
||||
begin
|
||||
tarray := "array ";
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=";" then
|
||||
begin
|
||||
return tarray;
|
||||
end else
|
||||
if tk="of" then
|
||||
begin
|
||||
tarray += "of ";
|
||||
ctoken(tk,tp,pos);
|
||||
end
|
||||
end
|
||||
return tarray+tk;
|
||||
end
|
||||
function parserfiled(priv);
|
||||
begin
|
||||
rcount := 0;
|
||||
r := array();
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=";" then
|
||||
begin
|
||||
if rcount then
|
||||
begin
|
||||
r[rcount]["last"]:= true;
|
||||
end
|
||||
r[rcount]["end"]:= pos;
|
||||
return r;
|
||||
end else
|
||||
if tk="," then
|
||||
begin
|
||||
if rcount>0 then
|
||||
begin
|
||||
r[rcount]["nextcomma"]:= pos;
|
||||
end else
|
||||
r[rcount]["first"]:= true;
|
||||
rcount++;
|
||||
r[rcount]["precomma"]:= pos;
|
||||
end else
|
||||
if tk=":" then
|
||||
begin
|
||||
tpv := parsertype();
|
||||
for i := 0 to length(r)-1 do
|
||||
begin
|
||||
r[i]["type"]:= tpv;
|
||||
end
|
||||
continue;
|
||||
ctoken(tk,tp,pos);
|
||||
tarray := "";
|
||||
if tk="array" then
|
||||
begin
|
||||
tarray := "array ";
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=";" then
|
||||
begin
|
||||
for i := 0 to length(r) do
|
||||
begin
|
||||
r[i]["type"]:= "array";
|
||||
end
|
||||
return r;
|
||||
end else
|
||||
if tk="of" then
|
||||
begin
|
||||
tarray += "of ";
|
||||
ctoken(tk,tp,pos);
|
||||
end
|
||||
end
|
||||
end else
|
||||
begin
|
||||
r[rcount]["name"]:= tk;
|
||||
r[rcount]["beg"]:= pos;
|
||||
r[rcount]["id"]:= rcount;
|
||||
r[rcount]["priv"]:= priv;
|
||||
end
|
||||
end
|
||||
return r;
|
||||
end
|
||||
function parserproperty();
|
||||
begin
|
||||
r := "";
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if not r then r := tk;
|
||||
if tk=";" then return r;
|
||||
end
|
||||
return r;
|
||||
end
|
||||
function parserfunction();
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
ctoken(tk,tp,pos);
|
||||
fn := "";
|
||||
if tk <> "(" then fn := tk;
|
||||
while true do
|
||||
begin
|
||||
if tk="begin" then
|
||||
begin
|
||||
//return parserstatement();
|
||||
parserstatement();
|
||||
break;
|
||||
end else
|
||||
if tk="(" then
|
||||
begin
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=")" and tp <> TT_STR then
|
||||
begin
|
||||
break;
|
||||
end
|
||||
end
|
||||
parserfunctionplus();
|
||||
break;
|
||||
end else
|
||||
if tk=":" then
|
||||
begin
|
||||
bpos();
|
||||
parserfunctionplus();
|
||||
break;
|
||||
end else
|
||||
if tk="." then
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
fn := tk;
|
||||
end else
|
||||
if tk=";" then
|
||||
begin
|
||||
parserfunctionplus();
|
||||
break;
|
||||
end
|
||||
ctoken(tk,tp,pos);
|
||||
end
|
||||
return fn;
|
||||
end
|
||||
function parserfunctionplus();
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then return;
|
||||
if tk=";" then
|
||||
begin
|
||||
parserfunctionplus();
|
||||
end else
|
||||
if tk=":" then
|
||||
begin
|
||||
parsertype();
|
||||
parserfunctionplus();
|
||||
end else
|
||||
if tk="begin" then
|
||||
begin
|
||||
return parserstatement();
|
||||
end else
|
||||
if tk="name" then
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
end else
|
||||
if tk in array("virtual","cdecl","stdcall","external","override","overload")then
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
parserfunctionplus();
|
||||
end else
|
||||
begin
|
||||
bpos();
|
||||
end
|
||||
end
|
||||
|
||||
function parserstatement();
|
||||
begin
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then return;
|
||||
if tk="end" and tp <> TT_STR then
|
||||
begin
|
||||
n := 0;
|
||||
while true do
|
||||
begin
|
||||
n++;
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then return;
|
||||
if tk <> ";" then
|
||||
begin
|
||||
bpos(n);
|
||||
return;
|
||||
end
|
||||
end
|
||||
return array(pos+3);
|
||||
end else
|
||||
if tp <> TT_STR and(tk in array("begin","select","sselect",
|
||||
"mselct","vselect","try","case","update"))then
|
||||
begin
|
||||
parserstatement();
|
||||
end
|
||||
end
|
||||
end
|
||||
property Script read GetScript write SetScript;
|
||||
property ScriptPath read FScriptPath write SetScriptPath;
|
||||
property Tokens read FTokens;
|
||||
property CurrentPos read FCurrentPos write FCurrentPos;
|
||||
end
|
||||
//************************************
|
||||
|
||||
implementation
|
||||
|
|
@ -2357,120 +1665,7 @@ type TDesignerProjectsRecoder = class() //
|
|||
|
||||
end
|
||||
//**********tsl parser token****************************
|
||||
type tslparserbase= class
|
||||
{**
|
||||
@explan(说明) tsl语言解析基类 %%
|
||||
**}
|
||||
static TT_IDE; //标示符
|
||||
static TT_STR; //字符串
|
||||
static TT_SYM; //分隔符
|
||||
static TT_OK;
|
||||
function create();
|
||||
begin
|
||||
if not TT_OK then
|
||||
begin
|
||||
TT_IDE := "标示符";
|
||||
TT_STR := "字符串";
|
||||
TT_SYM := "分割符";
|
||||
TT_OK := true;
|
||||
end
|
||||
end
|
||||
function setdata(ret,nk,vs,tp,idx,hh) //解析
|
||||
begin
|
||||
{**
|
||||
@explan(说明)保存数据
|
||||
**}
|
||||
if tp="空格" or tp="回车" or tp="换行" then return;
|
||||
if tp in array("说明0","说明1","说明2","说明")then
|
||||
begin
|
||||
vs := "";
|
||||
return;
|
||||
end
|
||||
if tp="语句" then //语句解析
|
||||
begin
|
||||
vs := lowercase(trim(vs));
|
||||
end
|
||||
//if vs in array("of","array") then tp := "关键字";
|
||||
ret[nk,0]:= vs;
|
||||
ret[nk,1]:= tp;
|
||||
if ifnumber(idx)and tp="语句" then ret[nk,2]:= idx-length(vs);
|
||||
else if ifnumber(idx)and tp <> "字符串" then ret[nk,2]:= idx;
|
||||
case tp of
|
||||
"语句":ret[nk,1]:= TT_IDE;
|
||||
"字符串":ret[nk,1]:= TT_STR;
|
||||
else ret[nk,1]:= TT_SYM;
|
||||
end;
|
||||
vs := "";
|
||||
ret[nk,3]:= hh;
|
||||
nk++;
|
||||
end;
|
||||
function findstringv2(str,fg,len,pos,hh);
|
||||
begin
|
||||
fgl := length(fg);
|
||||
pfg := 0;
|
||||
vs := "";
|
||||
while pos<len do
|
||||
begin
|
||||
vi := str[pos];
|
||||
if vi="\n" then
|
||||
begin
|
||||
hh++;
|
||||
end
|
||||
for i2 := 1 to fgl do
|
||||
begin
|
||||
vi := str[pos+i2];
|
||||
if vi <> fg[i2]then break;
|
||||
pfg := i2;
|
||||
if pos=len then break;
|
||||
end
|
||||
if pfg=fgl then
|
||||
begin
|
||||
pos += fgl;
|
||||
break;
|
||||
end
|
||||
vs += vi;
|
||||
pos++;
|
||||
end
|
||||
return vs;
|
||||
end
|
||||
function findstringv(str,f,len,pos,zy,hh);
|
||||
begin
|
||||
{**
|
||||
@explan(说明)查找以f结尾的字符串
|
||||
**}
|
||||
pos++;
|
||||
vs := "";
|
||||
if not(hh >= 0)then hh := 0;
|
||||
while pos<len do
|
||||
begin
|
||||
vi := str[pos];
|
||||
if vi="\n" then
|
||||
begin
|
||||
hh++;
|
||||
//echo "\r\nfindh:",hh;
|
||||
end
|
||||
pos++;
|
||||
if vi=f then break;
|
||||
if zy and vi="\\" then
|
||||
begin
|
||||
if pos=len then break;
|
||||
nvi := str[pos];
|
||||
case nvi of
|
||||
"r":vs += "\r";
|
||||
"n":vs += "\n";
|
||||
"t":vs += "\t";
|
||||
"b":vs += "\b";
|
||||
else vs += nvi;
|
||||
end;
|
||||
pos++;
|
||||
continue;
|
||||
end
|
||||
vs += vi;
|
||||
end
|
||||
pos--;
|
||||
return vs;
|
||||
end;
|
||||
end
|
||||
|
||||
|
||||
type TFileTree = class(TTreeCtl)
|
||||
type TTNode=class(TTreeNode) //TTreeCtlNode
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -3,7 +3,7 @@ interface
|
|||
{**
|
||||
@explan(说明) tsl语法编辑器库
|
||||
**}
|
||||
uses utslvclauxiliary,UTslMemo,TslVcl;
|
||||
uses utslvclauxiliary,UTslMemo;
|
||||
function FileSaveThreader(o,d);
|
||||
type TTSLCompletion= class(TSynCompletion)
|
||||
{**
|
||||
|
|
@ -1549,13 +1549,11 @@ end
|
|||
type TTsfFileParser = class //文件解析
|
||||
function Create();
|
||||
begin
|
||||
|
||||
FCacheDir :=TS_GetUserProfileHome()+"TslSynMemo"+ioFileseparator()+"cmpCaches";// d["value"];
|
||||
//FCacheAbsFileName := FCacheDir+"\\cacheabstruct.stm";
|
||||
//FFileWorker := new TThreadWorker("this.OnMessage :=findfunction('UTslSynMemo.FileSaveThreader') ;");
|
||||
FFindDirs := array();
|
||||
end
|
||||
|
||||
function DispatchMethod(o,d);//分发消息
|
||||
begin
|
||||
if not ifarray(d) then return ;
|
||||
|
|
@ -1898,7 +1896,7 @@ type TTsfFileParser = class //
|
|||
end
|
||||
function ParserFindDir(f); //解析缓存
|
||||
begin
|
||||
mtic;
|
||||
//mtic;
|
||||
if FCacheDir then
|
||||
begin
|
||||
FFileNames := array();
|
||||
|
|
@ -2081,24 +2079,4 @@ begin
|
|||
end
|
||||
|
||||
end
|
||||
type tparserdobject = class
|
||||
function create(d);
|
||||
begin
|
||||
echo "\r\n create f object===";
|
||||
if ifarray(d) then
|
||||
FData := d;
|
||||
end
|
||||
function operator[](idx);
|
||||
begin
|
||||
if FData then
|
||||
return FData[idx];
|
||||
end
|
||||
function operator[1](idx,v);
|
||||
begin
|
||||
if FData then
|
||||
FData[idx] := v;
|
||||
end
|
||||
private
|
||||
FData ;
|
||||
end
|
||||
end.
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,847 @@
|
|||
unit utslvclsyntaxparser;
|
||||
{**
|
||||
@explan(说明) 设计器中tsl脚本解析相关 %%
|
||||
@date(20220518)
|
||||
**}
|
||||
interface
|
||||
type ttslscripparser = class(tslparser) //对外接口
|
||||
{**
|
||||
@explan(说明) 解析tsl 类 %%
|
||||
**}
|
||||
function create();
|
||||
begin
|
||||
inherited;
|
||||
end
|
||||
end
|
||||
implementation
|
||||
type tslparser = class(tslparserbase) //语法解析
|
||||
private
|
||||
FTokener;
|
||||
FTokens;
|
||||
FCurrentPos;
|
||||
FTokenLen;
|
||||
FScriptPath;
|
||||
function SetScriptPath(v);
|
||||
begin
|
||||
size := filesize("",v); //获取文件大小
|
||||
readFile(rwraw(),"",v,0,size,data);
|
||||
SetScript(data);
|
||||
end
|
||||
function SetScript(v);
|
||||
begin
|
||||
if FTokener.tslstr <> v then
|
||||
begin
|
||||
FTokener.tslstr := v;
|
||||
FTokens := FTokener.tokens();
|
||||
if FTokens then FTokenLen := length(FTokens)-1;
|
||||
FTokenLen :=-1;
|
||||
end
|
||||
end
|
||||
function tkopok();
|
||||
begin
|
||||
return FCurrentPos>0 and FCurrentPos<FTokenLen;
|
||||
end
|
||||
function getTokenPos(ps);
|
||||
begin
|
||||
return FTokens[ps,2]+1;
|
||||
end
|
||||
function getTokenRow(ps);
|
||||
begin
|
||||
return FTokens[ps,3];
|
||||
end
|
||||
function ctoken(tk,tp,pos,r);
|
||||
begin
|
||||
if not FTokens then return 0;
|
||||
r := tkopok(pos);
|
||||
tk := FTokens[FCurrentPos,0];
|
||||
tp := FTokens[FCurrentPos,1];
|
||||
pos := FTokens[FCurrentPos,2]+1;
|
||||
r := FTokens[FCurrentPos,3];
|
||||
FCurrentPos++;
|
||||
return tk;
|
||||
end
|
||||
function bpos(n);
|
||||
begin
|
||||
if n >= 0 then FCurrentPos -= n;
|
||||
else FCurrentPos--;
|
||||
end
|
||||
function btoken(tk,tp,pos,n);
|
||||
begin
|
||||
bpos(n);
|
||||
r := ctoken(tk,tp,pos);
|
||||
return r;
|
||||
end
|
||||
function GetScript();
|
||||
begin
|
||||
return FTokener.tslstr;
|
||||
end
|
||||
public
|
||||
function create();
|
||||
begin
|
||||
inherited;
|
||||
FTokener := new tsltoken();
|
||||
end
|
||||
//type beg end name
|
||||
function GetClassAbstract();
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 获得class 的基本信息 %%
|
||||
@return(array) 包括"name","inherited","uses" 等信息 %%
|
||||
**}
|
||||
if not Tokens then array();
|
||||
FCurrentPos := 0;
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then return array();
|
||||
if tk="type" and tp <> TT_STR then
|
||||
begin
|
||||
r := array();
|
||||
ctoken(tk,tp,pos);
|
||||
if tp=TT_IDE then
|
||||
begin
|
||||
r["name"]:= tk;
|
||||
ctoken(tk,tp,pos);
|
||||
if tk <> "=" then return 0;
|
||||
ctoken(tk,tp,pos);
|
||||
if tk <> "class" then return 0;
|
||||
ctoken(tk,tp,pos);
|
||||
inh := array();
|
||||
if tk="(" then
|
||||
begin
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then break;
|
||||
if tk=")" then break;
|
||||
if tk="," then continue;
|
||||
else inh[length(inh)]:= tk;
|
||||
end
|
||||
r["inherited"]:= inh;
|
||||
end
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then break;
|
||||
if tk="uses" and tp <> TT_STR then
|
||||
begin
|
||||
ru := array();
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then break;
|
||||
if tk="," then continue;
|
||||
if tk=";" then break;
|
||||
ru[length(ru)]:= tk;
|
||||
end
|
||||
r["uses"]:= ru;
|
||||
break;
|
||||
end
|
||||
end
|
||||
return r;
|
||||
end
|
||||
end else
|
||||
return array();
|
||||
end
|
||||
end
|
||||
function GetClassInfo(fi);
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 获得class的详细信息 %%
|
||||
@param(fi)(bool) 是否获得class成员的位置信息 %%
|
||||
**}
|
||||
r := array();
|
||||
if not Tokens then return r;
|
||||
FCurrentPos := 0;
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then exit;
|
||||
if tk="type" and tp <> TT_STR then break;
|
||||
end
|
||||
if tk="type" and tp <> TT_STR then
|
||||
begin
|
||||
r["beg"]:= pos;
|
||||
tr := parserclass(fi);
|
||||
if ifarray(tr)then r union=tr;
|
||||
r["end"]:= CurrentPos;
|
||||
return r;
|
||||
end
|
||||
return r;
|
||||
end
|
||||
function parserclass(fi);
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 获得class详细 %%
|
||||
@param(fi)(bool) 是否获得函数的信息 %%
|
||||
**}
|
||||
ctoken(tk,tp,pos);
|
||||
r := array();
|
||||
if tp=TT_IDE then
|
||||
begin
|
||||
r["name"]:= tk;
|
||||
ctoken(tk,tp,pos);
|
||||
if tk <> "=" then raise "解析错误";
|
||||
ctoken(tk,tp,pos);
|
||||
if tk <> "class" then raise "解析错误";
|
||||
ctoken(tk,tp,pos);
|
||||
if tk="(" then
|
||||
begin
|
||||
pa := array();
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=")" then
|
||||
begin
|
||||
r["inheritedendpos"] := pos;
|
||||
break;
|
||||
end
|
||||
if tk <> "," then pa[length(pa)]:= tk;
|
||||
end
|
||||
r["inherited"]:= pa;
|
||||
end else
|
||||
begin
|
||||
bpos();
|
||||
end
|
||||
props := array();
|
||||
funcs := array();
|
||||
funcsinfo := array();
|
||||
filed := array();
|
||||
priv := "public";
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos,row);
|
||||
if ifnil(tk)then break;
|
||||
if tk in array("private","public","protected")then
|
||||
begin
|
||||
priv := tk;
|
||||
continue;
|
||||
end
|
||||
if tk="uses" and tp=TT_IDE then
|
||||
begin
|
||||
usb := pos;
|
||||
pu := array();
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if tp=TT_IDE then
|
||||
begin
|
||||
pu[length(pu)]:= tk;
|
||||
end else
|
||||
if tk=";" then break;
|
||||
end
|
||||
r["uses"]:= array("row":row,"beg":usb,"end":pos,"info":pu);
|
||||
end else
|
||||
if tk="static" and tp=TT_IDE then
|
||||
begin
|
||||
if not r["filed"]then r["filed"]:= array();
|
||||
sf := parserfiled();
|
||||
for i := 0 to length(sf)-1 do
|
||||
begin
|
||||
sf[i]["static"]:= true;
|
||||
sf[i]["staticpos"]:= pos;
|
||||
sf[i]["priv"]:= priv;
|
||||
end
|
||||
filed union=sf;
|
||||
end else
|
||||
if tk="function" or tk="procedure" then
|
||||
begin
|
||||
bpos();
|
||||
bfpos := CurrentPos;
|
||||
lenf := length(funcsinfo);
|
||||
tfn := parserfunction();
|
||||
if priv="public" then funcs[length(funcs)]:= tfn;
|
||||
if fi then
|
||||
begin
|
||||
funcsinfo[lenf]["name"]:= tfn;
|
||||
funcsinfo[lenf]["startpos"]:= getTokenPos(bfpos);
|
||||
funcsinfo[lenf]["endpos"]:= getTokenPos(self.CurrentPos)-1;
|
||||
funcsinfo[lenf]["row"]:= row;
|
||||
end
|
||||
end else
|
||||
if tk="property" then
|
||||
begin
|
||||
props[length(props)]:= parserproperty();
|
||||
end else
|
||||
if tk="class" and tp=TT_IDE then
|
||||
begin
|
||||
if priv="public" then funcs[length(funcs)]:= parserfunction();
|
||||
end else
|
||||
if tk=";" then continue;
|
||||
else if tk="end" and tp=TT_IDE then break;
|
||||
else if tk="type" then
|
||||
begin
|
||||
cr := array();
|
||||
cr["type"]:= "class";
|
||||
cr["beg"]:= pos;
|
||||
cr["info"]:= parserclass(fi);
|
||||
cr["end"]:= CurrentPos;
|
||||
end else
|
||||
if tk="type" then break;
|
||||
else
|
||||
begin
|
||||
bpos();
|
||||
filed union=parserfiled(priv);
|
||||
end
|
||||
end
|
||||
end
|
||||
r["prop"]:= props;
|
||||
r["funcs"]:= funcs;
|
||||
r["filed"]:= filed;
|
||||
r["funcsinfo"]:= funcsinfo;
|
||||
prn := array();
|
||||
if filed then prn := filed[:,"name"];
|
||||
r["members"]:=(prn union2 funcs)union2 props;
|
||||
return r;
|
||||
end
|
||||
function parsertype();
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
tarray := "";
|
||||
if tk="array" then
|
||||
begin
|
||||
tarray := "array ";
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=";" then
|
||||
begin
|
||||
return tarray;
|
||||
end else
|
||||
if tk="of" then
|
||||
begin
|
||||
tarray += "of ";
|
||||
ctoken(tk,tp,pos);
|
||||
end
|
||||
end
|
||||
return tarray+tk;
|
||||
end
|
||||
function parserfiled(priv);
|
||||
begin
|
||||
rcount := 0;
|
||||
r := array();
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=";" then
|
||||
begin
|
||||
if rcount then
|
||||
begin
|
||||
r[rcount]["last"]:= true;
|
||||
end
|
||||
r[rcount]["end"]:= pos;
|
||||
return r;
|
||||
end else
|
||||
if tk="," then
|
||||
begin
|
||||
if rcount>0 then
|
||||
begin
|
||||
r[rcount]["nextcomma"]:= pos;
|
||||
end else
|
||||
r[rcount]["first"]:= true;
|
||||
rcount++;
|
||||
r[rcount]["precomma"]:= pos;
|
||||
end else
|
||||
if tk=":" then
|
||||
begin
|
||||
tpv := parsertype();
|
||||
for i := 0 to length(r)-1 do
|
||||
begin
|
||||
r[i]["type"]:= tpv;
|
||||
end
|
||||
continue;
|
||||
ctoken(tk,tp,pos);
|
||||
tarray := "";
|
||||
if tk="array" then
|
||||
begin
|
||||
tarray := "array ";
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=";" then
|
||||
begin
|
||||
for i := 0 to length(r) do
|
||||
begin
|
||||
r[i]["type"]:= "array";
|
||||
end
|
||||
return r;
|
||||
end else
|
||||
if tk="of" then
|
||||
begin
|
||||
tarray += "of ";
|
||||
ctoken(tk,tp,pos);
|
||||
end
|
||||
end
|
||||
end else
|
||||
begin
|
||||
r[rcount]["name"]:= tk;
|
||||
r[rcount]["beg"]:= pos;
|
||||
r[rcount]["id"]:= rcount;
|
||||
r[rcount]["priv"]:= priv;
|
||||
end
|
||||
end
|
||||
return r;
|
||||
end
|
||||
function parserproperty();
|
||||
begin
|
||||
r := "";
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if not r then r := tk;
|
||||
if tk=";" then return r;
|
||||
end
|
||||
return r;
|
||||
end
|
||||
function parserfunction();
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
ctoken(tk,tp,pos);
|
||||
fn := "";
|
||||
if tk <> "(" then fn := tk;
|
||||
while true do
|
||||
begin
|
||||
if tk="begin" then
|
||||
begin
|
||||
//return parserstatement();
|
||||
parserstatement();
|
||||
break;
|
||||
end else
|
||||
if tk="(" then
|
||||
begin
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if tk=")" and tp <> TT_STR then
|
||||
begin
|
||||
break;
|
||||
end
|
||||
end
|
||||
parserfunctionplus();
|
||||
break;
|
||||
end else
|
||||
if tk=":" then
|
||||
begin
|
||||
bpos();
|
||||
parserfunctionplus();
|
||||
break;
|
||||
end else
|
||||
if tk="." then
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
fn := tk;
|
||||
end else
|
||||
if tk=";" then
|
||||
begin
|
||||
parserfunctionplus();
|
||||
break;
|
||||
end
|
||||
ctoken(tk,tp,pos);
|
||||
end
|
||||
return fn;
|
||||
end
|
||||
function parserfunctionplus();
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then return;
|
||||
if tk=";" then
|
||||
begin
|
||||
parserfunctionplus();
|
||||
end else
|
||||
if tk=":" then
|
||||
begin
|
||||
parsertype();
|
||||
parserfunctionplus();
|
||||
end else
|
||||
if tk="begin" then
|
||||
begin
|
||||
return parserstatement();
|
||||
end else
|
||||
if tk="name" then
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
end else
|
||||
if tk in array("virtual","cdecl","stdcall","external","override","overload")then
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
parserfunctionplus();
|
||||
end else
|
||||
begin
|
||||
bpos();
|
||||
end
|
||||
end
|
||||
|
||||
function parserstatement();
|
||||
begin
|
||||
while true do
|
||||
begin
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then return;
|
||||
if tk="end" and tp <> TT_STR then
|
||||
begin
|
||||
n := 0;
|
||||
while true do
|
||||
begin
|
||||
n++;
|
||||
ctoken(tk,tp,pos);
|
||||
if ifnil(tk)then return;
|
||||
if tk <> ";" then
|
||||
begin
|
||||
bpos(n);
|
||||
return;
|
||||
end
|
||||
end
|
||||
return array(pos+3);
|
||||
end else
|
||||
if tp <> TT_STR and(tk in array("begin","select","sselect",
|
||||
"mselct","vselect","try","case","update"))then
|
||||
begin
|
||||
parserstatement();
|
||||
end
|
||||
end
|
||||
end
|
||||
property Script read GetScript write SetScript;
|
||||
property ScriptPath read FScriptPath write SetScriptPath;
|
||||
property Tokens read FTokens;
|
||||
property CurrentPos read FCurrentPos write FCurrentPos;
|
||||
end
|
||||
|
||||
type tslparserbase= class //基础变量
|
||||
{**
|
||||
@explan(说明) tsl语言解析基类 %%
|
||||
**}
|
||||
static TT_IDE; //标示符
|
||||
static TT_STR; //字符串
|
||||
static TT_SYM; //分隔符
|
||||
static TT_OK;
|
||||
function create();
|
||||
begin
|
||||
if not TT_OK then
|
||||
begin
|
||||
TT_IDE := "标示符";
|
||||
TT_STR := "字符串";
|
||||
TT_SYM := "分割符";
|
||||
TT_OK := true;
|
||||
end
|
||||
end
|
||||
function setdata(ret,nk,vs,tp,idx,hh) //解析
|
||||
begin
|
||||
{**
|
||||
@explan(说明)保存数据
|
||||
**}
|
||||
if tp="空格" or tp="回车" or tp="换行" then return;
|
||||
if tp in array("说明0","说明1","说明2","说明")then
|
||||
begin
|
||||
vs := "";
|
||||
return;
|
||||
end
|
||||
if tp="语句" then //语句解析
|
||||
begin
|
||||
vs := lowercase(trim(vs));
|
||||
end
|
||||
//if vs in array("of","array") then tp := "关键字";
|
||||
ret[nk,0]:= vs;
|
||||
ret[nk,1]:= tp;
|
||||
if ifnumber(idx)and tp="语句" then ret[nk,2]:= idx-length(vs);
|
||||
else if ifnumber(idx)and tp <> "字符串" then ret[nk,2]:= idx;
|
||||
case tp of
|
||||
"语句":ret[nk,1]:= TT_IDE;
|
||||
"字符串":ret[nk,1]:= TT_STR;
|
||||
else ret[nk,1]:= TT_SYM;
|
||||
end;
|
||||
vs := "";
|
||||
ret[nk,3]:= hh;
|
||||
nk++;
|
||||
end;
|
||||
function findstringv2(str,fg,len,pos,hh);
|
||||
begin
|
||||
fgl := length(fg);
|
||||
pfg := 0;
|
||||
vs := "";
|
||||
while pos<len do
|
||||
begin
|
||||
vi := str[pos];
|
||||
if vi="\n" then
|
||||
begin
|
||||
hh++;
|
||||
end
|
||||
for i2 := 1 to fgl do
|
||||
begin
|
||||
vi := str[pos+i2];
|
||||
if vi <> fg[i2]then break;
|
||||
pfg := i2;
|
||||
if pos=len then break;
|
||||
end
|
||||
if pfg=fgl then
|
||||
begin
|
||||
pos += fgl;
|
||||
break;
|
||||
end
|
||||
vs += vi;
|
||||
pos++;
|
||||
end
|
||||
return vs;
|
||||
end
|
||||
function findstringv(str,f,len,pos,zy,hh);
|
||||
begin
|
||||
{**
|
||||
@explan(说明)查找以f结尾的字符串
|
||||
**}
|
||||
pos++;
|
||||
vs := "";
|
||||
if not(hh >= 0)then hh := 0;
|
||||
while pos<len do
|
||||
begin
|
||||
vi := str[pos];
|
||||
if vi="\n" then
|
||||
begin
|
||||
hh++;
|
||||
//echo "\r\nfindh:",hh;
|
||||
end
|
||||
pos++;
|
||||
if vi=f then break;
|
||||
if zy and vi="\\" then
|
||||
begin
|
||||
if pos=len then break;
|
||||
nvi := str[pos];
|
||||
case nvi of
|
||||
"r":vs += "\r";
|
||||
"n":vs += "\n";
|
||||
"t":vs += "\t";
|
||||
"b":vs += "\b";
|
||||
else vs += nvi;
|
||||
end;
|
||||
pos++;
|
||||
continue;
|
||||
end
|
||||
vs += vi;
|
||||
end
|
||||
pos--;
|
||||
return vs;
|
||||
end;
|
||||
end
|
||||
type tsltoken = class(tslparserbase) //分词
|
||||
{**
|
||||
@explan(说明) tsl语言分词 %%
|
||||
**}
|
||||
private
|
||||
FTSLstr;
|
||||
FTokens;
|
||||
function SetTslStr(v);
|
||||
begin
|
||||
if v <> FTSLstr then
|
||||
begin
|
||||
FTSLstr := v;
|
||||
FTokens := nil;
|
||||
end
|
||||
end
|
||||
public
|
||||
function create();
|
||||
begin
|
||||
inherited;
|
||||
end
|
||||
function tokens();
|
||||
begin
|
||||
if FTokens then return FTokens;
|
||||
if not ifstring(FTSLstr)then return array();
|
||||
str := binary(FTSLstr);
|
||||
pos :=-1;
|
||||
len := length(str);
|
||||
FTokens := array();
|
||||
nk := 0;
|
||||
vs := "";
|
||||
hh := 0;
|
||||
while true do
|
||||
begin
|
||||
pos++;
|
||||
if pos >= len then break;
|
||||
v := str[pos];
|
||||
if v="%" then
|
||||
begin
|
||||
kk := 1;
|
||||
v1 := str[pos+kk];
|
||||
if v1="%" then
|
||||
begin
|
||||
pls := "%%";
|
||||
while true do
|
||||
begin
|
||||
kk++;
|
||||
if pos+kk >= len then break;
|
||||
if str[pos+kk]in array(" ","\t","\r","\n")then
|
||||
begin
|
||||
if str[pos+kk]="\n" then hh++;
|
||||
break;
|
||||
end else
|
||||
pls += str[pos+kk];
|
||||
end
|
||||
pos += kk;
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv2(str,pls,len,pos,hh);
|
||||
//vs := findstringv(str,pls,len,pos,nil,hh); //str,f,len,pos,zy,hh
|
||||
setdata(FTokens,nk,vs,"字符串",pos,hh);
|
||||
vf := 0;
|
||||
continue;
|
||||
end
|
||||
end
|
||||
if v='"' then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,'"',len,pos,1,hh);
|
||||
setdata(FTokens,nk,vs,"字符串",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
if v="'" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,"'",len,pos,1,hh);
|
||||
setdata(FTokens,nk,vs,"字符串",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
if v='{' then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,'}',len,pos,nil,hh);
|
||||
lvs := length(vs);
|
||||
flvs := true;
|
||||
if lvs>5 then
|
||||
begin
|
||||
if vs[1:2]="**" and(vs[3]in array(" ","\t","\r","\n"))and vs[lvs-1:lvs]="**" and(vs[lvs-2]in array(" ","\t","\r","\n"))then
|
||||
begin
|
||||
flvs := false;
|
||||
vv := trim(vs[3:lvs-2]);
|
||||
if vs[3]="\n" then hh++;
|
||||
setdata(FTokens,nk,vv,"说明",pos,hh);
|
||||
if vs[lvs-2]="\n" then hh++;
|
||||
vs := "";
|
||||
end
|
||||
end
|
||||
if flvs then setdata(FTokens,nk,vs,"说明0",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
if v="#" then
|
||||
begin
|
||||
pos++;
|
||||
vi := str[pos];
|
||||
if vi="!" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,'\n',len,pos,nil,hh);
|
||||
setdata(FTokens,nk,vs,"说明2",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
begin
|
||||
pos--;
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
setdata(FTokens,nk,v,"分割",pos,hh);
|
||||
vf := 0;
|
||||
end
|
||||
end else
|
||||
if v="/" then
|
||||
begin
|
||||
pos++;
|
||||
vi := str[pos];
|
||||
if vi="/" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
vs := findstringv(str,'\n',len,pos,nil,hh);
|
||||
setdata(FTokens,nk,vs,"说明2",pos,hh);
|
||||
vf := 0;
|
||||
end else
|
||||
begin
|
||||
vs += v;
|
||||
pos--;
|
||||
end
|
||||
end else
|
||||
if v='(' then
|
||||
begin
|
||||
pos++;
|
||||
vi := str[pos];
|
||||
if vi="*" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
pos++;
|
||||
while pos <= len do
|
||||
begin
|
||||
vi := str[pos];
|
||||
if vi="\n" then hh++;
|
||||
if pos<len and vi="*" and str[pos+1]=")" then
|
||||
begin
|
||||
pos += 1;
|
||||
break;
|
||||
end else
|
||||
vs += vi;
|
||||
pos++;
|
||||
end
|
||||
//*******************************************************
|
||||
lvs := length(vs);
|
||||
flvs := true;
|
||||
if lvs>3 then
|
||||
begin
|
||||
if vs[1]="*" and(vs[2]in array(" ","\t","\r","\n"))and vs[lvs]="*" and(vs[lvs-1]in array(" ","\t","\r","\n"))then
|
||||
begin
|
||||
flvs := false;
|
||||
vv := trim(vs[2:lvs-1]);
|
||||
if vs[2]="\n" then hh++;
|
||||
setdata(FTokens,nk,vv,"说明",pos,hh);
|
||||
if vs[lvs-1]="\n" then hh++;
|
||||
vs := "";
|
||||
end
|
||||
end
|
||||
if flvs then setdata(FTokens,nk,vs,"说明1",pos,hh);
|
||||
//*********************************************************
|
||||
vf := 0;
|
||||
end else
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos-1,hh);
|
||||
setdata(FTokens,nk,v,"前括号",pos,hh);
|
||||
pos--;
|
||||
continue;
|
||||
end
|
||||
end else
|
||||
if v=")" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
setdata(FTokens,nk,v,"后括号",pos,hh);
|
||||
end else
|
||||
if v="\t" then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
if vf then continue;
|
||||
vf := 1;
|
||||
setdata(FTokens,nk,v,"空格",pos,hh);
|
||||
end else
|
||||
if v=" " then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
if vf then continue;
|
||||
vf := 1;
|
||||
setdata(FTokens,nk,v,"空格",pos,hh);
|
||||
end else
|
||||
if v='\n' then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
hh++;
|
||||
if vf then continue;
|
||||
vf := 1;
|
||||
setdata(FTokens,nk,v,"换行",pos,hh);
|
||||
end else
|
||||
if v='\r' then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
if vf then continue;
|
||||
vf := 1;
|
||||
setdata(FTokens,nk,v,"回车",pos,hh);
|
||||
end else
|
||||
if v in array(",",";",".","]","[",":","=","!")then
|
||||
begin
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
setdata(FTokens,nk,v,"分割",pos,hh);
|
||||
end else
|
||||
begin
|
||||
vs += v;
|
||||
end
|
||||
end
|
||||
if length(vs)then setdata(FTokens,nk,vs,"语句",pos,hh);
|
||||
return FTokens;
|
||||
end
|
||||
property tslstr read FTSLstr write SetTSLstr;
|
||||
end
|
||||
initialization
|
||||
|
||||
end.
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
type tcomponent = class(TSLUIBASE)
|
||||
uses utslvclauxiliary,utslvclbase;
|
||||
uses utslvclauxiliary,UVCPropertyTypesPersistence,utslvclbase;
|
||||
{**
|
||||
@explan(说明) 可视化组件基类 %%
|
||||
@date(20220505) 分离tcomponent基类
|
||||
|
|
@ -31,9 +31,9 @@ uses utslvclauxiliary,utslvclbase;
|
|||
#!begin //private methods
|
||||
function GetLoader();
|
||||
begin
|
||||
global G_T_TTFM2COMPONET_;
|
||||
if not G_T_TTFM2COMPONET_ then return 0;
|
||||
if not FLoader then FLoader := createobject(G_T_TTFM2COMPONET_);
|
||||
m2 := class(tUIglobalData).uigetdata("G_T_TTFM2COMPONET_");
|
||||
if not m2 then return 0;
|
||||
if not FLoader then FLoader := createobject(m2);
|
||||
return FLoader;
|
||||
end
|
||||
function GetPropInfo();
|
||||
|
|
@ -320,7 +320,7 @@ public
|
|||
@explan(说明) 设置所有者,注意只能成功设置一次,之后设置无效 %%
|
||||
@param(AOwner)(tcomponent) 所有者 %%
|
||||
**}
|
||||
if ifnil(FOwner)and(AOwner is class(tcomponent))then
|
||||
if (ifnil(FOwner)) and (AOwner is class(tcomponent))then
|
||||
begin
|
||||
if isDescendant(AOwner)then exit;
|
||||
FOwner := AOwner;
|
||||
|
|
@ -471,7 +471,7 @@ public
|
|||
begin
|
||||
typ := v["type"];
|
||||
if typ="eventhandler" then continue;
|
||||
otype := GetPropertyType(typ);
|
||||
otype :=GetComponentPropertyType(typ);// GetPropertyType(typ);
|
||||
if otype then
|
||||
begin
|
||||
n := v["name"];
|
||||
|
|
@ -502,7 +502,7 @@ public
|
|||
begin
|
||||
typ := v["type"];
|
||||
if typ <> "eventhandler" then continue;
|
||||
otype := GetPropertyType(typ);
|
||||
otype :=GetComponentPropertyType(typ);// GetPropertyType(typ);
|
||||
if otype then
|
||||
begin
|
||||
n := v["name"];
|
||||
|
|
@ -532,7 +532,7 @@ public
|
|||
vv := FChangedProperties[n];
|
||||
if ifnil(vv)then continue;
|
||||
vit := vi["type"];
|
||||
otype := GetPropertyType(vit);
|
||||
otype := GetComponentPropertyType(vit);//GetPropertyType(vit);
|
||||
if vi["write"]and otype then
|
||||
begin
|
||||
r[n]:= otype.FormatTMF(vv);
|
||||
|
|
@ -570,7 +570,7 @@ public
|
|||
if n=vi["name"]then
|
||||
begin
|
||||
vit := vi["type"];
|
||||
otype := GetPropertyType(vit); //获得转换对象
|
||||
otype := GetComponentPropertyType(vit);//GetPropertyType(vit); //»ñµÃת»»¶ÔÏó
|
||||
if ifobj(otype)then
|
||||
begin
|
||||
iv := otype.UnformatEdit(v); //反转换
|
||||
|
|
|
|||
|
|
@ -3,6 +3,13 @@ type tcontrol = class(tcomponent)
|
|||
@explan(说明) 界面控件基类 %%
|
||||
@date(20220509) %%
|
||||
**}
|
||||
///////////ƽ̨ÅжÏ////////
|
||||
{$ifdef linux}
|
||||
{$define gtkpaint}
|
||||
{$define linuxgtk}
|
||||
{$else}
|
||||
{$define gdipaint}
|
||||
{$endif}
|
||||
uses utslvclauxiliary,utslvclmemstruct,utslvclevent,utslvclgdi,utslvclaction,utslvclmenu;
|
||||
private //计量处数据
|
||||
#!begin //members
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ unit tslvcl;
|
|||
interface
|
||||
uses utslvclconstant,utslvclbase,utslvclauxiliary,cstructurelib,utslvclmemstruct,utslvclevent,UVCPropertyTypesPersistence,utslvclgdi,utslvclaction,utslvclmenu,utslvclstdctl,utslvclgrid,utslvcltree;
|
||||
function initializeapplication(); //获得app对象
|
||||
function RegisterComponentType(n,typ); //设计器中注册控件
|
||||
function RegisterComponentType(n,typ); //注册控件,便于通过控件名称构造控件
|
||||
function GetAndDispatchMessageA(hwnd,minm,maxm); //win32 分发消息
|
||||
function ExitMessageLoop(); //退出主循环
|
||||
//function gettswin32api(); //win32 api
|
||||
|
|
@ -59,7 +59,6 @@ function TslToHexFormatStr(tsl);
|
|||
function HexFormatStrToTsl(D);
|
||||
function GetTextWidthAndHeightWidthFont(s,f,mul);
|
||||
//**********操作系统相关函数*********************
|
||||
function initlib();
|
||||
////////////////////////////////////
|
||||
|
||||
|
||||
|
|
@ -133,8 +132,7 @@ type Ttfm2Component = class(TTmfParser)
|
|||
nn := lowercase(n);
|
||||
r := FComponentTypes[nn];
|
||||
if r then return r;
|
||||
global G_F_TSLVCL_FINDCLASS;
|
||||
if G_F_TSLVCL_FINDCLASS then return call(G_F_TSLVCL_FINDCLASS,nn);
|
||||
return findclass(nn);
|
||||
end
|
||||
end
|
||||
function SetTfmData(owner,obj,data,lazydata);
|
||||
|
|
@ -156,7 +154,7 @@ type Ttfm2Component = class(TTmfParser)
|
|||
ddpv := ddp[n];
|
||||
if not ifarray(ddpv)then continue;
|
||||
cls := v["class"];
|
||||
et := owner.GetPropertyType(cls);
|
||||
et := GetComponentPropertyType(cls);//owner.GetPropertyType(cls);
|
||||
if not et then continue;
|
||||
td := SampleValue(ddpv);
|
||||
if et.LazyProperty()then
|
||||
|
|
@ -2097,7 +2095,6 @@ type tmemo = class(TSynMemoNorm)
|
|||
begin
|
||||
inherited;
|
||||
end
|
||||
|
||||
function MouseUp(o,e);override;
|
||||
begin
|
||||
if csDesigning in ComponentState then return ;
|
||||
|
|
@ -10450,8 +10447,6 @@ begin
|
|||
**}
|
||||
class(Ttfm2Component).RegisterComponentType(n,typ);
|
||||
end
|
||||
|
||||
|
||||
function initializeapplication();
|
||||
begin
|
||||
{**
|
||||
|
|
@ -10579,31 +10574,12 @@ begin
|
|||
**}
|
||||
return class(ttimer)._timeproc_(hwnd,message,wparam,lparam);
|
||||
end
|
||||
type tglobalabc=class
|
||||
function create();
|
||||
begin
|
||||
global xxxx;
|
||||
xxxx++;
|
||||
echo "\r\nin:",xxxx;
|
||||
end
|
||||
function destroy();
|
||||
begin
|
||||
global xxxx;
|
||||
xxxx--;
|
||||
echo "\r\nout:",xxxx;
|
||||
end
|
||||
end
|
||||
function controlisCustomPaint(id);
|
||||
begin
|
||||
wd := class(tUIglobalData).uigetdata("TGlobalValues").getvalue(id);
|
||||
if wd then return wd.isCustomPaint();
|
||||
return false;
|
||||
end
|
||||
function tslvclfindclass(n);
|
||||
begin
|
||||
r := findclass(n);
|
||||
return r;
|
||||
end
|
||||
function _twinproc_(hwnd,message,wparam,lparam); //消息分发
|
||||
begin
|
||||
{**
|
||||
|
|
@ -10701,29 +10677,7 @@ begin
|
|||
end
|
||||
end
|
||||
|
||||
function initallib();
|
||||
begin
|
||||
//ClearScriptCache();
|
||||
//global tuiapplication;
|
||||
//tuiapplication := getapplication();
|
||||
global G_F_CONTROL_IS_CUSTOMPAINT;
|
||||
global G_F_TSLVCL_FINDCLASS;
|
||||
global G_F_TWIN_PROC_;
|
||||
global G_F_TIME_PROC_;
|
||||
|
||||
global G_T_TTFM2COMPONET_;
|
||||
global G_T_TVCFORM_;
|
||||
|
||||
G_F_CONTROL_IS_CUSTOMPAINT := thisfunction(controlisCustomPaint);
|
||||
G_F_TSLVCL_FINDCLASS := thisfunction(tslvclfindclass);
|
||||
G_F_TWIN_PROC_ := thisfunction(_twinproc_);
|
||||
G_F_TIME_PROC_ := thisfunction(_timeproc_);
|
||||
G_T_TTFM2COMPONET_ := class(Ttfm2Component);
|
||||
G_T_TVCFORM_ := class(TVCForm);
|
||||
class(tUIglobalData).uisetdata("TGlobalComponentcache",class(TGlobalComponentcache));
|
||||
class(tUIglobalData).uisetdata("TGlobalValues",class(TGlobalValues));
|
||||
class(TRegKey).sinit(); //初始化reg注册表
|
||||
end
|
||||
|
||||
//function GetModuleFileNameA(m:pointer;var buf:string;len:integer):integer;stdcall;external "Kernel32.dll" name "GetModuleFileNameA";
|
||||
//function CallWindowProcA(lpPrevWndFunc:pointer;hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):pointer;stdcall;external "User32.dll" name "CallWindowProcA";
|
||||
|
|
@ -10743,23 +10697,22 @@ function TSL_FreeObj(L:pointer;v:pointer);cdecl;external {$ifdef linux}"libTSSVR
|
|||
//function TS_ModulePath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ModulePath";
|
||||
//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_ExecPath";
|
||||
function TS_GetUserProfileHome():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetUserProfileHome";
|
||||
|
||||
//function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetIniPath";
|
||||
function TSL_Check(func:string;funclen:integer;oResult:pointer):integer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_Check";
|
||||
procedure tslprocessmessages();begin {echo "\r\n processmessage";}end;
|
||||
function TS_GetUserProfileHome();
|
||||
begin
|
||||
return unit(utslvclauxiliary).TS_GetUserProfileHome();
|
||||
|
||||
end
|
||||
function RunWorkerThreadLoop();
|
||||
begin
|
||||
sleep(10);
|
||||
class(TThreadWorker).dispatch();
|
||||
end
|
||||
//procedure ClearScriptCache();cdecl;external "TSLInterp.dll" name "ClearScriptCache";
|
||||
function initlib();
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 初始化lib %%
|
||||
**}
|
||||
a := static initallib();
|
||||
end
|
||||
|
||||
function CreateDirWithFileName(fname);
|
||||
begin
|
||||
return unit(utslvclauxiliary).CreateDirWithFileName(fname);
|
||||
|
|
@ -11000,6 +10953,7 @@ begin
|
|||
**}
|
||||
return(a and not(b))or(b and not(a));
|
||||
end
|
||||
////////////////////封装已经移动到其他库的接口为了兼容///////////
|
||||
function TslToHexFormatStr(tsl);
|
||||
begin
|
||||
return unit(utslvclauxiliary).TslToHexFormatStr(tsl);
|
||||
|
|
@ -11016,7 +10970,55 @@ function CallMessgeFunction(f,o,e);
|
|||
begin
|
||||
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);
|
||||
end
|
||||
/////////////////////////初始化////////////////////////////////////
|
||||
function initallib();
|
||||
begin
|
||||
class(tUIglobalData).uisetdata("G_F_CONTROL_IS_CUSTOMPAINT",thisfunction(controlisCustomPaint));
|
||||
class(tUIglobalData).uisetdata("G_F_TWIN_PROC_",thisfunction(_twinproc_));
|
||||
class(tUIglobalData).uisetdata("G_F_TIME_PROC_",thisfunction(_timeproc_));
|
||||
class(tUIglobalData).uisetdata("G_T_TVCFORM_",class(TVCForm));
|
||||
class(tUIglobalData).uisetdata("G_T_TTFM2COMPONET_",class(Ttfm2Component));
|
||||
class(tUIglobalData).uisetdata("TGlobalComponentcache",class(TGlobalComponentcache));
|
||||
class(tUIglobalData).uisetdata("TGlobalValues",class(TGlobalValues));
|
||||
class(TRegKey).sinit(); //初始化reg注册表
|
||||
//导入注册的componet
|
||||
vclini := pluginpath()+"tslvcl.ini";
|
||||
if fileexists("",vclini) then
|
||||
begin
|
||||
ini := new TIniFileExta("",vclini);
|
||||
ini.LowerKey := true;
|
||||
for i,v in ini.ReadSectionValues("components") do //控件
|
||||
begin
|
||||
if v then
|
||||
begin
|
||||
cv := findclass(v);
|
||||
if cv then
|
||||
begin
|
||||
RegisterComponentType(i,cv);
|
||||
end
|
||||
end
|
||||
end
|
||||
for i,v in ini.ReadSectionValues("propertys") do //属性
|
||||
begin
|
||||
if v then
|
||||
begin
|
||||
cv := findclass(v);
|
||||
if cv then
|
||||
begin
|
||||
RegComponentPropertyType(createobject(cv));
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
end
|
||||
function initlib();
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 初始化lib %%
|
||||
**}
|
||||
a := static initallib();
|
||||
end
|
||||
|
||||
Initialization
|
||||
initlib();
|
||||
|
|
|
|||
|
|
@ -2432,8 +2432,8 @@ end
|
|||
if dispatchmenushortcut(o.Action,st) then return "havedoshortcut";
|
||||
if dispatchmenushortcut(o.PopupMenu,st) then return "havedoshortcut";
|
||||
end
|
||||
global G_T_TVCFORM_;
|
||||
if G_T_TVCFORM_ and (o is G_T_TVCFORM_ ) then
|
||||
w := class(tUIglobalData).uigetdata("G_T_TVCFORM_");
|
||||
if w and (o is w ) then
|
||||
begin
|
||||
if dispatchmenushortcut(o.MainMenu,st) then return "havedoshortcut";
|
||||
end
|
||||
|
|
|
|||
|
|
@ -455,7 +455,7 @@ type tsgtkapi = class(tgtkapis)
|
|||
// class(tUIglobalData).uigetdata("TGlobalComponentcache").getwndbyhwnd(hwnd);
|
||||
function Gtk_TrigMoveSizeEvent(h,aleft,atop,AWidth,AHeight,flg);
|
||||
begin
|
||||
global G_F_TWIN_PROC_;
|
||||
gfw := class(tUIglobalData).uigetdata("G_F_TWIN_PROC_");
|
||||
SWP_NOMOVE := 2;
|
||||
SWP_NOSIZE := 1;
|
||||
WM_WINDOWPOSCHANGED := 0x47;
|
||||
|
|
@ -479,14 +479,14 @@ type tsgtkapi = class(tgtkapis)
|
|||
else
|
||||
d.cy := AHeight;
|
||||
D.flags := SWP_NOMOVE;
|
||||
if G_F_TWIN_PROC_ then call(G_F_TWIN_PROC_,h,WM_WINDOWPOSCHANGED,0,d._getptr_);
|
||||
if gfw then call(gfw,h,WM_WINDOWPOSCHANGED,0,d._getptr_);
|
||||
end
|
||||
if PosChanged then
|
||||
begin
|
||||
d.x := ALeft;
|
||||
d.y := ATop;
|
||||
d.flags := SWP_NOSIZE;
|
||||
if G_F_TWIN_PROC_ then call(G_F_TWIN_PROC_,h,WM_WINDOWPOSCHANGED,0,d._getptr_);
|
||||
if gfw then call(gfw,h,WM_WINDOWPOSCHANGED,0,d._getptr_);
|
||||
end
|
||||
if SizeChanged then //这个是不是应该放前面
|
||||
begin
|
||||
|
|
@ -498,9 +498,9 @@ type tsgtkapi = class(tgtkapis)
|
|||
end}
|
||||
if PosChanged then
|
||||
begin
|
||||
if G_F_TWIN_PROC_ then
|
||||
if gfw then
|
||||
begin
|
||||
call(G_F_TWIN_PROC_,h,0x3,0,makeposition(ALeft,ATop));
|
||||
call(gfw,h,0x3,0,makeposition(ALeft,ATop));
|
||||
end
|
||||
|
||||
end
|
||||
|
|
@ -1894,10 +1894,10 @@ type tsgtkapi = class(tgtkapis)
|
|||
obj := g_image_list_caches[sptr,"imglist"] ;
|
||||
if not obj then return ;
|
||||
class(TGdiplusflat).GdipCreateBitmapFromHBITMAP(hbmImage,r1,0);
|
||||
global G_T_BITMAP_;
|
||||
if G_T_BITMAP_ then
|
||||
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
||||
if cbmp then
|
||||
begin
|
||||
bmp := createobject(G_T_BITMAP_);
|
||||
bmp := createobject(cbmp);
|
||||
bmp.Handle := r1;
|
||||
obj.Push(bmp);
|
||||
end
|
||||
|
|
@ -2007,11 +2007,11 @@ type tsgtkapi = class(tgtkapis)
|
|||
if not ifarray(g_image_list_caches) then return 0;
|
||||
obj := g_image_list_caches[inttostr(himl),"imglist"];
|
||||
if not obj then return ;
|
||||
global G_T_BITMAP_;
|
||||
if not G_T_BITMAP_ then return 0;
|
||||
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
||||
if not cbmp then return 0;
|
||||
class(TGdiplusflat).GdipCreateBitmapFromHBITMAP(hbmImage,0,r1);
|
||||
|
||||
bmp := createobject(G_T_BITMAP_);
|
||||
bmp := createobject(cbmp);
|
||||
bmp.Handle := r1;
|
||||
if id=-1 then obj.Push(bmp);
|
||||
else
|
||||
|
|
@ -2445,9 +2445,9 @@ type tsgtkapi = class(tgtkapis)
|
|||
global g_gtk_caret_cache_timer; //缓存
|
||||
if not g_gtk_caret_cache_timer then
|
||||
begin
|
||||
global G_T_TTIMER_;
|
||||
if not G_T_TTIMER_ then return 0;
|
||||
g_gtk_caret_cache_timer := createobject(G_T_TTIMER_,nil);
|
||||
ctm := class(tUIglobalData).uigetdata("G_T_TTIMER_");
|
||||
if not ctm then return 0;
|
||||
g_gtk_caret_cache_timer := createobject(ctm,nil);
|
||||
g_gtk_caret_cache_timer.Interval := 680;
|
||||
g_gtk_caret_cache_timer.Ontimer := function(o,e)begin
|
||||
global g_current_get_focus_widget;
|
||||
|
|
@ -4426,14 +4426,14 @@ type tenterouterlist = class
|
|||
end
|
||||
function create(api);
|
||||
begin
|
||||
global G_T_TTIMER_;
|
||||
if not G_T_TTIMER_ then return ;
|
||||
ctm := class(tUIglobalData).uigetdata("G_T_TTIMER_");
|
||||
if not ctm then return ;
|
||||
_wapi := api;
|
||||
FCpos := array(0,0);
|
||||
_wapi.GetCursorPos(FCpos);
|
||||
FList := array();
|
||||
FIndex := -1;
|
||||
FTimer := createobject(G_T_TTIMER_,nil);
|
||||
FTimer := createobject(ctm,nil);
|
||||
FTimer.interval := 30; //30毫秒
|
||||
FTimer.Ontimer := thisfunction(MouseIsMoved);
|
||||
FTimer.start();
|
||||
|
|
@ -4536,10 +4536,10 @@ type tgtk_ctl_object = class(_gtkeventtype)
|
|||
return AddMessageToGtkMessageQueue(FHandle,msg,w,l,p);
|
||||
end else
|
||||
begin
|
||||
global G_F_TWIN_PROC_;
|
||||
if G_F_TWIN_PROC_ then
|
||||
gfw := class(tUIglobalData).uigetdata("G_F_TWIN_PROC_");
|
||||
if gfw then
|
||||
begin
|
||||
r := call(G_F_TWIN_PROC_,FHandle,msg,w,l);
|
||||
r := call(gfw,FHandle,msg,w,l);
|
||||
end
|
||||
if msg = CM_CURSORCHANGED then
|
||||
begin
|
||||
|
|
@ -5877,12 +5877,12 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object)
|
|||
end;
|
||||
function CreateWnd(dwExStyle,lpClassName,lpWindowName,dwStyle,x,y,nwidth,nheight,hwndparent,hmenu,hinstance,lpParam);override;
|
||||
begin
|
||||
global G_F_CONTROL_IS_CUSTOMPAINT;
|
||||
fispaint := class(tUIglobalData).uigetdata("G_F_CONTROL_IS_CUSTOMPAINT");
|
||||
//echo "\r\nctl:",tostn(params),tostn(__stack_frame),datetimetostr(now());
|
||||
d := new tslcstructureobj(MemoryAlignmentCalculate( array(("lpcreateparams","intptr",0))),lpParam);
|
||||
if G_F_CONTROL_IS_CUSTOMPAINT then
|
||||
if fispaint then
|
||||
begin
|
||||
isp := call(G_F_CONTROL_IS_CUSTOMPAINT,d._getvalue_("lpcreateparams"));
|
||||
isp := call(fispaint,d._getvalue_("lpcreateparams"));
|
||||
end
|
||||
h := self.handle;
|
||||
{if (_const.WS_BORDER .& dwStyle)=_const.WS_BORDER then
|
||||
|
|
@ -6697,8 +6697,8 @@ begin
|
|||
end }
|
||||
if d[4]=0x113 and d[0]=0 then //定时
|
||||
begin
|
||||
global G_F_TIME_PROC_;
|
||||
if G_F_TIME_PROC_ then call(G_F_TIME_PROC_,d[0],d[1],d[2],d[3]);
|
||||
fgt := class(tUIglobalData).uigetdata("G_F_TIME_PROC_");
|
||||
if fgt then call(fgt,d[0],d[1],d[2],d[3]);
|
||||
end else
|
||||
if d[0] then
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -454,7 +454,7 @@ type TCustomMemoCmd=class()
|
|||
static ecColumnSelect;
|
||||
static ecLineSelect;
|
||||
static ecMatchBracket;
|
||||
static ecGotoMarker0;
|
||||
{static ecGotoMarker0;
|
||||
static ecGotoMarker1;
|
||||
static ecGotoMarker2;
|
||||
static ecGotoMarker3;
|
||||
|
|
@ -473,7 +473,7 @@ type TCustomMemoCmd=class()
|
|||
static ecSetMarker6;
|
||||
static ecSetMarker7;
|
||||
static ecSetMarker8;
|
||||
static ecSetMarker9;
|
||||
static ecSetMarker9;}
|
||||
static ecDeleteLastChar;
|
||||
static ecDeleteChar;
|
||||
static ecDeleteWord;
|
||||
|
|
@ -571,7 +571,7 @@ type TCustomMemoCmd=class()
|
|||
ecColumnSelect := 232; // Column selection mode
|
||||
ecLineSelect := 233; // Line selection mode
|
||||
ecMatchBracket := 250; // Go to matching bracket
|
||||
ecGotoMarker0 := 301; // Goto marker
|
||||
{ecGotoMarker0 := 301; // Goto marker
|
||||
ecGotoMarker1 := 302; // Goto marker
|
||||
ecGotoMarker2 := 303; // Goto marker
|
||||
ecGotoMarker3 := 304; // Goto marker
|
||||
|
|
@ -591,6 +591,7 @@ type TCustomMemoCmd=class()
|
|||
ecSetMarker7 := 358; // Set marker, Data := PPoint - X, Y Pos
|
||||
ecSetMarker8 := 359; // Set marker, Data := PPoint - X, Y Pos
|
||||
ecSetMarker9 := 360; // Set marker, Data := PPoint - X, Y Pos
|
||||
}
|
||||
ecDeleteLastChar := 501; // Delete last char (i.e. backspace key)
|
||||
ecDeleteChar := 502; // Delete char at cursor (i.e. delete key)
|
||||
ecDeleteWord := 503; // Delete from cursor to end of word
|
||||
|
|
@ -2360,6 +2361,7 @@ type TSynCompletion = class(TSynCompletionList)
|
|||
function SetJumpData(s);
|
||||
begin
|
||||
FJumpData := s;
|
||||
FFilter :="";
|
||||
end
|
||||
function Recycling();override;
|
||||
begin
|
||||
|
|
@ -2713,6 +2715,7 @@ type TSynCompletion = class(TSynCompletionList)
|
|||
begin
|
||||
SetMemo(nil);
|
||||
inherited;
|
||||
FCompData := array();
|
||||
end
|
||||
|
||||
function TryJump(s); //Ìøת
|
||||
|
|
|
|||
|
|
@ -24,6 +24,9 @@ function pointinrect(p,rec);
|
|||
function intersectrect(rec1,rec2,irec);
|
||||
|
||||
function bitcombination(s,v,f);
|
||||
function IsTextUTF8(str);
|
||||
function exportjsonformat(d,tbw,ct);
|
||||
|
||||
//****************************
|
||||
///////////////////
|
||||
function ParserCommandLine(s); //解析命令行参数
|
||||
|
|
@ -34,6 +37,8 @@ function TslToHexFormatStr(tsl);
|
|||
function HexFormatStrToTsl(D);
|
||||
function DeleteAllFiles(path);
|
||||
function CreateDirWithFileName(fname);
|
||||
function TS_GetUserProfileHome();
|
||||
function gettslexefullpath();
|
||||
|
||||
type tuiglobaldata=class
|
||||
static UIData;
|
||||
|
|
@ -997,6 +1002,103 @@ type tnumindexarray = Class
|
|||
@param(Data)(array) 数据 %%
|
||||
**}
|
||||
end
|
||||
//ifdef newgetop
|
||||
type trefarray = class
|
||||
function create(d,bidxs); //构造函数
|
||||
begin
|
||||
if ifarray(d) or (d is class(trefarray)) then
|
||||
begin
|
||||
FData := d;
|
||||
end else
|
||||
begin
|
||||
FData := array();
|
||||
end
|
||||
if ifarray(bidxs) then
|
||||
begin
|
||||
FBindexs := bidxs;
|
||||
end else
|
||||
begin
|
||||
FBindexs := array();
|
||||
end
|
||||
end
|
||||
function mgset(idxs,v); //根据下标设置值
|
||||
begin
|
||||
if not ifarray(idxs) then return nil;
|
||||
if ifarray(FData) then
|
||||
begin
|
||||
return magicsetarray(FData,FBindexs union idxs,v);
|
||||
end
|
||||
return FData.mgset(FBindexs union idxs,v);
|
||||
end
|
||||
function mgget(idxs); //根据获得值
|
||||
begin
|
||||
if not ifarray(idxs) then return nil;
|
||||
if ifarray(FData) then
|
||||
begin
|
||||
return magicgetarray(FData,idxs);
|
||||
end
|
||||
return FData.mgget(FBindexs union idxs,v);
|
||||
end
|
||||
function operator[0](idx,v); //获取值
|
||||
begin
|
||||
if v<0 then //一级直接返回
|
||||
begin
|
||||
return mgget(array(idx));
|
||||
end
|
||||
return new trefgetter(self,idx);//多级的时候构建一个中间对象
|
||||
end
|
||||
function operator[1](idx,v); //设置值
|
||||
begin
|
||||
if ifnone(v) then //多级构建一个中间对象
|
||||
begin
|
||||
return new trefsetter(self,idx);
|
||||
end
|
||||
return mgset(array(idx),v); //一级直接返回
|
||||
end
|
||||
private //成员变量
|
||||
FData;
|
||||
FBindexs;
|
||||
private //中间对象
|
||||
type trefsgter = class()
|
||||
function create(a,idx);
|
||||
begin
|
||||
FA := a;
|
||||
FIndexs := array(idx);
|
||||
FIndexsidx := 1;
|
||||
end
|
||||
protected
|
||||
FA;
|
||||
FIndexs;
|
||||
FIndexsidx;
|
||||
end
|
||||
type trefgetter = class(trefsgter) //getter 对象
|
||||
function operator[0](idx,v);
|
||||
begin
|
||||
FIndexs[FIndexsidx++] := idx;
|
||||
if v<0 then
|
||||
begin
|
||||
return fa.mgget(FIndexs);
|
||||
end
|
||||
return self;
|
||||
end
|
||||
function create(a,idx);
|
||||
begin
|
||||
inherited;
|
||||
end
|
||||
end
|
||||
type trefsetter = class(trefsgter) //setter 对象
|
||||
function operator[1](idx,v);
|
||||
begin
|
||||
FIndexs[FIndexsidx++] := idx;
|
||||
if ifnone(v) then return self;
|
||||
return fa.mgset(FIndexs,v);
|
||||
end
|
||||
function create(a,idx);
|
||||
begin
|
||||
inherited;
|
||||
end
|
||||
end
|
||||
end;
|
||||
type TGlobalValues=class
|
||||
private
|
||||
static FValues;
|
||||
|
|
@ -2194,6 +2296,189 @@ begin
|
|||
ph += vi;
|
||||
end
|
||||
end
|
||||
function TS_GetUserProfileHome():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetUserProfileHome";
|
||||
function IsTextUTF8(str)
|
||||
begin
|
||||
{utf8规则
|
||||
单字节: 0xxxxxxx
|
||||
二字节 110xxxxx 10xxxxxx
|
||||
三字节 1110xxxx 10xxxxxx 10xxxxxx
|
||||
四字节 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
|
||||
五字节 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
|
||||
刘字节 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
|
||||
}
|
||||
// 0 为ansi 编码,1 为utf8编码 -1 不能确定什么编码
|
||||
nBytes := 0; //UFT8可用1-6个字节编码,ASCII用一个字节
|
||||
DY := 0;
|
||||
chr := "";
|
||||
bAllAscii := TRUE; //如果全部都是ASCII, 说明不是UTF-8
|
||||
for i := 1 to length(str) do
|
||||
begin
|
||||
chr := ord(str[i]);
|
||||
if((chr .& 0x80)<> 0)then
|
||||
begin // 判断是否ASCII编码,如果不是,说明有可能是UTF-8,ASCII用7位编码,但用一个字节存,最高位标记为0,o0xxxxxxx
|
||||
bAllAscii := FALSE;
|
||||
end
|
||||
if(nBytes=0)then //如果不是ASCII码,应该是多字节符,计算字节数
|
||||
begin
|
||||
if(chr >= 0x80)then
|
||||
begin
|
||||
if(chr >= 0xFC and chr <= 0xFD)then nBytes := 6;
|
||||
else if(chr >= 0xF8)then nBytes := 5;
|
||||
else if(chr >= 0xF0)then nBytes := 4;
|
||||
else if(chr >= 0xE0)then nBytes := 3;
|
||||
else if(chr >= 0xC0)then nBytes := 2;
|
||||
else return 0;
|
||||
DY := MAX(nBytes,DY);
|
||||
nBytes--;
|
||||
end
|
||||
end else //多字节符的非首字节,应为 10xxxxxx
|
||||
begin
|
||||
if((chr .& 0xC0)<> 0x80)then return-1;
|
||||
nBytes--;
|
||||
end
|
||||
end;
|
||||
//违返规则
|
||||
if(nBytes>0)then
|
||||
return -1;
|
||||
//如果全部都是ASCII, 说明不是UTF-8
|
||||
if(bAllAscii)then
|
||||
return 0;
|
||||
//return 1;
|
||||
return DY>2;
|
||||
end
|
||||
|
||||
|
||||
function exportjsonformat(d,tbw,ct);
|
||||
begin
|
||||
//d:天软数据
|
||||
//tbw : 字符串,tab 宽度
|
||||
//ct 递归深度,忽略
|
||||
case datatype(d)of
|
||||
0,20:return inttostr(d);
|
||||
1:return floattostr(d);
|
||||
2:return tostn(d);
|
||||
8,10,11,12:return "null";
|
||||
end;
|
||||
if not(ct>0)then ct := 0;
|
||||
if not ifstring(tbw)then tbw := " ";
|
||||
tbstr := "";
|
||||
tbstra := "";
|
||||
for i := 0 to ct do
|
||||
begin
|
||||
tbstr += tbw;
|
||||
if i>0 then tbstra += tbw
|
||||
end
|
||||
if ifarray(d)then
|
||||
begin
|
||||
if not d then return "[]";
|
||||
idx := 0;
|
||||
for i,v in d do
|
||||
begin
|
||||
if idx <> i then
|
||||
begin
|
||||
fobj := true;
|
||||
break;
|
||||
end
|
||||
idx++;
|
||||
end
|
||||
if fobj then
|
||||
begin
|
||||
r := "{";
|
||||
for i,v in d do
|
||||
begin
|
||||
if ifstring(i)then ii := tostn(i);
|
||||
else ii := tostn(tostn(i));
|
||||
r += "\r\n"+tbstr+ii+":";
|
||||
if ifarray(v)and v then
|
||||
begin
|
||||
r += "\r\n"+tbstr;
|
||||
end
|
||||
r += exportjsonformat(v,tbw,ct+1)+",";
|
||||
end
|
||||
lr := length(r);
|
||||
r[lr:]:= "\r\n"+tbstra+"}";
|
||||
end else
|
||||
begin
|
||||
r := "[";
|
||||
for i,v in d do
|
||||
begin
|
||||
r += "\r\n"+(tbstr)+exportjsonformat(v,tbw,ct+1)+",";
|
||||
end
|
||||
lr := length(r);
|
||||
r[lr:]:= "\r\n"+tbstra+"]";
|
||||
end
|
||||
return r;
|
||||
end else
|
||||
if ifobj(d)then
|
||||
begin
|
||||
try
|
||||
//return "{}";
|
||||
//此处可以遍历对象信息
|
||||
tslobjtoarray(d,dinfo);
|
||||
for i,v in mrows(dinfo,1) do
|
||||
begin
|
||||
nv := invoke(d,v);
|
||||
if ifobj(nv)then nv := nil; //避免死循环
|
||||
dinfo[v]:= nv;
|
||||
end
|
||||
return exportjsonformat(dinfo,tbw,ct);
|
||||
except
|
||||
return "{}";
|
||||
end
|
||||
end else
|
||||
return "null";
|
||||
end
|
||||
function tslobjtoarray(o,r);
|
||||
begin
|
||||
d := o.classinfo();
|
||||
if not ifarray(r)then r := array();
|
||||
for i,v in d["inherited"] do
|
||||
begin
|
||||
tslobjtoarray(findclass(v,o),r);
|
||||
end
|
||||
for i,v in d["members"] do
|
||||
begin
|
||||
n := v["name"];
|
||||
if v["access"]in array(0,1)then
|
||||
begin
|
||||
r[n]:= 0;
|
||||
end else
|
||||
begin
|
||||
reindex(r,array(n:nil));
|
||||
end
|
||||
end
|
||||
for i,v in d["properties"] do
|
||||
begin
|
||||
n := v["name"];
|
||||
if v["read"]and(v["access"]in array(0,1))then
|
||||
begin
|
||||
r[n]:= 0;
|
||||
end else
|
||||
begin
|
||||
reindex(r,array(n:nil));
|
||||
end
|
||||
end
|
||||
end
|
||||
function gettslexefullpath();
|
||||
begin
|
||||
plg := pluginpath();
|
||||
sp := ioFileseparator();
|
||||
for i:= length(plg)-1 downto 1 do
|
||||
begin
|
||||
if plg[i]=sp then
|
||||
begin
|
||||
if sp="/" then
|
||||
begin
|
||||
return plg[1:i]+"TSL";
|
||||
end else
|
||||
begin
|
||||
return plg[1:i]+"tsl.exe";
|
||||
end
|
||||
end
|
||||
end
|
||||
return "";
|
||||
end
|
||||
|
||||
initialization
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ interface
|
|||
{$else}
|
||||
{$define gdipaint}
|
||||
{$endif}
|
||||
uses utslvclconstant,utslvclmemstruct,utslvclauxiliary,UVCPropertyTypesPersistence;
|
||||
uses utslvclconstant,utslvclmemstruct,utslvclauxiliary;
|
||||
type tswin32api = class({$ifdef linuxgtk}tsgtkapi {$else} twindowsapi {$endif} ) //windows½Ó¿Ú
|
||||
{$ifdef linuxgtk}
|
||||
uses ugtkinterface;
|
||||
|
|
@ -303,14 +303,6 @@ type TSLUIBASE=class(TSLUICONST) //ͼ
|
|||
if not(ifstring(_temppath)and _temppath)then _temppath := gettemppath()+"tinysoft";
|
||||
return _temppath;
|
||||
end
|
||||
class function RegPropertyType(v); //注册设计器编辑
|
||||
begin
|
||||
RegComponentPropertyType(v);
|
||||
end
|
||||
class function GetPropertyType(n); //获得设计器编辑
|
||||
begin
|
||||
return GetComponentPropertyType(n);
|
||||
end
|
||||
property happ read Gethapp write SetHapp;
|
||||
property ReCycleState read FReCycleState; //write FReCycleState;
|
||||
_Tag; //±êÇ©
|
||||
|
|
|
|||
|
|
@ -2981,10 +2981,8 @@ end
|
|||
initialization
|
||||
sinitgidplus();
|
||||
class(tcustomimage).sinit();
|
||||
global G_T_BITMAP_;
|
||||
global G_T_ICON_;
|
||||
G_T_BITMAP_ := class(TcustomBitmap);
|
||||
G_T_ICON_ := class(TcustomIcon);
|
||||
class(tUIglobalData).uisetdata("G_T_BITMAP_",class(TcustomBitmap));
|
||||
class(tUIglobalData).uisetdata("G_T_ICON_",class(TcustomIcon));
|
||||
finalization
|
||||
|
||||
end.
|
||||
|
|
@ -331,204 +331,6 @@ type TCustomTimer = class(tcomponent)//
|
|||
@param(Enabled)(bool) ÊÇ·ñÒѾÆô¶¯ %%
|
||||
**}
|
||||
end
|
||||
type TCustomTimer = class(tcomponent)//定时器类
|
||||
{**
|
||||
@explan(说明)定时器类,间隔是以毫秒为最小单位 %%
|
||||
**}
|
||||
{**
|
||||
@example(范例--定时器)
|
||||
//构造计算器,第一个参数为间隔(毫秒),第二个为函数指针
|
||||
tm := new TCustomTimer(1000,function(o,e)begin echo now(); end );
|
||||
tm.start();//启动定时器
|
||||
tm.stop();//停止
|
||||
**}
|
||||
private
|
||||
static _STIMERS; //TIMER对象
|
||||
static FSIDC; //id 构造器
|
||||
class function Sgettimer(id);
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 通过id获得定时器对象 %%
|
||||
@param(id)(integer) 定时器id %%
|
||||
**}
|
||||
return _STIMERS[id];
|
||||
end
|
||||
class function Ssettimer(tm);
|
||||
begin
|
||||
{**
|
||||
@explan(说明)存储定时器 %%
|
||||
@param(tm)(TCustomTimer) 定时器对象%%
|
||||
**}
|
||||
_STIMERS[tm.id]:= tm;
|
||||
end
|
||||
class function Sdeltimer(tid);
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 删除定时器 %%
|
||||
@param(tid)(integer) id%%
|
||||
**}
|
||||
if tid and(ifnumber(tid))then reindex(_STIMERS,array(tid:nil));
|
||||
end
|
||||
protected FOntimeout;
|
||||
private
|
||||
FOntimer;
|
||||
Fid;
|
||||
FInterval;
|
||||
FStart;
|
||||
_kill0; //标记
|
||||
function SetEnabled(f);
|
||||
begin
|
||||
if f then start();
|
||||
else stop();
|
||||
end
|
||||
function SetInterval(intv); //设置间隔
|
||||
begin
|
||||
{**
|
||||
@explan(说明)设置间隔 %%
|
||||
@param(intv)(integer) 间隔,毫秒 %%
|
||||
**}
|
||||
if not(ifnumber(intv))then return FInterval;
|
||||
if FStart then
|
||||
begin
|
||||
ndstart := 1;
|
||||
stop();
|
||||
end
|
||||
if intv <> FInterval and ifnumber(intv)and intv>0 then //时间不等
|
||||
begin
|
||||
FInterval := intv;
|
||||
end
|
||||
if ndstart then start();
|
||||
end
|
||||
public
|
||||
{**
|
||||
@param(FSIDC)(tidcreater) id构造器%%
|
||||
@param(_STIMERS)(array) 全局存储%%
|
||||
@param(FOntimer)(fpointer) timeout执行对象%%
|
||||
@param(_kill0)(bool) 标记%%
|
||||
**}
|
||||
function create(AOwner);override;
|
||||
begin
|
||||
inherited;
|
||||
FID := FSIDC.createid();
|
||||
FStart := false;
|
||||
FInterval := 1000;
|
||||
end
|
||||
function timeout(cmd,t); //一次性事件
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 一次性事件 %%
|
||||
@param(cmd)(fpointer) 执行回调 %%
|
||||
@param(t)(integer) t毫秒后执行 %%
|
||||
**}
|
||||
FOntimeout := cmd;
|
||||
if ifnumber(t)then SetInterval(t);
|
||||
FOntimer := function(o,e)
|
||||
begin
|
||||
try
|
||||
stop();
|
||||
CallMessgeFunction(FOntimeout,o,e);
|
||||
finally
|
||||
FOntimeout := nil;
|
||||
end;
|
||||
end;
|
||||
start();
|
||||
end
|
||||
function start(); //开始
|
||||
begin
|
||||
{**
|
||||
@explan(说明)启动 %%
|
||||
**}
|
||||
if not((datatype(FOntimer) = 7 )and FInterval)>0 then return-1;
|
||||
if FStart then return FStart;
|
||||
ret := _wapi.SetTimer(nil,Fid,FInterval,getwinprocptr(2));
|
||||
_kill0 := ret;
|
||||
Ssettimer(self(true));
|
||||
FStart := ret <> 0;
|
||||
return FStart;
|
||||
end
|
||||
function stop(); //停止
|
||||
begin
|
||||
{**
|
||||
@explan(说明)停止 %%
|
||||
**}
|
||||
if FStart then
|
||||
begin
|
||||
if _kill0 then
|
||||
begin
|
||||
FStart := not((_wapi.KillTimer(nil,_kill0))<> 0);
|
||||
if FStart=false then _kill0 := 0;
|
||||
end
|
||||
Sdeltimer(FID);
|
||||
end
|
||||
return not FStart;
|
||||
end
|
||||
function Recycling();override;
|
||||
begin
|
||||
{**
|
||||
@explan(说明)析构预备 %%
|
||||
**}
|
||||
stop();
|
||||
FSIDC.deleteid(FID);
|
||||
FOntimer := nil;
|
||||
FOntimeout := nil;
|
||||
FTimerStrc := nil;
|
||||
inherited;
|
||||
end
|
||||
function destroy();override;
|
||||
begin
|
||||
inherited;
|
||||
end
|
||||
class function _timeproc_(hwnd,message,wparam,lparam);
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 定时回调入接口 %%
|
||||
@param(hwnd)(integer) 窗口句柄 %%
|
||||
@param(message)(integer) 消息id %%
|
||||
@param(lparam)(integer) 消息参数2 %%
|
||||
@param(wparam)(integer) 消息参数1 %%
|
||||
**}
|
||||
e := new tuieventbase(message,wparam,lparam,hwnd);
|
||||
for i,iv in mrows(_STIMERS,1) do
|
||||
begin
|
||||
v := _STIMERS[iv];
|
||||
if v is class(TCustomTimer)then if v.tproc(e)then return;
|
||||
end
|
||||
//return _twinproc_(hwnd,message,wparam,lparam);
|
||||
end
|
||||
class function Sinit();override;
|
||||
begin
|
||||
{**
|
||||
@explan(说明)初始化定时器全局 %%
|
||||
**}
|
||||
if not FSIDC then
|
||||
begin
|
||||
_STIMERS := array();
|
||||
FSIDC := new tidcreater();
|
||||
end
|
||||
inherited;
|
||||
end
|
||||
function tproc(e);virtual;
|
||||
begin
|
||||
if e.wparam and(e.wparam=_kill0)then
|
||||
begin
|
||||
CallMessgeFunction(FOntimer,self(true),e);
|
||||
return 1;
|
||||
end
|
||||
end
|
||||
property Interval:integer read FInterval write SetInterval;
|
||||
property Ontimer:eventhandler read FOntimer write FOntimer;
|
||||
property Enabled:bool read FStart Write SetEnabled;
|
||||
property id read FID;
|
||||
function publishs();override;
|
||||
begin
|
||||
return array("name","interval","ontimer");
|
||||
end
|
||||
{**
|
||||
@param(Interval)(integer) 设置运行间隔 %%
|
||||
@param(Ontimer)(funtion[self,tuieventbase]) 定时调度 %%
|
||||
@param(Enabled)(bool) 是否已经启动 %%
|
||||
**}
|
||||
end
|
||||
type teditable=class(TSLUIBASE)
|
||||
private
|
||||
FInsertState;
|
||||
|
|
@ -2579,9 +2381,10 @@ type TCustomListBoxbase=class(TCustomScrollControl)
|
|||
if e.Button()=mbLeft then
|
||||
begin
|
||||
CallMessgeFunction(onclick,o,e);
|
||||
end
|
||||
e.skip := true;
|
||||
end
|
||||
|
||||
end
|
||||
function MouseDown(o,e);override;
|
||||
begin
|
||||
if e.Button()=mbLeft and e.shiftdouble()then
|
||||
|
|
@ -3976,14 +3779,10 @@ type TcustomToolBar=class(TCustomControl)
|
|||
FBtnRects := array();
|
||||
FTipWnd := new TTipWnd(self);
|
||||
FTipWnd.Parent := self;
|
||||
global G_T_TTIMER_;
|
||||
if G_T_TTIMER_ then
|
||||
begin
|
||||
FTimer := createobject(G_T_TTIMER_,self);
|
||||
FTimer := new TCustomTimer(self);
|
||||
FTimer.Interval := 200;
|
||||
FTimer.Ontimer := thisfunction(DoTimerShowTip);
|
||||
end
|
||||
end
|
||||
function MouseDown(o,e);override;
|
||||
begin
|
||||
if csDesigning in ComponentState then return;
|
||||
|
|
@ -4851,6 +4650,8 @@ type TTipWnd=class(TCustomControl) //tip
|
|||
FSize;
|
||||
end
|
||||
initialization
|
||||
global G_T_TTIMER_;
|
||||
G_T_TTIMER_ := class(TCustomTimer);
|
||||
{$ifdef linux}
|
||||
class(tUIglobalData).uisetdata("G_T_TTIMER_",class(TCustomTimer));
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
Unit UVCPropertyTypesPersistence;
|
||||
interface
|
||||
uses utslvclauxiliary;
|
||||
uses utslvclauxiliary;//,utslvclgdi;
|
||||
{**
|
||||
@explan(说明) 可视控件属性处理库 %%
|
||||
**}
|
||||
|
|
@ -926,7 +926,7 @@ type TPropertyType=class
|
|||
function FormatTMF(d);virtual;
|
||||
begin
|
||||
{**
|
||||
@explan(说明)修改表格数据转换为tfm文件数据 %%
|
||||
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
||||
**}
|
||||
return d;
|
||||
end
|
||||
|
|
@ -1182,7 +1182,7 @@ type TPropertyaction=class(TPropertyVarible) //action
|
|||
begin
|
||||
return "taction";
|
||||
end
|
||||
function IfComponent();virtual;
|
||||
function IfComponent();override;
|
||||
begin
|
||||
{**
|
||||
@explan(说明) 是否为控件%%
|
||||
|
|
@ -1190,19 +1190,19 @@ type TPropertyaction=class(TPropertyVarible) //action
|
|||
return true;
|
||||
end
|
||||
end
|
||||
type TPropertyTray=class(TPropertyaction) //action
|
||||
type TPropertyTray=class(TPropertyaction) //托盘
|
||||
Function EditType();override;
|
||||
begin
|
||||
return "ttray";
|
||||
end
|
||||
end
|
||||
type TPropertyPopupMenu=class(TPropertyaction) //action
|
||||
type TPropertyPopupMenu=class(TPropertyaction) //右键菜单
|
||||
Function EditType();override;
|
||||
begin
|
||||
return "tpopupmenu";
|
||||
end
|
||||
end
|
||||
type TPropertyMainMenu=class(TPropertyaction) //action
|
||||
type TPropertyMainMenu=class(TPropertyaction) //主菜单
|
||||
Function EditType();override;
|
||||
begin
|
||||
return "tmainmenu";
|
||||
|
|
@ -1216,21 +1216,21 @@ type TPropertyMainMenu=class(TPropertyaction) //action
|
|||
return false;
|
||||
end
|
||||
end
|
||||
type TPropertyImagelist=class(TPropertyaction) //action
|
||||
type TPropertyImagelist=class(TPropertyaction) //imagelist
|
||||
Function EditType();override;
|
||||
begin
|
||||
return "tcontrolimagelist";
|
||||
end
|
||||
end
|
||||
type TPropertyImagesData=class(TPropertyType)
|
||||
type TPropertyImagesData=class(TPropertyType) //imagedata,作为imagelist的数据
|
||||
Function EditType();override;
|
||||
begin
|
||||
return "imagesdata";
|
||||
end
|
||||
function TmfToNode(d);override;
|
||||
begin
|
||||
global G_T_BITMAP_;
|
||||
if not G_T_BITMAP_ then return ;
|
||||
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
||||
if not cbmp then return ;
|
||||
if ifstring(d)then
|
||||
begin
|
||||
r := HexFormatStrToTsl(d);
|
||||
|
|
@ -1239,7 +1239,7 @@ type TPropertyImagesData=class(TPropertyType)
|
|||
ret := array();
|
||||
for i,v in r["items"] do
|
||||
begin
|
||||
bmp := createobject(G_T_BITMAP_);
|
||||
bmp := createobject(cbmp);
|
||||
bmp.Readvcon(v);
|
||||
ret[i]:= bmp;
|
||||
end
|
||||
|
|
@ -1276,8 +1276,8 @@ type TPropertyImagesData=class(TPropertyType)
|
|||
end
|
||||
function ReadTMF(d,o);override;
|
||||
begin
|
||||
global G_T_BITMAP_;
|
||||
if not G_T_BITMAP_ then return ;
|
||||
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
||||
if not cbmp then return ;
|
||||
if ifstring(d)then
|
||||
begin
|
||||
r := HexFormatStrToTsl(d);
|
||||
|
|
@ -1286,7 +1286,7 @@ type TPropertyImagesData=class(TPropertyType)
|
|||
ret := array("type":"bmps");
|
||||
for i,v in r["items"] do
|
||||
begin
|
||||
bmp := createobject(G_T_BITMAP_);
|
||||
bmp := createobject(cbmp);
|
||||
bmp.Readvcon(v);
|
||||
ret["items"][i]:= bmp;
|
||||
end
|
||||
|
|
@ -1302,12 +1302,12 @@ type TPropertyBitmap=class(TPropertyType)
|
|||
end
|
||||
function TmfToNode(d);override;
|
||||
begin
|
||||
global G_T_BITMAP_;
|
||||
if not G_T_BITMAP_ then return ;
|
||||
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
||||
if not cbmp then return ;
|
||||
if ifstring(d)and d then
|
||||
begin
|
||||
tar := HexFormatStrToTsl(d);
|
||||
bmp := createobject(G_T_BITMAP_);
|
||||
bmp := createobject(cbmp);
|
||||
bmp.Readvcon(tar);
|
||||
return bmp;
|
||||
end
|
||||
|
|
@ -1319,11 +1319,9 @@ type TPropertyBitmap=class(TPropertyType)
|
|||
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
||||
**}
|
||||
reti := "";
|
||||
global G_T_BITMAP_;
|
||||
|
||||
if d is G_T_BITMAP_ then
|
||||
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
||||
if d is cbmp then
|
||||
begin
|
||||
echo " \r\nglob bitmap===";
|
||||
reti := TSlToHexFormatStr(d.tovcon);
|
||||
end
|
||||
ret := "{ ";
|
||||
|
|
@ -1343,14 +1341,14 @@ type TPropertyIcon=class(TPropertyType)
|
|||
end
|
||||
function TmfToNode(d);override;
|
||||
begin
|
||||
global G_T_ICON_;
|
||||
if not G_T_ICON_ then return ;
|
||||
cico := class(tUIglobalData).uigetdata("G_T_ICON_");
|
||||
if not cico then return ;
|
||||
if ifstring(d)and d then
|
||||
begin
|
||||
dd := HexFormatStrToTsl(d);
|
||||
if ifarray(dd)then
|
||||
begin
|
||||
r := createobject(G_T_ICON_);
|
||||
r := createobject(cico);
|
||||
r.Readvcon(dd);
|
||||
return r;
|
||||
end
|
||||
|
|
@ -1362,8 +1360,8 @@ type TPropertyIcon=class(TPropertyType)
|
|||
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
||||
**}
|
||||
reti := "";
|
||||
global G_T_ICON_;
|
||||
if G_T_ICON_ and (d is G_T_ICON_) then
|
||||
cico := class(tUIglobalData).uigetdata("G_T_ICON_");
|
||||
if cico and (d is cico) then
|
||||
begin
|
||||
reti := TSlToHexFormatStr(d.tovcon());
|
||||
end
|
||||
|
|
@ -1563,7 +1561,7 @@ type TPropertyAnchors=class(UniObjectMember)
|
|||
function create();
|
||||
begin
|
||||
akTop := 0;
|
||||
akTop := 1;
|
||||
akLeft := 1;
|
||||
akRight := 2;
|
||||
akBottom := 3;
|
||||
end
|
||||
|
|
@ -1995,6 +1993,25 @@ begin
|
|||
end
|
||||
return r;
|
||||
end
|
||||
function RegComponentPropertyType(v);
|
||||
begin
|
||||
//return ;
|
||||
global g_ComponentPropertyType_a;
|
||||
if not ifarray(g_ComponentPropertyType_a)then g_ComponentPropertyType_a := array();
|
||||
if v is class(TPropertyType) then
|
||||
begin
|
||||
n := v.EditType();
|
||||
if n and ifstring(n)then
|
||||
begin
|
||||
g_ComponentPropertyType_a[n]:= v; //createobject(v,0);
|
||||
end
|
||||
end
|
||||
end
|
||||
function GetComponentPropertyType(n);
|
||||
begin
|
||||
global g_ComponentPropertyType_a;
|
||||
if ifstring(n)and ifarray(g_ComponentPropertyType_a)then return g_ComponentPropertyType_a[n];
|
||||
end
|
||||
function Sinitlib();
|
||||
begin
|
||||
types := array( //"tpropertytype",
|
||||
|
|
@ -2049,28 +2066,7 @@ begin
|
|||
end
|
||||
//注册属性编辑
|
||||
end
|
||||
function RegComponentPropertyType(v);
|
||||
begin
|
||||
//return ;
|
||||
global g_ComponentPropertyType_a;
|
||||
if not ifarray(g_ComponentPropertyType_a)then g_ComponentPropertyType_a := array();
|
||||
if ifobj(v)then
|
||||
begin
|
||||
try
|
||||
n := v.EditType();
|
||||
if n and ifstring(n)then
|
||||
begin
|
||||
g_ComponentPropertyType_a[n]:= v; //createobject(v,0);
|
||||
end
|
||||
except
|
||||
end;
|
||||
end
|
||||
end
|
||||
function GetComponentPropertyType(n);
|
||||
begin
|
||||
global g_ComponentPropertyType_a;
|
||||
if ifstring(n)and ifarray(g_ComponentPropertyType_a)then return g_ComponentPropertyType_a[n];
|
||||
end
|
||||
|
||||
function InitLib();
|
||||
begin
|
||||
static Sinitlib();
|
||||
|
|
|
|||
Loading…
Reference in New Issue