unit tslvclDesigner;
{**
@explan(说明)设计器库 %%
**}
interface
uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclbase,
     utslvclgdi,utslvcldcomponents,utslvcldpropertytypes,tslvcl,
     UVCPropertyTypesPersistence,utslmemo,UDesignerProject;
//*******设计控件基类**********************
//**********设计控件类************

type TVclDesigner = class(tvcform)
{**
    @explan(说明) 控件设计器 对象 %%
**}
    private
    fcwindowinfo;  //当前窗口文件对象
    fwindowinfos; //窗口文件节点存储对象
    fcutcopyinfo;//复制的信息 
    FChmHelper; //帮助文档
    fdimagelist; //图标
    FViewBitmap;  //图片管理器
    FVariableSelecter; //当前控件树的变量
    FFunctionSelecter; //当前控件树的函数
    //**********菜单***************
    FMenu0; //主菜单
    //********************************
    FToolBars; //控件工具栏
    FTree; //当前的树
    FObjInspector; //控件树展示器
    FPropGrid;   //控件属性grid
    FEventGrid;  //控件事件grid
    
    //************************************
    FCurrentNode;
    FCurrentClikPos;
    FComponentCreater;
    FRounMenu;
    FStopMenu;
    FProjectsManager;
    FProjectManager;
    //***************************
    function WrapProjectTo(); //打包当前
    begin
        FProjectManager.WrapTo();
    end 
    function OpenProjectFromtpj(); //工程选择
    begin
        SetWndPostWithMouse(FProjectsManager);
        FProjectsManager.Show();
        return ;
    end 
    function ShowProjectView(o,e); //工程文件打开
    begin
        FProjectManager.visible := not FProjectManager.visible;
        if o then 
        begin 
            FProjectManager._tag := o;
            o.Checked := FProjectManager.visible;
        end 
        //FProjectManager.show();    
    end 

    function addtoolbuttons();//添加工具栏
    begin
    {**
        @explan(说明)添加工具栏 %%
    **}
        for i,v in class(TDComponent).GetClassItem() do 
        begin
            fdimagelist.RegisterDitem(v);
            //if not v.InToolBar() then continue;
            tb := new TToolButton(self);
            tb.caption := v.HitTip;
            tb.Enabled := v.InToolBar();
            ig := fdimagelist.GetImageId(V.dclassname);
            tb.imageid := ig;
            v.Imgs := ig;
            tb._tag := v;
            tb.onclick := thisfunction(OnToolButtonCick);
            FToolBars.addbtn(tb,v.classification);
        end 
    end 

    function calcheight(twidth); //高度计算
    begin
        //extheight := CaptionHeight()+MenuBarHeight();
        clc := array();
        for i,v in class(TDComponent).GetClassItem() do 
        begin
            cli := v.classification;
            if not(cli and ifstring(cli)) then cli := "常用";
            if ifnil(clc[cli]) then clc[cli] := 0;
            clc[cli]+=1;
        end 
        mx := 0;
        for i,v in clc do mx := max(mx,v);
        height := (integer(mx*32/twidth)+1)*32+60+30{+24}+5;
    end 

    function TreeNode2tfmsub(lib,node,itemnames,nd);//tmf文件字符串
    begin
        if not(node) then
        begin
            tr := ftree;
            if  nd then 
            begin 
                tr := fwindowinfos.gettreebyid(nd);   
            end 
            if not tr then return ;
            it := tr.RootItem;
            node := (it.items)[0];
        end 
        if not ifarray(itemnames) then itemnames := array();
        if not ifarray(lib) then lib := array();
        if not node then exit;
        tc := node.Component;
        wlibs := tc.libs();
        tlibs := array();
        for i,v in wlibs do if v and ifstring(v) then tlibs[length(tlibs)] := lowercase(v);
        tclib := lowercase(tc.libs());
        lib union2= tlibs;
        r := "";
        tab := "   ";
        if tc is class(TDComponent) then 
        begin
            tcname := tc.name;
            tcclassname := tc.dclassname;
            if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then raise "错误!";
            r+= "object "+ tc.name +":"+tc.dclassname+"\r\n";
            itemnames[length(itemnames)] := array(tc.name,tc.dclassname);
            cr := tc.GetChangedPublish();
            for i,v in cr do 
            begin
                if not(v and ifstring(i) and ifstring(v) ) then continue; //严格判断
                r+=tab;
                r+= i + "=" + v +"\r\n";
            end 
            for i := 0 to node.ItemCount-1 do 
            begin
                r += tablelines( call(thisfunction,lib,(node.items)[i],itemnames),tab);
            end 
            r += "end";
        end 
        return r;
        //GetChangedPublish
    end 

    function DeletComponent(comp);  //删除控件
    begin
        if comp is class(TDComponent) then 
        begin
            DeleteNode(comp.TreeNode);
        end 
    end 
    function DeleteNode(node); //删除节点
    begin
        if node Is class(TComponentTreeNode) then 
        begin
            comp := node.Component;
            node.Recycling();  //销毁节点
            if comp is class(TDComponent) then //销毁节点对应控件
            begin
                wd := comp.Cwnd;
                if wd is class(TComponent) then wd.Recycling();
            end 
        end 
    end 
    function createmainmenubyarray(ms,pm,oer); //构造菜单
    begin
        if not(ifarray(ms) and ms) then exit;
        if ms["type"]="menu" then 
        begin    
            if not pm then pm := new TMainmenu(oer);
            if ifstring(ms["caption"]) then 
            begin
                mu := new tmenu(oer);
                mu.caption := ms["caption"];
                o := ms["onclick"];
                mu.onclick := ms["onclick"];
                mu.parent := pm;
                if ms["checked"] =1 then 
                begin
                    mu.Checked := true;
                end 
                field := ms["filed"];
                if ms["checked"]=true then 
                begin
                    mu.Checked := true;
                end else 
                begin 
                    bp := ms["bitmap"];
                    if bp and ifstring(bp) then 
                    begin
                        bpp := new tbitmap();
                        bpp.Readvcon(HexFormatStrToTsl( bp));
                        mu.bitmap := bpp;
                    end 
                
                end 
                if ms["enabled"]=0 then 
                begin
                    mu.Enabled := false;
                end 
                if ifstring(field) then 
                begin
                    try
                        invoke(oer,lowercase(field),1,mu);
                    except
                    end ;
                end 
                call(thisfunction,ms["items"],mu,oer);
            end 
        end 
        else for i,v in ms do 
        begin
            call(thisfunction,v,pm,oer);
        end 
    end 
    public   //复制粘贴
    function copynode(node); //复制
    begin
        fcutcopyinfo := getnodeinfodata(node);
    end 
    function cutnode(node); //剪切节点
    begin
        fcutcopyinfo := getnodeinfodata(node);
        fcutcopyinfo[2] := true;
    end 
    function pasttonode(nd);//粘贴节点
    begin
        if not fcutcopyinfo then return ;
        ifc := fcutcopyinfo[2];
        r := pastinfotonode(nd,fcutcopyinfo,1,not(ifc)); 
        if ifc and not(r) then fcutcopyinfo := nil;    //如果失败就不清除内容
    end 
    function pastinfotonode(nd,data,fst,notcute); //粘贴节点
    begin
        tc := data[0];
        if ifstring(tc) then tc := class(TDComponent).GetClassItem(tc);
        if (tc is class(TDRootComponent)) and not( tc is class(TDMenu)) then 
        begin
            tr := nd.owner;
            nd  := (tr.RootItem.items)[0];
        end 
        pwnd := nd.Component.Cwnd;
        nnd := tc.ComponentCreater(nd,pwnd);
        if not nnd then return 1; //加入失败处理
        nnd.CreateName();    
        FVariableSelecter.additem(nnd);
        BindCwndMessage(nnd.Cwnd);
        if fst and (pwnd is class(TWinControl)) then 
            pclt := pwnd.ClientRect; //获得父节点区域
        for i,v in data do 
        begin
            vi := v;
            if not ifstring(i) then continue;
            ///////////////////////
            if pclt and ( (i = "left") or (i= "top") ) then  //特殊位置处理
            begin
                if notcute then //复制
                begin
                    vi+=6;
                end 
                pidx := 2;
                if i = "top" then pidx := 3 ; //位置判断
                if vi>pclt[pidx] then 
                begin
                    vi := integer(pclt[pidx]+(pclt[pidx-2]/2)-10); //位置处理
                end                 
            end 
            nnd.SetComponentProperties(i,vi);       
        end 
        for i,v in data[1] do 
        begin
            pastinfotonode(nnd.TreeNode,v);            
        end 
    end 
    function getnodeinfodata(node); //复制节点信息
    begin
        tc := node.Component;
        r := array();
        if tc is class(TDComponent) then 
        begin
            r[0] := tc.dclassname() ;
            cr := tc.GetChangedPublish(2);
            for i,v in cr do 
            begin
                if not(v and ifstring(i) ) then continue; //严格判断
                r[i] := v;
            end 
            for i := 0 to node.ItemCount-1 do 
            begin
                r[1,i] := getnodeinfodata((node.items)[i]);//
            end 
        end 
        return r;    
    end 
    public //设计器工程
    function OpenFileFromTpjFile(); //从文件打开工程 
    begin
        FProjectFileOpener.caption := "打开";
        if FProjectFileOpener.OpenDlg() then 
        begin 
            f := FProjectFileOpener.FileName;
            FProjectsManager.OpenFileFromTpjFile(f);
            fio := ioFileseparator();
            for i := length(f) downto 2 do 
            begin
                if f[i]=fio then 
                begin
                    FProjectFileOpener.initialDir := f[1:(i-1)];
                    break;
                end 
            end 
        end 
    end
    function OpenExaple(); 
    begin
        FProjectFileOpener.caption := "打开范例...."; 
        f := 0;// tslfilename();
        fio := ioFileseparator();
        if f then 
        begin 
            for i := length(f) downto 2 do 
            begin
                if f[i]=fio then 
                begin
                    ef := f[1:i]+"examples";
                    if filelist("",ef) then 
                    begin 
                        FProjectFileOpener.initialDir := ef;
                    end 
                    else 
                    begin 
                        FProjectFileOpener.initialDir := f[1:(i-1)];
                    end 
                    break;
                end 
            end 
        end else 
        begin   
            f := sysexecname();     
            for i := length(f) downto 3 do 
            begin
                if f[i]=fio then 
                begin
                    ef := f[1:i]+"designer"+fio+"examples";
                    if filelist("",ef) then 
                    begin 
                        FProjectFileOpener.initialDir := ef;
                    end 
                    else 
                    begin 
                        FProjectFileOpener.initialDir := f[1:(i-1)];
                    end 
                    break;
                end 
            end 
        end 
        if FProjectFileOpener.OpenDlg() then 
        begin  
            //echo ,"\r\n";
            FProjectsManager.OpenFileFromTpjFile(FProjectFileOpener.FileName);
        end    
    end  
    function CreateTpjFomFile();//新建工程
    begin
        FProjectFileOpener.caption := "新建";
        if FProjectFileOpener.OpenDlg() then 
        begin 
            f := FProjectFileOpener.FileName;
            if parseregexpr(".tpj$",f,"",pp1,pp2,pp3)<>1 then f+=".tpj";
            FProjectsManager.CreateTpjFomFile(f);
        end 
    end 
    function db(o,e): WM_NCLBUTTONDBLCLK;virtual;//最大化处理
    begin
        e.skip := true;
    end 
    function openclassfile(); //打开编辑器
    begin
        FProjectManager.ShowCurrentFormCode();//ShowEditor();
    end 
    function TreeNode2tfm(lib,itemnames,nd); //转换文件 
    begin
    {**
        @explan(说明) 将结构转换为文件格式 %%
    **}
        r :=  TreeNode2tfmsub(lib,nil,itemnames,nd);
        if itemnames then itemnames := itemnames[1:];
        return r;
    end 

    function saveCurrentForm();  //保存当前编辑
    begin
        FProjectManager.saveCurrentEdit();
    end 
    function mainmenus(); //设计器菜单
    begin
    {**
        @explan(说明) 菜单
    **}
        return array(
        ("type":"menu","caption":"文件","onclick",nil,"items":(
            ("type":"menu","caption":"保存","onclick":thisfunction(saveCurrentForm), 
            "bitmap":GetSaveFileBitmapInfo()),
            ("type":"menu","caption":"代码编辑","onclick":thisfunction(openclassfile),
            "bitmap":geteditcodebitmapinfo())
            )),
        ("type":"menu","caption":"视图","items":(
            ("type":"menu","caption":"工程文件管理","checked":1,"bitmap":GetWindowMgrBmp(),"onclick":thisfunction(ShowProjectView)),
            ("type":"menu","caption":"对象浏览","checked":true,"onclick":thisfunction(Mobjinspect),
            "bitmap":getdefaultbmpinfo())
            )),
        ("type":"menu","caption":"工程","items":(
            ("type":"menu","caption":"打开工程","onclick":thisfunction(OpenFileFromTpjFile), 
            "bitmap":GetOpenFileBitmapInfo()),
            ("type":"menu","caption":"新建工程","onclick":thisfunction(CreateTpjFomFile), 
            "bitmap":getcreateprojectbmpinfo()),
            ("type":"menu","caption":"打开历史","onclick":thisfunction(OpenProjectFromtpj), 
            "bitmap":GetHostroyBimp()),
            //("type":"menu","caption":"打包到","onclick":thisfunction(WrapProjectTo),"bitmap":getwrapprojectbmpinfo())
            )
            ),
        ("type":"menu","caption":"运行","items":(
        ("type":"menu","caption":"配置命令行","onclick":thisfunction(editcommandline)),
        //{$ifdef linux}
        //("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu","bitmap":getrunbmpinfo()),
        //("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu","bitmap":getstopbmpinfo()),
        //{$else}
        ("type":"menu","caption":"运行","bitmap":getrunbmpinfo(),"onclick":thisfunction(  debugproject)),  //之前的调试运行
        //{$endif}
          
        )),
        ("type":"menu","caption":"工具","items":(
            ("type":"menu","caption":"打开图片","checked":0,"onclick":thisfunction(ViewBitmap))
            )),
        ("type":"menu","caption":"帮助","items":(
            ("type":"menu","caption":"使用手册","onclick":thisfunction(OpenHelp),
            "bitmap":getmanubmpinfo()),
            ("type":"menu","caption":"控件详情","onclick":thisfunction(OpenHelp),
            "bitmap":getctlsbmpinfo()),
            ("type":"menu","caption":"范例..","onclick":thisfunction(OpenExaple),
            "bitmap":getexamplesbmpinfo())
            ),
            
        )
        );
    end 
    public //编辑器中代码操作
    function DeleFiledFromEdit(n,nn); //删除变量
    begin
        if FTree.Loading then return ;
        FProjectManager.DeleteAFiled(n,nn);
    end 
    function AddFiledFromEdit(n); //添加变量
    begin
        if FTree.Loading then return ;
        FProjectManager.AddAFiled(n);
    end
    function AddusesFromEdit(lbs); //添加uses
    begin
        if FTree.Loading then return ;
        FProjectManager.adduses(lbs);
    end
    function EditerCodeChanged(nd); //代码改变
    begin
        if FTree.Loading then return ;
        classinfo := FProjectManager.GetFormClassInfo(nd);
        if classinfo and ifarray(classinfo) then 
        begin 
            class(TDComponent).TemporaryNotName := classinfo["members"];
            SetFunctionList(classinfo["funcs"]);
        end
    end  
    function LoadProject(n);  //当如工程
    begin
        FProjectManager.SetProjectInfo(n);
    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 OpenHelp(o,e); //打开帮助
    begin
        if not FChmHelper then 
        begin 
            FChmHelper := new unit(UtslCodeEditor).TTslChmHelp();
        end 
        case o.caption of 
            "使用手册":
            begin
                FChmHelper.ChmName := "help\\designerUserGuid.CHM"; 
              // p := "C:\\Program Files\\Tinysoft\\Analyse.NETplug\\help\\designerUserGuid.pdf" ;//pluginpath()+"..\\help\\designerUserGuid.pdf";
               //_wapi.WinExec(format('cmd.exe /C call "start %s"',p),0); //http://bzjj.sinaapp.com/tslvclhelp/index.html
               //_wapi.WinExec(format('start "%s"',p),0);
                //_wapi.WinExec('cmd.exe /C start http://bzjj.sinaapp.com/tslvclhelp/index.html',0);
                //_wapi.WinExec('cmd.exe /C "start http://bzjj.sinaapp.com/tvcldesignerhelp/tvcldesigner.pdf"',0);
                
            end 
            "常用控件":
            begin
                FChmHelper.ChmName := "help\\vclNormalControls.CHM"; 
            end 
            "控件详情":
            begin
                FChmHelper.ChmName := "help\\tslvclhelp.chm";                  
            end         
        end 
        FChmHelper.ShowTslLangChm(); 
        //_wapi.WinExec('cmd.exe /C start http://bzjj.sinaapp.com/tslvclhelp/index.html',0);
    end 
    function ComponentMove(o,e); //控件移动
    begin    
    {**
        @explan(说明) 移动 控件 %%
    **}
        //setcomponentfocus(o,false);
        FPropGrid.SetGridValue("left",O.left,O)    ;
        FPropGrid.SetGridValue("top",o.top,O);    
        
    end 
    function ComponentSize(o,e);//大小改变
    begin
    {**
        @explan(说明) 调整控件大小 %%
    **}
        FPropGrid.SetGridValue("width",o.width,O);
        FPropGrid.SetGridValue("height",o.height,O);    
        //setcomponentfocus(o,false);
    end 
    function DesignerClose(o,e) //控件窗口关闭
    begin
    {**
        @explan(说明)保存 %%
    **}
        if _wapi.MessageBoxA(self.Handle,"退出应用","提示", MB_YESNO.| MB_ICONWARNING) = IDNO then 
        begin
            e.skip := true;
        end 
        else 
        begin //工程处理
            FProjectManager.StopProject();
            FProjectManager.CloseCurrentEdit("all");
        end 
    end 
    function CompClose(o,e); //隐藏控件
    begin
    {**
        @explan(说明) 控件关闭 %%
    **}
        e.skip := true;
    end 
    function OnDesignerActivate(o,e);
    begin
    {**
        @explan(说明) 设计器被激活 %%
    **}
        return ;
        if e.wparam = WA_CLICKACTIVE then 
        begin
        end 
    end 
    
    public //控件选中
    //****************************************
    function CreateComponent(); //构造控件 
    begin
    {**
        @explan(说明) 构造组件 %%
        @return (TDComponent)     
    **}
        if FComponentCreater and FCurrentNode and FCurrentClikPos then 
        begin
            par := FCurrentNode.Component.Cwnd;
            r := FComponentCreater.ComponentCreater(FCurrentNode,FCurrentNode.Component.Cwnd);
            if not r then exit;
            r.CreateName();    
            FVariableSelecter.additem(r);
            BindCwndMessage(r.Cwnd);
            if ifarray(FCurrentClikPos) and (r.Cwnd is class(TControl))   then 
            begin
                if   r.Cwnd.Align<>alnone  then 
                begin
                    //par.DoControlAlign();
                end else 
                begin 
                    x := FCurrentClikPos[0];
                    y := FCurrentClikPos[1];
                    if r.Cwnd is class(TControl) then 
                    begin 
                        if ifnumber(x) then r.Cwnd.left := x;
                        if ifnumber(y) then r.Cwnd.top := y;
                    end 
                end 
            end 
            FTree.SetSel(r.TreeNode);
        end 
        FCurrentClikPos := nil;
        FComponentCreater := nil;
        FCurrentNode := nil;
        FTree.PopupMenu := nil;
        //echo "\r\n 添加控件";
        return r;
    end 
    function setcomponentfocus(cwnd,fk); //设置获得选中
    begin
        {**
        @explan(说明) 设计控件获得焦点 %%
    **}
        if not(cwnd is class(TWincontrol)) then exit ;
        if not cwnd.HandleAllocated() then exit;
        return cwnd.DesigningSelect(fk);
    end 
    function TreeNodeSelected(n); //控件树选中节点
    begin
    {**
        @explan(说明) 节点被选择 %%
        @param(n)(TComponentTreeNode) 被选择节点 %%
    **}
        if FCurrentNode=n then exit;
        FCurrentNode := n;
        if not ifobj(n) then exit;
        t := n.Component;
        if not t then exit;
        mu := t.CreateMenu();
        n.owner.PopupMenu := mu;
        FPropGrid.Component := t;
        FEventGrid.Component := t;
        wd := t.cwnd ;
        setcomponentfocus(wd,true);
        return t.SelectedNode();        
    end 
    private //右键菜单处理
    function RClickComponent(o,e); //右键控件窗口
    begin
    {**
        @explan(说明)右键菜单 %%
    **}
        nd := o._tag;
        tr := nd.owner;
        if not(tr.visible) then 
        begin
            wnd := fwindowinfos.getnodebytree(tr);
            FProjectManager.setnodesel(wnd);
            return ;//
        end 
        if FCurrentNode<>nd then 
        begin
            nd.owner.SetSel(nd);
            TreeNodeSelected(nd);
        end 
        cp := nd.Component;
        if cp  then 
        begin 
            mu := cp.CreateMenu();            
            if mu then 
            begin
                //直接将弹出菜单赋值给控件,修正gtk窗口焦点导致弹出菜单的问题
                cwnd := cp.Cwnd;
                cwnd.PopupMenu := mu;                 
                xy := o.ClientToScreen(e.lolparamsigned,e.hilparamsigned);
                _send_(WM_CONTEXTMENU,cwnd.handle,makeposition(xy[0],xy[1]),1);
                return ;
                uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
                _wapi.TrackPopupMenu(mu.Handle,uf,xy[0],xy[1],0,self.Handle,nil);
            end 
        end 
    end 
    //FClickTime;
    public  //双击添加事件到代码
    function addandopeneventbyname(nd,n); //打开事件函数位置
    begin
        if nd then 
        begin
            cp := nd.Component;
            if cp  then 
            begin
                pe := cp.GetPublishEvents();
                if ifstring(n) and n then 
                begin
                    de := cp.geteventfunctionbyname(n);
                end else 
                    de := cp.DefaultEvent;
                if ifarray(de) and de then 
                begin 
                    dei := de["event"];
                    dvs := pe[dei];
                    if ifarray(dvs) then 
                    begin
                        dv := dvs["value"];
                        if not dv then 
                        begin
                            td := de;
                            td["name"] := cp.Name+"_"+td["name"];
                            if FProjectManager.AddAFunction(td) then 
                            begin 
                                FEventGrid.SetGridValue(dei,td["name"],cp.Cwnd);
                                FProjectManager.GoToAFunction(td["name"]);
                                return ;
                            end     
                        end else 
                        begin
                            FProjectManager.GoToAFunction(dv);
                            return ;
                        end
                    end 
                end         
            end 
        end  
        FProjectManager.ShowEditor();    
    end 
    function AddAndOPenEvent(nd); //打开事件函数
    begin
        {**
            @explan(说明)通过节点打开函数编辑器 %%
        **}        
        addandopeneventbyname(nd,n); 
    end 
    function DBLClickComponent(o,e);//双击组件
    begin
    {**
        @explan(说明) 组件被双击 %%
    **}
        if o then AddAndOPenEvent(o._tag);
        if e then e.skip := true;
    end 
    private //节点点击
    function ClickComponent(o,e); //点击组件选择
    begin
    {**
        @explan(说明) 组件被点击 %%
    **}
        nd := o._tag;
        tr := nd.owner;
        if not(tr.visible) then 
        begin
            wnd := fwindowinfos.getnodebytree(tr);
            FProjectManager.setnodesel(wnd);
            return ;//
        end 
        if FCurrentNode<> nd then 
        begin 
            wd := o;//nd.Component.Cwnd;
            //if wd is class(TWincontrol) then _wapi.BringWindowToTop(wd.Handle); 
            tr.SetSel(nd);
            TreeNodeSelected(nd);
        end; 
        setcomponentfocus(o,true);
        if FComponentCreater and FCurrentNode then 
        begin 
            //SetSysParam("cpos_screan",array(e.lolparam,e.hilparam));
            if FComponentCreater is class(TDRootComponent) then 
            begin 
                FCurrentNode := (tr.RootItem.items)[0];
                if  not FCurrentNode then exit;
                O1 := FCurrentNode.Component.Cwnd;
                if not o1 then exit;
            end else o1 := o;  
            xy := array(0,0);  
            _wapi.GetCursorPos(xy);
            FCurrentClikPos := o.ScreenToClient(xy[0],xy[1]);
            //FCurrentClikPos := array(e.lolparam,e.hilparam);//o1.screentoclient(e.lolparam,e.hilparam);   
            r := CreateComponent(); 
        end 
        return ;
    end 
    function ClickTreeNode(o,e);//点击树选择 
    begin
    {**
        @explan(说明) 通过点击选择节点 %%
    **}
        od := e.itemold;
        if od then 
        begin
            cp := od.Component;
            if cp then 
            begin
                setcomponentfocus(cp.Cwnd,false); 
            end 
        end 
        TreeNodeSelected(e.item);
    end 


    function SpectorClose(o,e);//objectspector 关闭 
    begin
    {**
        @explan(说明) 目录树关闭 %%
    **}
        e.skip := true;
        o.visible := false;
        if o._Tag is class(tmenu) then o._tag.Checked := false;
    end 

    function OnToolButtonCick(o,e);  //工具按钮被点击
    begin
        {**
            @explan(说明) 选择工具按钮 %%
        **}
        cct := o._tag;
        //if FComponentCreater=cct then exit;
        FComponentCreater := cct;        
    end 
    
    function CloseShowForm(); //主窗口关闭
    begin
    {**
        @explan(说明)关闭当前工程窗口%%
    **}
       FProjectManager.CloseCurrentEdit(nil,true);
    end 
    public //设计器中绑定事件
    function BindCwndMessage(wnd); //给控件绑定处理函数
    begin
    {**
        @explan(说明) 为控件添加事件 %%
    **}
        if wnd is class(tmenu) then wnd.OnDesignClick := thisfunction(ClickComponent);
        if wnd is  class(TWincontrol) then 
        begin
            wnd.OnDesignClick := thisfunction(ClickComponent);
            wnd.OnDesigndblClick := thisfunction(DBLClickComponent);
            wnd.OnDesignrClick := thisfunction(RClickComponent);
            wnd.onmove := thisfunction(ComponentMove);
            wnd.onsize := thisfunction(ComponentSize);
            //wnd.Onclose := thisfunction(CompClose); //只是忽略 
            wnd.Onclose := function(o,e)begin
                    e.skip := true;
                    CloseShowForm();  //并保存窗口信息
                end ;  
            wnd.bindmessage(wnd.WM_NCLBUTTONDOWN,thisfunction(ClickComponent));
            //WM_NCLBUTTONUP wnd.
            if  (wnd is class(TVCForm)) then 
            begin
                wnd.OnMinimize := thisfunction(CompClose);
            end 
        end 
    end 
    function UnLoadTreeNode(wndnode); //卸载控件树
    begin
    {**
        @explan(说明) 卸载tree的节点%%
    **}   
        nd := fwindowinfos.getdata(wndnode);
        if not nd then return ;
        hidenatree(nd);
        tr := nd.ftree;
        node := tr.RootItem;
        if node.ItemCount>0 then
        begin
            DeleteNode((Node.items)[0]);
        end
        fwindowinfos.deletedata(wndnode);
        tr.Recycling();
    end 
    private //不同窗口切换
    function hidenatree(nd);//隐藏控件树
    begin
        FCurrentNode := nil;
        if nd then 
        begin 
            tr := nd.ftree;
            tr.visible := false;
            nd.fvars :=  FVariableSelecter.getlistds();
            nd.fcomp := FEventGrid.Component;
            FEventGrid.Component := array();
            FPropGrid.Component := array();
            nd.ffuncs :=  FFunctionSelecter.List.data;
            nd.fnames := class(TDComponent).TemporaryNotName;
            class(TDComponent).TemporaryNotName:= array();
        end 
    end 
    function showtree(nd); //显示控件树
    begin
        FCurrentNode := nil;
        tr := nd.ftree;
        tr.visible := false;
        FTree.visible := true;
        FVariableSelecter.setlistds(nd.fvars);
        FFunctionSelecter.additems(nd.ffuncs);
        class(TDComponent).TemporaryNotName := nd.fnames;
        FPropGrid.Component := nd.fcomp ;
        FEventGrid.Component := nd.fcomp ;
    end 
    function switchtree(nd); //切换控件树
    begin
        FCurrentNode := nil;
        if nd<>fcwindowinfo then 
        begin
            if fcwindowinfo then //处理就有的
            begin
                hidenatree(fcwindowinfo);
            end 
            fcwindowinfo := nd;
            if nd then 
            begin
                FTree := fcwindowinfo.ftree;
                showtree(fcwindowinfo);
                if not(nd.fclk) then  //不在最上层处理一下
                begin                     
                    nnd := FTree.RootItem.GetNodeByIndex(0);
                    if nnd then 
                    begin
                        cp := nnd.Component;
                        if cp then 
                        begin 
                            wd := cp.Cwnd;                
                            if wd.visible then 
                            begin
                                wd.visible := false;
                                wd.visible := true;                   
                            end 
                        end 
                    end 
                end 
                nd.fclk := false;                
            end 
        end 
    end 
    public //加载以及处理
    function ExecuteCommand(cmd,p);override;
    begin
        case cmd of 
            "imglist":
            begin
                return fdimagelist;
            end 
            "allopendnod":
            begin
                r := array();
                for i,v in fwindowinfos.fdata.data do 
                begin
                    r[i] := v.fnode;
                end 
                return r;
            end 
            "hiddrennode":
            begin
                hidenatree(fcwindowinfo);
                fcwindowinfo := nil;
            end 
        
            "renamefile": //修改名字
            begin
                node := FTree.RootItem;
                nnd := node.GetNodeByIndex(0);  
                if nnd then 
                begin
                    nnd.Component.dclassname(p);
                    cp := nnd.caption;
                    pidx := pos(":",cp);
                    if pidx then cp[pidx:] := ":"+p;
                    nnd.caption := cp;
                end 
            end 
            else 
                return inherited;
        end ;
        
    end 
    function LoadTreeNode(Ptfm,inh,wndnode);//加载控件树
    begin
    {**
        @explan(说明) 加载tree节点 %%
    **}
        if FTree and FTree.Loading then return ;
        cwindowinfo := fwindowinfos.getorcreate(wndnode,ifold);        
        if cwindowinfo = fcwindowinfo then 
        begin
            return ;//重复导入
        end 
        switchtree(cwindowinfo);
        //处理新的        
        if ifold then 
        begin
            return ;//
        end 
        FTree.Loading := true; 
        try 
            prs := array();  
            obarray := array(); 
            loadtfmtotree(Ptfm,Ptfm.gettree,FTree.RootItem,FTree,prs,obarray,const inh);
            for i,v in prs do 
            begin
                va := obarray[v[2]]; 
                if va then 
                begin
                    v[0].SetComponentProperties(v[1],va.GetTrueComponent());
                end 
            end 
            
        except 
        end ;
        FTree.Loading := nil;
    end 
    function loadtfmtotree(p,d,node,wr,prs,obarray,inhname);//当如信息
    begin
    {**
        @explan(说明) 导入tfm文件 %%
    **}
        if  not ifarray(d) then exit;
        if not d["type"]=p.TT_COMP then exit;
        dcls := d["class"];
        it := class(TDComponent).GetClassItem(dcls);
        if not it then 
        begin
            if ("tdcreateform" in inhname) then 
            begin 
                it := NEW TDForm();
            end else 
            if "tdcreatepanel" in inhname then
            begin  
                it := new TDPanelForm();
            end else return ;
            it.dclassname(d["class"]);
            it.Imgs := fdimagelist.GetImageId("tdcreateform");
        end 
        comp := it.ComponentCreater(node,wr);
        comp.name := d["name"];
        obarray[d["name"]] := comp;
        FVariableSelecter.additem(comp);
        BindCwndMessage(comp.Cwnd);
        pubs := comp.GetPublishProperties() union comp.GetPublishEvents();
        dprop := d["property"];
        ddp := array();
        for i,v in dprop do 
        begin
            ddp[v["name"]] :=v;
        end 
        if comp.DefaultAlign() then 
        begin
            if ifarray(ddp["align"]) and (ddp["align"]["value"]="alnone") then 
            begin
                comp.Cwnd.align := alnone;
            end 
        end 
        lazy := array(); 
        for i,v in pubs do 
        begin
            n := i;
            ddpv := ddp[n];
            if not ifarray(ddpv) then continue;
            cls := v["class"];
            et := GetComponentPropertyType(cls);//GetPropertyType(cls);
            if not et then continue;
            setddpv := et.TmfToNode(p.SampleValue(ddpv));
            if et.IfComponent() then 
            begin
                prs[length(prs)]:= array(comp,n,setddpv);
                continue;
            end 
            if et.LazyProperty() then 
            begin
                lazy[length(lazy)] := array(n,setddpv);
                continue;
            end 
            comp.SetComponentProperties(n,setddpv);
        end 
        for i,v in d["object"] do 
        begin    
            call(thisfunction,p,v,comp.TreeNode,comp.Cwnd,prs,obarray,inhname);
        end 
        for i,v in lazy do 
        begin
            comp.SetComponentProperties(v[0],v[1]);
        end 
        //comp.DoControlAlign();
    end 
    function SetFunctionList(v); //设置函数信息
    begin
    {**
        @explan(说明) 设置当前类使用的函数名称 %%
    **}
        FFunctionSelecter.clean();
        FFunctionSelecter.additem("(none)");
        for i,vi in v do 
        begin
            if vi in array("(none)","create","destroy","recycling","loadfromtfm") then continue;
            FFunctionSelecter.additem(vi);
        end 
    end 
    
    function create(AOwner);
    begin
        inherited; 
        
        top := 10;
        left := 10;
        rect := _wapi.GetScreenRect();
        twidth := (rect[2]-50);
        width := twidth;
        calcheight(twidth);
        caption := "TVCL界面设计器";    
        FProjectsManager := new TProjectManagerForm(self);
        ico := new tbitmap();
        ico.Readvcon(HexFormatStrToTsl( GetHostroyBimp()));
        FProjectsManager.FormICon :=  ico.ToIcon();
        
        FProjectsManager.parent  := self;
        FProjectManager := new TProjectView(self);
        FProjectManager.height := rect[3]-top-height-20;
        FProjectManager.left := left;
        FProjectManager.top := top+height;
        ico := new tbitmap();
        ico.Readvcon(HexFormatStrToTsl(GetWindowMgrBmp()));
        FProjectManager.FormICon := ico.ToIcon();
        FProjectManager.parent := self;
        //FTempCanvas := new 
        //***********************************************
        FObjInspector := initobjinspector();
        FObjInspector.height := rect[3]-top-height-20;
        tparent := new TPairSplitterSide(self);
        tparent.border := false;
        pparent := new TPairSplitterSide(self);
        //**********树************************
        //FTree := new TComponentTree(self);
        //FTree.onselchanged := thisfunction(ClickTreeNode);
        //FTree.align := alClient;
        //*************属性修改器**********************
        pedits :=  new TPageControl(self);
        pedits.align := alclient;
        FProp := new TTabSheet(self);
        FProp.caption := "properties";
        FEvent := new TTabSheet(self);    
        FEvent.caption := "events";
        FPropGrid := new TPropEditGrid(self);
        FPropGrid.border := false;
        FPropGrid.Component := self;
        FEventGrid := new TEventEditGrid(self);
        FVariableSelecter := new TListVariableFilter(self);
        FVariableSelecter.visible := false;
        FVariableSelecter.parent := FPropGrid;
        FFunctionSelecter := new TListStr(self);
        FFunctionSelecter.visible := false;
        FFunctionSelecter.parent := FEventGrid;
        FEventGrid.EventEditer := FFunctionSelecter;
        FPropGrid.VariabeEditer := FVariableSelecter;
        //**************父窗口关系*********************    
        FObjInspector.parent := self;
        tparent.parent := FObjInspector;
        pparent.parent := FObjInspector;
        //FTree.parent := tparent;
        pedits.parent := pparent ;
        FProp.parent := pedits;
        FEvent.parent := pedits;
        
        FPropGrid.align := alclient;
        FEventGrid.align := alclient;
        FPropGrid.parent := FProp;
        FEventGrid.parent := FEvent;
        
        Mobjinspect();

        onactivate := thisfunction(OnDesignerActivate);
        fdimagelist :=  new TDesigImageList(self); 
        //FTree.Imagelist := fdimagelist;
        fwindowinfos := new tfilesinfo(self,thisfunction(ClickTreeNode),fdimagelist,tparent); 
        //******************toolbar ***************
        tlbar := FProjectManager.FTslEditer.gettoolbar();
        savebtn := FProjectManager.FTslEditer.gettoolbarbtn();
        for i,v in  savebtn do  //处理一下保存工程
        begin
            v._tag := array(thisfunction(saveCurrentForm),v.onclick);
            v.onclick := function(o,e)
                        begin
                            for i,v in o._tag do 
                            begin
                                CallDataFunction(v,o,e);
                            end 
                        end 
        end 
        tlbar.Align := alLeft;
        tlbar.width :=450;
        tlbar.parent := self;
        tlbar.arrange :="0;1";
        sp1 := new tsplitter(self);
        sp1.Align := alLeft;
        sp1.parent := self;
        FToolBars := new TDesignertoolbars(self);
        FToolBars.parent := self;
        FToolBars.Imagelist := fdimagelist;
        FToolBars.Font.width := 9;
        FToolBars.Font.height := 18;
        
        addtoolbuttons();
        FToolBars.Align := alClient;
        //************菜单******************************
        createmainmenubyarray(mainmenus(),FMenu0,self);
        Mainmenu := FMenu0;
        self.onclose := thisfunction(DesignerClose);
        ic := new Ticon();
        ic.Readvcon(HexFormatStrToTsl(GetTsIconBitmapInfo()));
        self.FormICon := ic;        
        //文件打窗口        
        FProjectFileOpener := new  TOpenFileADlg(self);
        FProjectFileOpener.filter := array("tvcl工程":"*.tpj");
        FProjectFileOpener.parent := self;
        FProjectManager.FTslEditer.setdbugruncall(thisfunction(debugproject)); //设置调试回调
        
    end 
    property VariableSelecter read FVariableSelecter; //当前控件树的变量对象
    private  //其他资源函数
    function ViewBitmap(o,e);
    begin
        if not FViewBitmap then 
        begin
            FViewBitmap := new TViewBitmap(self);
            FViewBitmap.minmaxbox := FALSE;
            FViewBitmap.visible := 0;
            FViewBitmap.visible := false;
            FViewBitmap.onclose := thisfunction(SpectorClose);
            FViewBitmap.parent := self;
            FViewBitmap._Tag := o;
            //FViewBitmap.show(0);
        end 
        FViewBitmap.visible := not  FViewBitmap.visible;
        if o then o.Checked := FViewBitmap.visible;
    end 
    function StopProject(o,e); //停止运行,目前没用
    begin
        //FRounMenu.Enabled := true;
        //FStopMenu.Enabled := false;
        FProjectManager.StopProject();
    end 
    function RunProject(o,e); //运行
    begin
        FRounMenu.Enabled := false;
        FStopMenu.Enabled := true;
        FProjectManager.RunProject();
        FRounMenu.Enabled := true;
        FStopMenu.Enabled := false;
    end 
    function editcommandline();//执行命令行
    begin
        FProjectManager.ShowExeEditer();        
    end 
    function debugproject(o,e); //调试运行
    begin
        FProjectManager.debugproject();    
    end 
    function Mobjinspect(o,e); //切换属性展示器
    begin
    {**
        @explan(说明) 属性修改器 %%
    **}
        FObjInspector.Visible := not FObjInspector.Visible;
        if FObjInspector.Visible then 
        begin 
            FObjInspector.left := width+ Left-FObjInspector.width;
            FObjInspector.top := top+height;
        end 
        if o then 
        begin 
            FObjInspector._tag := o;
            o.Checked := FObjInspector.Visible
        end   
    end 
    function initobjinspector(); //初始化
    begin
        project := new TPairSplitter(self);
        project.visible := false;
        project.caption := "object inspector";
        project.Onclose := thisfunction(spectorclose);
        project.WsPopUp := true;
        project.Visible := false;
        project.Width := 300;//
        project.height := 800;
        project.WsCaption := true;
        project.WsSysmenu := true;
        project.WSSizebox := true;    
        project.SplitterType := pstVertical;
        project.position := 250;
        return project;
    end 
    function GetWindowMgrBmp();
    begin
    
        return "0502000000060400000074797065000203000000696D670006040000006461746
