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

设计器

Browse Source 
实现窗口继承
This commit is contained in:
JianjunLiu
2022-10-18 17:02:40 +08:00
parent 791217a4b1
commit e2cc54dcbc
8 changed files with 657 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files
funcext/tvclib/tcomponent.tsf
+9 -3
View File
@@ -450,6 +450,7 @@ public //
#!end
private //设计器中属性事件相关
FEventsProperties;
FChangedPropertiesflg;
FChangedProperties;
FVariableProperties;
function GetPublishInfo();//属性获取
@@ -551,6 +552,7 @@ public //
for i,vi in ps do
begin
n := vi["name"];
if ifarray(FChangedPropertiesflg) and FChangedPropertiesflg[n] then continue;
vv := FChangedProperties[n];
if ifnil(vv)then continue;
vit := vi["type"];
@@ -568,14 +570,18 @@ public //
end
return r;
end
function SetChangedPublish(n,v);virtual;//设置属性
function SetChangedPublish(n,v,pp);virtual;//设置属性
begin
{**
@explan(说明) 设计器相关函数 %%
**}
if not ifarray(FChangedProperties)then FChangedProperties := array();
if not ifarray(FChangedPropertiesflg)then FChangedPropertiesflg := array();
if pp then FChangedPropertiesflg[n] := true;
//reindex(FChangedProperties,array(n:nil));
if FChangedProperties[n]=v then return ;
FChangedProperties[n]:= v;
if not(pp) then reindex(FChangedPropertiesflg,array(n:nil));
end
function DeleteChangedPublish(n);virtual;//删除属性
begin
@@ -585,7 +591,7 @@ public //
reindex(FChangedProperties,array(n:nil));
end
end
function SetPublish(n,v);virtual;//设置属性
function SetPublish(n,v,pp);virtual;//设置属性
begin
{**
@explan(说明) 修改单个值,设计器使用 %%
@@ -602,7 +608,7 @@ public //
if ifobj(otype)then
begin
iv := otype.UnformatEdit(v); //反转换
SetChangedPublish(n,iv); //保存
SetChangedPublish(n,iv,pp); //保存
if vit="eventhandler" then //分类保存
begin
FEventsProperties[n]:= iv;
funcext/tvclib/tslvcl.tsf
+24 -12
View File
@@ -208,7 +208,7 @@ type Ttfm2Component = class(TTmfParser)
self.Script := s;
lazydata := array();
//lazydata[0] := array();
darray := gettree();
darray := gettree2();
SetTfmData(owner,owner,darray,lazydata);
for i,v in lazydata do
begin
@@ -228,6 +228,17 @@ type Ttfm2Component = class(TTmfParser)
Loadinherited(owner); //导入
end
private
function hastfmfile(phs,cn);
begin
for i,v in phs do
begin
pi := v+cn+".tfm";
if fileexists("",pi) then
begin
return true;
end
end
end
function Loadtfmtoform(o,phs,cn);
begin
for i,v in phs do
@@ -252,22 +263,23 @@ type Ttfm2Component = class(TTmfParser)
o2 := o;
phs := static GetSourceDirs();
objs := array();
fssourdirs := phs;
while true do
begin
ci := o2.classinfo();
cn := ci["classname"];
if cn="tdcreateform" or cn="tdcreatepanel" then return ;
if hastfmfile(phs,cn) then
begin
Loadtfmtoform(o2,phs,cn);
return ;
end
ic := ci["inherited"][0];
if((cn<>"tdcreateform") and (cn<>"tdcreatepanel")) then
begin
objs[length(objs)] := cn;
o2 := findclass(ic,o2);
end else break;
end
for i := length(objs)-1 downto 0 do
begin
Loadtfmtoform(o,phs,objs[i]);
end
end
if ic then
o2 := findclass(ic,o2);
else return ;
end
end
function GetSourceDirs();
begin
lps := GetLibPaths();
funcext/tvclib/utslvclmenu.tsf
+1 -1
View File
@@ -802,7 +802,7 @@ private
end
end
public
function SetChangedPublish(n,v);virtual;
function SetChangedPublish(n,v,pp);virtual;
begin
{**
@explan(说明) 设计器相关函数 %%
funcext/tvclib/uvcpropertytypespersistence.tsf
+301 -26
View File
@@ -90,7 +90,7 @@ type TTmfParserToken = class(TTmfParserbase)
FSyms; //符号
FNumberChar;
FHexChar;
Function SetScript(S);
Function SetScript(S);//设置文本
begin
IF FScript <> S then
begin
@@ -105,7 +105,7 @@ type TTmfParserToken = class(TTmfParserbase)
end
end
public
class function sinit();override;
class function sinit();override;//初始化
begin
inherited;
end
@@ -130,7 +130,7 @@ type TTmfParserToken = class(TTmfParserbase)
begin
return FCurrent<FScriptLen;
end
class function delct(r,ct,len,n);
class function delct(r,ct,len,n);//处理字符
begin
{**
@explan(说明) 处理当前字符 %%
@@ -147,7 +147,7 @@ type TTmfParserToken = class(TTmfParserbase)
ct := "";
end
end
function GetNumber(len);
function GetNumber(len);//解析数字
begin
c := cchar();
r := "";
@@ -218,7 +218,7 @@ type TTmfParserToken = class(TTmfParserbase)
goto parnb;
end
end
function GetBinary(len);
function GetBinary(len); //二进制数据
begin
r := "";
while whileok() do
@@ -236,7 +236,7 @@ type TTmfParserToken = class(TTmfParserbase)
r += c;
end
end
function gettokens();
function gettokens();//解析字符
begin
{**
@explan(说明) 解析token %%
@@ -335,7 +335,7 @@ type TTmfParserToken = class(TTmfParserbase)
end
return r;
end
function PHexNumber();
function PHexNumber();//16进制解析
begin
{**
@explan(说明)解析16进制数
@@ -406,12 +406,14 @@ type TTmfParser = class(TTmfParserbase)
{**
@explan(说明)tmf文件解析 %%
**}
fssourdirs;
private
FCurrent;
FTokens;
FTokenlen;
FParsers;
FTree;
ftreeobj;
FS;
function SetScriptPath(fn);
begin
@@ -421,18 +423,19 @@ type TTmfParser = class(TTmfParserbase)
if readFile(rwraw(),"",fn,0,size,data)then
begin
Script := data;
end
end else Script := "";
end
end
function SetScript(s);
begin
if fs <> s then
if (fs <> s) and ifstring(s) then
begin
FParsers.Script := s;
FTokens := FParsers.gettokens();
FTokenlen := length(FTokens);
FCurrent := 0;
FTree := nil;
ftreeobj := nil;
end
end
public
@@ -535,21 +538,6 @@ type TTmfParser = class(TTmfParserbase)
return v;
end else
return tostn(v);
{sa := ord("a");
sz := ord("z");
s0 := ord("0");
s9 := ord("9");
IsVariableName
for i := 1 to length(v) do
begin
vi := v[i];
ov := ord(vi);
if not((ov>=sa and ov<=sz)or( ov>=s0 and ov<=s9)or(vi="_") ) then
begin
return tostn(v);
end
end
return v;}
end else
return tostn(v);
end
@@ -563,6 +551,7 @@ type TTmfParser = class(TTmfParserbase)
r[length(r)]:= v["name"];
call(thisfunction,v,r);
end
return r;
end
function gettree();
begin
@@ -574,6 +563,84 @@ type TTmfParser = class(TTmfParserbase)
return array();
//return echo tostn(CreateObj());
end
function gettree2(); //获得继承关系树
begin
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
return object2tree2(d);
end
end
function inheritedcoy(n,t,ht);
begin
d := gettreeasobject();
if d then
begin
d.setinhertedpaths(fssourdirs);//设置路径
d.initinherited();
return d.inheritedstr(n,t,ht,0);
end
return "";
end
function object2tree2(t); //获得继承关系
begin
r := array();
r["inherited"] := t.ifinherited;
r["class"] := t.fnodetype;
r["name"] := t.fnodename;
r["parent"] := t.finheritedname;
ps := array();
vps := t.getallpropertys();
for i,v in vps.IndexNames() do
begin
vi := vps[v];
ps[v] := array("name":v,"value":vi.fvalue,"type":vi.ftype,"pp":vi.finh);
end
objs := array();
fos := t.fobjects;
for i,v in fos.IndexNames() do
begin
objs[v] := object2tree2(fos[v]);
end
r["property"] := ps;
r["object"] := objs;
return r;
end
function gettreeasobject();
begin
if ftreeobj then return ftreeobj;
gettree();
if FTree then
begin
//ttfmnode
ftreeobj := createndeobjects(FTree);
return ftreeobj;
end
return nil;
end
function createndeobjects(d);
begin
if ifarray(d) then
begin
r := new ttfmnode(d["class"],d["name"]);
r.ifinherited := d["inherited"];
r.finheritedname := d["parent"];
for i,v in d["property"] do
begin
r.setprovalue(v["name"],v["value"],v["type"]);
end
for i,v in d["object"] do
begin
vi := createndeobjects(v);
r.addobject(vi);
end
return r;
end
end
function TSLasItem(d);
begin
if not ifarray(d)then return totfmstr(d);
@@ -641,7 +708,13 @@ type TTmfParser = class(TTmfParserbase)
while whileok() do
begin
ctoken(tv,tt);
if tv="object" and(tt <> TT_STR)then return getobject();
if (tv="object" or tv="inherited") and(tt <> TT_STR) then
begin
r := getobject();
if tv="inherited" then
r["inherited"] := true;
return r;
end
end
end
function getobject();
@@ -660,6 +733,7 @@ type TTmfParser = class(TTmfParserbase)
rt := getmembers();
r["property"]:= rt["property"];
r["object"]:= rt["object"];
r["parent"] := rt["parent"];
return r;
end
function GetSampleValue();
@@ -727,9 +801,11 @@ type TTmfParser = class(TTmfParserbase)
while whileok() do
begin
ctoken(tv,tt);
if tv="object" and tt <> TT_STR then
if (tv="object" or tv="inherited") and tt <> TT_STR then
begin
ro := getobject();
if (tv="inherited") then
ro["inherited"] := true;
r["object"][objlen++]:= ro;
end else
if tv="end" and tt <> TT_STR then
@@ -756,6 +832,15 @@ type TTmfParser = class(TTmfParserbase)
end
pp := tv;
end else
if tt=TT_SIG and tv="(" then
begin
while whileok() do
begin
ctoken(tv,tt);
if tt=TT_SIG and tv=")" then break;
r["parent"] := tv;
end
end else
PError("其他错误",1);
end
return r;
@@ -1997,6 +2082,196 @@ end
//////////////////////////////////////////////////////////////////////////
implementation
type tproper = class()
function create(t,v);
begin
fvalue := v;
ftype := t;
end
fvalue;
ftype;
finh;
end
type ttfmnode = class()
function setinhertedpaths(phs);
begin
finheritedpaths := phs;
end
function create(t,n);
begin
fnodename := n;
fnodetype := t;
fpropertys := new tstrindexarray();
fobjects := new tstrindexarray();
finheritedpaths := array();
end
function initinherited();
begin
s := finheritedname;
if s and ifstring(s) then
begin
for i,v in finheritedpaths do
begin
fv := v+s+".tfm";
if fileexists("",fv) then
begin
oa := new TTmfParser();
oa.ScriptPath := fv;
nd := oa.gettreeasobject();
if ifobj(nd) then
begin
nd.setinhertedpaths(finheritedpaths);
nd.initinherited();
end
finheritednode := nd;
addinheritednode(nd);
return ;
end
end
end
end
function addinheritednode(nd); //处理继承的节点
begin
for i,v in fobjects.IndexNames() do
begin
ov := fobjects[v];
if ov.ifinherited then
begin
if ifobj(nd) then
begin
fd := nd.getnodebyname(ov.fnodename);
if fd then
begin
ov.finheritednode :=fd;
end else //不在
begin
fobjects.deleteindex(v);
end
end else
begin
fobjects.deleteindex(v);
end
end
ov.addinheritednode(nd);
end
end
function getnodebyname(sb);//获得节点
begin
if fobjects.HaveIndex(sb) then
begin
o := fobjects[sb];
return o;
end
for i,v in fobjects.IndexNames() do
begin
o := fobjects[v];
r := o.getnodebyname(sb);
if r then return r;
end
end
function addobject(nd);
begin
if nd then
begin
fobjects[nd.fnodename] := nd;
end
end
function delnodebyname(sb);//删除节点
begin
if fobjects.HaveIndex(sb) then
begin
o := fobjects[sb];
fobjects.deleteindex(sb);
return o;
end
for i,v in fobjects.IndexNames() do
begin
o := fobjects[v];
r := delnodebyname(sb);
if r then return r;
end
end
function setprovalue(p,v,t);//设置属性
begin
if not ifstring(p) then return ;
if ifnil(v) then fpropertys.deleteindex(p);
vobj := fpropertys[p];
if not vobj then
begin
vobj := new tproper(nil,true);
fpropertys[p] := vobj;
end
vobj.fvalue := v;
vobj.ftype := t;
end
function setobjpropvalue(sb,p,v,t);//设置值
begin
if fobjects.HaveIndex(sb) then
begin
o := fobjects[sb];
o.setprovalue(p,v,t);
return o;
end
for i,v in fobjects.IndexNames() do
begin
o := fobjects[v];
r := o.setobjpropvalue(sub,p,v,t);
if r then return r;
end
end
function getallpropertys();//获得所有属性
begin
if not exts then exts := array();
if finheritednode then
begin
r := finheritednode.getallpropertys();
for i,v in r.IndexNames() do
begin
r[i].finh := true;
end
end
if not r then r := new tstrindexarray();
for i,v in fpropertys.IndexNames() do
begin
r[i] := fpropertys[v];
end
return r;
end
function inheritedstr(n,t,ht,h);
begin
if ifnil(n) then n := fnodename;
if ifnil(t) then t := fnodetype;
ws := "";
if not(h>=0) then h := 0;
for i:= 0 to h-1 do
begin
ws+=" ";
end
r := ws+"inherited "+n+":"+t;
if ht then r+="("+ht+")";
r+="\r\n";
for i,v in fobjects.IndexNames() do
begin
vo := fobjects[v];
r+=vo.inheritedstr(nil,nil,nil,h+1);
end
r+="\r\n";
r+=ws+"end\r\n";
return r;
end
ifinherited;
finheritedname;
finheritednode;
fnodetype; //属性,对象
fnodename;
fobjects;
private
fpropertys;
finheritedpaths;
end
function tablelines(str,n);
begin
lines := str2array(str,"\r\n");