type textcompclassadder=class(tdcreateform)
    uses tslvcl;
    e_classname:tedit;
    label1:tlabel;
    b_classfile:tbtn;
    label2:tlabel;
    p_imgshow:tpanel;
    b_img:tbtn;    
    b_ok:tbtn;
    b_cancel:tbtn;
    f_open:topenfileadlg;
    function Create(AOwner);override; //构造
    begin		
        inherited;
    end 
    function extcompclassadder_close(o;e);virtual;
    begin
        e.skip := true;
        Visible := false;
        EndModal(0);     
        inherited;
    end
    function b_cancel_clk(o;e);virtual;
    begin
        EndModal(0);
    end
    function b_ok_clk(o;e);virtual;
    begin
        s := e_classname.text;
        if fclasshash and fclasshash[s] then 
        begin
            messageboxa("该控件已经注册","提示",0,self);
            return ;
        end             
        oc := findclass(s); 
        if not (oc is class(TWinControl)) then 
        begin
            messageboxa("组件类型错误,或者组件不存在","提示",0,self);
            return ;    
        end   
        if not fbmp then 
        begin 
            messageboxa("请选择合适的图标","提示",0,self);
            return ;     
        end  
        EndModal(1);
    end
    function b_img_clk(o;e);virtual;
    begin
        f_open.filter := array("图片文件":"*");
        if  not(f_open.OpenDlg()) then  return ;
        fbmp := new TBitmap();
        fbmp.id := f_open.filename;
        p_imgshow.BKBitmap := fbmp;
        if fbmp.HandleAllocated() then return ;
        fbmp := nil;
    end

    function b_classfile_clk(o;e);virtual;
    begin
        f_open.filter := array("控件类文件":"*.tsf");
        e_classname.text := "";
        if  not(f_open.OpenDlg()) then  return ;
        iof := iofileseparator();
        fn := f_open.filename;
        nf := fn[1:length(fn)-4];
        n := "";
        for i:= length(nf) downto 1 do 
        begin 
            vi := nf[i];
            if vi=iof then 
            begin             
                break;
            end 
            n := vi+n;    
        end  
        ln := lowercase(n);
        e_classname.text := ln;        
    end
    function DoControlAlign();override;//对齐子控件
    begin
        //当窗口大小改变时,该函数会被调用,
        //可以通过 clientrect 获取客户区大小,设置子控件的位置以及大小
        //如果自己处理了子控件的对齐,就可以去掉 inherited 
        inherited;
    end 
    function Recycling();override; //回收变量
    begin
        inherited;
        ci := self.classinfo();   //将成员变量赋值为nil避免循环引用
        for i,v in ci["members"] do 
        begin
            if v["static"] then continue;
            invoke(self,v["name"],nil);
        end 
    end 
    function createdclass();
    begin 
        ra := %% type %s =class(TDComponent)
    uses utslvcldcomponents;
    function create(AOwner);
    begin
        inherited;
    end 
    function classification();override;
    begin
        return "自定义";
    end 
    function bitmapinfo();override;
    begin
        return "%s";
    end 
    function WndClass();override;
    begin
        return Class(%s);
    end 
end         
%%;
        r := format(ra,"td_a_"+e_classname.text,TslToHexFormatStr(fbmp.tovcon()),e_classname.text);    
        return r; 
    end 
    function getreginfo();
    begin
        r := array();
        r["name"] := e_classname.text;
        r["dclassname"] := "td_a_"+e_classname.text;
        r["dclassbody"] := createdclass();
        return r;
    end 
    property classhash read fclasshash write setclasshash;
    fclasshash;
    fbmp;
    private 
    function setclasshash(v);
    begin 
        if v<>fclasshash then 
        begin 
            fclasshash := array();
            for i,vi in v do 
            begin 
                fclasshash[vi] := true;    
            end 
        end 
    end 
end