10002DA01000089504E470D0A1A0A0000000D4948445200000010000000100806
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000016F49444154
384FA593EB4EC2401484F7790595702FC59710451451047C0C140C218410EA637
0BFDF2119CF54DA748DBFA0C964DBCDCC7732BBA9C2998F4A96DA48962C24DFBF
65A52C98450B89621BC65B0BF17C13B19706A2B93A22D91AC24F5FC7E8EF23000
B370C1F650A242100A3D0465C00B1D726A202883CD7255C43E8F11F8016161902
880B20966F212A8070AE8150B68EA00082993F005300FBFD1E87C3C115BF77BB1
D369B0D96CB25E6F33926930986C321020F55AD8E32A52BCD1483DEF07ABDB601
B3D9CC055CA72B5A1D9528B46CF376BB75E50D73FA743AC56834C26030C0E57D4
5ABA30C39651A57AB951DE2CA6F27CCE9E3F1D806F4FB7DF8EF3EB53A8A5744A3
A3C562E10639D909737AAFD783CF03601DC503E106CD14DF1D39619A39DD06A43
EB43A8AA7C90DAF18A0686290EA76BBE8743AF0DD966D8F5347F12A789A415120
53C5B5F4BA4A57E1173A0D9C485D1C575FAAACD5D1FE8553EA688053EA688053E
A9CF93B033F9EA579B5AA7EC4E00000000049454E44AE42608200";
    end 
    FProjectFileOpener;
