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;
    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 ct or(n=TT_STR)then
        begin
            if n=TT_NUM then
            begin
                if pos(".",ct)then ct := strtofloat(ct);
                else ct := strtoint(ct);
            end
            if n=TT_SYM then ct := lowercase(ct);
            r[len++]:= array(ct,n);
            ct := "";
        end
    end
    function GetNumber(len);
    begin
        c := cchar();
        r := "";
        iffloat := false;
        if c="0" then
        begin
            label parnb;
            cc := cchar();
            if cc in FNumberChar then
            begin
                while whileok() do
                begin
                    cc := cchar();
                    if not(iffloat)and cc="." then
                    begin
                        iffloat := true;
                        r += ".";
                        continue;
                    end
                    if(cc="l" or cc="L")and not(iffloat)then
                    begin
                        if r then
                        begin
                            //长整数
                            strtoint(r);
                            return;
                        end
                    end else
                    if(cc="l" or cc="L")then
                    begin
                        //错误
                        return;
                    end
                    if not(cc in FNumberChar)then
                    begin
                        if not r then
                        begin
                            return; //错误 
                        end
                        if iffloat then
                        begin
                            strtofloat(r); //实数 
                        end else
                        strtoint(r); //整数
                        cback();
                    end
                    r += cc;
                end
            end else
            if cc="x" or cc="X" then
            begin
                while whileok() do
                begin
                    cc := cchar();
                    if not(cc in FHexChar)then
                    begin
                        cback();
                        break;
                    end
                    r += cc;
                end
            end else
            begin
            end
        end else
        begin
            r := c;
            goto parnb;
        end
    end
    function GetBinary(len);
    begin
        r := "";
        while whileok() do
        begin
            c := cchar();
            if c="}" then
            begin
                delct(r,ct,len,TT_BIN);
                break;
            end
            if c in FSplitter then
            begin
                continue;
            end
            r += c;
        end
    end
    function gettokens();
    begin
        {**
        @explan(说明) 解析token %%
        **}
        if FTokens then return FTokens;
        r := array();
        len := 0;
        ct := ""; //当前字符
        pnumber := true;
        while whileok() do
        begin
            c := cchar();
            if c="0" and pnumber 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 c='"' or c="'" then
            begin
                delct(r,ct,len,TT_SYM);
                delct(r,Pstring(c),len,TT_STR);
            end else
            if c in array(' ','\t',"\r","\n",";",",")then
            begin
                if ct="0" and pnumber then delct(r,ct,len,TT_NUM);
                else delct(r,ct,len,TT_SYM);
            end else
            if c="{" then
            begin
                pnumber := false;
                delct(r,ct,len,TT_SYM);
                delct(r,c,len,TT_SIG);
            end else
            if c="}" then
            begin
                delct(r,ct,len,TT_SYM);
                delct(r,c,len,TT_SIG);
                pnumber := true;
            end else
            if c in array("=",":","(",")","<",">","[","]")then
            begin
                delct(r,ct,len,TT_SYM);
                delct(r,c,len,TT_SIG);
            end else
            {if c ="." then 
            begin
            delct(r,ct,len,TT_SYM);
            delct(r,c,len,TT_POI);
            end else }
            if c="-" then
            begin
                delct(r,ct,len,TT_SYM);
                delct(r,c+Pnumber(),len,TT_NUM);
            end else
            if(c in FNumbers)and pnumber and(not(ct)) {(not(ct))  and (r[len][0]="=")}then
            begin
                delct(r,ct,len,TT_SYM);
                v := c+Pnumber();
                delct(r,v,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();
    begin
        {**
        @explan(说明)解析16进制数
        **}
        c := cchar();
        c := lowercase(c);
        its := inttostr(0 -> 9)union array("a","b","c","d","e","f");
        r := "";
        if c="x" then
        begin
            while whileok() do
            begin
                c := lowercase(cchar());
                if not(c in its)then
                begin
                    cback();
                    break;
                end
                r += c;
            end
            return eval(&("0x"+r));
        end else
        begin
            cback();
            return "d";
        end
    end
    function Pnumber(); //数字
    begin
        {**
        @explan(说明) 解析数字 %%
        **}
        r := "";
        its := inttostr(0 -> 9);
        its[length(its)]:= ".";
        while whileok() do
        begin
            c := cchar();
            if(c in array(" ","\t","\r","\n"))then break;
            if c="l" or c="L" then
            begin
                cchar();
                break;
            end
            if not(c in its)then break;
            r += c;
        end
        cback();
        return r;
    end
    function create();override;
    begin
        inherited;
        FNumbers := inttostr(0 -> 9);
        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文件解析 %%
    **}
    private
    FCurrent;
    FTokens;
    FTokenlen;
    FParsers;
    FTree;
    FS;
    function SetScriptPath(fn);
    begin
        if ifstring(fn)then
        begin
            size := filesize("",fn); //获取文件大小
            if readFile(rwraw(),"",fn,0,size,data)then
            begin
                Script := data;
            end
        end
    end
    function SetScript(s);
    begin
        if fs <> s then
        begin
            FParsers.Script := s;
            FTokens := FParsers.gettokens();
            FTokenlen := length(FTokens);
            FCurrent := 0;
            FTree := nil;
        end
    end
    public
    function create();override;
    begin
        inherited;
        FCurrent := 0;
        FTokens := array();
        FParsers := new TTmfParserToken();
    end
    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
    function samplevalue(v);virtual;
    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
    private
    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 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")then return tostn(v);
            if new TCharDiscrimi().IsVariableName(v)then
            begin
                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
    public
    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
    end
    function gettree();
    begin
        {**
        @explan(说明) 获得语法树%%
        **}
        if FTree then return FTree;
        IF FTokens then return FTree := createobj();
        return array();
        //return echo tostn(CreateObj());
    end
    function TSLasItem(d);
    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(si+"="+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
    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" and(tt <> TT_STR)then return getobject();
        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"];
        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" and tt <> TT_STR then
            begin
                ro := getobject();
                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
            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
    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 false;
    end
    function IfComponent();virtual;
    begin
        {**
        @explan(说明) 是否为控件%%
        **}
        return false;
    end
    property TmfParser:TTmfParser read Gettfmparser;
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 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
        r := "{ "+TslToHexFormatStr(d)+" }";
        return r;
    end
    function TmfToNode(d);override;
    begin
        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 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
            return FNameMap[d];
        end
        return nil;
    end
    function CreateInfoOBJ();virtual;
    begin
    end
    property Multisel read fMultisel write fMultisel;
    protected FInfoObj;
    FValueMap;
    FNameMap;
    fMultisel;
    private
    function CreateSelValues();override;
    begin
        //FNameMap := FValueMap := array();
        FNameMap := New tstrindexarray();
        FValueMap := New tstrindexarray();
        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;
            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 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 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
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",
        "tpropertyimagesdata",
        "tpropertybitmap",
        "tpropertyicon",
        "tpropertystatusitems",
        "tpropertyfilefilter",
        "tpropertylazyinteger",
        "uniselproperty",
        "uniobjectmember",
        "tpropertyalign9",
        "tpropertyanchors",
        "tpropertyalign3",
        "tpropertydayofweek",
        "tpropertypairint",
        "tpropertysplitertype",
        "tpropertytreeviewdata",
        "tpropertyalign",
        "tpropertytabalign",
        "tpropertytext",
        "tpropertystrings",
        "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
Initialization
InitLib();

end.