2418 lines
58 KiB
Plaintext
2418 lines
58 KiB
Plaintext
Unit UVCPropertyTypesPersistence;
|
|
interface
|
|
uses utslvclauxiliary;//,utslvclgdi;
|
|
{**
|
|
@explan(说明) 可视控件属性处理库 %%
|
|
**}
|
|
////////////tmf文件相关//////////////////////////////////////////////
|
|
/////////////tmf字符串解析///////////////////////
|
|
function RegComponentPropertyType(vc);
|
|
function GetComponentPropertyType(n);
|
|
type TTmfParserbase = class
|
|
{**
|
|
@explan(说明) 解析基类,提供基础类型,提供类型常量
|
|
目前使用的常量有 TT_NUM,TT_BIN,TT_STR,TT_SYM%%
|
|
**}
|
|
Static Fsok;
|
|
static TT_NUM;//数字
|
|
static TT_LLB;//大括号
|
|
static TT_RLB;//大括号
|
|
static TT_LSB; //(
|
|
static TT_RSB; //)
|
|
static TT_STR;//字符串
|
|
static TT_SYM;//符号
|
|
static TT_POI;//点 .
|
|
static TT_SIG;// : + - :< > =
|
|
static TT_BNK;//空白 \r \n \t
|
|
static TT_ITEM;
|
|
static TT_RMB;
|
|
static TT_LMB;
|
|
static TT_SET;
|
|
static TT_COLL;
|
|
static TT_LIST;
|
|
static TT_BIN;
|
|
static TT_BOOL;
|
|
static TT_IDENT;
|
|
static TT_HEX;
|
|
static TT_COMP;
|
|
public
|
|
class function sinit();virtual;
|
|
begin
|
|
if not Fsok then
|
|
begin
|
|
TT_NUM := 1; //数字
|
|
TT_LLB := 2; //大括号
|
|
TT_RLB := 3; //大括号
|
|
TT_LSB := 4; //(
|
|
TT_RSB := 5; //)
|
|
TT_STR := 6; //字符串
|
|
TT_SYM := 7; //符号
|
|
TT_POI := 8; //点 .
|
|
TT_SIG := 9; // : + - :< > =
|
|
TT_BNK := 10; //空白 \r \n \t
|
|
TT_ITEM := 11;
|
|
TT_LMB := 12;
|
|
TT_RMB := 13;
|
|
TT_SET := 14;
|
|
TT_HASH := 15;
|
|
TT_COLL := 0x10;
|
|
TT_BIN := 0x11;
|
|
TT_BOOL := 0x12;
|
|
TT_LIST := 0x13;
|
|
TT_IDENT := 0x14;
|
|
TT_HEX := 0x15;
|
|
TT_COMP := 0x16;
|
|
Fsok := true;
|
|
end
|
|
end
|
|
class function PError(msg,lev);
|
|
begin
|
|
//messagebox(msg,"解析错误",1);
|
|
end
|
|
function create();virtual;
|
|
begin
|
|
sinit();
|
|
end
|
|
|
|
end
|
|
type TTmfParserToken = class(TTmfParserbase)
|
|
{**
|
|
@explan(说明) tmf 文件解析token %%
|
|
**}
|
|
private
|
|
FScript;
|
|
FScriptLen;
|
|
FCurrent;
|
|
FNumbers;
|
|
FHexnumbers;
|
|
Ffloat;
|
|
FTokens;
|
|
FSplitter; //分隔符
|
|
FSyms; //符号
|
|
FNumberChar;
|
|
FHexChar;
|
|
Function SetScript(S);//设置文本
|
|
begin
|
|
IF FScript <> S then
|
|
begin
|
|
FScriptLen := 0;
|
|
FScript := s;
|
|
FCurrent := 1;
|
|
FTokens := array();
|
|
if ifstring(s)then
|
|
begin
|
|
FScriptLen := length(s)+1;
|
|
end
|
|
end
|
|
end
|
|
public
|
|
class function sinit();override;//初始化
|
|
begin
|
|
inherited;
|
|
end
|
|
function cchar();
|
|
begin
|
|
{**
|
|
@explan(说明) 获得当前字符,并且位置移动 %%
|
|
**}
|
|
r := FScript[FCurrent];
|
|
FCurrent++;
|
|
return r;
|
|
end
|
|
Function cback(N);
|
|
begin
|
|
{**
|
|
@explan(说明) 倒退位置 %%
|
|
**}
|
|
if not(n>0)then n := 1;
|
|
FCurrent -= n;
|
|
end
|
|
Function whileok();
|
|
begin
|
|
return FCurrent<FScriptLen;
|
|
end
|
|
class function delct(r,ct,len,n);//处理字符
|
|
begin
|
|
{**
|
|
@explan(说明) 处理当前字符 %%
|
|
**}
|
|
if n=TT_STR then
|
|
begin
|
|
r[len++]:= array(ct,n);
|
|
ct := "";
|
|
end else
|
|
begin
|
|
if ct="" then return ;
|
|
if n=TT_NUM then
|
|
begin
|
|
if pos(".",ct)then ct := strtofloat(ct);
|
|
else ct := strtoint(ct);
|
|
end else
|
|
if n=TT_SYM then ct := lowercase(ct);
|
|
r[len++]:= array(ct,n);
|
|
ct := "";
|
|
end
|
|
end
|
|
|
|
function gettokens();//解析字符
|
|
begin
|
|
{**
|
|
@explan(说明) 解析token %%
|
|
**}
|
|
if FTokens then return FTokens;
|
|
r := array();
|
|
len := 0;
|
|
ct := ""; //当前字符
|
|
kb := array(" ":1,"\t":1,"\r":1,"\n":1);
|
|
fgf := array(' ':1,'\t':1,"\r":1,"\n":1,";":1,",":1);
|
|
sns := array("=":1,":":1,"(":1,")":1,"<":1,">":1,"[":1,"]":1);
|
|
while whileok() do
|
|
begin
|
|
c := cchar();
|
|
if fgf[c] then // in array(' ','\t',"\r","\n",";",",")
|
|
begin
|
|
if ct="0" then delct(r,ct,len,TT_NUM);
|
|
else delct(r,ct,len,TT_SYM);
|
|
end else
|
|
if sns[c]then
|
|
begin
|
|
delct(r,ct,len,TT_SYM);
|
|
delct(r,c,len,TT_SIG);
|
|
end else
|
|
if c='"' or c="'" then
|
|
begin
|
|
delct(r,ct,len,TT_SYM);
|
|
delct(r,Pstring(c),len,TT_STR);
|
|
end else
|
|
if c="0" and (not ct)then
|
|
begin
|
|
tv := PHexNumber();
|
|
if tv="d" then
|
|
begin
|
|
ct := c;
|
|
end else
|
|
delct(r,tv,len,TT_HEX);
|
|
end else
|
|
if(FNumbers[c]) and(not(ct))then
|
|
begin
|
|
//delct(r,ct,len,TT_SYM);
|
|
v := c+Pnumber();
|
|
delct(r,v,len,TT_NUM);
|
|
end else
|
|
if c="{" then
|
|
begin
|
|
delct(r,ct,len,TT_SYM);
|
|
delct(r,c,len,TT_SIG);
|
|
ct:="";
|
|
while whileok() do
|
|
begin
|
|
c := cchar();
|
|
if kb[c] then continue;
|
|
if c="}" then
|
|
begin
|
|
delct(r,ct,len,TT_BIN);
|
|
delct(r,c,len,TT_SIG);
|
|
break;
|
|
end else
|
|
begin
|
|
ct+=c;
|
|
end
|
|
end
|
|
end else
|
|
if c="-" then
|
|
begin
|
|
delct(r,ct,len,TT_SYM);
|
|
delct(r,c+Pnumber(),len,TT_NUM);
|
|
end else
|
|
begin
|
|
ct += c;
|
|
end
|
|
end
|
|
FTokens := r;
|
|
return r;
|
|
end
|
|
function Pstring(ltk); //字符串
|
|
begin
|
|
{**
|
|
@explan(说明) 解析字符串 %%
|
|
**}
|
|
rtk := ltk;
|
|
r := "";
|
|
while FCurrent <= FScriptLen do
|
|
begin
|
|
c := cchar();
|
|
if c="\\" then
|
|
begin
|
|
c := cchar();
|
|
case c of
|
|
"r":r += "\r";
|
|
"n":r += "\n";
|
|
"t":r += "\t";
|
|
"b":r += "\b";
|
|
else r += c;
|
|
end;
|
|
continue;
|
|
end
|
|
if c=ltk then break;
|
|
r += c;
|
|
end
|
|
return r;
|
|
end
|
|
function PHexNumber();//16进制解析
|
|
begin
|
|
{**
|
|
@explan(说明)解析16进制数
|
|
**}
|
|
c := cchar();
|
|
c := lowercase(c);
|
|
//its := inttostr(0 -> 9)union array("a","b","c","d","e","f");
|
|
r := "";
|
|
case c of
|
|
"x":
|
|
begin
|
|
while whileok() do
|
|
begin
|
|
c := cchar();
|
|
if not(FHexnumbers[c])then
|
|
begin
|
|
cback();
|
|
break;
|
|
end
|
|
r += c;
|
|
end
|
|
if r then return eval(&("0x"+r));
|
|
return 0;
|
|
end
|
|
"l":
|
|
begin
|
|
return 0;
|
|
end
|
|
else
|
|
begin
|
|
cback();
|
|
return "d";
|
|
end
|
|
|
|
|
|
end;
|
|
if c="x" then
|
|
begin
|
|
while whileok() do
|
|
begin
|
|
c := cchar();
|
|
if not(FHexnumbers[c])then
|
|
begin
|
|
cback();
|
|
break;
|
|
end
|
|
r += c;
|
|
end
|
|
if r then
|
|
return eval(&("0x"+r));
|
|
return 0;
|
|
end else
|
|
begin
|
|
cback();
|
|
return "d";
|
|
end
|
|
end
|
|
function Pnumber(); //数字
|
|
begin
|
|
{**
|
|
@explan(说明) 解析数字 %%
|
|
**}
|
|
r := "";
|
|
kb := array(" ":1,"\t":1,"\r":1,"\n":1);
|
|
while whileok() do
|
|
begin
|
|
c := cchar();
|
|
if(kb[c] )then break;
|
|
if c="l" or c="L" then
|
|
begin
|
|
cchar();
|
|
break;
|
|
end
|
|
if not(c="." or FNumbers[c])then break;
|
|
r += c;
|
|
end
|
|
cback();
|
|
return r;
|
|
end
|
|
function create();override;
|
|
begin
|
|
inherited;
|
|
//FNumbers := inttostr(0 -> 9);
|
|
FNumbers := array();
|
|
FHexnumbers := array();
|
|
for i := 0 to 9 do
|
|
begin
|
|
FNumbers[inttostr(i)] := true;
|
|
FHexnumbers[inttostr(i)] := true;
|
|
end
|
|
for i,v in array("A","B","C","D","E","F") do
|
|
begin
|
|
FHexnumbers[v] := true;
|
|
end
|
|
for i,v in array("a","b","c","d","e","f") do
|
|
begin
|
|
FHexnumbers[v] := true;
|
|
end
|
|
//Ffloat := FNumbers union array(".");
|
|
FSplitter := array(' ','\t',"\r","\n",";",",");
|
|
FSyms := array("=",":","(",")","<",">","[","]");
|
|
FNumberChar := inttostr(0 -> 9);
|
|
FHexChar := FNumberChar union array("a","b","c","d","e","f",
|
|
"A","B","C","D","E","F");
|
|
end
|
|
property Script read FScript write SetScript;
|
|
{**
|
|
@param(script)(string) 带解析的脚本 %%
|
|
**}
|
|
end
|
|
type TTmfParser = class(TTmfParserbase)
|
|
{**
|
|
@explan(说明)tmf文件解析 %%
|
|
**}
|
|
fssourdirs;
|
|
private
|
|
FCurrent;
|
|
FTokens;
|
|
FTokenlen;
|
|
FParsers;
|
|
FTree;
|
|
ftreeobj;
|
|
FS;
|
|
FCharDiscrimi;
|
|
function SetScriptPath(fn);
|
|
begin
|
|
if ifstring(fn)then
|
|
begin
|
|
size := filesize("",fn); //获取文件大小
|
|
if readFile(rwraw(),"",fn,0,size,data)then
|
|
begin
|
|
Script := data;
|
|
end else Script := "";
|
|
end
|
|
end
|
|
function SetScript(s);
|
|
begin
|
|
if (fs <> s) and ifstring(s) then
|
|
begin
|
|
FParsers.Script := s;
|
|
//setprofiler(1+2+4+8);
|
|
FTokens := FParsers.gettokens();
|
|
FTokenlen := length(FTokens);
|
|
FCurrent := 0;
|
|
FTree := nil;
|
|
ftreeobj := nil;
|
|
//d := getprofilerinfo();
|
|
//exportfile(ftstream(),"","d:\\tst\\abc.stm",d);
|
|
end
|
|
end
|
|
//public
|
|
|
|
function whileok();
|
|
begin
|
|
return FCurrent<FTokenlen;
|
|
end
|
|
function ctoken(tv,tt);
|
|
begin
|
|
tv := tt := nil;
|
|
r := FTokens[FCurrent++];
|
|
if ifarray(r)then
|
|
begin
|
|
tv := r[0];
|
|
tt := r[1];
|
|
end
|
|
end
|
|
function btoken(n);
|
|
begin
|
|
if not(n>0)then n := 1;
|
|
FCurrent -= n;
|
|
end
|
|
public
|
|
function samplevalue(v);
|
|
begin
|
|
{**
|
|
@expaln(说明) 简化结果%%
|
|
@param(v)(array) 标记类型的数组 %%
|
|
**}
|
|
r := nil;
|
|
if ifarray(v)and v then
|
|
begin
|
|
case v["type"]of
|
|
TT_STR,TT_NUM,TT_SYM,TT_BIN,TT_HEX:
|
|
begin
|
|
r := v["value"];
|
|
end
|
|
TT_SET,TT_LIST:
|
|
begin
|
|
r := array();
|
|
for ii,vv in v["value"] do
|
|
begin
|
|
r[ii]:= call(thisfunction,vv);
|
|
end
|
|
end
|
|
TT_COLL:
|
|
begin
|
|
r := array();
|
|
for ii,vv in v["value"] do
|
|
begin
|
|
ri := array();
|
|
for iii,vvv in vv do
|
|
begin
|
|
ri[vvv["name"]]:= call(thisfunction,vvv);
|
|
end
|
|
r[ii]:= ri;
|
|
end
|
|
end
|
|
TT_ITEM:
|
|
begin
|
|
r := array();
|
|
for ii,vv in v["value"] do
|
|
begin
|
|
r[vv["name"]]:= call(thisfunction,vv);
|
|
end
|
|
end
|
|
end;
|
|
end
|
|
return r;
|
|
end
|
|
|
|
|
|
function create();override;
|
|
begin
|
|
inherited;
|
|
FCharDiscrimi := new TCharDiscrimi();
|
|
FCurrent := 0;
|
|
FTokens := array();
|
|
FParsers := new TTmfParserToken();
|
|
end
|
|
function GetAllSubObjects(obj,r);
|
|
begin
|
|
if not obj then obj := gettree();
|
|
if not ifarray(r)then r := array();
|
|
for i,v in obj["object"] do
|
|
begin
|
|
r[length(r)]:= v["name"];
|
|
call(thisfunction,v,r);
|
|
end
|
|
return r;
|
|
end
|
|
function gettree();
|
|
begin
|
|
{**
|
|
@explan(说明) 获得语法树%%
|
|
**}
|
|
if FTree then return FTree;
|
|
IF FTokens then return FTree := createobj();
|
|
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);//tsl转换为tfm字符串格式
|
|
begin
|
|
if not ifarray(d)then return totfmstr(d);
|
|
rows := mrows(d,1);
|
|
ifobj := false;
|
|
for i,v in rows do
|
|
begin
|
|
if i <> v then
|
|
begin
|
|
ifobj := true;
|
|
break;
|
|
end
|
|
end
|
|
if ifobj then
|
|
begin
|
|
r := "<\r\n";
|
|
for i,v in d do
|
|
begin
|
|
//if ifstring(i)then si := i;
|
|
//else si := tostn(i);
|
|
r += tablelines(totfmstr(i)+"="+call(thisfunction,v)," ");
|
|
//r+="\r\n";
|
|
end
|
|
r += " >\r\n";
|
|
end else
|
|
begin
|
|
r := "[";
|
|
its := "";
|
|
itsl := 0;
|
|
for i,v in d do
|
|
begin
|
|
its := call(thisfunction,v);
|
|
itsl += length(its);
|
|
r += its;
|
|
if itsl>50 then
|
|
begin
|
|
itsl := 0;
|
|
r += "\r\n";
|
|
end else
|
|
r += " ";
|
|
end
|
|
r += "]\r\n";
|
|
end
|
|
return r;
|
|
end
|
|
private //解析相关
|
|
function totfmstr(v);
|
|
begin
|
|
if ifnil(v)then return tostn("");
|
|
if ifstring(v)and(not v)then return tostn("");
|
|
if ifstring(v)then
|
|
begin
|
|
if v in array({"item",}"end","object","inherited")then return tostn(v);
|
|
if FCharDiscrimi.IsLowercaseVariableName(v)then
|
|
begin
|
|
return v;
|
|
end else
|
|
return tostn(v);
|
|
end else
|
|
return tostn(v);
|
|
end
|
|
function GetItem();
|
|
begin
|
|
while whileok() do
|
|
begin
|
|
ctoken(tv,tt);
|
|
{if tv="item" and(tt <> TT_STR)then return samplevalue(array("value":getabitem(tv),"type":TT_ITEM));
|
|
else }if tv="<" and(tt <> TT_STR)then
|
|
begin
|
|
v := getabitem(tv,fff);
|
|
lx := ffff?TT_COLL:TT_ITEM;
|
|
return samplevalue(array("value":v,"type":lx));
|
|
end
|
|
end
|
|
end
|
|
function createobj();
|
|
begin
|
|
{**
|
|
@explan(说明) 获取对象 %%
|
|
**}
|
|
while whileok() do
|
|
begin
|
|
ctoken(tv,tt);
|
|
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();
|
|
begin
|
|
{**
|
|
@explan(说明) 获得对象 %%
|
|
**}
|
|
r := array();
|
|
ctoken(tv,tt);
|
|
r["name"]:= tv;
|
|
r["type"]:= TT_COMP;
|
|
ctoken(tv,tt);
|
|
if tv <> ":" then PError("类对象没有:",1);
|
|
ctoken(tv,tt);
|
|
r["class"]:= tv;
|
|
rt := getmembers();
|
|
r["property"]:= rt["property"];
|
|
r["object"]:= rt["object"];
|
|
r["parent"] := rt["parent"];
|
|
return r;
|
|
end
|
|
function GetSampleValue();
|
|
begin
|
|
{**
|
|
@explan(说明) 获得简约形式的tfm数据%%
|
|
@return(any) 天软类型 %%
|
|
**}
|
|
getpvalue(val,lx);
|
|
return SampleValue(array("value":val,"type":lx));
|
|
end
|
|
function getpvalue(val,lx);
|
|
begin
|
|
ctoken(tv,tt);
|
|
lx := tt;
|
|
{if tv="item" and(tt <> TT_STR)then
|
|
begin
|
|
lx := TT_ITEM;
|
|
val := getabitem();
|
|
end else}
|
|
if tv="[" and(tt <> TT_STR)then
|
|
begin
|
|
lx := TT_SET;
|
|
val := getset();
|
|
end else
|
|
if tv="<" and(tt <> TT_STR)then
|
|
begin
|
|
val := getabitem(tv,fff); // getab();
|
|
if fff then lx := TT_COLL;
|
|
else lx := TT_ITEM; //TT_COLL;
|
|
end else
|
|
if tv="(" and(tt <> TT_STR)then
|
|
begin
|
|
val := getsb();
|
|
lx := TT_LIST;
|
|
end else
|
|
if tv="{" and(tt <> TT_STR)then
|
|
begin
|
|
val := getlb();
|
|
lx := TT_BIN;
|
|
end else
|
|
if tv="true" and(tt <> TT_STR)then
|
|
begin
|
|
val := true;
|
|
lx := TT_NUM;
|
|
end else
|
|
if tv="false" and(tt <> TT_STR)then
|
|
begin
|
|
val := false;
|
|
lx := TT_NUM;
|
|
end else
|
|
val := tv;
|
|
end
|
|
function getmembers();
|
|
begin
|
|
{**
|
|
@explan(说明) 获得成员 %%
|
|
@return(array) 包括 object property 下标 %%
|
|
**}
|
|
r := array();
|
|
objlen := 0;
|
|
prolen := 0;
|
|
rl := 0;
|
|
pp := 0;
|
|
while whileok() do
|
|
begin
|
|
ctoken(tv,tt);
|
|
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
|
|
begin
|
|
return r;
|
|
end else
|
|
if tv="=" and tt <> TT_STR then
|
|
begin
|
|
if pp then //变量
|
|
begin
|
|
getpvalue(val,lx);
|
|
r["property"][prolen++]:= array("name":pp,"value":val,"type":lx);
|
|
pp := 0;
|
|
end else
|
|
begin
|
|
PError("=前面没有符号",1);
|
|
end
|
|
end else
|
|
if tt=TT_SYM then
|
|
begin
|
|
if pp then
|
|
begin
|
|
//PError("非OBject见",1);
|
|
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
|
|
if tt=TT_STR then
|
|
begin
|
|
if not pp then
|
|
begin
|
|
pp := tv;
|
|
end
|
|
end else
|
|
PError("其他错误",1);
|
|
end
|
|
return r;
|
|
end
|
|
function getset();
|
|
begin
|
|
r := array();
|
|
rl := 0;
|
|
while whileok() do
|
|
begin
|
|
ctoken(tv,tt);
|
|
if tv="]" and tt <> TT_STR then return r;
|
|
//if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
|
|
else if tv="<" and tt <> TT_STR then
|
|
begin
|
|
v := getabitem(tv,fff);
|
|
lx := fff?TT_COLL:TT_ITEM;
|
|
r[rl++]:= array("value":v,"type":lx);
|
|
end else
|
|
if tv="[" and tt <> TT_STR then r[rl++]:= array("value":getset(),"type":TT_SET);
|
|
else r[rl++]:= array("value":tv,"type":tt);
|
|
end
|
|
end
|
|
function getabitem(tp,ifitem);
|
|
begin
|
|
if not ifstring(tp)then endtp := "end";
|
|
//else if tp="item" then endtp := "end";
|
|
else if tp="<" then endtp := ">";
|
|
else PError("dict错误",1);
|
|
r := array();
|
|
rl := 0;
|
|
ifitem := false;
|
|
while whileok() do
|
|
begin
|
|
ctoken(tv,tt);
|
|
if tv=endtp {"end"}and tt <> TT_STR then return r;
|
|
p := tv;
|
|
ptt := tt;
|
|
ctoken(tv,tt);
|
|
if tv="=" then
|
|
begin
|
|
getpvalue(val,lx);
|
|
if ifnil(val)or ifnil(lx)then PError("item无值",1);
|
|
r[rl++]:= array("name":p,"value":val,"type":lx);
|
|
end else
|
|
{if p="item" and ptt <> TT_STR and(length(r)<1)then
|
|
begin
|
|
ifitem := true;
|
|
btoken(2);
|
|
return getab();
|
|
end else}
|
|
PError("item没有=",1);
|
|
end
|
|
end
|
|
function getab();
|
|
begin
|
|
{**
|
|
@explan(说明) 获得尖括号类容 %%
|
|
**}
|
|
r := array();
|
|
rl := 0;
|
|
while whileok() do
|
|
begin
|
|
ctoken(tv,tt);
|
|
if tv=">" then
|
|
begin
|
|
return r;
|
|
end else
|
|
{if tv="item" and tt <> TT_STR then
|
|
begin
|
|
r[rl++]:= getabitem();
|
|
end else}
|
|
begin
|
|
return PError("<>内容错误",1);
|
|
end
|
|
end
|
|
return r;
|
|
end
|
|
function getsb();
|
|
begin
|
|
{**
|
|
@explan(说明) 获得小括号内容 %%
|
|
**}
|
|
r := array();
|
|
rl := 0;
|
|
while whileok() do
|
|
begin
|
|
ctoken(tv,tt);
|
|
if(tv="(")and(tt <> TT_STR)then
|
|
begin
|
|
r[rl++]:= getsb();
|
|
end else
|
|
if(tv=")")and(tt <> TT_STR)then
|
|
begin
|
|
return r;
|
|
end else
|
|
{if tv="item" and tt <> TT_STR then r[rl++]:= array("value":getabitem(tv),"type":TT_ITEM);
|
|
else }if tv="<" and tt <> TT_STR then
|
|
begin
|
|
v := getabitem(tv,fff);
|
|
lx := fff?TT_COLL:TT_ITEM;
|
|
r[rl++]:= array("value":v,"type":lx);
|
|
end else
|
|
begin
|
|
r[rl++]:= array("value":tv,"type":tt);
|
|
end
|
|
end
|
|
end
|
|
function getlb();
|
|
begin
|
|
{**
|
|
@explan(说明) 获得大括号内容 %%
|
|
**}
|
|
r := "";
|
|
while whileok() do
|
|
begin
|
|
ctoken(tv,tt);
|
|
if tv="}" then
|
|
begin
|
|
return r;
|
|
end
|
|
r += tv;
|
|
end
|
|
return r;
|
|
end
|
|
public
|
|
property Script write SetScript;
|
|
property ScriptPath write SetScriptPath;
|
|
{**
|
|
@param(Script)(string) 设置脚本文件 %%
|
|
@param(ScriptPath)(string) 脚本路径 %%
|
|
**}
|
|
end
|
|
|
|
////////////tmf文件相关//////////////////////////////////////////////
|
|
type TPropertyType=class
|
|
private
|
|
FTmfParser;
|
|
function Gettfmparser();
|
|
begin
|
|
if not FTmfParser then FTmfParser := new TTmfParser();
|
|
return FTmfParser;
|
|
end
|
|
public
|
|
function EditType();virtual;
|
|
begin
|
|
{**
|
|
@explan(说明)类型名称 %%
|
|
@return(string) 字符串 %%
|
|
**}
|
|
return nil;
|
|
end
|
|
function FormatEdit(d,modify);virtual;
|
|
begin
|
|
{**
|
|
@explan(说明)控件数据转换为修改表格展示数据 %%
|
|
@param(d)(any) 数据 %%
|
|
@param(modify)(bool) 是否可以修改 %%
|
|
**}
|
|
return array("type":"object","class":EditType(),"value":d,"edit":modify);
|
|
end
|
|
function UnformatEdit(d);virtual;
|
|
begin
|
|
{**
|
|
@explan(说明)修改表格数据转换为设计器控件数据 %%
|
|
**}
|
|
return d;
|
|
end
|
|
function FormatTMF(d);virtual;
|
|
begin
|
|
{**
|
|
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
|
**}
|
|
return d;
|
|
end
|
|
function TmfToNode(d);virtual;
|
|
begin
|
|
{**
|
|
@explan(说明) 读取tfm数据到设计器控件 %%
|
|
**}
|
|
return d;
|
|
end
|
|
function ReadTMF(d,o);virtual;
|
|
begin
|
|
{**
|
|
@explan(说明) 读取tfm 数据实际窗口
|
|
**}
|
|
return d;
|
|
end
|
|
function LazyProperty();virtual;
|
|
begin
|
|
{**
|
|
@explan(说明) 是否为延迟设置属性%%
|
|
@return(bool)
|
|
**}
|
|
return Fislazy;
|
|
end
|
|
function IfComponent();virtual;
|
|
begin
|
|
{**
|
|
@explan(说明) 是否为控件%%
|
|
**}
|
|
return false;
|
|
end
|
|
property TmfParser:TTmfParser read Gettfmparser;
|
|
property islazy read Fislazy write Fislazy; //是否后天就数据
|
|
private
|
|
Fislazy;
|
|
end
|
|
type TPropertyNatural=class(TPropertyType) //自然数
|
|
function EditType();override;
|
|
begin
|
|
return "natural";
|
|
end
|
|
function FormatTMF(d);virtual;
|
|
begin
|
|
{**
|
|
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
|
**}
|
|
return tostn(d);
|
|
end
|
|
end
|
|
type TPropertyInteger=class(TPropertyNatural) //整数
|
|
function EditType();override;
|
|
begin
|
|
return "integer";
|
|
end
|
|
end
|
|
type TPropertyString=class(TPropertyNatural) //字符串
|
|
function EditType();override;
|
|
begin
|
|
return "string";
|
|
end
|
|
end
|
|
type TPropertyColor=class(TPropertyType) //颜色
|
|
function EditType();override;
|
|
begin
|
|
return "color";
|
|
end
|
|
function FormatTMF(d);virtual;
|
|
begin
|
|
{**
|
|
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
|
**}
|
|
if ifnumber(d)then return format("0x%x",d);
|
|
end
|
|
end
|
|
type TPropertyDirectory=class(TPropertyType) //目录
|
|
function EditType();override;
|
|
begin
|
|
return "directory";
|
|
end
|
|
function FormatTMF(d);virtual;
|
|
begin
|
|
return tostn(d);
|
|
end
|
|
end
|
|
type TPropertyFileName=class(TPropertyDirectory) //文件
|
|
function EditType();override;
|
|
begin
|
|
return "filename";
|
|
end
|
|
end
|
|
type TPropertyFont=class(TPropertyType) //字体
|
|
function EditType();override;
|
|
begin
|
|
return "font";
|
|
end
|
|
function FormatEdit(d,modify);override;
|
|
begin
|
|
r := inherited;
|
|
if ifobj(d)then
|
|
begin
|
|
try
|
|
r["value"]:= d.fontinfo;
|
|
except
|
|
end;
|
|
end
|
|
return r;
|
|
end
|
|
function TmfToNode(d);override;
|
|
begin
|
|
//echo tostn(d);
|
|
return d;
|
|
end
|
|
function LazyProperty();override;
|
|
begin
|
|
return true;
|
|
end
|
|
function FormatTMF(d);virtual;
|
|
begin
|
|
return TmfParser.tslasItem(d);
|
|
end
|
|
end
|
|
type TPropertyHotkey=class(TPropertyType) //热键
|
|
function EditType();override;
|
|
begin
|
|
return "thotkey";
|
|
end
|
|
function FormatTMF(d);virtual;
|
|
begin
|
|
return tostn(d);
|
|
end
|
|
end
|
|
type TPropertyBool=class(TPropertyType) //bool
|
|
function EditType();override;
|
|
begin
|
|
return "bool";
|
|
end
|
|
function FormatEdit(d,modify);override;
|
|
begin
|
|
{**
|
|
@explan(说明)控件数据转换为修改表格数据 %%
|
|
**}
|
|
r := inherited;
|
|
if not ifnil(d)then
|
|
begin
|
|
r["value"]:= d?true:false;
|
|
end
|
|
return r;
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
{**
|
|
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
|
**}
|
|
return d?"true":"false";
|
|
end
|
|
end
|
|
type TPropertyTypeEvent=class(TPropertyType) //事件函数
|
|
function EditType();override;
|
|
begin
|
|
return "eventhandler";
|
|
end
|
|
function ReadTMF(d,o);override;
|
|
begin
|
|
try
|
|
r := FindFunction(d,o);
|
|
return r;
|
|
except
|
|
return 0;
|
|
end;
|
|
end
|
|
end
|
|
type TPropertyTypeSysCursor=class(UniObjectMember)
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new tsyscursor();
|
|
end
|
|
function EditType();override;
|
|
begin
|
|
return "syscursor";
|
|
end
|
|
private
|
|
type tsyscursor=class
|
|
OCR_WAIT;
|
|
OCR_CROSS;
|
|
OCR_UP;
|
|
OCR_SIZE;
|
|
OCR_SIZENWSE;
|
|
OCR_SIZENESW;
|
|
OCR_SIZEWE;
|
|
OCR_SIZENS;
|
|
OCR_SIZEALL;
|
|
OCR_ICOCUR;
|
|
OCR_NO;
|
|
OCR_HAND;
|
|
OCR_APPSTARTING;
|
|
OCR_IBEAM;
|
|
function Create();
|
|
begin
|
|
OCR_WAIT := 32514;
|
|
OCR_CROSS := 32515;
|
|
OCR_UP := 32516;
|
|
OCR_SIZE := 32640;
|
|
OCR_SIZENWSE := 32642;
|
|
OCR_SIZENESW := 32643;
|
|
OCR_SIZEWE := 32644;
|
|
OCR_SIZENS := 32645;
|
|
OCR_SIZEALL := 32646;
|
|
OCR_ICOCUR := 32647;
|
|
OCR_NO := 32648;
|
|
OCR_HAND := 32649;
|
|
OCR_APPSTARTING := 32650;
|
|
OCR_IBEAM := 32513;
|
|
end
|
|
end
|
|
end
|
|
type TPropertyVarible=class(TPropertyType) //变量
|
|
Function EditType();override;
|
|
begin
|
|
return "variable";
|
|
end
|
|
function LazyProperty();override;
|
|
begin
|
|
return true;
|
|
end
|
|
function ReadTMF(d,o);override;
|
|
begin
|
|
if not ifobj(o)then return 0;
|
|
try
|
|
//echo d,"===",(o.classinfo)["classname"],"****\r\n";
|
|
r := invoke(o,d);
|
|
return r;
|
|
except
|
|
if d like(o.classinfo)["classname"]then return o;
|
|
end;
|
|
return 0;
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
if not ifobj(d)then return d;
|
|
try
|
|
r := invoke(d,"name");
|
|
if ifstring(r)then return r;
|
|
except
|
|
return nil;
|
|
end
|
|
return nil;
|
|
end
|
|
end
|
|
type TPropertyaction=class(TPropertyVarible) //action
|
|
Function EditType();override;
|
|
begin
|
|
return "taction";
|
|
end
|
|
function IfComponent();override;
|
|
begin
|
|
{**
|
|
@explan(说明) 是否为控件%%
|
|
**}
|
|
return true;
|
|
end
|
|
end
|
|
type TPropertyTray=class(TPropertyaction) //托盘
|
|
Function EditType();override;
|
|
begin
|
|
return "ttray";
|
|
end
|
|
end
|
|
type TPropertyPopupMenu=class(TPropertyaction) //右键菜单
|
|
Function EditType();override;
|
|
begin
|
|
return "tpopupmenu";
|
|
end
|
|
end
|
|
type TPropertyMainMenu=class(TPropertyaction) //主菜单
|
|
Function EditType();override;
|
|
begin
|
|
return "tmainmenu";
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
try
|
|
return d.Name;
|
|
except
|
|
end
|
|
return false;
|
|
end
|
|
end
|
|
type TPropertyImagelist=class(TPropertyaction) //imagelist
|
|
Function EditType();override;
|
|
begin
|
|
return "tcontrolimagelist";
|
|
end
|
|
end
|
|
type TPropertyhgt=class(TPropertyaction) //imagelist
|
|
Function EditType();override;
|
|
begin
|
|
return "thighlighter";
|
|
end
|
|
end
|
|
type TPropertyImagesData=class(TPropertyType) //imagedata,作为imagelist的数据
|
|
Function EditType();override;
|
|
begin
|
|
return "imagesdata";
|
|
end
|
|
function TmfToNode(d);override;
|
|
begin
|
|
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
|
if not cbmp then return ;
|
|
if ifstring(d)then
|
|
begin
|
|
r := HexFormatStrToTsl(d);
|
|
if ifarray(r)and r["type"]="bmps" then
|
|
begin
|
|
ret := array();
|
|
for i,v in r["items"] do
|
|
begin
|
|
bmp := createobject(cbmp);
|
|
bmp.Readvcon(v);
|
|
ret[i]:= bmp;
|
|
end
|
|
return array("type":"bmps","items":ret);
|
|
return ret;
|
|
end
|
|
end
|
|
end
|
|
function LazyProperty();override;
|
|
begin
|
|
return true;
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
{**
|
|
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
|
**}
|
|
r := array("type":"bmps");
|
|
its := array();
|
|
if ifarray(d)and d["type"]="bmps" then
|
|
begin
|
|
for i,v in d["items"] do
|
|
begin
|
|
dv := v.tovcon();
|
|
its[length(its)]:= dv;
|
|
end
|
|
end
|
|
r["items"]:= its;
|
|
reti := TSlToHexFormatStr(r);
|
|
ret := "{ ";
|
|
ret += reti;
|
|
ret += " }";
|
|
return ret;
|
|
end
|
|
function ReadTMF(d,o);override;
|
|
begin
|
|
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
|
if not cbmp then return ;
|
|
if ifstring(d)then
|
|
begin
|
|
r := HexFormatStrToTsl(d);
|
|
if ifarray(r)and r["type"]="bmps" then
|
|
begin
|
|
ret := array("type":"bmps");
|
|
for i,v in r["items"] do
|
|
begin
|
|
bmp := createobject(cbmp);
|
|
bmp.Readvcon(v);
|
|
ret["items"][i]:= bmp;
|
|
end
|
|
return ret;
|
|
end
|
|
end
|
|
end
|
|
end
|
|
type TPropertyBitmap=class(TPropertyType)
|
|
function EditType();override;
|
|
begin
|
|
return "tbitmap";
|
|
end
|
|
function TmfToNode(d);override;
|
|
begin
|
|
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
|
if not cbmp then return ;
|
|
if ifstring(d)and d then
|
|
begin
|
|
tar := HexFormatStrToTsl(d);
|
|
bmp := createobject(cbmp);
|
|
bmp.Readvcon(tar);
|
|
return bmp;
|
|
end
|
|
return nil;
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
{**
|
|
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
|
**}
|
|
reti := "";
|
|
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
|
|
if d is cbmp then
|
|
begin
|
|
reti := TSlToHexFormatStr(d.tovcon);
|
|
end
|
|
ret := "{ ";
|
|
ret += reti;
|
|
ret += " }";
|
|
return ret;
|
|
end
|
|
function ReadTMF(d,o);override;
|
|
begin
|
|
return TmfToNode(d);
|
|
end
|
|
end
|
|
type TPropertyIcon=class(TPropertyType)
|
|
function EditType();override;
|
|
begin
|
|
return "ticon";
|
|
end
|
|
function TmfToNode(d);override;
|
|
begin
|
|
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(cico);
|
|
r.Readvcon(dd);
|
|
return r;
|
|
end
|
|
end
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
{**
|
|
@explan(说明)修改表格数据转换为tmf文件数据 %%
|
|
**}
|
|
reti := "";
|
|
cico := class(tUIglobalData).uigetdata("G_T_ICON_");
|
|
if cico and (d is cico) then
|
|
begin
|
|
reti := TSlToHexFormatStr(d.tovcon());
|
|
end
|
|
ret := "{ ";
|
|
ret += reti;
|
|
ret += " }";
|
|
return ret;
|
|
end
|
|
function ReadTMF(d,o);override;
|
|
begin
|
|
return TmfToNode(d);
|
|
end
|
|
end
|
|
type TPropertyStatusItems=class(TPropertyType)
|
|
function EditType();override;
|
|
begin
|
|
return "statusitems";
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
r := "[";
|
|
for i,v in d do
|
|
begin
|
|
r += "< \r\n";
|
|
if v["width"]>0 and ifstring(v["text"])then
|
|
begin
|
|
r += "width="+inttostr(v["width"])+"\r\n";
|
|
r += "text="+tostn(v["text"])+"\r\n";
|
|
end
|
|
r += ">\r\n";
|
|
end
|
|
r += "]";
|
|
return tablelines(r," ");
|
|
return r;
|
|
end
|
|
end
|
|
type TPropertyFileFilter=class(TPropertyType)
|
|
function EditType();override;
|
|
begin
|
|
return "filefilter";
|
|
end
|
|
function ReadTMF(d,o);override;
|
|
begin
|
|
return TmfToNode(d);
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
if dataisnotsample(d) then return "";
|
|
return TmfParser.tslasItem(d);
|
|
end
|
|
function TmfToNode(d);override;
|
|
begin
|
|
return d;
|
|
//return HexFormatStrToTSL(d);
|
|
end
|
|
end
|
|
type TPropertyLazyInteger=class(TPropertyInteger)
|
|
function EditType();override;
|
|
begin
|
|
return "lazyinteger";
|
|
end
|
|
function LazyProperty();override;
|
|
begin
|
|
return true;
|
|
end
|
|
end
|
|
type TPropertyLazystr=class(TPropertyString)
|
|
function EditType();override;
|
|
begin
|
|
return "lazystr";
|
|
end
|
|
function LazyProperty();override;
|
|
begin
|
|
return true;
|
|
end
|
|
end
|
|
|
|
type UniSelProperty=class(TPropertyType)
|
|
function Create();
|
|
begin
|
|
FSelRange := CreateSelValues();
|
|
end
|
|
Property SelRange read FSelRange;
|
|
protected
|
|
function UnifRagge(d);
|
|
begin
|
|
r := array();
|
|
for i,v in d do
|
|
begin
|
|
r[i]:= array(v,v);
|
|
end
|
|
return r;
|
|
end
|
|
private
|
|
function CreateSelValues();virtual;
|
|
begin
|
|
//UnifRagge(array("alleft","alright","albottom","altop","alnone","alclient"));
|
|
end
|
|
FSelRange;
|
|
end
|
|
type UniObjectMember=class(UniSelProperty)
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
if FValueMap then
|
|
begin
|
|
if fMultisel and ifarray(d)then
|
|
begin
|
|
r := "[";
|
|
ld := length(d)-1;
|
|
for i,v in d do
|
|
begin
|
|
r += FValueMap[v];
|
|
if i<ld then r += " ";
|
|
end
|
|
r += "]";
|
|
return r;
|
|
end
|
|
return FValueMap[d];
|
|
end
|
|
return nil;
|
|
end
|
|
function ReadTMF(d,o);override;
|
|
begin
|
|
return TmfToNode(d);
|
|
if FNameMap then
|
|
begin
|
|
if fMultisel and ifarray(d)then
|
|
begin
|
|
r := array();
|
|
for i,v in d do
|
|
begin
|
|
r[i]:= FNameMap[v];
|
|
end
|
|
return r;
|
|
end
|
|
return FNameMap[d];
|
|
end
|
|
end
|
|
function TmfToNode(d);override;
|
|
begin
|
|
if FNameMap then
|
|
begin
|
|
if fMultisel and ifarray(d)then
|
|
begin
|
|
r := array();
|
|
for i,v in d do
|
|
begin
|
|
r[i]:= FNameMap[v];
|
|
end
|
|
return r;
|
|
end
|
|
r := FNameMap[d];
|
|
if ifnil(r) then return FNameMap2[d];
|
|
return r;
|
|
end
|
|
return nil;
|
|
end
|
|
function CreateInfoOBJ();virtual;
|
|
begin
|
|
end
|
|
property Multisel read fMultisel write fMultisel;
|
|
protected FInfoObj;
|
|
FValueMap;
|
|
FNameMap;
|
|
FNameMap2;
|
|
fMultisel;
|
|
private
|
|
function CreateSelValues();override;
|
|
begin
|
|
//FNameMap := FValueMap := array();
|
|
FNameMap := New tstrindexarray();
|
|
FValueMap := New tstrindexarray();
|
|
FNameMap2 := array();
|
|
FInfoObj := CreateInfoOBJ();
|
|
r := array();
|
|
if not ifobj(FInfoObj)then return array();
|
|
for i,v in FInfoObj.classinfo()["members"] do
|
|
begin
|
|
ni := v["name"];
|
|
vi := invoke(FInfoObj,ni);
|
|
r[i]:= array(ni,vi);
|
|
FNameMap[ni]:= vi;
|
|
FNameMap2[vi] := vi;
|
|
FValueMap[vi]:= ni;
|
|
end
|
|
return r;
|
|
end
|
|
end
|
|
type TPropertyAnchors=class(UniObjectMember)
|
|
function EditType();override;
|
|
begin
|
|
return "anchors";
|
|
end
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
Multisel := true;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new TAnchorKind();
|
|
end
|
|
function LazyProperty();override;
|
|
begin
|
|
return true;
|
|
end
|
|
private
|
|
type TAnchorKind=class()
|
|
//akTop, akLeft, akRight, akBottom
|
|
function create();
|
|
begin
|
|
akTop := 0;
|
|
akLeft := 1;
|
|
akRight := 2;
|
|
akBottom := 3;
|
|
end
|
|
akTop;
|
|
akLeft;
|
|
akRight;
|
|
akBottom;
|
|
end
|
|
end
|
|
type TPropertyAlign9=class(UniObjectMember)
|
|
function EditType();override;
|
|
begin
|
|
return "alignstyle9";
|
|
end
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new TAlignStyle9_123();
|
|
end
|
|
private
|
|
type TAlignStyle9_123=class()
|
|
function Create()
|
|
begin
|
|
AL9_DEFAULT := 0; //0
|
|
AL9_TOPLEFT := 1; //1
|
|
AL9_TOPCENTER := 2; //2
|
|
AL9_TOPRIGHT := 3; //3
|
|
AL9_CENTERLEFT := 4; //4
|
|
AL9_CENTER := 5; //5
|
|
AL9_CENTERRIGHT := 6; //6
|
|
AL9_BOTTOMLEFT := 7; //7
|
|
AL9_BOTTOMCENTER := 8; //8
|
|
AL9_BOTTOMRIGHT := 9; //9
|
|
end
|
|
AL9_DEFAULT; //0
|
|
AL9_TOPLEFT; //1
|
|
AL9_TOPCENTER; //2
|
|
AL9_TOPRIGHT; //3
|
|
AL9_CENTERLEFT; //4
|
|
AL9_CENTER; //5
|
|
AL9_CENTERRIGHT; //6
|
|
AL9_BOTTOMLEFT; //7
|
|
AL9_BOTTOMCENTER; //8
|
|
AL9_BOTTOMRIGHT; //9
|
|
end
|
|
end
|
|
type TPropertyAlign3=class(UniSelProperty)
|
|
function EditType();override;
|
|
begin
|
|
return "alignstyle3";
|
|
end
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();
|
|
begin
|
|
return TAlignStyleH3_123();
|
|
end
|
|
private
|
|
type TAlignStyleH3_123=class()
|
|
AL3_LEFT; //0
|
|
AL3_RIGHT; //1
|
|
AL3_CENTER; //2
|
|
function Create();
|
|
begin
|
|
AL3_LEFT := 0; //0
|
|
AL3_RIGHT := 1; //1
|
|
AL3_CENTER := 2; //2
|
|
end
|
|
end
|
|
end
|
|
type TPropertyDayOfWeek=class(UniObjectMember)
|
|
function EditType();override;
|
|
begin
|
|
return "dayofweek";
|
|
end
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new tdyofweek();
|
|
end
|
|
private
|
|
type tdyofweek=class()
|
|
Monday; //0
|
|
Tuesday; //1
|
|
Wednesday; //2
|
|
Thursday;
|
|
Friday;
|
|
Saturday;
|
|
Sunday;
|
|
function Create();
|
|
begin
|
|
Monday := 0; //0
|
|
Tuesday := 1; //1
|
|
Wednesday := 2; //2
|
|
Thursday := 3;
|
|
Friday := 4;
|
|
Saturday := 5;
|
|
Sunday := 6;
|
|
end
|
|
end
|
|
end
|
|
type TPropertyPairInt=class(TPropertyType)
|
|
function EditType();override;
|
|
begin
|
|
return "pairint";
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
if not ifnil(d)then
|
|
begin
|
|
str := "("+tostn(d[0])+","+tostn(d[1])+")";
|
|
return str;
|
|
end
|
|
end
|
|
end
|
|
type TPropertySpliterType=class(UniObjectMember)
|
|
function EditType();override;
|
|
begin
|
|
return "splittertype";
|
|
end
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new TSpltype();
|
|
end
|
|
type TSpltype=class
|
|
pstHorizontal;
|
|
pstVertical;
|
|
function Create();
|
|
begin
|
|
pstHorizontal := 0;
|
|
pstVertical := 1;
|
|
end
|
|
end
|
|
end
|
|
type TPropertyTreeViewData=class(TPropertyType)
|
|
function EditType();override;
|
|
begin
|
|
return "treedata";
|
|
end
|
|
function UnformatEdit(d);override;
|
|
begin
|
|
return ifnil(d)?inherited:d;
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
return "{"+TslToHexFormatStr(d)+"}";
|
|
end
|
|
function ReadTMF(d,o);override;
|
|
begin
|
|
r := HexFormatStrToTSL(d);
|
|
return r;
|
|
end
|
|
function TmfToNode(d);override;
|
|
begin
|
|
r := HexFormatStrToTSL(d);
|
|
return r;
|
|
end
|
|
end
|
|
//////////////////red///////////////////////
|
|
type TPropertyTabAlign=class(UniObjectMember)
|
|
type TAlign123=class
|
|
alTop;
|
|
alBottom;
|
|
function create();
|
|
begin
|
|
alTop := 1;
|
|
alBottom := 2;
|
|
end
|
|
end
|
|
function EditType();override;
|
|
begin
|
|
return "tabalign";
|
|
end
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new TAlign123();
|
|
end
|
|
end
|
|
type TPropertylistseltype=class(UniObjectMember)
|
|
type TAlign123=class
|
|
single;
|
|
multisel;
|
|
inmultisel;
|
|
function create();
|
|
begin
|
|
single := 0;
|
|
multisel := 1;
|
|
inmultisel := 2;
|
|
end
|
|
end
|
|
function EditType();override;
|
|
begin
|
|
return "listseltype";
|
|
end
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new TAlign123();
|
|
end
|
|
end
|
|
type TPropertyAlign=class(UniObjectMember)
|
|
type TAlign123=class
|
|
alNone;
|
|
alTop;
|
|
alBottom;
|
|
alLeft;
|
|
alRight;
|
|
alClient;
|
|
function create();
|
|
begin
|
|
alNone := 0;
|
|
alTop := 1;
|
|
alBottom := 2;
|
|
alLeft := 3;
|
|
alRight := 4;
|
|
alClient := 5;
|
|
end
|
|
end
|
|
function LazyProperty();override;
|
|
begin
|
|
{**
|
|
@explan(说明) 是否为延迟设置属性%%
|
|
@return(bool)
|
|
**}
|
|
return true;
|
|
end
|
|
function EditType();override;
|
|
begin
|
|
return "align";
|
|
end
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new TAlign123();
|
|
end
|
|
end
|
|
type TPropertyText=class(TPropertyString)
|
|
function EditType();override;
|
|
begin
|
|
return "text";
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
return tostn(d);
|
|
end
|
|
end
|
|
type tpropertytsl=class(TPropertyType)
|
|
Function EditType();override;
|
|
begin
|
|
return "tsl";
|
|
end
|
|
function TmfToNode(d);override;
|
|
begin
|
|
return d;
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
if dataisnotsample(d) then return "";
|
|
return TmfParser.tslasItem(d);
|
|
end
|
|
function ReadTMF(d,o);override;
|
|
begin
|
|
return d;
|
|
end
|
|
end
|
|
type tpropertylazytsl = class(tpropertytsl)
|
|
Function EditType();override;
|
|
begin
|
|
return "lazytsl";
|
|
end
|
|
function LazyProperty();override;
|
|
begin
|
|
return true;
|
|
end
|
|
end
|
|
type TPropertyStrings=class(TPropertyType)
|
|
function EditType();override;
|
|
begin
|
|
return "strings";
|
|
end
|
|
function FormatTMF(d);override;
|
|
begin
|
|
{**
|
|
@explan(说明)修改表格数据转换为tmf文件数据%%
|
|
**}
|
|
return TmfParser.TSLasItem(d);
|
|
end
|
|
end
|
|
type TPropertyEsAlign=class(UniObjectMember)
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function EditType();override;
|
|
begin
|
|
return "es_algin";
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new TESalign();
|
|
end
|
|
private
|
|
type TESalign=class
|
|
ES_LEFT;
|
|
ES_CENTER;
|
|
ES_RIGHT;
|
|
function Create();
|
|
begin
|
|
ES_LEFT := 0x0;
|
|
ES_CENTER := 0x1;
|
|
ES_RIGHT := 0x2;
|
|
end
|
|
end
|
|
end
|
|
type TPropertymbbtnstyle=class(UniObjectMember)
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new tmbbtnstyle();
|
|
end
|
|
function EditType();override;
|
|
begin
|
|
return "mbbtnstyle";
|
|
end
|
|
private
|
|
type tmbbtnstyle=class
|
|
MB_OK;
|
|
MB_OKCANCEL;
|
|
MB_ABORTRETRYIGNORE;
|
|
MB_YESNOCANCEL;
|
|
MB_YESNO;
|
|
MB_RETRYCANCEL;
|
|
MB_CANCELTRYCONTINUE;
|
|
MB_HELP;
|
|
function Create();
|
|
begin
|
|
MB_OK := 0;
|
|
MB_OKCANCEL := 1;
|
|
MB_ABORTRETRYIGNORE := 2;
|
|
MB_YESNOCANCEL := 3;
|
|
MB_YESNO := 4;
|
|
MB_RETRYCANCEL := 5;
|
|
MB_CANCELTRYCONTINUE := 6;
|
|
MB_HELP := 16384;
|
|
end
|
|
end
|
|
end
|
|
type TPropertymbicostyle=class(UniObjectMember)
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new tmbicostyle();
|
|
end
|
|
function EditType();override;
|
|
begin
|
|
return "mbiconstyle";
|
|
end
|
|
private
|
|
type tmbicostyle=class
|
|
MB_ICONWARNING;
|
|
MB_ICONASTERISK;
|
|
MB_ICONQUESTION;
|
|
MB_ICONSTOP;
|
|
function Create();
|
|
begin
|
|
MB_ICONWARNING := 48;
|
|
MB_ICONASTERISK := 64;
|
|
MB_ICONQUESTION := 32;
|
|
MB_ICONSTOP := 16;
|
|
end
|
|
end
|
|
end
|
|
type TPropertyColorList=class(UniObjectMember)
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
end
|
|
function CreateInfoOBJ();override;
|
|
begin
|
|
return new tcolorlist();
|
|
end
|
|
function EditType();override;
|
|
begin
|
|
return "colorbox";
|
|
end
|
|
private
|
|
type tcolorlist=class
|
|
Black;
|
|
Maroon;
|
|
Green;
|
|
Olive;
|
|
Navy;
|
|
Purple;
|
|
Teal;
|
|
Gray;
|
|
Silver;
|
|
Red;
|
|
Lime;
|
|
Yellow;
|
|
Blue;
|
|
Fuchsia;
|
|
Aqua;
|
|
LtGray;
|
|
DkGray;
|
|
White;
|
|
MoneyGreen;
|
|
SkyBlue;
|
|
Cream;
|
|
MedGray;
|
|
function Create();
|
|
begin
|
|
Black := "Black";
|
|
Maroon := "Maroon";
|
|
Green := "Green";
|
|
Olive := "Olive";
|
|
Navy := "Navy";
|
|
Purple := "Purple";
|
|
Teal := "Teal";
|
|
Gray := "Gray";
|
|
Silver := "Silver";
|
|
Red := "Red";
|
|
Lime := "Lime";
|
|
Yellow := "Yellow";
|
|
Blue := "Blue";
|
|
Fuchsia := "Fuchsia";
|
|
Aqua := "Aqua";
|
|
LtGray := "LtGray";
|
|
DkGray := "DkGray";
|
|
White := "White";
|
|
MoneyGreen := "MoneyGreen";
|
|
SkyBlue := "SkyBlue";
|
|
Cream := "Cream";
|
|
MedGray := "MedGray";
|
|
end
|
|
end
|
|
end
|
|
|
|
///////////////////类型////////////////////////////////////////////////////////
|
|
// tmf文件相关类型 该类型注册到tcomponent下面
|
|
|
|
// 表格相关类型 注册到设计器下面
|
|
|
|
//////////////////////////////////////////////////////////////////////////
|
|
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");
|
|
r := "";
|
|
for i,v in lines do
|
|
begin
|
|
if not v then continue;
|
|
r += n;
|
|
r += v;
|
|
r += "\r\n";
|
|
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",
|
|
"tpropertynatural",
|
|
"tpropertyinteger",
|
|
"tpropertystring",
|
|
"tpropertycolor",
|
|
"tpropertydirectory",
|
|
"tpropertyfilename",
|
|
"tpropertyfont",
|
|
"tpropertyhotkey",
|
|
"tpropertybool",
|
|
"tpropertytypeevent",
|
|
"tpropertytypesyscursor",
|
|
"tpropertyvarible",
|
|
"tpropertyaction",
|
|
"tpropertytray",
|
|
"tpropertypopupmenu",
|
|
"tpropertymainmenu",
|
|
"tpropertyimagelist",
|
|
"tpropertyhgt",
|
|
"tpropertyimagesdata",
|
|
"tpropertybitmap",
|
|
"tpropertyicon",
|
|
"tpropertystatusitems",
|
|
"tpropertyfilefilter",
|
|
"tpropertylazyinteger",
|
|
"TPropertyLazystr",
|
|
"uniselproperty",
|
|
"uniobjectmember",
|
|
"tpropertyalign9",
|
|
"tpropertyanchors",
|
|
"tpropertyalign3",
|
|
"tpropertydayofweek",
|
|
"tpropertypairint",
|
|
"tpropertysplitertype",
|
|
"tpropertytreeviewdata",
|
|
"tpropertyalign",
|
|
"tpropertytabalign",
|
|
"TPropertylistseltype",
|
|
"tpropertytext",
|
|
"tpropertystrings",
|
|
"tpropertytsl",
|
|
"tpropertylazytsl",
|
|
"tpropertyesalign",
|
|
"tpropertymbbtnstyle",
|
|
"tpropertymbicostyle",
|
|
"tpropertycolorlist");
|
|
for i,v in types do
|
|
begin
|
|
c := findclass(v);
|
|
if c is class(TPropertyType)then
|
|
begin
|
|
vc := CreateObject(c);
|
|
RegComponentPropertyType(vc);
|
|
end
|
|
end
|
|
//注册属性编辑
|
|
end
|
|
|
|
function InitLib();
|
|
begin
|
|
static Sinitlib();
|
|
end
|
|
function dataisnotsample(d);//
|
|
begin
|
|
if ifobj(d) then return true;
|
|
if ifarray(d) then
|
|
begin
|
|
for i ,v in d do
|
|
begin
|
|
if (dataisnotsample(v)) then return true;
|
|
end
|
|
end
|
|
return false;
|
|
end
|
|
Initialization
|
|
InitLib();
|
|
|
|
end. |