end 


implementation
type tfileinfonode = class()
    fnode;   //文件节点
    ftree;  //窗口对应树
    ffuncs;  //函数名
    fvars;   //变量
    fnames;  //可用的变量名
    fcomp;   //选中的控件
    fclk;    //是否点击选择
end 
type tfilesinfo = class() //控件树存储对象
    private
    fdesginer;
    fcompclick;
    fimg;
    fparent;
    public 
    function create(dser,clk,img,fp);
    begin
        FData := new tnumindexarray();
        fimg := img;
        fcompclick := clk;
        fdesginer := dser;
        fparent := fp;
        
    end 
    function getdata(id); //通文件节点获得信息
    begin
        if not id then return  fdata;
        for i,v in fdata.data do 
        begin
            if v.fnode = id then return v;
        end 
    end 
    function gettreebyid(id); //通过文件节点树获得树
    begin
        if not id then return  fdata;
        for i,v in fdata.data do 
        begin
            if v.fnode = id then return v.FTree;
        end 
    end 
    function getnodebytree(tr); //通过树获得文件节点
    begin
        for i,v in fdata.data do 
        begin
            if v.ftree = tr then 
            begin
                v.fclk := true;
                return v.fnode;
            end 
        end  
    end 
    function getorcreate(id,ifold); //如果存在返回,不存在构造并返回
    begin
        nd := getdata(id);
        ifold := true ;
        if not nd then 
        begin
            tr := new TComponentTree(fdesginer);
            img := fdesginer.ExecuteCommand("imglist");
            tr.visible := false;
            tr.ImageList := img;
            tr.Align := tr.alClient;
            tr.parent := fparent;
            tr.onselchanged := fcompclick;
            nd := add(id,tr,array(),array());
            ifold := false;
        end 
        return nd;
    end 
    function add(nd,tr,fcs,vs);//添加一个
    begin
        for i,v in FData.data do 
        begin
            if v.fnode=nd then return 0;
        end 
        nnd := new tfileinfonode();
        FData.Push(nnd);
        nnd.fnode := nd;
        nnd.ftree := tr;
        nnd.ffuncs := fcs;
        nnd.fvars := vs;
        return nnd;
    end 
    function deletedata(id); //删除
    begin
        for i,v in FData.data do 
        begin
            if v.fnode = id then 
            begin
                r := v;
                FData.splice(i,1);
                return r;
            end 
        end 
    end 
    ftreeparnet;
    fdata;
end 
type TPropEditGrid = class(TPropGrid) //属性编辑
{**
    @explan(说明) 属性编辑 %%
**}
    protected
    function SetComponent(v);override;
    begin
        if v=FComponent then exit;
        if v is class(TDComponent) then 
        begin
            TSLData := v.GetPublishProperties();
        end else 
        begin
            TSLData := array();//array(NIL);
        end 
        inherited;
    end 
    public
    function Create(AOwner);
    begin
        inherited;
    end 

end 
type TEventEditGrid = class(TPropGrid)   //事件编辑器
{**
    @explan(说明) 事件编辑 %%
**}
    protected
    function SetComponent(v);override;
    begin
        if v=FComponent then exit;
        if v is class(TDComponent) then 
        begin
            TSLData := v.GetPublishEvents();
            //echo tostn(TSLData);
        end else 
        begin
            TSLData := array(NIL);
        end 
        inherited;
    end 

    public
    function Create(AOwner);
    begin
        inherited;
        OndblClick := thisfunction(GridCellDblClick);
    end 
    function GridCellDblClick(o,e);override;//双击处理
    begin
        i := e.iitem;
        j := e.isubitem;
        cellid := array(i,j);
        if not(i >= 0 and j >= 0)then
        begin
            exit;
        end
        d := getdata(i,j);
        if ifarray(d)and d["type"]="object" then
        begin
            rd := GetRegCellRender(d["class"]);
            if rd is class(TGCellRender)then //处理双击
            begin
                if FComponent then 
                begin
                    FDesigner.addandopeneventbyname(FComponent.TreeNode,getdata(i,0));//DBLClickComponent();
                end 
            end
        end 
    end

end 

type TDesigImageList = class(TControlImageList)
{**
    @explan(说明) 设计器imagelist %%
**}
    private
    FIconMaps;
    public 
    function Create(AOwner);override;
    begin
        inherited;
        Width := 24;
        Height := 24;
        FIconMaps := array();
    end 
    function RegisterDitem(item);virtual;
    begin
    {**
        @explan(说明) 注册图标 %%
        @param(item)(TDComponent) %%
    **}
        if item  is Class(TDComponent) then 
        begin
            n := item.dclassname;
            id :=  FIconMaps[n];
            bmp := item.bitmap();
            if (bmp is class(TcustomBitmap)) and bmp.HandleAllocated() then 
            begin
                if id>=0 then 
                begin
                    Replaceimge(id,bmp)    ;
                end else 
                begin
                    addbmp(bmp);
                    FIconMaps[n] := ImageCount-1;
                end  
            end 
        end 
    end 
    function GetImageId(v);
    begin
        if ifstring(v) then 
        begin
            n := v;
        end 
        if v is class(TDComponent) then 
        begin 
            n := V.dclassname;    
        end 
        r :=  FIconMaps[n];
        return r?r:0;
    end 
end 
type TDesignertoolbars = class(TPageControl)  //设计器控件按钮
    private
    FToolbars;
    FLabels ;
    fimg;
    
    function SetImageList(im);
    begin
        fimg := im;
    end 
    public
    Flabelcharlen;
    function Create(AOwner);override;
    begin
        inherited;
        align := alClient;
        FToolbars := array();
        Flabelcharlen := 0;
    end 
    Procedure Notification(AComponent,Operation);virtual;
    begin
        if Operation=opRemove then 
        begin 
            if AComponent=fimg  then 
            begin 
                fimg := nil;
            end else 
            begin 
                for i,v in FToolbars do 
                begin
                    if v=AComponent then 
                    begin
                        idx := i;
                    end 
                end 
                if idx then
                begin
                    reindex(FToolbars,array(idx:nil));
                end 
            end 
        end 
        inherited;
    end 
    function CrossCursor(f);
    begin
        for i,v in FToolbars do 
        begin
            if f then 
                v.Cursor := OCR_CROSS;
            else v.Cursor := OCR_NORMAL;
        end 
    end  
    function addbtn(btn,t); //加入按钮
    begin
        if not(t and  ifstring(t)) then 
        begin
            t := "常用";
        end 
        tb := FToolbars[t];
        if not tb then 
        begin
            st := new TTabSheet(self);
            st.caption := t;
            tb := new ttoolbar(self);
            tb.align := alClient;
            if t<>"隐藏"  then 
            begin
                st.parent := self;
                tb.parent := st;
                Flabelcharlen+= length(t)+2;
            end 
            tb.imagelist := fimg;
            FToolbars[t] := tb;
        end 
        btn.parent := tb;    
    end 
    property ImageList write SetImageList;
    
end 
 
type TViewBitmap = class(TvcForm)
{**
    @explan(说明) 图片信息采集%%
**}
    private
    FFileopen;
    FBmp;
    FText;
    FOldSize;
    Fimage;
    FMU;
    FMopen;
    FMhelp;
    FMCopy;
    FClipBoard;
    FLB;
    public 
    function paint();override;
    begin
        if FBmp and FBmp.Handle then 
        begin
            if FBmp.bmwidth<200 and FBmp.bmheight<300 then 
                FBmp.draw(self.canvas,650,100);
            else 
                FBmp.StretchDraw(self.canvas,array(650,100,650+200,100+300));
        end 
    end 
    function GetBimpOpenBmp();
    begin
        return getbitmapviewerbitmapinfo();
    end 
    function Create(AOwner);override;
    begin
        inherited;
        ico := new tbitmap();
        ico.Readvcon(HexFormatStrToTsl( GetBimpOpenBmp()));
        FormICon := ico.ToIcon();
        caption := "图片信息提取,支持bmp,ico,png,jpg,jpeg格式";
        FFileopen := new TOpenFileADlg(self);
        FClipBoard := new TClipBoard(self);
        FMU := new TMainmenu(self);
        FMopen := new TMenu(self);
        FMopen.caption := "打开图片";
        FMhelp := new TMenu(self);
        FMCopy := new TMenu(self);
        FMhelp.caption := "帮助";
        FMCopy.caption := "拷贝信息到粘贴板";
        FMopen.parent := FMU;
        FMCopy.parent := FMu;
        FMhelp.parent := FMu;
        FMhelp.OnClick := thisfunction(OnHelp);
        FMCopy.OnClick := thisfunction(OnCopy);
        FMopen.onclick := thisfunction(OpenBmp);
        FFileopen.wndowner := self;
        FFileopen.filter := array("all":"*.bmp;*.ico;*.png;*.jpg;*.jpeg","bmp":"*.bmp","ico":"*.ico","png":"*.png");
        FBmp := new TBitmap();
        FText := new TSynMemoNorm(self);
        FText.border := true;
        FText.readonly := true;
        FText.parent := self;
        
        FText.top := 15;
        FText.width := 600;
        FText.Height := 430;
        lb := new TLabel(self);
        FLB := lb;
        lb.caption := "浏览图片:";
        lb.left := 650;
        lb.top := 20;
        lb.width := 200;
        lb.parent := self;
        Fimage := new timage();
        FOldSize := array(0,0);
        Mainmenu := FMU;
    end 
    function OnHelp(o,e);
    begin
        _wapi.MessageBoxA(self.Handle,"将图片信息转换为16进制字符串\r\nHexFormatStrToTsl 函数可以将该信息转换为tsl数组\r\n然后btmap对象通过Readvcon读入该数组得到bitmap","帮助",0);
    end 
    function Oncopy(o,e);
    begin
        r := FText.text;
        if r then 
        begin 
            FClipBoard.text := r;
            _wapi.MessageBoxA(self.Handle,"拷贝到粘贴板成功!","提示",0);
        end else _wapi.MessageBoxA(self.Handle,"数据为空!","提示",0);
    end 
    function OpenBmp(o,e);virtual;
    begin
        IF FFileopen.ChooseDlg() then 
        begin
            r := 3;
            r := Fimage.LoadFromFile(FFileopen.FileName);
            if r<>0 then 
            begin
                _wapi.MessageBoxA(0,"打开失败","错误",0);
                return ;
            end 
            FBmp.Handle := Fimage.ToHBitmap();
            size := array(FBmp.bmwidth,FBmp.bmheight);
            Flb.caption := format("浏览图片:%d*%d",size[0],size[1]);
            rsize := array(min(300,max(size[0],FOldSize[0])),min(300,max(size[1],FOldSize[1])));
            FText.text :=  TSLToHexFormatStr(FBmp.TOvcon);
            Invalidaterect(array(650,100,650+rsize[0],100+rsize[1]));
            FOldSize := size;
        end 
    end 
end


function staticInit();
begin
    //class(TDSocketServer),class(TDSocketClient),   
    //注册的componet
    vclini := pluginpath()+"tslvcldesigner.ini";
    if fileexists("",vclini) then 
    begin
        ini := new TIniFileExta("",vclini);
        ini.LowerKey := true;
        its := array();
        for i,v in ini.ReadSectionValues("components") do  //控件
        begin
            if v then 
            begin
                cv := findclass(v);
                if cv then 
                begin
                    its[length(its)] := cv;
                end 
            end   
        end 
        o := class(TDComponent);
        o.RegestorClassItems(its);
        its := array();
        o.class(TPropGrid);
        for i,v in ini.ReadSectionValues("properties") do  //属性
        begin
            if v then 
            begin
                cv := findclass(v);
                if cv then 
                begin 
                    it := createobject( cv,0);
                    o.RegCellRender(it);
                end 
            end         
        end   
    end     
end  
////5108321
initialization
    staticInit();
end.