unit tslvclDesigner; {** @explan(说明)设计器库 %% **} interface uses tslvcl,cstructurelib,UVCPropertyTypesPersistence,utslmemo,UDesignerProject; function initlib(); //*******设计控件基类********************** //**********设计控件类************ type TComponentMenu= class(tmenu) {** @explan(说明) 设计控件菜单类 %% **} private FComponent; public function Create(AOwner);override; begin inherited; end function Recycling();override; begin FComponent := nil; inherited; end property Component read FComponent write FComponent; {** @param(Component)(TDComponent) 设计控件 %% **} end type TDComponent = class() {** @explan(说明) 设计控件基类 **} private feventnametable; FMenuDel; FTreeNode; FCwnd; FMenus; FBitmap; FImgs; class function DeleteItemsByIndexs(r,dxs); begin {** @explan(说明) 删除数组下标, %% @param(r)(array) 待删除下标的数组,采用字符串下标的数组,变参返回%%; **} if not ifarray(r) then exit; rdx := array(); for i,v in dxs do rdx[v] := nil; return reindex(r,rdx); end function SetImgs(id); begin FImgs := id; end function GetImgs(); begin return FImgs; end function SetName(v); begin SetComponentName(v); end function GetName(v); begin obj := GetTrueComponent(); if obj then return obj.Name; end function SetCwnd(v) begin if ifnil(FCwnd) and (v is class(TWincontrol)) then FCwnd := v; end function SetTreeNode(v); begin if FTreeNode<>v then begin if FTreeNode is class(TComponentTreeNode) then begin FTreeNode.Component := nil; end FTreeNode := V; if FTreeNode is class(TComponentTreeNode) then begin FTreeNode.Component := self(true); end end end public function libs();virtual; begin {** @explan(说明)关联的unit ; **} return array("tslvcl"); end function InToolBar();virtual; begin {** @explan(说明) 工具栏按钮是否可用 **} return true; end class function ClassName();virtual; begin {** @explan(说明) 控件类名称 该函数必须override%% **} return "tcomponent"; end function ComponentClass();virtual; begin {** @explan(说明) 控件类 %% **} return WndClass(); end class function HitTip();virtual; begin {** @explan(说明)工具栏提示 该函数必须override%% **} return "tcomponent"; end function classification();virtual; begin {** @explan(说明) 分类 %% **} return "常用"; end function DoControlAlign();virtual; begin {** @explan(说明) 调整控件 %% **} if FCwnd is class(TWincontrol) then FCwnd.DoControlAlign(); end function IsContainer();virtual; begin {** @explan(说明) 是否可以容纳其他控件 %% **} return true; end function bitmap();virtual; begin {** @explan(说明) 图标信息接口 %% **} if not FBitmap then begin FBitmap := new tbitmap(); d := HexFormatStrToTsl( bitmapinfo()); FBitmap.Readvcon(d); end return FBitmap; end function bitmapinfo();override; begin {** @expand(说明) 图标的bitmap信息 %% **} return GetDefaultIconInfo(); end function ClassObject();virtual; begin {** @ignore(忽略) %% @explan(说明) 返回自身的构造函数 该函数必须override %% **} return self(true).classinfo(1); end function WndClass();virtual; begin {** @explan(说明) 返回显示的窗口类,该函数必须override %% **} return class(TWincontrol); end function CheckParentWnd(Pwnd);virtual; begin {** @explan(说明) 判断父窗口是否有效 %% **} return Pwnd is class(Twincontrol); end function CheckParent(dcomp,Pwnd);virtual; begin {** @explan(说明) 判断父节点 %% @param(pwnd)(window) 返回值,窗口 %% **} if not (dcomp is class(TDComponent)) then return 0; IF not dcomp.CheckChild(self(true)) then return 0; if not dcomp.IsContainer() then return 0; Pwnd := dcomp.Cwnd; if not(CheckParentWnd(Pwnd) ) then return false; return true; end function CheckChild(dcmp);virtual; begin {** @explan(说明) 判断添加的子控件是否合法 %% **} return true; end function NodeOk(tnode,owner,tree,Pwnd);virtual; begin {** @explan(说明) 节点判断,在此函数判断节点和owner是否合法 可以重写该函数判断是否构建新窗口 %% @param(tnode)(TComponentTreeNode) 父节点 %% @param(owner)(tcomponent) 所有者 %% @param(tree)(TComponentTree) 返回值,从tnode 提取 %% @param(Pwnd)(TWincontrol) 返回值,从tnode 提取 %% @return(bool) 判断节点是否成功 %% **} if not( owner is class(TComponent)) then return 0; if not( tnode is class(TComponentTreeNode)) then return 0; tree := tnode.owner ; if not(tree is class(TTreeView)) then return 0; dcomp := tnode.Component; if not CheckParent(dcomp,Pwnd) then return 0; return true; end function CreateMenu(); begin {** @explan(说明) 构造控件菜单 %% **} if FMenus then return FMenus; createmenubyarray(menus(),FMenus); return FMenus; end function DeleteMenu(mu,n); begin {** @explan(说明) 根据caption删除菜单 %% **} if ifarray(mu) and mu then exit; if mu["type"] <> "menu" then begin if mu["caption"]<>n then begin r := mu; end end else for i,v in mu do begin r := array(); rt := call(thisfunction,v,n); if rt then r[length(r)] := rt; end return r; end function deleteclick(o,e);virtual; //控件删除操作 begin cp:=o.Component; if not cp then exit; nd := cp.TreeNode; If not nd then exit; ndp := nd.parent; if ndp then begin dm := gettswin32api().MessageBoxA(nd.owner.handle,"即将删除:"+nd.Caption,"删除",0x1 .| 0x30); if dm<>1 then exit; wd := nd.Component.Cwnd; ds := nd.owner.Designer; //ds.setcomponentfocus(wd,false); ndp.deletenode(nd); ns := array(); wds := array(); GetDeleteNames(nd,ns,wds); //处理删除名字 for i,nsv in ns do ds.DeleFiledFromEdit(nsv,""); ds.EditerCodeChanged(); nd.Recycling(); if wd then begin wd.Recycling(); end o.Component := nil; ndp.Owner.SetSel(ndp); end end function GetDeleteNames(nd,ns,wds); begin ns[length(ns)] := nd.Component.GetName(); wds[length(wds)] := nd.Component; for i:= 0 to nd.ItemCount-1 do begin GetDeleteNames(nd.GetNodeByIndex(i),ns,wds); end end function MoveComponentUp(o,e);virtual; //控件上移 begin cp:=o.Component; if not cp then exit; nd := cp.TreeNode; If not nd then exit; if nd.moveup() then begin wd := nd.Component.Cwnd; if (wd is class(TWincontrol)) or (wd is class(tmenu)) then begin wd.zorder := wd.zorder -1; end nd.owner.SetSel(nd); end return ; ndp := nd.parent; if ndp then begin idx := ndp.indexof(nd); if idx>0 then begin bf := ndp.GetNodeByPosition(idx-1); ndp.deletenode(nd); ndp.insertnode(nd,bf); wd := nd.Component.Cwnd; if wd is class(TWincontrol) then wd.zorder := wd.zorder -1; end end end function MoveComponentDown(o,e);virtual; //控件下移 begin cp:=o.Component; if not cp then exit; nd := cp.TreeNode; If not nd then exit; if nd.movedown() then begin wd := nd.Component.Cwnd; if (wd is class(TWincontrol)) or (wd is class(tmenu)) then wd.zorder := wd.zorder+1; nd.owner.SetSel(nd); end return ; ndp := nd.parent; if ndp then begin idx := ndp.indexof(nd); if ndp.ItemCount>1 and idx<(ndp.ItemCount-1) then begin if idx< ndp.ItemCount-2 then begin bf := ndp.GetNodeByPosition(idx+2); end else begin bf := nil; end ndp.deletenode(nd); ndp.insertnode(nd,bf); wd := nd.Component.Cwnd; if wd is class(TWincontrol) then wd.zorder := wd.zorder+1; end end end function createmenubyarray(ms,pm); //构造菜单 begin if not(ifarray(ms) and ms) then exit; if ms["type"]="menu" then begin if not pm then pm := new TPopUpmenu(FCwnd); if ifstring(ms["caption"]) then begin mu := new TComponentMenu(FCwnd); mu.caption := ms["caption"]; mu.onclick := ms["onclick"]; if ms["id"] = "delete" then begin FMenuDel := mu; end mu.Component := self(true); mu.parent := pm; call(thisfunction,ms["items"],mu); end end else for i,v in ms do begin call(thisfunction,v,pm); end end function menus();virtual; //菜单项 begin return array( ("type":"menu","caption":"删除","id":"delete","onclick":thisfunction(deleteclick)), ("type":"menu","caption":"上移","onclick":thisfunction(MoveComponentUp)), ("type":"menu","caption":"下移","onclick":thisfunction(MoveComponentDown)) ); end function CreateNode(tnode,owner,tree,Pwnd);virtual; begin {** @explan(说明) 构造节点 %% @return(TComponentTreeNode|false) 节点 %% **} if not NodeOk(tnode,owner,tree,Pwnd) then return false; return tnode.insertnode(array("type":"treenode"),tnode.TVI_LAST); end function SetViewParent(wnd,pwnd);virtual; begin {** @explan(说明)控件的父窗口%% **} wnd.parent := Pwnd; end function ComponentCreater(tnode,owner);virtual; begin {** @explan(说明) 构建新节点窗口 %% @param(tnode)(TComponentTreeNode) 父节点 %% @param(owner)(TWincontrol) 窗口所有者 %% @return(TDComponent|0)成功返回对象失返回0%% **} tn := CreateNode(tnode,owner,tree,Pwnd); if not tn then return 0; if Imgs >=0 then begin tn.ImgId := Imgs; tn.SelImgId := Imgs; end o := createobject({ClassObject()}self(true).classinfo(1),owner); if not o then return 0; o.TreeNode := tn; SetViewParent(o.Cwnd,Pwnd); o.Cwnd._tag := tn; //tree.SetSel(tn); return o; end function create(AOwner);virtual; begin {** @explan(说明) 构造控件的构造函数 %% **} feventnametable := array(); if not(AOwner is class(TComponent)) then exit; c := WndClass(); if c is class(TComponent) then begin FCwnd := createobject(c,AOwner); FCwnd.SetDesigning(true); end else raise "类型错误!"; end function GetChangedPropertiesn(n); begin if FCwnd then return FCwnd.GetChangedPropertiesn(n); return nil; end function GetChangedPublish();virtual; begin {** @explan(说明)获得改变的属性%% **} if FCwnd then return FCwnd.GetChangedPublish(); return array(); end function GetPublishProperties();virtual; begin {** @explan(说明)获得所有的属性%% **} if FCwnd then return FCwnd.GetPublishProperties(); return array(); end function GetPublishEvents();virtual; begin {** @explan(说明)获得改变事件回调属性%% **} if FCwnd then return FCwnd.GetPublishEvents(); end function DefaultAlign();virtual; begin return false; end function destroy();virtual; begin FTreeNode := nil; FCwnd := nil; end function SetComponentProperties(n,v); begin {** @explan(说明)修改属性%% **} if FCwnd then begin if n="name" then begin return SetComponentName(v); end else return FCwnd.SetPublish(n,v); end end function GetTrueComponent();virtual; begin {** @explan(说明) 获得真实的控件%% **} if FCwnd is class(TDVirutalWindow) then return FCwnd.BindComp; return FCwnd; end function SetComponentName(v); begin {** @explan(说明) 修改控件name %% **} obj := GetTrueComponent(); if obj and ifstring(v) then begin odn := obj.name; v := lowercase(v); if v=odn then return false; if v in TemporaryNotName then return false; cn := ClassName(); obj.name := v; if v=(obj.name) then begin if TreeNode then TreeNode.caption := v+":"+cn; if ifstring(odn) and v then begin ds := FTreeNode.owner.Designer; ds.DeleFiledFromEdit(odn,(v+":"+cn)); ds.EditerCodeChanged(); end return true; end end end function SelectedNode();virtual; begin {** @explan(说明) 设置控件节点被选择时候的操作 %% **} if (FCwnd is class(TWincontrol)) and FCwnd.HandleAllocated() then begin FCwnd._wapi.BringWindowToTop(FCwnd.Handle); end end static TemporaryNotName; function CreateName();virtual; begin {** @explan(说明)给无名控件构造一个名字%% **} obj := GetTrueComponent(); if obj then begin cn := ClassName(); cn1 := cn[1]; if cn1="t" and length(cn)>1 then begin cn := cn[2:]; end i := 1; oname := obj.name; if ifstring(cn) and cn and not(oname) then begin while oname<>nn do begin nn := cn+inttostr(i++); if nn in TemporaryNotName then continue; obj.name := nn; SetComponentProperties("caption",nn); oname := nn;//obj.name; end end if TreeNode then TreeNode.caption := oname+":"+cn; end return nn; end function SetDefalutEvent(ev); begin if ifarray(ev) then hs := createtslfunction(ev); if not hs then begin FDefaultEvent := nil; return ; end r := format("type ca = class\r\n%s \r\nend",hs); if CheckTslCode(r,err) then begin feventnametable[ev["event"]] := ev; FDefaultEvent := ev["event"]; end end private FDefaultEvent; function GetDefalutEvent(); begin return feventnametable[FDefaultEvent]; end public function geteventfunctionbyname(n); begin r := feventnametable[n] ; if r and ifarray(r) then begin return r; end else begin r := array(); r["name"] := n; r["event"] := n; r["param"] := array("o","e"); r["body"] := format(" {** @explan(说明) %s消息回调 %% @param(e)(tuievent) 消息对象 %% @param(o)(tcomponent) 组件 %% **}",n); end return r; end property TreeNode read FTreeNode write SetTreeNode; property Cwnd read FCwnd write SetCwnd; property Name read GetName write SetName; property Imgs read GetImgs write SetImgs; property DefaultEvent read GetDefalutEvent write SetDefalutEvent; {** @param(TreeNode)(TComponentTreeNode) 树结点 %% @param(Cwnd)(TWincontrol) 树结点 %% @param(Name)(string) 变量名 %% @param(TemporaryNotName)(array of string) 非法的变量名 %% @param(Imgs)(integer) 图标序号,不需要使用 %% **} end type TDRootComponent = class(TDComponent) {** @explan(说明) 只能作为主窗口子节点组件,比如菜单,文件选择,定时器等 %% **} function Create(AOwner);override; begin inherited; end function CheckParentWnd(Pwnd);override; begin return (Pwnd is class(tvcform)) or (Pwnd is class(tpanelform)); end end //**********red**DControl***************************** type TDedit= class(TDComponent) class function HitTip();override; begin return "文本框控件"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002D201000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000016749444154 484BED93B18AC2401445D30BDAA51214044997C6D680A2A435D8DB59FA0D0BFE4 26C52588B9FB06065C02A453A0B9580A50A12B5D03477796F278B59571CC16CE5 8107F74E60CE304314A4CC5BF090FF117C0C3F539984E0D53C2598CD6668B7DBA 225511485E7777E4A309D4E619AA6687F136F1C735710451156AB1576BB9D5849 0A96CB25C230E47C8D9460B15840D775B45A2D94CB650C06035E2741B55A85655 93C854201B66DF3B71829C17EBFC7F178E44CB252A9C49904994C06411070DF6C 36505515DBED963B2125A0EB711C079D4E874F9CCBE5789D048661708EA9D56A7 05D57344941AFD743B7DBC57C3EC7E1704808EAF53AE7984AA502DFF7459314D0 29279309E7F1789C1064B359ACD76BEE9EE7A1582CE272B97027A404A3D108F97 C1ECD6613FD7E9F1F93A0FFA0D168F0E3D3D5699A96B81E424A40D0A9CEE7B368 B79C4E2791BEA18DE3CDAFF35DC1ABB811A4313F8234790B1E92B200F80266B31 3963A1FCCDB0000000049454E44AE42608200"; end; class function ClassName();override; begin return "tedit"; end function ClassObject();override; begin return class(TDedit); end function WndClass();override; begin return Class(tedit); end function Create(AOwner);override; begin inherited; end function IsContainer();override; begin return false; end end type TDmemo= class(TDComponent) class function HitTip();override; begin return "多行文本"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100027103000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000030649444154 5847ED96DD4F52711CC6A1EEB21B2FEA3FD07FC0D98DAD1BB76EF2A23B6FEAA2B A68D3CD2D6D6D66EAD6EB48D010255158CA459B93B9C4347039D37005A8883A82 5E6C1C5FC68B5BE69029439FCEF7B08327E4E086076BCECFF6BBE0EC1CCEE73CC FF7F04386FF8C132162777717ABDFBF61F9AB0FF1789CFBCC73E4427473C6FB05 F6B379982E2F87C73583ADADADA498A850A3C12AFDD25B50ABE9852D3F1FE8EE4 654A5C2DB9212B8ED9F108D46B1B3B39359484AE8E983C1203A3B7530299AF05B A100535A0A7761219ACF9FC3DA5A984BEA488448666565199393362C2EFEC0C88 8152F6EDE80A3A000E6BC33E8AAAB83DFEF472412C9BD10C9F8FD2E188D8F303E FE81139A9E9E82C1A047CDA58B50D754C36EB7836198DC0BF1320B0B173036F60 C66730FBB06303838C80A1AA1D777C166FB08AFD78B70388BCA8A8A8A0E5C3C09 9959B8DDC570B95AD819512210B80C8DA606F50D0DE8E979C5C9783C1E6EB6723 AD4BCCCDC5C31666654EC0D9BD8A365181A3A85D1D1D3B856796F9F0CBDF684E4 42C29A9C4E257BC3E7ECD1320C0FCB593919B4DA0ADCAA6DDE2743D7119254C6F 3B78C8A9D8B443266B39C1D6419DADB2BB8642A1FEBD3CA10922524AC89662614 4A2443325353245399ACE96E4B6F5A19421221A10CCD4C20B0571325A3D5EEC95 032752FCD696588AC2BE3A12F6518773219A14C6A327C4D0D5DEFD2CA10874E68 7B7B1B86D6EB7863AA4FD63430202E43C9D09E26C6A184E82927462D887826F0B EAF1DB1D815F4F7CBD98196A1ADAD2AAD0C5D93E9BBB3AE8C564747074C8656C4 995944662D303DBD0D8743CEFEF8256484E70A674632A154363737F1E46123829 FCDF8D9A740F79DAB68D33CE036D174C9F0E44CC86AB540A954E27E7515FA5E1B B9CDD3E974C0E7F3B1F314127DB52513125640D066180A053981F9F9796E935C5 A62A056AB93E751ADA9E42CA1582C868D8D0DEECF55381CC2FAFA2FAE463A4E1B A5183913CA16C9848495A52E9D4E97F11C21C73721A9904C28B506B19AD21D177 27C13928A13A183C85A28974B0C51A17FC5895066803FCD8B95CBA6C573F60000 000049454E44AE42608200"; end; class function ClassName();override; begin return "tmemo"; end function ClassObject();override; begin return class(TDmemo); end function WndClass();override; begin return Class(tmemo); end function Create(AOwner);override; begin inherited; DefaultEvent := array( "event":"onchange", "name":"change", "param":array("o","e"), "virtual":true, "body": " {** @explan(说明) 文本改变回调 %% @param(e)(tuievent) 消息对象 %% @param(o)(tmemo) 多行文本框对象 %% **} " ); end function IsContainer();override; begin return false; end end type TDpassword= class(TDComponent) class function HitTip();override; begin return "密码框"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002F300000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000008849444154 5847ED91010A80300845BD795DA48374BA859065C36644A163FFC18789321E4A2 51910F2809007843CF20A4DCB1A1AE12214C5D8424474C4AA99B00D69094DBF42 44F3FEBABE6B9ECF41C89B7B29C49FB622583D9D1A9C8CF945883F6D45B07A3A3 538193396D0D7A4106209895533611BBAA31FA1C808E7219300210F087940A84D 291BB496CCEA5B2547890000000049454E44AE42608200"; end; class function ClassName();override; begin return "tpassword"; end function ClassObject();override; begin return class(TDpassword); end function WndClass();override; begin return Class(tpassword); end function Create(AOwner);override; begin inherited; end function IsContainer();override; begin return false; end end (** type TDtrackbar= class(TDComponent) class function HitTip();override; begin return "跟踪条"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100026701000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000FC49444154 5847EDCE310AC2401085E1345676E2592CBC876061A3A59E40B0C8416CAC3C400 A1B0B0BCBA0206A2A53580882A0A0A006C9E8CAAE923871125835C2FCF020EC66 E133206531888A41540CA2224146694A4E67E9055996850E038487BD4B3A55006 4DBF6CB304078D8BB2463103506516310B54810360C101EF62EE9540F5054D9CA 1C45A8897B9D91A0EE708742D43A83ADFC534F2448546FAF504CE376AEBB5820E FE243B1E5063085E6024E9E2FFFD0572C9068B9F1205F73EE985CD501777D9637 7A8B0D12F52707C89467D01BEFE589FE12814423F728BF3E130A324D537E3DFBC 69988412AEC4CF41FA05FC6202A065131E87D0057498A8BEBDBFB6A1400000000 49454E44AE42608200"; end; class function ClassName();override; begin return "ttrackbar"; end function ClassObject();override; begin return class(TDtrackbar); end function WndClass();override; begin return Class(ttrackbar); end function Create(AOwner);override; begin inherited; end function IsContainer();override; begin return false; end end **) type TDcomboBox= class(TDComponent) class function HitTip();override; begin return "下拉选择框"; end class function ImageId();override; begin return 6; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100023501000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000CA49444154 5847ED92C109C42010452D45F094A385A4A65461135660375EEC220797C92ABBD 90C314AD4ECE0838F8387CF6318E61FC6104AB1139AE7B969300E427772D6D755 C839B7BD409CB3859665294E04FAD675F5D33479A5D41698E1AF9B1060ADF59CF 32D3003D94277F0DD07225106E82EF4CB65A196C1A8BAA13386508A2221C6D82D D15A87C60F343654131A42D83D5C8D3126B4E0D0D8504D680861B791132965683 A42634335A12184DD45698410A1F50D8D0DD5E47F855A066327F40486508A2174 8EF72FB778FABEB46AB5F60000000049454E44AE42608200"; end; class function ClassName();override; begin return "tcombobox"; end function ClassObject();override; begin return class(TDcomboBox); end function WndClass();override; begin return Class(tcomboBox); end function Create(AOwner);override; begin inherited; DefaultEvent := array( "event":"onselchanged", "name":"sel", "virtual":true, "param":array("o","e"), "body": " {** @explan(说明) item选择改变回调 %% @param(e)(tuievent) 消息对象 %% @param(o)(tcomboBox)combobox控件 %% **} MessageBoxA('选中了项id:'+tostn(o.itemIndex),'提示',0,o); " ); end function IsContainer();override; begin return false; end end type TDColorComboBox= class(TDComponent) class function HitTip();override; begin return "颜色下拉选择框"; end class function ImageId();override; begin return 6; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100023001000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000C549444154 5847EDD1DF09C32010C77147F13513640AD7C81A9DC2453A45B7F0C52D7CB039F 1A0A1FEC9859C49E03EF02392807C6955BC1909EAD904196386AEE42FE84CADFB E841EFD7F165789FF73E3D019EE941CBFAE9E832B82F8410A7698AD6DA3438C3B BCB8280732E6AADD3E00CE841A5BF62EFB2DFFB200463003DE804ADFB76078D5C 09EB2FD4F2FC20B5F00C49506D881CC44D827AE8416AFDC4B14C82AACBE841CC2 4A8871C347F66962109AA0D9183B84950CF738346AE6413740712D416E317FE0C 479C51B569C20000000049454E44AE42608200"; end; class function ClassName();override; begin return "tcolorcombobox"; end function ClassObject();override; begin return class(TDColorComboBox); end function WndClass();override; begin return Class(tcolorcombobox); end function Create(AOwner);override; begin inherited; end end type TDradiobtn = class(TDComponent) class function HitTip();override; begin return "单选框"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002AD02000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000024249444154 5847ED96C96EE2401086E7F5B23C14121C13D63B08DE055022E0C076040408894 54A2EEC4835FE9CB2C621B6BB1D26520EFEA492ACEAEAF2EFEEEA6AFF915F4622 C84422C84422C8C44D8296CBA574BB5D69341AAEF1BC5AAD74F47BC416743E9FA 55EAF4BA15090542A15688C2190D8B8C412349D4E259BCDBA2FADD56AD26EB765 B3D9C8E974726DBD5EBB3EC688C9E572329BCD74B61DD682FAFDBEA4D36929954 A32994CD41B0E31C5625132998C0C0603F59AB112C4CA20A652A9C87EBF57AF19 62CBE5B22BCA76A58C82A803B689958923C663B7DBB92B95CFE7E572B9A8371CA 3200A987A188FC7EAF94CB3298EE00FE33908B68F1C14BA09A3204E0C457ACDDB 9BC8DD9D93C0C9E0B7FB7B91F7770DF251AD56DD95321129883EC397753A1DF5F C23488C670F0F1AE4A3D56AB9B94C7DCA991E0E8D8E241C6D3F6C4D9010BFBDBC 68B0424B2057AFD7534F30CED470BCFA391E8FEAF9E0E9E9AB806B7B7ED660851 CE432D59133351C267F571045EEE77038DC2EE8D76D19054812AE836B384D4142 B0C7470DF2E11535C2A270A647C3510D3AF61C6D4E5390981F3BF6E015F668345 2CF67D81AEAC5B947E5F5559D57788DB119D6397D18057175706BD3FAB7DBAD7A EDF9EF57072C160BF782E4A2E405B610EB5DAEF3F95CBDD15809027E2148CCD78 6DD6B7E88219639C3E150BD66AC0501BF102C3DF5409172723835F4298C677C8C 1143ACEDCA78C41204D401CD8DAFE7A541C618056C5333D7C416E48715A179F27 28C67539F317193A09F2011642211642211148DC85F768426F04BC530CE000000 0049454E44AE42608200"; end; class function ImageId();override; begin return 6; end class function ClassName();override; begin return "tradiobtn"; end function ClassObject();override; begin return class(TDradiobtn); end function WndClass();override; begin return Class(tradiobtn); end function Create(AOwner);override; begin inherited; end end type TDipaddr= class(TDComponent) {** @explan(说明)ip设计控件%% **} class function HitTip();override; begin return "ip地址控件"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002B402000089504E470D0A1A0A0000000D4948445200000020000000200806 000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000024949444154 5847B5963D8B14411086E7771819980882B870F88170222A2826228A81707881C 1B1818966C7456AA226FA238C4C04115610111185FB211E9C7A6A20D33353774F 431DDD3DDD3D33BBB3EFF232B3555D55EFCCF4471532005FEA6FB2593D966BE69 69C3697E4989958728F0D1F6386A053C00FD99167D54B395F5E9523E5F15E642C 31C476212B8024A7CC6AB4481F124B8E1C92026E98BBD1A4F3905C2944059C28C F45132D4272C6D012C0848A251883E40EE109B85F3D88068E496AB83814C06489 052C83EEC4B402582EA9D97ED3AC2599F34FCA0BAD5C4A6AE912B502724F9F5A4 614C9F9C16EF353BE37DB72BDBA93CC6B059C292FB70628870A785EBFB2B6D7CD 1BF9DC7CB5B63DF923EBD5D4CB4B4D507CA83F798E90FA4A5DA80D7F28208C7F5 BBFB776AEA18FDAC5A36AABE508190A707D5D0234F66FF3AFE5A376C121123A42 2E228009A7D0B7A6A476D167E35944C056FDD4DAFF1FFC8E96273D1FB50B8E53D 718E33C0256CC456FD379D7CCBC3848EDD105C4F04B7ECB5973C58B8356C0D89F 20C4ACF9286BD58617A3B49F60CC49A87BC093FA854CAB8772DBDCF3C686B4939 0362AE674D95700F7AEAF8BD42EE8E1624E97CB12406DBB15E7FA3D92868D26FF 11A57EC51001D404A31E464304685CE771CC409E38A42B406D7D05B48E633044F DA2D4A7078702C0989D708A6187EC0900CBE88895B1CEB82500F4D91D87929C31 440580313BE4B01376911400D85A53ABA30F8975275C0C590180E542925CDF189 2B1C4E852CBA153800B7A38DA280E11BE29C729E41E1B3EC6F487C83E6F6E81BB 6E01F9710000000049454E44AE42608200"; end; class function ClassName();override; begin return "tipaddr"; end function ClassObject();override; begin return class(TDipaddr); end function WndClass();override; begin return Class(tipaddr); end function Create(AOwner);override; begin inherited; end end type TDmessagebox = class(TDRootComponent) class function HitTip();override; begin return "提示框"; end function bitmapinfo();override; begin return GetMessageBoxBitmapInfo(); end; function classification();override; begin return "对话框"; end class function ClassName();override; begin return "tmessageboxadlg"; end function ComponentClass();virtual; begin {** @explan(说明) 控件类 %% **} return class(tmessageboxadlg); end function ClassObject();override; begin return class(TDmessagebox); end function WndClass();override; begin return Class(TDMessageboxWindow); end function Create(AOwner);override; begin inherited; end end type TDMessageboxWindow = class(TDVirutalWindow) {** @explan(说明) 颜色选择控件窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TMessageboxADlg(self);; end function GetPublishEvents();override; begin return array(1:nil); end function bitmapinfo();override; begin return GetMessageBoxBitmapInfo(); end; end //***********zh**DControl*********************** type TDListBox=class(TDComponent) private FLBItemEdit; public function isContainer();override;begin return 0; end class function HitTip();override;begin return "列表框"; end class function ClassName();override;begin return "tlistbox"; end function setItems(o,e);begin if ifnil(FLBItemEdit) then FLBItemEdit:= new TItemEditer(); // {伪代码} // FLBItemEdit.setdata(FlistBox.getdata()); // FLBItemEdit.onOK:=void(){FlistBox.setData(FLBItemEdit.getdata());} end function menus();override;begin r := inherited; r[length(r)] := array("type":"menu","caption":"編輯列表項","onclick":thisfunction(setItems)); return r; end function ClassObject();override;begin return class(TDListBox); end function WndClass();override;begin return Class(tlistbox); end function Create(AOwner);override;begin inherited; end function bitmapinfo();override;begin return "0502000000060400000074797065000203000000696D670006040000006461746 100025401000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000E949444154 5847ED96410EC2201045390ADB1E86E371122FE0A69C807D37BD451798C192D8F 643156841C24B5E6C884E5E9C6860A6327AD0199B2021C4AD220E413909CD2B1E 344D93D55134884238E756171515C418FB49A5D4FAC937346F5916330C8391525 AE999CEA2825271F3E679B6AF847B2E1A84880A426B41FA86D37948C4E5DFD0F8 7C40DB0842EB09897E6528868C0A4AA5FD20B496BD5AEBF5DD47B207A5D27E105 A11D2373C7B502AED07A1F584FC8B3FC69088CB837C4405A1B5207DC3DD795517 B42AAFB0D92EF9A97CCEA3101743140FDAF375D09D22364135D083CEE841618C7 90143F9BE01B37879820000000049454E44AE42608200"; end end type TDColorBox=class(TDComponent) function isContainer();override;begin return 0; end class function HitTip();override;begin return "颜色列表框"; end class function ImageId();override;begin return 5; end class function ClassName();override;begin return "tcolorbox"; end function ClassObject();override;begin return class(TDColorBox); end function WndClass();override;begin return Class(tcolorBox); end function Create(AOwner);override;begin inherited; end function bitmapinfo();override;begin return "0502000000060400000074797065000203000000696D670006040000006461746 100025B01000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000F049444154 5847ED96B10D833010451985969A822958838D3C49164813295BD0B00585C3593 AC9266793B33E06059EF48485A5F32B5CB8B227E30EDA2208EAFBBEA8125F4148 52F30E0F1AC7D1C9E8838665CB37039E4721755D3B390A16D4B6EDA60CCD9BE7D 9364D638D314E5AD3BFC38288699ADC97E0352C4843EC50421F0480E6A594D83D E8F57C88AA83AA2134872241D22566D75C3348033408C19F0755CB966F064582A 4CBBC96B96690066C10805306A594880675EF2E3087D8A1042C48BAC4BE3E3C0F F2404305C19EB0B1200D3C0FF3C807E0CFA3108E210E0F5AF37350492582A0337 0076D7107A5B1F6034F9699CCB1141CEB0000000049454E44AE42608200"; end end type TDCalendar=class(TDComponent) private public function isContainer();override;begin return 0; end class function HitTip();override;begin return "日历"; end class function ImageId();override;begin return 5; end class function ClassName();override;begin return "tmonthcalendar"; end function ClassObject();override;begin return class(TDCalendar); end function WndClass();override;begin return Class(tmonthcalendar); end function Create(AOwner);override;begin inherited; end function GetPublishEvents();override;begin r:=inherited; if r then reindex(r,array("ondrawitem":nil,"onpaint":nil)); return r; end function bitmapinfo();override;begin return "0502000000060400000074797065000203000000696D670006040000006461746 100029901000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000012E49444154 484BED94B1AA82501CC6DD7C010D71745268953B2AEE3E40F80A2E977A1371095 C0D8256C1390209DC5C05373721084104BF8BA77335A2AB51D725FAC187E77F3E F0770E884CC23098321FC168DE40F0F51D612ADA77BFB160B55A41D775489284F D7E4F772F6CB75BB27F9DC3E140DB9E41C172B9C466B301C77108C390EE5EF03C 0F8661204DD32E6559D2B66750F08B288A7705A669D2E96F5E12F03C0F5996A16 91AD6EB359AA6A16DCFD382388E110401922481EFFB98CD66701C87B63D4F0B6E 715D17AAAAD2A9E7DF04EDC7A0280A9D7A0605A7D3094551401004EC763BB2AEE B9A745114A1AA2AB2CEF39C9CDEB66D325F332898CFE760DA7FC9558EC723E92C CB02CBB2E476ED73B1589003DD322818E37C3E23CBB2EE26F77849F0081FC1289 D60BA44F8013782F60023EBD3020000000049454E44AE42608200"; end end type TDProgressBar=class(TDComponent) public function isContainer();override;begin return 0; end class function HitTip();override;begin return "进度条"; end class function ImageId();override;begin return 5; end class function ClassName();override;begin return "tprogressbar"; end function ClassObject();override;begin return class(TDProgressBar); end function WndClass();override;begin return Class(tprogressbar); end function Create(AOwner);override;begin inherited; end function bitmapinfo();override;begin return "0502000000060400000074797065000203000000696D670006040000006461746 100024C02000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000001E149444154 5847ED95476E633110447DAB39978FA395749C11A09C73CE3967A907D540CBF46 75BF46EB46003B57109CDA72A52FEA0371B0FE41A0FE41A0FE41A0FE41A0FE41A 068A4422140A85FEABC0F004C21FB6DB2D9D4EA7A78EC7231D0E07DAEFF7ACDD6 EC79FD96C36B45EAF9F5AAD56B45C2E69B158D07C3EA7D96CC69A4EA734994C68 3C1ED36834A2E1704883C180D5EFF7A9D7EB51B7DB65351A0D66F806743E9FE9F 178D0FD7E67DD6E37BA5EAF74B95CD8D34005D20435014D48133008D96AB56C20 1C04883F9F7F2D0984E60984E601E23749359B4D1B08DF1869688B250DCD93343 4CF841010B3AE4EA7C3AAD7EB3610224725DA62A944F3A412CD0B429820ED769B AB423AD56AD50642EC48425B0CEF552DA844F38269088480E032239D52A964032 17A24A12D96CBA9795289E64925661A0201D56A354EA75028D840381017545B2C AF44F3A412CD13081344202A950AAB5C2E532E97B381702052D216CB2BD13CA94 4F38210020208D4542C16399D4C26630321FA5797F3552DA844F3CC3404C204C9 E7F39C4E3299B48110FD4F3F5CAE57E2AA24082120D96C96D3492412361096BB5 E832BFA9F0E84D2E934A552294E0300F1789C158BC5281A8D7E077A877FAEE170 F80BE89DC603B9C603B9C603B9C603B9C603BD1EA27F2BABB3A7A95F430C00000 00049454E44AE42608200"; end end type TDCheckBtn=class(TDComponent) public function isContainer();override;begin return 0; end class function HitTip();override;begin return "复选框"; end class function ImageId();override;begin return 5; end class function ClassName();override;begin return "tcheckbtn"; end function ClassObject();override;begin return class(TDCheckBtn); end function WndClass();override;begin return Class(tcheckbtn); end function Create(AOwner);override;begin inherited; DefaultEvent := array( "event":"onclick", "name":"clk", "param":array("o","e"), "virtual":true, "body": " {** @explan(说明) 点击回调 %% @param(e)(tuievent) 消息对象 %% @param(o)(tcheckbtn)选择按钮 %% **} MessageBoxA(((o.checked)?'选中':'没选中'),'提示',0,o); " ); end function bitmapinfo();override;begin return "0502000000060400000074797065000203000000696D670006040000006461746 100023A02000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000001CF49444154 5847EDD64B4EC2501406602638C10487C484810B70EC0274430E7527121640888 AACC0A9C1F22ECF02A52D85D296D70A7E295822A5F6564E8D0EFA2767D873BFDC 474E23F8670941AC84205642102B9EA09BFB775CDDBE055A564FAF7882AC06ABD 50ACBE5128BC502F3F91CB3D90CA669C2300CE8BA8EE9740A4DD330994C301E8F A1AA2A46A3111445812CCB902409C3E110A2286230186C7A7A85090A12D3EFF7E 9A02031BD5E8F0E3A162308D2014610043AE818CCEBAB846452472A25EF61BADD 2E1D740C26913010899888460D3C3C58BBB5C5743A1D3AC80DA3AA6C8C5D27272 6D269718369B7DB74901393CF6BB8BC34C0712A1363553C6EE0E9A9BFC1B45A2D 3AC889393DDD2E747161A050507E8469369B74908D7979D1108BED2F68A13219C 5157376A6AFBFE9ED611A8D061D645FE07C7EB2DB1D56B9ED8C85E1799E0EFAFA 9A72399589F2C2D4EB753AC8F99A9E9F47EBA33B3C223F985AAD4607399FB6350 E1E1FE503941F4CB55AA5839C187B1C64B3D20EE51753A954E820378C3D0E3219 11E7E7BA6F4CB95CA683BEC3D8E380E7BBBE31A552890EF2C2D8E3C02FA6582CD 2414162388EA38382C49041BFF1937F7D57F8ECEE1E4FD05F2404B11282580941 DE013E00FF2B90FB3AF2B1880000000049454E44AE42608200"; end end type TDDateTimePicker=class(TDComponent) private public function isContainer();override;begin return 0; end class function HitTip();override;begin return "时间日期选择"; end class function ClassName();override;begin return "tdatetimepicker"; end function ClassObject();override;begin return class(TDDateTimePicker); end function WndClass();override;begin return Class(tdatetimepicker); end function Create(AOwner);override;begin inherited; end function bitmapinfo();override;begin return "0502000000060400000074797065000203000000696D670006040000006461746 100020E01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000A349444154 484BD58FD10D83300C44D9285B650D6FD14DFACD10198221F2E1F62C8C5C29941 80C88279D8C2C398F1BF864AE13E49CC362F91178D19B5AAB046C0A88C6AE00DC 945238A524C177B8001091046C0A3CB46EFE0AA26239D4A04597E0F59EDC51BA0 57B260869C0C3F76CCEB29B0969208F9BB94B20478D3F5DDB2BAE06F28899BA5F 9B20A4412B8AAB81770257034F942EC111EE1544C5B208CEE2E902E60FE420D1B CC541E3100000000049454E44AE42608200"; end end type TDTimePicker=class(TDComponent) public function isContainer();override;begin return 0; end class function HitTip();override;begin return "时间选择"; end class function ClassName();override;begin return "ttimepicker"; end function ClassObject();override;begin return class(TDTimePicker); end function WndClass();override;begin return Class(ttimepicker); end function Create(AOwner);override;begin inherited; end function bitmapinfo();override;begin r := "0502000000060400000074797065000203000000696D670006040000006461746 100024C02000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000001E149444154 484BDD95CB2F434114C6FD0D96D65D5AD8B0B42376B622362291486C88C442626 3819060A189854A4988054917E2FD4A4BC43BA242545BFAD097BEB455F5F8DC73 EF54AFA90CF558F04B4E7266EECD7C933373E6CBC32FF3CF04F2B5E72818B240A 3B3A2506F43F1F8254A27AF503EE540A5C189AA19376AE7AFD1B0EC41F39A176D 1B7E746C05D0BB7B83C1C310868FC398388DB2D514DE086874172C7B1FADB4088 508A14089B463114667420E1142818A6907CBBE8E50A05AAAF177110A34AE7859 96C11CB887FE24024B28C56614561D71985C776C944128D0BEE9679942F7CE0D6 6AC31F8138FD2F9D8114C3EC9F3D6700A9367D1DC05FAF6822CCBA64CBAAACB57 7139AF5FF460E932FE3A56231418954A617225E45073FFF48C9A59E57C5A8D3E1 82CB7D049777EC41C91E788818310666D31B1007DA49FE8673554AA397B1C4D52 735133A6A368CC267F23D21BA34DAAC912E0E9D90DA26B3BC0461968E1F4E26AF 8320B05FAF783F2AE8EFC49B8630F4829672C438BBF27CC5F14A140DD82072DEB 3E746E2BBB557731958C8287BFEA1F962857F866FD7101FEB9C949E0338F1DFF6 0E624F099E79A7FF2B304C834C83CC844C84CC854C85CC864C86CC874C87CC884 C88CC894C89CC8A4C8ACA83FD4BC11F80DFEBA00F002CD0C9338BD4F383600000 00049454E44AE42608200"; return r; end end //************主窗口******************* type TDForm = class(TDComponent) {** @explan(说明) 主窗口 %% **} private static FClassName; static FParser; function savecurrentform(o,e); begin cp:=o.Component; if not cp then exit; nd := cp.TreeNode; if nd then d := nd.owner.Designer; if d then begin d.saveCurrentForm(); //d.openclassfile(); end end function OpenClass(o,e); begin cp:=o.Component; if not cp then exit; nd := cp.TreeNode; if nd then d := nd.owner.Designer; if d then begin d.openclassfile(); end end public function menus();override; begin r := array(); //r[0] := array("type":"menu","caption":"保存窗口"); r[0] := array("type":"menu","caption":"打开tsf文件","onclick":thisfunction(OpenClass)); r[1] := array("type":"menu","caption":"保存当前窗口","onclick":thisfunction(savecurrentform)); //r[2] := array("type":"menu","caption":"打开工程目录","onclick":thisfunction(openProjectDir)); return r; end function InToolBar();override; begin return false; end function ComponentCreater(tnode,owner);virtual; begin r := inherited; return r; end function classification();override; begin return "非点击添加控件"; end class function HitTip();override; begin return "主窗口\r\n在工具栏file\r\nfile manager中管理"; end class function ClassName(v);override; begin if ifstring(v) and v then begin FClassName := v; end if not FClassName then return "tdcreateform"; return FClassName; end function bitmapinfo();override; begin return "0507000000060400000074797065000203000000626D700006050000007769647 468000010000000060C000000626D776964746862797465730000400000000608 000000626D706C616E6573000001000000060B000000626D62697473706978656 C0000200000000606000000686569676874000010000000060500000062797465 73000200040000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000000000000000000 00000000000000000000CEA47CFFCFA47CFFD0A57DFFD0A57CFFD0A57CFFD0A47 BFFCFA47BFFCFA37BFFCDA27AFFCCA179FFCAA078FFC89E77FFC69D76FFC49B75 FFC29A74FF00000000CFA47CFFD0A57CFFD1A57CFFD1A57CFFD1A57CFFD1A47BF FD0A47BFFCFA37AFFCEA279FFCCA178FFCB9F77FFC89E76FFC69C75FFC49B74FF C29973FF00000000D0A57CFFD1A57CFFD1A57CFFD1A57CFFD1A57BFFD1A47AFFD 0A379FFCFA379FFCEA278FFCDA077FFCA9F76FFC89D75FFC69B73FFC49A72FFC2 9972FF00000000D0A57CFFFCFCFCFFFDFDFDFFFEFEFEFFFEFEFEFFFEFEFEFFFDF DFDFFFCFCFCFFFBFBFBFFF9F9F9FFF6F6F6FFF3F3F3FFF1F1F1FFEEEEEEFFC198 70FF00000000CFA47CFFFCFCFCFFFDFDFDFFFDFDFDFFFEFEFEFFFEFEFEFFFDFDF DFFFCFCFCFFFBFBFBFFF9F9F9FFF6F6F6FFF3F3F3FFF1F1F1FFEEEEEEFFC1976F FF00000000CFA47BFFFBFBFBFFFCFCFCFFFDFDFDFFFDFDFDFFFDFDFDFFFCFCFCF FFBFBFBFFFAFAFAFFF8F8F8FFF6F6F6FFF3F3F3FFF0F0F0FFEDEDEDFFC0966EFF 00000000CEA37AFFFAFAFAFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFFBFBFBFFF AFAFAFFF9F9F9FFF7F7F7FFF5F5F5FFF2F2F2FFEFEFEFFFEDEDEDFFC0956CFF00 000000CCA179FFF8F8F8FFF9F9F9FFF9F9F9FFF9F9F9FFF9F9F9FFF9F9F9FFF8F 8F8FFF7F7F7FFF5F5F5FFF3F3F3FFF1F1F1FFEFEFEFFFEDEDEDFFBF946CFF0000 0000CAA078FFF5F5F5FFF6F6F6FFF7F7F7FFF7F7F7FFF7F7F7FFF6F6F6FFF6F6F 6FFF5F5F5FFF3F3F3FFF1F1F1FFF0F0F0FFEEEEEEFFECECECFFBE936BFF000000 00C89E77FFF3F3F3FFF3F3F3FFF4F4F4FFF4F4F4FFF4F4F4FFF4F4F4FFF3F3F3F FF3F3F3FFF1F1F1FFF0F0F0FFEEEEEEFFEDEDEDFFEBEBEBFFBE936AFF00000000 C69D76FFF0F0F0FFF1F1F1FFF1F1F1FFF1F1F1FFF1F1F1FFF0F0F0FFF0F0F0FFF 0F0F0FFEFEFEFFFEDEDEDFFECECECFFEBEBEBFFEAEAEAFFBD936AFF00000000C4 9B75FFEEEEEEFFEEEEEEFFEEEEEEFFEEEEEEFFEEEEEEFFEEEEEEFFEEEEEEFFEDE DEDFFECECECFFEBEBEBFFEAEAEAFFEAEAEAFFE9E9E9FFBD936BFF00000000C29A 74FFC29973FFC29972FFC19870FFC1976FFFC1966EFFC0956DFFC0956CFFC0946 BFFBF946BFFBE936AFFBE936AFFBD926AFFBD936BFFBD936BFF00000000000000 00000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000000000000000000 00000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000"; end function ClassObject();override; begin return class(TDForm); end function WndClass();override; begin return class(tvcform); //return class(TDCreateForm); end function create(AOwner);override; begin inherited; DefaultEvent := array( "event":"onclose", "name":"close", "virtual":true, "param":array("o","e"), "body": " {** @explan(说明) 主窗口关闭回调 %% @param(e)(tuievent) 消息对象 %% @param(o)(ttimer) 当前主窗口 %% **} if MessageBoxA('是否关闭当前窗口','关闭',MB_YESNO,o)<>IDYES then e.skip := true; "); end end type TDPanelForm = class(TDForm) {** @explan(说明) 主窗口 %% **} function ClassObject();override; begin return class(TDPanelForm); end function WndClass();override; begin return class(TpanelForm); //return class(TDCreatePanel); end function create(AOwner);override; begin inherited; end end //**************TPanel************************** type TDPanel = class(TDComponent) class function HitTip();override; begin return "容器控件"; end class function ClassName();override; begin return "tpanel"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002CA00000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000005F49444154 5847EDD7B109C0300C05D1ECBF812AADA94EC1453A91AB4C1CB80F571ABDD6571 F36413441B41194991D115B5B37A68DA0F5A0AAB6B66E4C13F42488124409A204 5182284194204A1025881244FD1B74DC47F1CB09A2097A5FF70DF185865E9BB41 DE30000000049454E44AE42608200"; end function ClassObject();override; begin return class(TDPanel); end function WndClass();override; begin return Class(tpanel); end function ComponentCreater(node,pt);override; begin r := inherited; return r; if r then begin r.Cwnd.Color := rgb(240,240,240); end return r; end function Create(AOwner);override; begin inherited; DefaultEvent := "no"; end end //**************groupbox************************** type TDGroupBox = class(TDComponent) {** @explan(说明) groupbox控件 **} class function HitTip();override; begin return "分组框"; end class function ClassName();override; begin return "tgroupbox"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100020B01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000A049444154 484BCD91510A83301044BD92782B2F90DF9CA11F3D8FED358A7894C8424736B0A 43B89A11978B0129D67922975CE7F04EB732FC2E41284F0B8B04A35FA5D0B9D4C 8058A59A52A4E7BDBDBE4F86E0383ED548F138821863F6B107B740CAE5AC2199E 7E527940012CC5E28410DE3EC80BD035A0009662F94A0867176C0DE81400920C1 EC8512D4E012C8620B45C15D980289FE9356904CD0239D05299D037BBA604E978 76D0000000049454E44AE42608200"; end function ClassObject();override; begin return class(TDGroupBox); end function WndClass();override; begin return Class(tgroupbox); end function Create(AOwner);override; begin inherited; end end //*****************Check GroupBox************************ type TDBtn = class(TDComponent) class function HitTip();override; begin return "按钮"; end function IsContainer();override; begin return false; end class function ClassName();override; begin return "tbtn"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002A101000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000013649444154 484BED95416A83401486BD5537D90A929D8A0B1123928D889B627B93D21E21076 87B80B408AD8A95E042415C4430907887BFBC81144D44A1D14221031F8CCFF7E6 1B477C7298785C0583637AC1C3F316B3BB4FDCDC7E8C0AADF9F8B2054793F7B84 45DD7A3F2F6556276EF83235B57C218D0DABF12A469DA193F655090651996CB25 0CC380A669088280C5154539CBED6250208A22C23064F33CCFC1F33CF6FBFD8F6 0B3D9A0288A564D935E4155559065B915B32C0B51143181E779505515BBDDAE95 D3A45750962524496AC54840BB160401F3F99C6DA279FF945E01418BC471CCE67 444747D381CD813388E83D56A7556D36450902409168B054CD384AEEBEC7828EE BA2E7B17B66DC3F7FDB3BA2383824BF91B01B50AFAACBB122E617D6C15D490A66 A764FAFE5F587333CFEBB00F8061B912011B78C94420000000049454E44AE4260 8200"; end; function ClassObject();override; begin return class(TDBtn); end function WndClass();override; begin return Class(tbtn); end function Create(AOwner);override; begin inherited; DefaultEvent := array( "event":"onclick", "name":"clk", "virtual":true, "param":array("o","e"), "body": " {** @explan(说明) 点击回调 %% @param(e)(tuievent) 消息对象 %% @param(o)(tbtn)按钮对象 %% **} MessageBoxA(o.caption+':被点击','提示',0,o); " ); end end //*****************TPairSplitter******************************* type TDPairSplitterSide = class(TDComponent) class function HitTip();override; begin return "PairSplitterSide\r\n在splitter控件中右键添加"; end class function ClassName();override; begin return "tpairsplitterside"; end function classification();override; begin return "非点击添加控件" ; end function menus();override; begin r := inherited; return select * from r where ["caption"]="删除" end ; end function InToolBar();override; begin return false; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002E601000089504E470D0A1A0A0000000D4948445200000010000000100806 0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000017B49444154 384FA592DB4EC24010867D5E51349C29F8128AA82082808F81882184A0507C0CC E6728C7DFFDDB6E5D9B182FD8E4BBE874E6DBD9DD39C191CB14C48B2D818EAB97 36E236B122D1112BE8D0F24D449F3F11C935107EAA2394A92198AE22907A9702D D2EFC728815491B9A1044F32D4484209CFD404808828F350484C0FF2005EE6281 2604D1425BA0232204E15C13A16C03C14C1DFE740DBE54153E55B0DBEDB0DFEF7 1381C1CF8CDF876BBC57ABDC672B9C46C36C36432C17038C4E57DE5E70852A04A FE135CDCD9025E169354895ABCD96C60188623188FC7180C06F026DF2C8156689 9494C76C338775FAD56582C16984EA7188D46A6E0ECD616F089B80313DD302E8B 65FB8E2051B6047C5F26B045264BF84DD462B6CFF3F7FB7D786E5E2D018783096 43E9FFF42C6D562EEDEEBF5702A059C2CFE64920A6312D936776671B7DB158292 25E058D2FC17EE42D2E974C4116C01679A63C9C9E270F07DBDC90ACEC52DF3A63 D0952365B36B92E99C58EE09875A400F80678339550E1D72CF30000000049454E 44AE42608200"; end function ClassObject();override; begin return class(TDPairSplitterSide); end function WndClass();override; begin return Class(TPairSplitterSide); end function CheckParentWnd(Pwnd);override; begin {** @explan(说明) 父节点判断 %% **} r := Pwnd is class(TPairSplitter); if (not r) and (Pwnd is class(TWincontrol) ) then Pwnd._wapi.MessageBoxA(Pwnd.Handle,"需要 TPairSplitter 作为父窗口","失败",0); return r; end function Create(AOwner);override; begin inherited; end end type TDPairSplitter = class(TDComponent) class function HitTip();override; begin return "成对分配器"; end class function ClassName();override; begin return "tpairsplitter"; end function AddsplitterSide(o,e);override; begin cp := o.Component; r := (GetDCompObject("tpairsplitterside")).ComponentCreater(cp.TreeNode,cp.Cwnd); if not r then exit; r.CreateName(); tr := r.TreeNode.owner.Designer; tr.BindCwndMessage(r.Cwnd); tr.VariableSelecter.additem(r); end function menus();override; begin r := inherited; r[length(r)] := array("type":"menu","caption":"添加splitterside","onclick":thisfunction(AddsplitterSide)); return r; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100023301000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000C849444154 484B63F84F63304C2C983973264E0C02870E1CC4C020804D3D0CC3005E1FC0148 20CBC7FFF361C97974F028B231B840B0C2E0B40060F0D1F3C7BFB1D4C136B014C 3D368061C18B77DFFF07371C07B3D12DC01544FEB5C7FE3F79FD0DCC46072816C 00CB7C8D907E613EB03907A5C96C02D40369C5C8CCD12B8059913CE61D5442A06 99830CE8E70310A0691CC0004D53110CD0341F2003622DC00748B2005710E1038 3CB07645B0052880B8300C80290A1C81804B0A9876118C0EB036A001A5BF0FF3F 008B200E0EE56C49BF0000000049454E44AE42608200"; end function ClassObject();override; begin return class(TDPairSplitter); end function WndClass();override; begin return Class(TPairSplitter); end function CheckChild(dcmp);override; begin return dcmp is Class(TDPairSplitterSide); end function Create(AOwner);override; begin inherited; end function ComponentCreater(tnode,owner);override; begin {** @explan(说明) 构建新节点窗口 %% @param(tnode)(TComponentTreeNode) 父节点 %% @param(owner)(TWincontrol) 窗口所有者 %% @return(TDComponent|0)成功返回对象失返回0%% **} o := inherited; //if o then o.Cwnd.color := rgb(200,200,200); return o; end end type TDTabSheet = class(TDComponent) function CheckParent(p,pwnd);override; begin if not (p is class(TDPage)) then return 0; return inherited; end class function HitTip();override; begin return "pagesheet\r\n在page控件中右键添加"; end class function ClassName();override; begin return "ttabsheet"; end function classification();override; begin return "非点击添加控件"; end function SelectedNode();override; begin if Cwnd is class(ttabsheet) then begin pc := Cwnd.Parent; if pc is class(TPageControl) then begin pc.cursel := Cwnd; end end inherited; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002AE01000089504E470D0A1A0A0000000D4948445200000010000000100806 0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000014349444154 384FAD92C94AC4501045FBAFFC1657BA722B7E862E04FDAA86A61511119C5A5D6 44E77E639B9D67DCD4B7A08226AE040A0EA5C2A55991C9C4DF11754002693D1E2 4FF8A709469EB66DD1340DEABA465996288A02799E234D53244982388EC7030EC FE77B1C5FDEE2E6C9EDE5288A1086E17E40D7754A68E5BDE9805AA884FBCF1827 D777983DDABDBC5AADB603F4C80C28242113522111E206982D221CC9244110287 9B95C0E015AAEAA4A0544229C5E5CF5F835E009AC51F47D1F9EE70D015C14652E 8B4D6C7605A7022CC1140C8135CAAEEBC2719C2180B2DE329BD8BC3901792FD60 15AB62C6B08A09C6599DA329B3E4A6021C29BF02ABCE4C0B3C09A6DDB4A364D73 08D0326FCB2636EF4EF090AD03281A86A1E803F48FC113B189CD63B0A6E5AD00C ABC2D4FC4A6EF180DD03F863E915E14BF7773E45DFA80DF33C517615C294C8193 B0280000000049454E44AE42608200"; end function menus();override; begin r := inherited; return select * from r where ["caption"]="删除" end ; end function InToolBar();override; begin return false; end function ClassObject();override; begin return class(TDTabSheet); end function WndClass();override; begin return Class(TTabSheet); end function Create(AOwner);override; begin inherited; end end type TDPage = class(TDComponent) class function HitTip();override; begin return "页面控件"; end class function ClassName();override; begin return "tpagecontrol"; end function addtabsheet(o,e); begin cp := o.Component; r := (GetDCompObject("ttabsheet")).ComponentCreater(cp.TreeNode,cp.Cwnd); if not r then exit; r.CreateName(); cp.TreeNode.expand(); tr := r.TreeNode.owner.Designer; tr.BindCwndMessage(r.Cwnd); tr.VariableSelecter.additem(r); end function menus();override; begin r := inherited; r[length(r)] := array("type":"menu","caption":"添加tabsheet","onclick":thisfunction(addtabsheet)); return r; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100023001000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000C549444154 5847ED97C10A84201400F76BA36E7EB5274F9A969AB9BC43B1CBEAB30EED53706 02E29398181BE6265F4A0123DA8C419C4188BC330A0C29CA7398360C112E338FE 441E4ED3947C0EDEF9905B413087739E14C6841049AFBCFBA0EEA07DDF51FF1E1 44240AD2E08DBB8D818F633809F9BFE2B68DB361261ED83BA83BCF72466839C73 24B61364AD25311BB4AE2B89ED042DCB426236C81843623B415A6B12DB099AE79 9C46C90528AC47682A49424B61174E5A2F894C9236C2DF4A0123D0827C637259C FCE218FD50E80000000049454E44AE42608200"; end function CheckChild(cd);override; begin return cd is class(TDTabSheet); end function ClassObject();override; begin return class(TDPage); end function WndClass();override; begin return Class(TPageControl); end function Create(AOwner);override; begin inherited; end end //************TImageList*********************** type TDVirutalWindow = class(TCustomControl) {** @explan(说明) 非可视控件的窗口容器 %% **} private FBitmap; FBindComponent; FWindowFileds; function SetBindComponent(v); begin if v is class(TComponent) then begin FBindComponent := v; end end protected function deletefiled(r); begin {** @explan(说明)删除模拟窗口中的属性 %% **} rdx := array(); for i,v in FWindowFileds do rdx[v] := nil; reindex(r,rdx); return r; end function getnotnil(ra); begin r := array(); for i,v in FWindowFileds do begin if v="name" then continue; rav := ra[v]; if not ifnil(ra[v]) then r[v] := rav; end return r; end public function Create(AOwner);override; begin inherited; width := 30; height := 30; FWindowFileds := array("left","top","height","width"); end function paint();override; begin //canvas.draw("polyline",array((0,0),(20,0),(20,20),(0,20))); canvas.StretchDraw(array(0,0,30,30),GetBitmap()); end function GetBitmap(); begin if not FBitmap then begin FBitmap := new tbitmap(); FBitmap.Readvcon(HexFormatStrToTsl(bitmapinfo())); end return FBitmap; end function bitmapinfo();override; begin return nil; end function GetPublishProperties();override; begin r := inherited; r := r[FWindowFileds]; if not FBindComponent then return r; r2 := FBindComponent.GetPublishProperties(); if r2 then begin deletefiled(r2); return r union r2; end return r; end function GetPublishEvents();override; begin if FBindComponent then begin r := FBindComponent.GetPublishEvents(); return r; end if not r then return array(1:nil); return r; end function GetChangedPublish();override; begin r := getnotnil(inherited); if not FBindComponent then exit; r2 :=FBindComponent.GetChangedPublish(); if r2 then begin deletefiled(r2); r union= r2; end return r; end function SetPublish(n,v);override; begin if n in FWindowFileds then begin return inherited; end if FBindComponent then begin return FBindComponent.SetPublish(n,v); end end function DesigningSizer();override; begin return false; end function Recycling();override; begin inherited; if FBindComponent is class(TComponent) then begin FBindComponent.Recycling(); FBindComponent := nil; end end property BindComp read FBindComponent write SetBindComponent; property WindowFileds read FWindowFileds write FWindowFileds; {** @param(BindComp)(tcomponent) 绑定的控件 %% @param(WindowFileds)(array of string) 容器控件替代的属性 %% **} end type TDFileWindow = class(TDVirutalWindow) {** @explan(说明) 文件选择容器 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TOpenFileADlg(self);; end function GetPublishEvents();override; begin return array(1:nil); end function bitmapinfo();override; begin return GetOpenFileBitmapInfo(); end end type TDFileSaveWindow = class(TDVirutalWindow) {** @explan(说明) 文件选择容器 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TSavefileADlg(self);; end function GetPublishEvents();override; begin return array(1:nil); end function bitmapinfo();override; begin return GetSaveFileBitmapInfo(); end end type TDInputQuerysWindow = class(TDVirutalWindow) {** @explan(说明) 文件选择容器 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TInPutQuerys(self);; end function GetPublishEvents();override; begin return array(); //return array(1:nil); end function bitmapinfo();override; begin return GetInputquerysBitmapInfo(); end end type TDColorChooseWindow = class(TDVirutalWindow) {** @explan(说明) 颜色选择控件窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TColorChooseADlg(self);; end function GetPublishEvents();override; begin return array(1:nil); end function bitmapinfo();override; begin return GetColorChooseBitmapInfo(); end end type TDFontChooseWindow = class(TDVirutalWindow) {** @explan(说明) 颜色选择控件窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TFontChooseADlg(self);; end function GetPublishEvents();override; begin return array(1:nil); end function bitmapinfo();override; begin return GetFontChooseBitmapInfo(); end end type TDFolderChooseWindow = class(TDVirutalWindow) {** @explan(说明) 颜色选择控件窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TFolderChooseADlg(self);; end function GetPublishEvents();override; begin return array(1:nil); end function bitmapinfo();override; begin return GetFolderChooseBitmapInfo(); end end type TImageListWindow = class(TDVirutalWindow) {** @explan(说明) imagelist 容器窗口 %% **} public function Create(AOwner);override; begin inherited; WindowFileds := array("left","top","height","width"); BindComp := new TControlImageList(self);; end function bitmapinfo();override; begin return GetImageListBitmapInfo(); end end type TDImageList = class(TDRootComponent) {** @explan(说明)imagelist 设计控件 %% **} class function HitTip();override; begin return "图像列表"; end class function ImageId();override; begin return 12; end function bitmapinfo();override; begin return GetImageListBitmapInfo(); end function IsContainer();override; begin return false; end function ComponentClass();override; begin return class(TControlImageList); end class function ClassName();override; begin return "tcontrolimagelist"; end function menus();override; begin r := inherited; //r[length(r)] := array("type":"menu","caption":"编辑","onclick":nil); return r; end function ClassObject();override; begin return class(TDImageList); end function WndClass();override; begin return Class(TImageListWindow); end function Create(AOwner);override; begin inherited; end function GetPublishProperties();override; begin r := inherited; return r[ array("name","top","left","images","imgwidth","imgheight")]; end end //******************label******************* type TGraphicLabelWindow = class(TDVirutalWindow) {** @explan(说明) label 控件替代窗口 %% **} function paint();override; begin canvas.Font := font; al := BindComp.TextAlign; BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al); end function SetPublish(n,v);override; begin r := inherited; if n="bkbitmap" then bkbitmap := v; if (n="textalign" or n="caption" or n="font" or n="bkbitmap") then InvalidateRect(nil,true); return r; end function Create(AOwner);override; begin inherited; BindComp := new tlabel(self); width := BindComp.width; height := BindComp.Height; WindowFileds := array("left","top","width","height","color","font","caption","visible","align","anchors"); end function DesigningSizer();override; begin return true; end end type TDLabel = class(TDComponent) {** @explan(说明) label控件 %% **} class function HitTip();override; begin return "静态文本框"; end function IsContainer();override; begin return false; end function ComponentClass();override; begin return class(tlabel); end class function ClassName();override; begin return "tlabel"; end function ClassObject();override; begin return class(TDLabel); end function WndClass();override; begin return Class(TGraphicLabelWindow); end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100026B03000089504E470D0A1A0A0000000D4948445200000024000000240806 000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000030049444154 5847ED95F94F134114C7FDAFD488B73F6922C6C478FF6A4C20A0164C4004B1A08 9261A148207225034C1185083E281504A6D2986C3022D7297231469A172B4F4E2 39EF31EB76D9BA1B43C4FEB09F64D37933B333DF7DF37DD32D90606882D4D004A 9A109524313A48626480D55419E9F4198F6067824A7A8761074A5DF78B4711405 45A2AB7028DB0CDB529B6072D6CF7BA5E45739E0ECCD761E6D1C454126FB2CEC4 86B26518FDF8EF05E299B2A28F3A11D528ABAA0F0991392732C105D5DE523229B 26C8BB10A4ECD45BA7A173601EB6A63481CDE9E5A32282A050380A559F5C905ED C0DE925DD50D33C01E188FC03267EF8C977A9F7BA686EF1AB21580945F9A88220 035B7CD705232CFAC38089399A67859CF25E3E2A82824E15DA28939798B9CBDE8 DC29527BDE4BB6CF61B4B2BB3C04EB6E6C9021B0929793D4CED59DF0A9FA120E8 84DE06B94FFB7804F0A87E0492D28C30BF18E23D6BA020CCDE7A8F5537BAA8BF8 36517996319DFAB6B818C0776CAA600DA20CA8A4720AE20FBB08F16B3F6894784 A9C6AF7E619CE03D6BA0A0DD175B201411374170D3A4742394378C52FCFCF338B D3F332F66231E7105A189D13F2F5B26A1CE3CF5FB399865863337A406168E2C1E 78CC85D54E6A5F3738E070CE176A2B2113E40F46609FCE047BD8571FC834491E4 C3966CEE95AE0B34553C703DFB955F39DDA79157D907CD5426D256482B0AA70D3 81C945DE23820647A3DFE69B202808378EF50132E65EA6756A5BA72846B36F4F6 D66060E52FC276482CEDFED84E3FA361EC9C10ADA9F618200CB242298BAF2C318 C508FA47C7CC8B99F62DAD15C19427409EBACCEEB6D832C7228935B94410FE3DA 0F12A62165F8FD5E12501EFBFBA294641C7F2DBE034F3D6B93B1D50C03C83317A B0B17386E60834B4BBA9FF48AE05AE553A20ABAC876C105BB91241FDE30B50F5D 1A598563C1A2CE9D61E0FC566F68BC7BC1408D3DDA53738A1F4CD308C4E2FD3F8 7A5C33CB7485E0BCFB7543D0DE3F47F79C80ECC8FE37124178147FF3FC0B123B4 3898026480D4D901A9A2035124C10C02FFABD674D6A547CAC0000000049454E44 AE42608200"; end function Create(AOwner);override; begin inherited; end end //****************timmer**************************** type TTimerWindow = class(TDVirutalWindow) {** @explan(说明)timmer 容器窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new Ttimer(self); end function bitmapinfo();override; begin return GetTimerBitmapInfo(); end end type TDTimer = class(TDRootComponent) {** @explan(说明) timmer 设计器控件 %% **} class function HitTip();override; begin return "定时器"; end function bitmapinfo();override; begin return GetTimerBitmapInfo(); end function IsContainer();override; begin return false; end function ComponentClass();override; begin return class(TTimer); end class function ClassName();override; begin return "ttimer"; end function menus();override; begin r := inherited; //r[length(r)] := array("type":"menu","caption":"编辑","onclick":nil); return r; end function ClassObject();override; begin return class(TDTimer); end function WndClass();override; begin return Class(TTimerWindow); end function Create(AOwner);override; begin inherited; DefaultEvent := array( "event":"ontimer", "name":"time", "virtual":true, "param":array("o","e"), "body": " {** @explan(说明) 定时调 %% @param(e)(tuievent) 消息对象 %% @param(o)(ttimer) 定时器对象 %% **} " ); end end //**************FMainMenu******************************** type TMainMenuWindow = class(TDVirutalWindow) {** @explan(说明) 主菜单容器窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TMainmenu(self); end function bitmapinfo();override; begin return GetMainMenuBitmapInfo(); end end type TTrayWindow = class(TDVirutalWindow) {** @explan(说明) imagelist 容器窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TTray(self);; end function bitmapinfo();override; begin return GetTrayBitmapInfo(); end end //**********actionlistwindow********************** type TActionListWindow = class(TDVirutalWindow) {** @explan(说明) actionlist 容器窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TActionList(self); end function bitmapinfo();override; begin return GetActionListBitmapInfo(); end end //***********opendlg***************** type TDOpenFileADlg = class(TDRootComponent) {** @explan(说明) 文件打开控件 %% **} class function HitTip();override; begin return "文件选择"; end function classification();override; begin return "对话框"; end function bitmapinfo();override; begin return GetOpenFileBitmapInfo(); end function IsContainer();override; begin return false; end function ComponentClass();override; begin return class(TOpenFileADlg); end class function ClassName();override; begin return "topenfileadlg"; end function ClassObject();override; begin return class(TDOpenFileADlg); end function WndClass();override; begin return Class(TDFileWindow); // end function Create(AOwner);override; begin inherited; end end //***********savefile*************************** type TDSaveFileADlg = class(TDRootComponent) {** @explan(说明) 文件打开控件 %% **} class function HitTip();override; begin return "文件保存选择"; end function bitmapinfo();override; begin return GetSaveFileBitmapInfo(); end function classification();override; begin return "对话框"; end function IsContainer();override; begin return false; end function ComponentClass();override; begin return class(TSavefileADlg); end class function ClassName();override; begin return "tsavefileadlg"; end function ClassObject();override; begin return class(TDSaveFileADlg); end function GetPublishProperties();override; begin r := inherited; if r then reindex(r,array("multiselected":nil)); return r; end function WndClass();override; begin return Class(TDFileSaveWindow); // end function Create(AOwner);override; begin inherited; end end //************querys************************************** type TDInputQuerys = class(TDRootComponent) {** @explan(说明) 文件打开控件 %% **} class function HitTip();override; begin return "数据输入对话框"; end function bitmapinfo();override; begin return GetInputquerysBitmapInfo(); end function classification();override; begin return "对话框"; end function IsContainer();override; begin return false; end function ComponentClass();override; begin return class(TInPutQuerys); end class function ClassName();override; begin return "tinputquerys"; end function ClassObject();override; begin return class(TDInputQuerys); end function WndClass();override; begin return Class(TDInputQuerysWindow); // end function Create(AOwner);override; begin inherited; end end //***********colorchoose******************************* type TDColorChoose = class(TDRootComponent) {** @explan(说明) 文件打开控件 %% **} class function HitTip();override; begin return "颜色选择"; end function bitmapinfo();override; begin return GetColorChooseBitmapInfo(); end function IsContainer();override; begin return false; end function classification();override; begin return "对话框"; end function ComponentClass();override; begin return class(TColorChooseADlg); end class function ClassName();override; begin return "tcolorchooseadlg"; end function ClassObject();override; begin return class(TDColorChoose); end function WndClass();override; begin return Class(TDColorChooseWindow); // end function Create(AOwner);override; begin inherited; end end //*************font choose ********************************** type TDFontChoose = class(TDRootComponent) {** @explan(说明) 文件打开控件 %% **} class function HitTip();override; begin return "字体选择"; end function classification();override; begin return "对话框"; end function bitmapinfo();override; begin return GetFontChooseBitmapInfo(); end function IsContainer();override; begin return false; end function ComponentClass();override; begin return class(TFontChooseADlg); end class function ClassName();override; begin return "tfontchooseadlg"; end function ClassObject();override; begin return class(TDFontChoose); end function WndClass();override; begin return Class(TDFontChooseWindow); // end function Create(AOwner);override; begin inherited; end end //**************folder********************* type TDFolderChoose = class(TDRootComponent) {** @explan(说明) 文件打开控件 %% **} class function HitTip();override; begin return "目录选择"; end function classification();override; begin return "对话框"; end function bitmapinfo();override; begin return GetFolderChooseBitmapInfo(); end function IsContainer();override; begin return false; end function ComponentClass();override; begin return class(TFolderChooseADlg); end class function ClassName();override; begin return "tfolderchooseadlg"; end function ClassObject();override; begin return class(TDFolderChoose); end function WndClass();override; begin return Class(TDFolderChooseWindow); // end function Create(AOwner);override; begin inherited; end end //****************toolbar*********************************** type TDToolButton = class(TDComponent) {** @explan(说明) toolbar 按钮设计控件 %% **} class function HitTip();override; begin return "toolbutton"; end function classification();override; begin return "非点击添加控件" ; end class function ClassName();override; begin return "ttoolbutton"; end function IsContainer();override; begin return false; end function InToolBar();override; begin return false; end function CheckParent(p,pwnd);override; begin if not(p is class(TDToolBar)) then return false; pwnd := p.Cwnd; return true; end function ClassObject();override; begin return class(TDToolButton); end function WndClass();override; begin return Class(TToolButton); end function Create(AOwner);override; begin inherited; end function ComponentCreater(node,owner);override; begin r := inherited; node.owner.expand(node); return r; end end type TDToolBar = class(TDComponent) {** @explan(说明) toolbar 设计器控件 %% **} private function createabutton(o,n); begin cp := o.Component; if not cp then exit; if n=0 then r := (GetDCompObject("ttoolbutton")).ComponentCreater(cp.TreeNode,cp.Cwnd); if n=2 then r := (GetDCompObject("ttoolsepbutton")).ComponentCreater(cp.TreeNode,cp.Cwnd); if not r then exit; r.CreateName(); tr := r.TreeNode.owner.Designer; tr.VariableSelecter.additem(r); end public class function HitTip();override; begin return "工具栏"; end function DefaultAlign();override; begin return true; end class function ClassName();override; begin return "ttoolbar"; end function addtoolbutton(o,e); begin createabutton(o,0); end function addtoolbutton2(o,e); begin createabutton(o,2); end function menus();override; begin r := inherited; r[length(r)] := array("type":"menu","caption":"添加工具栏按钮","onclick":thisfunction(addtoolbutton)); //r[length(r)] := array("type":"menu","caption":"添加工具容器按钮","onclick":thisfunction(addtoolbutton2)); return r; end function CheckChild(CD);override; begin return cd is class(TDToolButton); end function ClassObject();override; begin return class(TDToolBar); end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002BE01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000015349444154 484BED953D4AC5501085C77DD8887BD0C645B8010B05155C811BB0114454B4119 5B78654EE41105110440B9BFCE7BD972016BEC0E8B9E184686E7E40D288031F37 8799CC979022A203D71F10388EA343225996695F7003CAD66B42D234D5BE5060E B3521D3E95417B6776B6C1C5F6A14278A3EA180F9E960B946751EC86432310B59 B89EE5B96E9D8D74EDF05C832852CC000A98B150DF1F4A90D923321E8F6B02D4C 72CD7CDD391AE1F5D28660005CC46905E97F02DAA340A509020B70AA2AB562449 929AE027980114301B81BBA72F272BDF9EBA8AC4716C9634157A980114306381B EEE14E7DBAD1589BE3E62970033800266B3F879B538BD7D2B128661A700338002 66B3F871A914D9F8BDE06EBE38EF17AD4810049D02CC000A98CDE29BB9F2B421B EEF9B256D600650C08CC55D88E779DA170A6CBD26C4755DED0B05B65E13C3FF0F CC230D58FF828E52FD0481EEF4FA779294570000000049454E44AE42608200"; end function WndClass();override; begin return Class(TToolBar); end function Create(AOwner);override; begin inherited; end function ComponentCreater(tnode,owner);override; begin r := inherited; //r.Cwnd.align := r.Cwnd.alnone; return r; end end type TDStatusBar = class(TDComponent) {** @explan(说明) statusbar设计器控件 %% **} class function HitTip();override; begin return "状态栏"; end class function ClassName();override; begin return "tstatusbar"; end function ComponentCreater(tnode,owner);virtual; begin r := inherited; //owner.DoControlAlign(); return r; end function menus();override; begin r := inherited; //r[length(r)] := array("type":"menu","caption":"添加工具栏按钮","onclick":thisfunction(addtoolbutton)); return r; end function ClassObject();override; begin return class(TDStatusBar); end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100025001000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000E549444154 484BDD8E5106846014856757B3AED941DB6847F39088881E22A2878888F4D4B88 77324535373FD0F33978FF3517DDD96C0F72781FBE3190C04E67906711C9BCABD 28304D136080EE4581711C0103742F0A0CC30018A07B51A0EF7BC000DD8B025DD 70106E85E1468DB163040BFCAF65D059AA6010CD0AF621745915C81BAAE0103F4 6FB000B70255550106E867583FBFDE860265590206E867B0B3BFDE6E4381A2280 003F4B3D847DF6D05F23C070CD0F7583FB3B70D05B22C030CD0F7B0B33F3DDA86 02699A0206E847D8873E6D059224010CD0BD286023140884BC5F0F2CCB0BD5861 2A5BA8CBF2E0000000049454E44AE42608200"; end function WndClass();override; begin return Class(TStatusBar); end function IsContainer();override; begin return false; end function Create(AOwner);override; begin inherited; end end type TDTray = class(TDRootComponent) {** @explan(说明) statusbar设计器控件 %% **} class function HitTip();override; begin return "托盘"; end class function ClassName();override; begin return "ttray"; end function menus();override; begin r := inherited; //r[length(r)] := array("type":"menu","caption":"添加工具栏按钮","onclick":thisfunction(addtoolbutton)); return r; end function ClassObject();override; begin return class(TDTray); end function CheckParentWnd(Pwnd);override; begin return (Pwnd is class(TVCForm)) ; end function bitmapinfo();override; begin return GetTrayBitmapInfo(); end function ComponentClass();override; begin return class(TTray); end function WndClass();override; begin return Class(TTrayWindow); end function Create(AOwner);override; begin inherited; end end //*************菜单*********************** type TDMenuBase = class(TDRootComponent) {** @explan(说明) 菜单设计器控件基类 %% **} function CheckChild(cd);override; begin return cd is class(TDMenu); end function addmenu(o,e); begin {** @explan(说明)添加菜单 **} cp := o.Component; r := (GetDCompObject("tmenu")).ComponentCreater(cp.TreeNode,cp.Cwnd); r.CreateName(); tr := r.TreeNode.owner.Designer; tr.BindCwndMessage(r.Cwnd); tr.VariableSelecter.additem(r); end function menus();override; begin r := inherited; r[length(r)] := array("type":"menu","caption":"添加子菜单","onclick":thisfunction(addmenu)); return r; end function Create(AOwner);override; begin inherited; end end type TDMainMenu = class(TDMenuBase) {** @explan(说明) 主菜单设计器控件 %% **} class function HitTip();override; begin return "主菜单"; end function ComponentClass();override; begin return class(tmainmenu); end class function ClassName();override; begin return "tmainmenu"; end function bitmapinfo();override; begin return GetMainMenuBitmapInfo(); end function CheckParentWnd(Pwnd);override; begin return (Pwnd is class(TVCForm)) ; end function ClassObject();override; begin return class(TDMainMenu); end function WndClass();override; begin return Class(TMainMenuWindow); end function Create(AOwner);override; begin inherited; end end type TDMenu = class(TDMenuBase) {** @explan(说明) 普通菜单设计器控件 %% **} class function HitTip();override; begin return "menu\r\n通过右键添加"; end function classification();override; begin return "非点击添加控件" ; end class function ClassName();override; begin return "tmenu"; end function InToolBar();override; begin return false; end function WndClass();override; begin return class(tmenu); end function ClassObject();override; begin return class(TDMenu); end function Create(AOwner);override; begin inherited; end function CheckParent(p,pwnd);override; begin r := (p is class(TDMenu)) or (p is class(TDMainMenu)) or (p is class(TDPopUpMenu)); Pwnd := p.GetTrueComponent; return r; end private function ifmainmenunode(pwnd); begin if pwnd is class(tmainmenu) then return true; if pwnd is class(tmenu) then begin return ifmainmenunode(pwnd.parent); end return false; end public function SetViewParent(wnd,pwnd);override; begin if ifmainmenunode(pwnd) then wnd.parent := pwnd; end function ComponentCreater(node,owner);override; begin r := inherited; node.owner.expand(node); return r; end end type TDAction = class(TDComponent) {** @explan(说明) action设计器控件 %% **} class function HitTip();override; begin return "taction\r\n通过右键添加"; end function IsContainer();override; begin return false; end function classification();override; begin return "非点击添加控件" ; end function InToolBar();override; begin return false; end function CheckParent(dcomp,Pwnd);override; begin if dcomp is class(TDActionList) then return TRUE; Pwnd := dcomp.Cwnd; return false; end class function ClassName();override; begin return "taction"; end function ClassObject();override; begin return class(TDAction); end function WndClass();override; begin return Class(taction); end function ComponentCreater(node,owner);override; begin r := inherited; node.owner.expand(node); return r; end function create(AOwner);override; begin inherited; end end type TDActionList = class(TDRootComponent) {** @expand(说明)actionlist 设计器控件 %% **} class function HitTip();override; begin return "actionlist"; end function CheckChild(cd);override; begin return cd is class(TDAction); end function bitmapinfo();override; begin return GetActionListBitmapInfo(); end function addaction(o,e); begin cp := o.Component; r := (GetDCompObject("taction")).ComponentCreater(cp.TreeNode,cp.Cwnd); r.CreateName(); tr := r.TreeNode.owner.Designer; tr.VariableSelecter.additem(r); end function menus();override; begin r := inherited; r[length(r)] := array("type":"menu","caption":"add action","onclick":thisfunction(addaction)); return r; end function ComponentClass();override; begin return class(tactionlist); end class function ClassName();override; begin return "tactionlist"; end function ClassObject();override; begin return class(TDActionList); end function WndClass();override; begin return Class(TActionListWindow); end function Create(AOwner);override; begin inherited; end end //**************FMainMenu******************************** type TPopUpMenuWindow = class(TDVirutalWindow) {** @explan(说明) 弹出菜单虚拟窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TPopUpmenu(self); end function bitmapinfo();override; begin return GetPopUpMenuBitmapInfo(); end end type TSocketServerWindow = class(TDVirutalWindow) function Create(AOwner);override; begin inherited; BindComp := new TSocketServer(self); end function bitmapinfo();override; begin return GetServerBitmapInfo(); end end type TSocketClientWindow = class(TDVirutalWindow) function Create(AOwner);override; begin inherited; BindComp := new TSocketClient(self); end function bitmapinfo();override; begin return GetClientBitmapInfo(); end end type TClipBordWindow = class(TDVirutalWindow) function Create(AOwner);override; begin inherited; BindComp := new TClipBoard(self); end function bitmapinfo();override; begin return GetClipboardBitmapInfo(); end end //********************* type TQuotationWindow = class(TDVirutalWindow) function Create(AOwner);override; begin inherited; BindComp := new TQuotations(self); end function bitmapinfo();override; begin return GetQuotationBitmapInfo(); end end type TLoginWindow = class(TDVirutalWindow) function Create(AOwner);override; begin inherited; BindComp := new tlogincontrol(self); end function bitmapinfo();override; begin return GetLoginBitmapInfo(); end end type TDPopUpMenu = class(TDMenuBase) {** @explan(说明) 弹出菜单控件 %% **} class function HitTip();override; begin return "右键菜单"; end function libs();override; begin return array(); end function ComponentClass();override; begin return class(tpopupmenu); end class function ClassName();override; begin return "tpopupmenu"; end function bitmapinfo();override; begin return GetPopUpMenuBitmapInfo(); end function ClassObject();override; begin return class(TDPopUpMenu); end function WndClass();override; begin return Class(TPopUpMenuWindow); end function Create(AOwner);override; begin inherited; end end //*****************clipboard******************** type TDClipBoard = class(TDRootComponent) class function HitTip();override; begin return "剪切板"; end function libs();override; begin return array(); end function classification();override; begin return "天软"; end function ComponentClass();override; begin return class(TClipBoard); end class function ClassName();override; begin return "tclipboard"; end function bitmapinfo();override; begin return GetClipboardBitmapInfo(); end function WndClass();override; begin return Class(TClipBordWindow); end function Create(AOwner);override; begin inherited; end end //***********订阅************************ type TDQuotations = class(TDRootComponent) class function HitTip();override; begin return "行情订阅"; end function libs();override; begin return array(); end function ComponentClass();override; begin return class(TQuotations); end function classification();override; begin return "天软"; end class function ClassName();override; begin return "tquotations"; end function bitmapinfo();override; begin return GetQuotationBitmapInfo(); end function WndClass();override; begin return Class(TQuotationWindow); end function Create(AOwner);override; begin inherited; end end //**************************** type TDtlogincontrol = class(TDRootComponent) class function HitTip();override; begin return "登陆天软"; end function classification();override; begin return "天软"; end function libs();override; begin return array(); end function ComponentClass();override; begin return class(tlogincontrol); end class function ClassName();override; begin return "tlogincontrol"; end function bitmapinfo();override; begin return GetLoginBitmapInfo(); end function WndClass();override; begin return Class(TLoginWindow); end function Create(AOwner);override; begin inherited; end end //*************Server************************* type TDSocketServer = class(TDRootComponent) {** @explan(说明) 弹出菜单控件 %% **} class function HitTip();override; begin return "socket服务端"; end function libs();override; begin return array(); end function classification();override; begin return "天软"; end function ComponentClass();override; begin return class(TSocketServer); end class function ClassName();override; begin return "tsocketserver"; end function bitmapinfo();override; begin return GetServerBitmapInfo(); end function WndClass();override; begin return Class(TSocketServerWindow); end function Create(AOwner);override; begin inherited; end end //*************client********************** type TDSocketClient = class(TDRootComponent) {** @explan(说明) 弹出菜单控件 %% **} class function HitTip();override; begin return "socket客户端"; end function classification();override; begin return "天软"; end function libs();override; begin return array(); end function ComponentClass();override; begin return class(TSocketClient); end class function ClassName();override; begin return "tsocketclient"; end function bitmapinfo();override; begin return GetClientBitmapInfo(); end function WndClass();override; begin return Class(TSocketClientWindow); end function Create(AOwner);override; begin inherited; end end //*************TTreeView*************************** type TDTreeView = class (TDComponent) {** @explan(说明) 树形设计控件 %% **} class function HitTip();override; begin return "树控件"; end class function ClassName();override; begin return "ttreeview"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100027101000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000010649444154 484BB595CB0D83400C05530725A44ADAE0C43DF55009FFCF61A387F422AFB3364 B084823451C668C7DC823DCFCEC81BAAE4355557F05CE4F002FB66D8B58D73562 599688799E23A6698A80F32B109AE7CE55F9388EE940F37A44FC2ACF0E4058144 516529E0C701D65595E9A3C2B40296F72563E0C831F207A65B972332057027400 C2D4FE819427035ACE75E04BCE4C0EFABEF703943340296F7224770352CE80751 34B6E06B41C53CB2FD00148F52DCC404ACE95E077CE5A48D7757EC09A3857EE06 28B7027A2544CACD80940308718333939B81945C0620E54D8EE46DDBFA01CA192 07A6596DC0D4839906BD10108F52DDC8027CF598B240ADCFEA77FDF13C21B71B1 C6D53F7109130000000049454E44AE42608200"; end function IsContainer();override; begin return false; end function ClassObject();override; begin return class(TDTreeView); end function WndClass();override; begin return Class(ttreeview); end function Create(AOwner);override; begin inherited; DefaultEvent := array( "event":"onselchanged", "name":"sel", "virtual":true, "param":array("o","e"), "body": " {** @explan(说明) item选择改变回调 %% @param(e)(tuieventtree) 消息对象 %% @param(o)(ttreeview)树控件 %% **} if e.itemold and e.itemnew then begin MessageBoxA(e.itemold.caption+' 切换到 '+e.itemnew.caption,'提示',0,o); end " ); end end //**************TSPinEdit***************************** type TDSpinEdit = class(TDComponent) {** @explan(说明) spinedit 设计器控件 %% **} class function HitTip();override; begin return "SpinEdit"; end function IsContainer();override; begin return false; end class function ClassName();override; begin return "tspinedit"; end function ClassObject();override; begin return class(TDSPinEdit); end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 100026901000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000FE49444154 484B63F84F63306A0141401F0BEAE7EE240B83C0FCF9F3FFCF9C39132B06C9C12 D2015C0F4800C828113274E80310C80E4A866C1FEFDFBFF7371718131880D0244 5BB074EDEEFF21A9F5607CE5C67DB018BA05929292FF191818C018C40601A22D2 86D9EFEFFDCE55B501E04A05B800D106D415A690F182F5EB3EBFFDFBFFFC06230 3D5489E4874F5E80830614446BB61C048B11D203034459F0EBD76F30DDD8BBE0F FECA55BC06CAAFA20B77AE2FFC0E4DAFFF1F9EDFF3F7FF9061683E90119840B80 E488B2001B40B7405A5A1A9E8A406C10A0AA0514E5036C00DD0210387EFC3818C 3008A05E46010202A926909462D200886BA05FFFF03002A9E4731011BC45B0000 000049454E44AE42608200"; end function WndClass();override; begin return Class(TSpinEdit); end function Create(AOwner);override; begin inherited; end end //************tlistview****************************** type TDListView = class(TDComponent) {** @explan(说明) TTSLDataGrid 设计器控件 %% **} class function HitTip();override; begin return "列表视图控件"; end function IsContainer();override; begin return false; end class function ClassName();override; begin return "tlistview"; end function bitmapinfo();override; begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002ED01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000018249444154 484BB5D52D4CC3401407F0E770381C0E8947A3499A60700B06B3E006212080646 A1364624B204D9A34080C0EB1A48E90903A1C0E070AB97EAD1FE2D1077B973B76 57D1B54DFEE689DFFFF5724D015B7E7E0B5CD745DBB61B0D99A28006455128C9F 35C4996654AD23455329FCF9590A92DD8BA4871B337C38DE36F057F0340BFCC73 1919061F10BC328F20F02449CC058CAF1F7D2A9B33EEFD2F58E0E0FC15106E2C2 090F1B5CE87C0298C3F490504320E2310B8B6808F8323E314796BC6E5C8B8B1C0 B2ACA510AE9B13AA9B131EC7B1F90D56DD9C70630181B317C0AF29E07B79B632F C7AD0C7E9DE193EEC76157C78EFE0F5DD184F6F0602D716F0C68CFBAE5AC0F8ED 4E47D99CF16EFF52E05114990B18F726EA6D617CB0BD2F700AE387E72702AF2C9 0B7665C8E8C53786B193716E86E05A1BA39E1BAB9B1A0A9CD2961189A0BC077CB CF7F527EA1C3DA7875C10207E7AA366E2C20907118F56AE3DA023E0ECE2A78100 4FA02DDADA8831B0B9AD8BCB2A0297CA9A0F59F7E7B0FE20F1D79BA1B7D429BC4 0000000049454E44AE42608200"; end function WndClass();override; begin return Class(TListView); end function Create(AOwner);override; begin inherited; DefaultEvent := array( "event":"onselchanged", "name":"sel", "param":array("o"), "virtual":true, "body": " {** @explan(说明) 选择发生改变回调 %% @param(o)(tlistview) tlistview对象 %% **} MessageBoxA('当前选中:'+tostn(o.selectedid),'提示',0,o); " ); end end //**********属性编辑类*************** (*type TGCellRender = class(TSLUIBASE) {** @ignore(忽略) %% @explan(说明) gridcell渲染器 %% **} private FActivate; public class function EditType();virtual; begin {** @explan(说明)类型名称 %% @return(string) 字符串 %% **} return nil; end function CreateEditer(AOwner);virtual; begin return createobject(self(true).classinfo(1),AOwner); end function Create(AOwner);override; begin {** @explan(说明) 构造编辑器 %% **} class(TSLuibase).create(); end function CellClick(grid,e,d);virtual; begin {** @explan(说明) 格子点击 %% **} FActivate := true; end function CellDraw(grid,e,d);virtual; begin {** @explan(说明) 绘制格子 %% **} end function CellLeave(grid);virtual; begin {** @explan(说明) 离开编辑格子 %% **} FActivate := false; end; property Activated read FActivate; end *) type TGCellRender = class(TSLUIBASE) {** @explan(说明) gridcell渲染器 %% **} private FActivate; public function CreateEditer(AOwner);virtual; begin return createobject(self(true).classinfo(1),AOwner); end function Create(AOwner);override; begin {** @explan(说明) 构造编辑器 %% **} class(TSLuibase).create(); end function CelldbClick(grid,e,d);virtual; begin end function CellClick(grid,e,d);virtual; begin {** @explan(说明) 格子点击 %% **} FActivate := true; end function CellDraw(grid,e,d);virtual; begin {** @explan(说明) 绘制格子 %% **} end function CellLeave(grid);virtual; begin {** @explan(说明) 离开编辑格子 %% **} FActivate := false; end; property Activated read FActivate; end type TTSLDataGrid=class(TDrawGrid) {** @ignore(忽略) %% @explan(说明)TSL数组和对象展示 %% **} private type TGCellBoolRender=class(TGCellRender) class Function EditType();override; begin return "bool"; end function CellClick(o,e,d);override; begin if not ifarray(d)then return; i := e.iitem; j := e.isubitem; pt := e.ptaction; indexs := 1; o.getdata(i,j,cp,indexs); dv := d["value"]; o.setvalue(indexs union array("value"),not dv); rec := o.GetSubItemRect(i,j); o.InvalidateRect(rec,true); end function CellDraw(o,e,d);override; begin dc := e.canvas; DrawBoolButton(dc,e.SubItemRect,d["value"]); end function DrawBoolButton(dc,srca,v); begin FRbuttonWidth := 20; src := srca; src[0]:= src[2]-FRbuttonWidth-10; src[2]-= 10; src[1]+= 3; src[3]-= 3; //_wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,v?DFCS_CHECKED:DFCS_BUTTONCHECK); dc.Draw("framecontrol",array(src[0:1],src[2:3]),DFC_BUTTON,v?DFCS_CHECKED:DFCS_BUTTONCHECK); end end FCols; Fdata; FObjectData; FMRWD; FGridControl; FRows; FShowTwo; FCControls; FColumnWidth; FRowHeader; static FGCellRender; FCanEditStr; FEditStr; FControlIndex; FStringAlign; FNumberAlign; FDefAlign; function SetStringAlign(v); begin if v <> FStringAlign then begin FStringAlign := v; InvalidateRect(nil,true); end end function SetNumberAlign(v); begin if v <> FNumberAlign then begin FNumberAlign := v; InvalidateRect(nil,true); end end function SetdefAlign(v); begin if v <> FDefAlign then begin FDefAlign := v; InvalidateRect(nil,true); end end function GetTSLData(); begin if FObjectData then return FObjectData; return FData; end function CreateFedit(); begin if not FEditStr then begin FEditStr := new tedit(self); FEditStr.onkeypress := thisfunction(EditKeyPress); FEditStr.onkillfocus := thisfunction(EditKillFocus); FEditStr.visible := false; FEditStr.parent := self; end return FEditStr; end function StrToNumber(s); begin if pos(".",s)then begin return StrToFloatDef(s,0); end else begin return StrToIntDef(s,0); end end public function GetCellRender(n); begin if not ifarray(FGCellRender)then begin FGCellRender := array(); end return FGCellRender[n]; end private function SetRowHeader(v); begin nv := v?true:false; if FRowHeader <> nv then begin FRowHeader := nv; FD := FData; SetData(array()); SetData(FD); end end function SetTwoD(v); begin if parent is class(TTSLDataGrid)then exit; nv := v?true:false; if nv <> FShowTwo then begin FD := FData; SetData(array()); FShowTwo := nv; SetData(FD); end end function setdatap(); begin if not Fdata then exit; FCols := nil; FRows := mrows(Fdata,1); FCL := mcols(Fdata,1); allFCL := true; for i,v in FData do begin if not ifarray(v)then begin allFCL := false; break; end end fcs := array(); wd := 80; ftwidth := font.width; for i,v in FRows do begin if ifstring(v)then begin wd := max(wd,length(v) * ftwidth+3); if wd>200 then break; end end if RowHeader then begin fcs[0]:= array("text":" ","width":min(200,wd)); end if FCL and allFCL and FShowTwo then begin FCols := FCl; for i,v in FCols do begin fcs[length(fcs)]:= array("text":ifstring(v)?v:inttostr(v),"width":FMRWD); end end else begin fcs[length(fcs)]:= array("text":" ","width":ColumnWidth>20?ColumnWidth:100); end Columns := fcs; ItemCount := length(FRows); end function objecttoarray(d); begin if dep<0 then return 0; if not ifobj(d)then return 0; try di := d.classinfo(); except return 0; end; da := array(); inhs := array(); for i,v in di["inherited"] do begin inhs[v]:= findclass(v,d); end if inhs then da["inherited"]:= inhs; k := 0; for i,v in di["members"] do begin if(v["access"]in array(0,1,4))then begin vn := v["name"]; da[vn]:= invoke(d,vn); end end for i,v in di["properties"] do begin if v["access"]in array(0,1,4)then begin vn := v["name"]; if not(v["read"])then continue; da[vn]:= invoke(d,vn); end end return da; end function SetData(data,f); begin if Fdata=data then return; DeleteAllColumns(); if ifobj(data)then begin FObjectData := data; r := objecttoarray(data); return SetData(r,1); end if not ifarray(data)then return; if f then FObjectData := nil; FData := data; setdatap(); end function itemishow(r,r2); begin return r[2]r2[2]; end function getitemcontrol(d,p,i,j,tp,cp,idexs); begin idx := format("%d*%d",i,j); o := FCControls[idx]; if tp="grid" then begin if not o then begin o := new TTSlDataGrid(self); o.ControlIndexs(idexs); o.height := 500; o.width := 500; o.Twodimensional := Twodimensional; O.CanEditStr := CanEditStr; o.Visible := false; o.wspopup := true; o.WsSysMenu := true; o.WsSizeBox := true; o.parent := self; o.onclose := thisfunction(ShowDataClose); FCControls[idx]:= o; end o.Twodimensional := Twodimensional; if o.wspopup then p := ClientToScreen(p[0],p[1]); o.left := p[0]; o.top := p[1]; o.caption := cp; o.TSLdata := d; o.show(); end end public function create(AOwner);override; begin inherited; FCControls := array(); FRowHeader := true; FixedColumns := 1; caption := ""; FMRWD := 100; FShowTwo := false; //OndblClick := thisfunction(GridCellDblClick); OnClick := thisfunction(CellClick); RegisterRender(new TGCellBoolRender()); FNumberAlign := AL9_CENTERRIGHT; FStringAlign := AL9_CENTERLEFT; FDefAlign := AL9_CENTER; end function InitializeWnd();override; begin inherited; end procedure Notification(AComponent:TComponent;Operation:TOperation);override; begin if Operation=opRemove then begin for i,v in FCControls do begin if v=AComponent then begin reindex(FCControls,array(i:nil)); break; end end end inherited; end function getdata(i,j,cp,indexs); begin {** @explan(说明) 获取数据 **} if not FRows then return nil; if j=0 and FRowHeader then return FRows[i]; r := FRows[i]; if FCols and FShowTwo then begin if FRowHeader then c := FCols[j-1]; else c := FCols[j]; d := FData[r][c]; if cp then cp := "["+tostn(r)+"]"; if cp then cp += "["+tostn(c)+"]"; if indexs then indexs := array(r,c); end else begin d := FData[FRows[i]]; if cp then cp := "["+tostn(r)+"]"; if indexs then indexs := array(r); end return d; end function DoDrawSubItem(o,e);override; begin inherited; if e.skip then exit; dc := e.canvas; i := e.itemid; j := e.subitemid; d := getdata(i,j); src := e.SubItemRect; if j=0 and FRowHeader then begin //_wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,DFCS_BUTTONPUSH); dc.Draw("framecontrol",array(src[0:1],src[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH); end ds := ""; dc.font.color := 0; if ifarray(d)then begin if d["type"]="object" then begin rd := GetCellRender(d["class"]); if rd is class(TGCellRender)then begin rd.CellDraw(o,e,d); end end else begin ds := format("",length(d)); //dc.drawtext(ds,src); class(TLabel).CanvasDrawAlignText(dc,src,ds,FDefAlign); end end else if ifstring(d)then begin ds := d; //dc.drawtext(ds,src); class(TLabel).CanvasDrawAlignText(dc,src,ds,FStringAlign); end else if ifobj(d)then begin //dc.drawtext("",src); class(TLabel).CanvasDrawAlignText(dc,src,"",FDefAlign); end else begin ds := tostn(d); if d<0 then dc.font.color := rgb(200,0,0); if ifnumber(d)and j>0 then begin //dc.drawtext(ds,src,DT_RIGHT); class(TLabel).CanvasDrawAlignText(dc,src,ds,FNumberAlign); end else begin //dc.drawtext(ds,src); if not ifnil(d)then class(TLabel).CanvasDrawAlignText(dc,src,ds,FStringAlign); end end end function DoDrawItem(o,e);override; begin dc := e.canvas; rc := e.rcitem; {if SelectedRow = e.id then if ifnumber(SelectRowColor) then dc.brush.color := SelectRowColor; else dc.brush.color := rgb(150,150,150); else } if color then dc.brush.color := color; // else dc.brush.color := rgb(255,255,255); dc.fillrect(rc); inherited; end function CellClick(o,e);virtual; 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 := GetCellRender(d["class"]); if rd is class(TGCellRender)then begin return rd.CellClick(o,e,d); end end else if ifnumber(d)or ifstring(d)or ifnil(d)then begin CreateFedit(); if not CanEditStr then exit; onShowEdit(e); end end function GridCellDblClick(o,e);virtual; begin cp := 1; cl := e.isubitem; if cl<1 and FRowHeader then exit; indexs := 1; d := getdata(e.iitem,cl,cp,indexs); p := e.ptaction; if ifarray(d)then begin if d["type"]="object" then begin rd := GetCellRender(d["class"]); if r then return r.CelldbClick(o,e,d); end getitemcontrol(d,p,e.iitem,cl,"grid",cp,indexs); end else if ifobj(d)then begin return getitemcontrol(d,p,e.iitem,cl,"grid",cp,indexs); end end function ShowDataClose(o,e); begin o.show(false); o.TSLdata := array(); e.skip := true; o.Recycling(); end function Recycling();override; begin FCols := nil; Fdata := nil; inherited; end function SetValue(index,val);virtual; begin if ifobj(FObjectData)then begin p := index[0]; if ifstring(p)then begin try invoke(FObjectData,p,1,val); except end end end if not ifarray(FData)then exit; r := magicsetarray(FData,index,val); if FControlIndex then begin if parent is class(TTSLDataGrid)then begin parent.SetValue(FControlIndex,FData); end end return r; idx := "FData"; for i,v in index do begin if ifnumber(v)then idx += format("[%d]",v); else if ifstring(v)then begin idx += format('["%s"]',v); end end if length(idx)>5 then begin vals := idx+":="+tostn(val)+";"; //FData["c"]["value"]:=0; try eval(&vals); except //echo "===errr"; end; end end function ControlIndexs(dx); begin {** @ignore(忽略) %% **} if dx then FControlIndex := dx; return FControlIndex; end function RegisterRender(it); begin if it is class(TGCellRender)then begin if not ifarray(FGCellRender)then FGCellRender := array(); FGCellRender[it.EditType()]:= it; end else if ifarray(it)then begin for i,v in it do call(thisfunction,v); end end function EditKeyPress(o,e); begin k := e.wparam; if k=VK_ESCAPE or k=13 then begin info := o._tag; if ifarray(info)then begin v := o.text; v2 := info[2]; if ifnumber(v2)then begin vi := StrToNumber(v); if v2 <> vi then begin SetValue(info[3],vi); end end else begin if v2 <> v then begin SetValue(info[3],v2); end end end o.visible := false; end end function EditKillFocus(o,e); begin o.visible := false; end function onShowEdit(e); begin {** @explan(说明) 显示编辑框 %% **} i := e.iitem; j := e.isubitem; rc := GetSubItemRect(i,j); FEditStr.SetBoundsRect(rc); indexs := 1; v := getdata(i,j,nil,indexs); FEditStr._tag := array(i,j,v,indexs); vs := ""; if ifstring(v)then vs := v; else if ifnumber(v)then v := tostn(v); FEditStr.text := v; FEditStr.show(); xy := e.ptaction; pt := makelong(xy[0]-rc[0],xy[1]-rc[1]); FEditStr._send_(WM_LBUTTONDOWN,0,pt,0); end property Twodimensional:bool read FShowTwo write SetTwoD; property TSLdata:variable read GetTSLData write SetData; property ColumnWidth:integer read FColumnWidth write FColumnWidth; property RowHeader:bool read FRowHeader write SetRowHeader; property CanEditStr:bool read FCanEditStr write FCanEditStr; property StringAlign:AlignStyle9 read FStringAlign write SetStringAlign; property NumberAlign:AlignStyle9 read FNumberAlign write SetNumberAlign; property DefAlign:AlignStyle9 read FDefAlign write SetdefAlign; {** @param(Twodimensional)(BOOL) 是否二维强制二维展示 %% @param(TSLdata)(array) tsl数据 %% **} end type TGridPropertyRender = class(TGCellRender) function CreateEditer(AOwner);override; begin return CreateObject(self(true).Classinfo(1),AOwner); end function Create(AOwner); begin inherited; Owner := AOwner; end Owner ; end type TGridCellEditWithButton = class(TGridPropertyRender) {** @explan(说明) 带有按钮的格子% **} private FRbuttonWidth; FCurorList; FUpRect; FDownRect; protected function ptinrect(pt,rec); begin return (pt[0]>rec[0] and pt[0]<=rec[2]) and (pt[1]>rec[1] and pt[1]<=rec[3]); end function splitrect(r,rs);virtual; begin rs := array(); src := r; wd := FRbuttonWidth?FRbuttonWidth:20; src[0] := src[2]-wd; src[1]+=3; src[3]-=3; rs[0] := src; src := r; src[2]-=wd; rs[1] := src; end public function GetPopRectByHeight(h); begin {** @explan(说明)根据格子获得弹出的区域 %% **} if not(h>10) then h:= 100; dn := GetPopRect(); if dn[3]-dn[1]=h then begin dn[1]:= dn[3]-h; end else begin dn := dna; end end return dn; end function GetPopRect(f); begin {** @explan(说明) 获得弹出区域%% @param(f)(bool) ture获得上方弹出区域,false 获得下方 %% **} if f then return FUpRect; return FDownRect; end function DrawButton(dc,src,d); begin {** @explan(说明) 绘制按钮%% **} dc.Draw("framecontrol",array(src[0:1],src[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN); end Function Create(AOwner);override; begin inherited; //echo "\r\nwitchbtn:"; ButtonWidth := 20; end function CellDraw(grid,e,d);override; begin rec := e.SubItemRect; dc := e.canvas; splitrect(rec,rs); DrawButton(dc,rs[0],d); CellDrawLabel(dc,rs[1],d); end function CellDrawLabel(dc,rect,d);override; begin {** @explan(说明) 绘制标签 %% **} if ifarray(d) then begin //dc.drawtext(self(true).EditType(),rect); end end function CellClick(grid,e,d);override; begin {** @explan(说明) 格子点击 %% **} inherited; i := e.iitem; j := e.isubitem; pt := e.ptaction; rec := grid.getSubItemRect(i,j); splitrect(rec,rs); btr := rs[0]; lr := rs[1]; x1y1 := grid.ClientToScreen(rec[0],rec[1]); x2y2 := grid.ClientToScreen(rec[2],rec[3]); src := _wapi.GetScreenRect(); FUpRect := array(x1y1[0],src[1],x2y2[0],x1y1[1]); FDownRect := array(x1y1[0],x2y2[1],x2y2[0],src[3]); if ptinrect(pt,btr) then begin ButtonClick(grid,e,d); end else if ptinrect(pt,lr) then begin LabelClick(grid,e,d); end end function CelldbClick(grid,e,d);override; begin {** @explan(说明) 格子点击 %% **} inherited; i := e.iitem; j := e.isubitem; pt := e.ptaction; rec := grid.getSubItemRect(i,j); splitrect(rec,rs); btr := rs[0]; lr := rs[1]; x1y1 := grid.ClientToScreen(rec[0],rec[1]); x2y2 := grid.ClientToScreen(rec[2],rec[3]); src := _wapi.GetScreenRect(); FUpRect := array(x1y1[0],src[1],x2y2[0],x1y1[1]); FDownRect := array(x1y1[0],x2y2[1],x2y2[0],src[3]); if ptinrect(pt,lr) then begin //LabelClick(grid,e,d); end end function ButtonClick(grid,e,d);virtual; begin {** @explan(说明) 按钮被点击 %% **} end function LabelClick(grid,e,d);virtual; begin {** @explan(说明)标签被点击 %% **} end function CellLeave(grid);override; begin {** @explan(说明) 离开编辑格子 %% **} inherited; end; property ButtonWidth read FRbuttonWidth write FRbuttonWidth; {** @param(ButtonWidth)(integer) 按钮宽度 %% **} end ///////////////////////////////////////////////////////////////////////// type TGridCellNaturalEdit = class(TGridPropertyRender,TPropertyNatural) FRow; FCol; FGrid; FEdit; public function create(AOwner);override; begin inherited; FGrid := AOwner; end function numbertotext(num);virtual; begin if ifnumber(num) then return inttostr(num); return ""; end function textonumber(txt);virtual; begin return strtointdef(txt,0); end function Ched(o,e); begin v := textonumber(o.TEXT); FGrid.CellChanged(FRow,FCol,"value",v); //o.parent.CallChanged(o.parent,nil); end function EditKeyPress(o,e);virtual; begin if 13 = e.wparam then begin try ched(o); o.visible := false; except end ; end else begin if not(e.wparam >= ord("0") and e.wparam<= ord("9") or e.wparam = VK_BACK) then e.skip := true; end end function CellClick(grid,e,d);override; begin {** @explan(说明) 格子点击 %% **} i := e.iitem; j := e.isubitem; Frow := i; FCol := j; pt := e.ptaction; rec := grid.getSubItemRect(i,j); if d["class"]=EditType() and (FGrid is class(TDrawGrid)) then begin if not(FEdit is class(TWincontrol)) then begin FEdit := new TPopEditCtrl(FGrid);//CreateExtendEdit(FGrid); FEdit.visible := false; FEdit.OnKeyPress := thisfunction(EditKeyPress); FEdit.parent := FGrid; FEdit.OnChanged := thisfunction(Ched); end FEdit.SetBoundsRect(FGrid.clienttoscreen(rec[0],rec[1]) union FGrid.clienttoscreen(rec[2],rec[3])); FEdit.text := numbertotext(d["value"]); FEdit.parent := grid; FEdit.SetFocus(); FEdit.visible := true; end end function CellDraw(grid,e,d);override; begin {** @explan(说明) 绘制格子 %% **} if FGrid is class(TDrawGrid) then e.canvas.drawtext(numbertotext(d["value"]),e.subItemRect,DT_CENTER); end function CellLeave(grid);virtual; begin {** @explan(说明) 离开编辑格子 %% **} if not(FEdit is class(TEdit)) then exit; FEdit.text := ""; FEdit.visible := false; inherited; end; end type TGridCellIntegerEdit = class(TGridCellNaturalEdit) {** @explan(说明) 整数编辑 %% **} function CreateEditer(AOwner);override; begin return new TGridCellIntegerEdit(AOwner); end function EditType();override; begin return "integer"; end function FormatEdit(d,modify);override; begin {** @explan(说明)控件数据转换为修改表格数据 %% **} r := inherited; r["class"] := EditType(); if not ifnil(d) then begin r["value"] := d; end return r; end public function Create(AOwner);override; begin inherited; end function EditKeyPress(o,e);override; begin if e.wparam = ord("-") then begin end else inherited; end end type TGridCellStringEdit = class(TGridCellNaturalEdit) {** @explan(说明) 整数编辑 %% **} function CreateEditer(AOwner);override; begin return new TGridCellStringEdit(AOwner); end function EditType();override; begin return "string"; end function FormatEdit(d,modify);override; begin {** @explan(说明)控件数据转换为修改表格数据 %% **} r := inherited; r["class"] := EditType(); if not ifnil(d) then begin r["value"] := d?:""; end return r; end public function Create(AOwner);override; begin inherited; end function textonumber(txt);override; begin return txt; end function numbertotext(num);override; begin return num; end function EditKeyPress(o,e);override; begin if e.wparam <>13 then begin end else inherited; end end type TPopEditCtrl = class(TCustomControl) private FEdit; FOnChanged; FOnKeyPress; function GetText(); begin return FEdit.Text; end function SetText(v); begin FEdit.Text := v; end public function dosetfocus();override; begin FEdit.SetFocus; end function WMACTIVATE(o,e):WM_ACTIVATE;override; begin if e.wparam = 0 then begin CallChanged(o,e); end end function CallChanged(o,e); begin o.visible := false; CallDataFunction(FOnChanged,o,e); //O.text := ""; end function create(AOwner);override; begin inherited; WsPopUp := true; WsDlgModalFrame := false; FEdit := new tedit(self); width := FEdit.Width+2; height := FEdit.Height +2; FEdit.align := alClient; FEdit.parent := self; FEdit.OnKeyPress := function(o,e)begin CallDataFunction(FOnKeyPress,self,e); end end function ReCycling();override; begin FOnChanged := nil; FOnKeyPress := nil; inherited; end property Text read GetText write SetText; //文本 property OnKeyPress read FOnKeyPress write FOnKeyPress; //按下 property OnChanged read FOnChanged write FOnChanged; //改变 end type TGridCellColorEdit = class(TGridCellEditWithButton,TPropertyColor) {** @explan(说明) color edit **} private Fcpok ; FColorChoose; public function create(AOwner);override; begin inherited; FRbuttonWidth := 20; end function ButtonClick(grid,e,d);override; begin Fcpok := true; if not(FColorChoose) then begin FColorChoose := new TColorChooseADlg(grid); FColorChoose.Parent := grid; end FColorChoose.Result := d["value"]; if FColorChoose.OpenDlg() and Fcpok then begin grid.CellChanged(e.iitem,e.isubitem,"value",FColorChoose.Result); end end function CellDrawLabel(dc,rect,d);override; begin {** @explan(说明) 绘制格子 %% **} dc.brush.color := d["value"]; dc.fillrect(rect); end function CellLeave();override; begin Fcpok := false; inherited; end end type TGridCellDirectoryEdit = class(TGridCellEditWithButton,TPropertyDirectory) {** @explan(说明) color edit **} private Fcpok ; FColorChoose; public function create(AOwner);override; begin inherited; end function ButtonClick(grid,e,d);override; begin Fcpok := true; if not(FColorChoose) then begin FColorChoose := new TFolderChooseADlg(grid); FColorChoose.Parent := grid; end if FColorChoose.OpenDlg() and Fcpok then begin grid.CellChanged(e.iitem,e.isubitem,"value",FColorChoose.Folder); end end function CellDrawLabel(dc,rect,d);override; begin {** @explan(说明) 绘制格子 %% **} if ifarray(d) then begin dc.drawtext(d["value"],rect); end end function CellLeave();override; begin Fcpok := false; inherited; end end type TGridCellFileNameEdit = class(TGridCellEditWithButton,TPropertyFileName) {** @explan(说明) color edit **} private Fcpok ; FColorChoose; public function create(AOwner);override; begin inherited; end function ButtonClick(grid,e,d);override; begin Fcpok := true; if not(FColorChoose) then begin FColorChoose := new TOpenFileADlg(grid); FColorChoose.Parent := grid; end if FColorChoose.OpenDlg() and Fcpok then begin grid.CellChanged(e.iitem,e.isubitem,"value",FColorChoose.FileName); end end function CellDrawLabel(dc,rect,d);override; begin {** @explan(说明) 绘制格子 %% **} if ifarray(d) then begin dc.drawtext(d["value"],rect); end end function CellLeave();override; begin Fcpok := false; inherited; end end type TGridCellFontEdit = class(TGridCellEditWithButton,TPropertyFont) {** @explan(说明) font edit **} private Fcpok ; FColorChoose; fparser; public function create(AOwner);override; begin inherited; end function ButtonClick(grid,e,d);override; begin Fcpok := true; if not(FColorChoose) then begin FColorChoose := new TFontChooseADlg(grid); FColorChoose.Parent := grid; end FColorChoose.fontinfo := d["value"]; if FColorChoose.OpenDlg() and Fcpok then begin i := e.iitem; j := e.isubitem; grid.CellChanged(i,j,"value",FColorChoose.fontinfo); end end function CellDrawLabel(dc,rect,d);override; begin dc.SaveDC(); dc.font := d["value"]; dc.drawtext("tfont",rect); dc.RestoreDC(); end function CellLeave();override; begin Fcpok := false; inherited; end end type TGridCellhotkeyEdit = class(TGridPropertyRender,TPropertyHotkey) {** @explan(说明) 自然数编辑 **} FRow; FCol; FGrid; FEdit; function hotchange(o,e); begin if e.wparam = 13 then begin e.skip := true; FGrid.CellChanged(FRow,FCol,"value",FEdit.hotkey); end end public function create(AOwner);override; begin inherited; FGrid := AOwner; end function CellClick(grid,e,d);override; begin {** @explan(说明) 格子点击 %% **} i := e.iitem; j := e.isubitem; Frow := i; FCol := j; pt := e.ptaction; rec := grid.getSubItemRect(i,j); if d["class"]=EditType() and (FGrid is class(TDrawGrid)) then begin if not(FEdit is class(TEdit)) then begin FEdit := new thotkey(FGrid); FEdit.visible := false; FEdit.parent := FGrid; FEdit.onkeydown := thisfunction(hotchange); end FEdit.SetBoundsRect(rec); FEdit.hotkey := d["value"]; FEdit.parent := grid; FEdit.SetFocus(); FEdit.visible := true; end end function CellDraw(grid,e,d);override; begin {** @explan(说明) 绘制格子 %% **} if FGrid is class(TDrawGrid) then if ifarray(d) then e.canvas.drawtext(class(thotkey).hotkeytostr(d["value"]),e.subItemRect,DT_CENTER); end function CellLeave(grid);override; begin {** @explan(说明) 离开编辑格子 %% **} if not(FEdit is class(thotkey)) then exit; FEdit.visible := false; inherited; FGrid.CellChanged(FRow,FCol,"value",FEdit.hotkey); end; end type TGridCellBoolEdit = class(TGridPropertyRender,TPropertyBool) {** @explan(说明) boolcell编辑 **} private FRbuttonWidth; function DrawButton(dc,srca,v); begin src := srca; src[0] := src[2]-FRbuttonWidth; src[1]+=3; src[3]-=3; _wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,v?DFCS_CHECKED:DFCS_BUTTONCHECK); end public function create(AOwner);override; begin inherited; FRbuttonWidth := 20; end function CellClick(grid,e,d);override; begin {** @explan(说明) 格子点击 %% **} if not( grid is class(TDrawGrid)) then exit; i := e.iitem; j := e.isubitem; pt := e.ptaction; rec := grid.getSubItemRect(i,j); if pt[0]<(rec[2]-FRbuttonWidth) then exit; if d["class"]="bool" then begin grid.CellChanged(i,j,"value",not(d["value"])); end end function CellDraw(grid,e,d);override; begin {** @explan(说明) 绘制格子 %% **} src := e.SubItemRect; dv := d["value"]; dc := e.canvas; if src[2]-src[0]>50 then begin src1 := src; src1[2]-=FRbuttonWidth; dc.drawtext(dv?"TRUE":"FALSE",src1,DT_CENTER); end DrawButton(dc,src,dv); end end type TGridCellEditList = class(TGridCellEditWithButton) protected Fi; fj; FGrid; private FDataList; function GetDataList();virtual; begin return FDataList; end function SetDataList(v);virtual; begin FDataList:=v; end public function create(AOwner);override; begin inherited; end function GetItemValue(v);virtual; begin return v; end function CellDrawLabel(dc,rect,d);override; begin v := d["value"]; dc.DrawText(v,rect,DT_LEFT); end function nameFilter();virtual; begin return nil; end function ButtonClick(grid,e,d);override; begin {** @explan(说明) 按钮被点击 %% **} FGrid := grid; i := e.iitem; FI := I; j := e.isubitem; FJ := J; dlist := DataList; if dlist then begin try dlist.filter := nameFilter(); except end ; dn := GetPopRectByHeight(250); dlist.width := dn[2]-dn[0]; dlist.height := 250; dlist.left := dn[0]; dlist.top := dn[1]; dlist.OnClickSelected := thisfunction(OnvSelected); dlist.SetSelectedByValue(d["value"]); //dlist.visible := true; dlist.show(); end end function OnvSelected(o); begin sv:=GetItemValue(o.SelectedValue); Fgrid.CellChanged(fi,fj,"value",sv); o.visible := false; end property DataList read GetDataList write SetDataList; end type TGridCellEventHandleEdit = class(TGridCellEditList,TPropertyTypeEvent) public function create(owner);override; begin inherited; end function CelldbClick(grid,e,d);virtual; begin FGrid := grid; i := e.iitem; FI := I; j := e.isubitem; FJ := J; //处理双击添加回调函数 end end type TGridCellSysCursorEidt=class(TOneSelectCell,TPropertyTypeSysCursor) function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertyTypeSysCursor).Create(); end private function SelPalRange();virtual; begin return SelRange; end end //属性编辑表格 type TGridCellVariableEdit = class(TGridCellEditList,TPropertyVarible) public function create(owner);override; begin inherited; end function nameFilter();virtual; begin return nil; end function GetItemValue(v);override; begin try if v then return v.name; except end ; return v; end end type TGridCellVariableTactionEdit = class(TGridCellVariableEdit) function nameFilter();override; begin return EditType(); end function IfComponent();virtual; begin {** @explan(说明) 是否为控件%% **} return true; end Function EditType();override; begin return "taction"; end function CellDrawLabel(dc,rect,d);override; begin v := d["value"]; if v is class(tcomponent) then begin dc.DrawText(v.name,rect,DT_LEFT); end else inherited; end function create(owner);override; begin inherited; end end type TGridCellVariableTrayEdit = class(TGridCellVariableTactionEdit) Function EditType();override; begin return "ttray"; end function create(owner);override; begin inherited; end end type TGridCellVariabletpopupmenuEdit = class(TGridCellVariableTactionEdit) Function EditType();override; begin return "tpopupmenu"; end function create(owner);override; begin inherited; end end type TGridCellVariabletmainmenuEdit = class(TGridCellVariableTactionEdit) Function EditType();override; begin return "tmainmenu"; end function create(owner);override; begin inherited; end function FormatTMF(d);override; begin if d is class(tcomponent) then begin r := d.name; if r then return r; end return false; end function GetItemValue(V);override; begin if v is class(TDComponent) then r := v.GetTrueComponent(); return r; end end type TGridCellVariabletimagelistEdit = class(TGridCellVariableTactionEdit) Function EditType();override; begin return "tcontrolimagelist"; end function CellDrawLabel(dc,rect,d);override; begin v := d["value"]; if v is class(tcomponent) then begin dc.DrawText(v.name,rect,DT_LEFT); end end function FormatTMF(d);override; begin if d is class(tcomponent) then begin r := d.name; if r then return r; end return false; end function GetItemValue(V);override; begin if v is class(TDComponent) then r := v.GetTrueComponent(); return r; end function create(owner);override; begin inherited; end end type TBtnCellDrawVTtype = class(TGridCellEditWithButton) function Create(AOwner);override; begin inherited; end function CellDrawLabel(dc,rect,d);override; begin {** @explan(说明) 绘制标签 %% **} if ifarray(d) then begin dc.drawtext(self(true).EditType(),rect); end end end type TGridCellImagesEdit = class(TBtnCellDrawVTtype,TPropertyImagesData) private FGrid; FEdit; FImageEditer; function GetImagesEdit(); begin if not FImageEditer then begin FImageEditer := new TIconsEditer(FGrid); FImageEditer.parent := FGrid; end FImageEditer.clean(); return FImageEditer; end public function CellDrawLabel(dc,rect,d);override; begin if not(d and ifarray(d)) then exit; dv := d["value"]; if ifarray(dv) and dv["type"]="bmps" then begin its := dv["items"]; if ifarray(its) then dc.DrawText("imgs:"+inttostr(length(its)),rect); end end function create(AOwner);override; begin inherited; FRbuttonWidth := 20; FGrid := AOwner; end function ButtonClick(grid,e,d);override; begin GetImagesEdit(); if FImageEditer then begin FImageEditer.seticons(d["value"]["items"]); FImageEditer.showmodal(); if self.Activated then begin dd := FImageEditer.GetIcons(); //echo tostn(dd); grid.CellChanged(e.iitem,e.isubitem,"value",array("type":"bmps","items":dd)); end end end end type TGridCellBitmapEdit = class(TBtnCellDrawVTtype,TPropertyBitmap) private FGrid; FEdit; FImageEditer; function GetImagesEdit(); begin if not FImageEditer then begin FImageEditer := new TOpenFileADlg(FGrid); FImageEditer.parent := FGrid; end return FImageEditer; end public function CellDrawLabel(dc,rect,d);override; begin {** @explan(说明) 绘制格子 %% **} if ifarray(d) and (d["value"] is class(tbitmap) )then inherited; end function create(AOwner);override; begin inherited; FRbuttonWidth := 20; FGrid := AOwner; end function ButtonClick(grid,e,d);override; begin i := e.iitem; j := e.isubitem; pt := e.ptaction; rec := grid.getSubItemRect(i,j); GetImagesEdit(); if FImageEditer.opendlg() then begin inherited; bmp := new tbitmap(); bmp.id := FImageEditer.FileName; if bmp.HandleAllocated() then grid.CellChanged(i,j,"value",bmp); else grid.CellChanged(i,j,"value",nil); end else grid.CellChanged(i,j,"value",nil); end end type TGridCellIconEdit = class(TBtnCellDrawVTtype,TPropertyIcon) private FGrid; FEdit; FImageEditer; function GetImagesEdit(); begin if not FImageEditer then begin FImageEditer := new TOpenFileADlg(FGrid); FImageEditer.parent := FGrid; end return FImageEditer; end public function CellDrawLabel(dc,rect,d);override; begin {** @explan(说明) 绘制格子 %% **} if ifarray(d) and (d["value"] is class(ticon)) then inherited; end function create(AOwner);override; begin inherited; FRbuttonWidth := 20; FGrid := AOwner; end function ButtonClick(grid,e,d);override; begin i := e.iitem; j := e.isubitem; pt := e.ptaction; rec := grid.getSubItemRect(i,j); GetImagesEdit(); if FImageEditer.opendlg() then begin inherited; ic := new Ticon(); ic.id := FImageEditer.FileName; if ic.HandleAllocated() then grid.CellChanged(i,j,"value",ic); else grid.CellChanged(i,j,"value",nil); end else grid.CellChanged(i,j,"value",nil); end end type TGridCellStatusItemsEdit = class(TBtnCellDrawVTtype,TPropertyStatusItems) private FGrid; FStatus; function GetWnd(); begin if (not FStatus) and (FGrid is class(TWincontrol)) then begin FStatus := new TListStatusEdit(FGrid); FStatus.parent := FGrid; end return FStatus; end public function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) and ifarray(d["value"]) then begin dc.DrawText("item:"+inttostr(length(d["value"])),rect); end end function create(owner);override; begin inherited; FGrid := owner; end function OnApplay(o,e);virtual; begin o.EndModalCode := true; o.EndModal(); end function ButtonClick(grid,e,d);override; begin if GetWnd() then begin inherited; FStatus.OnApplay := thisfunction(OnApplay); FStatus.setitems(d["value"]); FStatus.EndModalCode := false; if FStatus.showmodal() then begin grid.CellChanged(e.iitem,e.isubitem,"value",FStatus.ListControl.ListValues); end end end end type TGridCellFileFilterEdit = class(TGridCellEditWithButton,TPropertyFileFilter) private FGrid; FStatus; function GetWnd(); begin if (not FStatus) and (FGrid is class(TWincontrol)) then begin FStatus := new TListStatusEdit2(FGrid); FStatus.SetLable(0,"显示"); FStatus.SetLable(1,"条件"); FStatus.SetColoumn(1,"文本"); FStatus.SetColoumn(2,"筛选"); FStatus.parent := FGrid; FStatus.FCheckNumber := false; end return FStatus; end public function create(owner);override; begin inherited; FGrid := owner; end function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) and ifarray(d["value"]) then begin dc.DrawText("item:"+inttostr(length(d["value"])),rect); end end function OnApplay(o,e);virtual; begin o.EndModalCode := true; o.EndModal(); end function ButtonClick(grid,e,d);override; begin if GetWnd() then begin inherited; FStatus.OnApplay := thisfunction(OnApplay); dv := array(); dvi := 0; for i,v in d["value"] do begin dv[dvi]["width"] := i; dv[dvi++]["text"] := v; end FStatus.setitems(dv); FStatus.EndModalCode := false; if FStatus.showmodal() then begin vs := FStatus.ListControl.ListValues; dv := array(); for i,v in vs do begin dv[v["width"]] := v["text"]; end grid.CellChanged(e.iitem,e.isubitem,"value",dv); end end end end type TGridCellLazyIntegerEdit = class(TGridCellIntegerEdit) function CreateEditer(AOwner);override; begin return new TGridCellLazyIntegerEdit(AOwner); end function EditType();override; begin return "lazyinteger"; end function LazyProperty();override; begin return true; end function create(AOwner);override; begin inherited; end end //*****************选择list******************************************* type UniCheckList = class(TTreeView) //单选 private Fdata; FOnSelChanged; public function Create(AOwner);override; begin inherited; hasline := false; Fdata := array(); OnActivate := function(o,e) begin if e.lowparam = WA_INACTIVE then begin Visible := false; end end ; end function DoOnSelChang(v); begin Calldatafunction(FOnSelChanged,self(true),v); end function MouseUp(o,e);override; begin it := CurrentNode; nit := GetItemIndexByYpos(e.ypos); if nit >=0 then begin inherited; if CurrentNode<>nit then begin DoOnSelChang(CurrentNode._tag); end end else begin DoOnSelChang(nil); end end function hasFocus();override; begin return true; end function SetList(lst); begin clean(); //清空 rnd := RootNode; Fdata := array(); for i,v in lst do begin nd := CreateTreeNode(self); nd.Caption := v[0]; nd._tag := v[1]; nd.Parent := rnd; Fdata[v[1]] := nd; end end function SetSelValue(v); begin for i,vi in FData do begin if vi._tag = v then return SetSel(vi); end end property OnSelChanged read FOnSelChanged write FOnSelChanged; end type MultiCheckListPanel = class(TCustomControl) //多选 private Flist; fbtn; FIDokClick; protected type MultiCheckList = class(TTreeView) private Fdata; public function Create(AOwner);override; begin inherited; Fdata := array(); end function MouseUp(o,e);override; begin inherited; end function hasFocus();override; begin return false; end function SetList(lst); begin clean(); //清空 rnd := RootNode; Fdata := array(); for i,v in lst do begin nd := CreateTreeNode(self); nd.Caption := v[0]; nd._tag := v[1]; nd.Parent := rnd; Fdata[v[1]] := nd; end end function SetSelValue(v); begin for i,vi in FData do begin if vi._tag in v then vi.Checked := true; //if vi._tag = v then return SetSel(vi); end end function GetSelValue(); begin r := array(); for i,vi in FData do begin if vi.Checked then r[rl++] := vi._tag; end return r; end end PUBLIC function Create(AOwner);override; begin inherited; height := 200; //WsDlgModalFrame := true; Flist := new MultiCheckList(self); flist.CheckBox := true; flist.border := false; //flist.WsDlgModalFrame := true; Flist.parent := self; fbtn := new TBtn(self); fbtn.height := 25; fbtn.width := 40; fbtn.caption := "确定"; fbtn.Parent := self; fbtn.Onclick := function(o,e)begin Calldatafunction(FIDokClick,self(true),e); end end function DoControlAlign();override; begin if not(FList and fbtn) then return; rc := ClientRect; rc[3]-=30; FList.SetBoundsRect(rc); fbtn.top := rc[3]+2; fbtn.left := rc[2]-fbtn.width-3; end function SetList(lst); begin FList.SetList(lst); end function SetSelValue(v); begin FList.SetSelValue(v); end function GetSelValue(); begin return FList.GetSelValue(); end property IdOKClick read FIDokClick write FIDokClick; end //*************zh**property******************************* type tGridCellAlignPos3BoxEdit=class(TOneSelectCell ,TPropertyAlign3) function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertyAlign3).Create(); end private function SelPalRange();virtual; begin return SelRange; end end type tGridCellDayOfWeekBoxEdit=class(TOneSelectCell,TPropertyDayOfWeek) function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertyDayOfWeek).Create(); end private function SelPalRange();virtual; begin return SelRange; end end type TGridCellPairIntEdit=class(TGridPropertyRender,TPropertyPairInt) private FGrid; FeditWindow; Fi; Fj; type PairWindow=class(tpanel) private ts1; ts2; edit1; edit2; btn; ari; FonOK; function is_valid_int(str);begin arr:=array('0','1','2','3','4','5','6','7','8','9'); if r:=length(str) then begin if r=1 then return not (r='-'); if str[1] in arr or str[1]='-' then begin for i:=2 to r do if not(str[i] in arr) then return 0; return 1; end end return 0; end public function initializewnd();override;begin inherited; ts1.caption:="下限:"; ts2.caption:="上限:"; ts1.left:=8; ts1.top:=8; ts2.left:=8; ts2.top:=40; edit1.top:=8; edit1.left:=50; edit2.top:=40; edit2.left:=50; btn.top:=68; btn.left:=30; btn.caption:="确定"; ts1.parent:=self; ts2.parent:=self; edit1.parent:=self; edit2.parent:=self; btn.parent:=self; end function create(aowner);override;begin inherited; height:=132; width:=152; caption:="设置"; wscaption := true; wssysmenu := true; wspopup := true; visible := false; ari:=array(0,0); ts1:=new tstext(self); ts2:=new tstext(self); edit1:=new tedit(self); edit2:=new tedit(self); btn:=new tbtn(self); btn.onclick:=function(o,e)begin if(is_valid_int(edit1.text) and is_valid_int(edit2.text)) then begin i:=strtoint(edit1.text); j:=strtoint(edit2.text); if i<=j then begin ari:=array(i,j); calldatafunction(FonOK,o,e); visible:=0; setarr(array("","")); return; end end _wapi.MessageBoxA(self.handle,"非法范围","错误",0); end end function WMCLOSE(o,e):WM_CLOSE;override; begin o.visible := false; e.skip := true; inherited; end function getarr();begin return ari; end function setarr(ari);begin edit1.text:=ari[0]; edit2.text:=ari[1]; end property onOK read FonOK write FonOK; end type Tstext = class(TGraphicControl) FCaption ; function create(owner); begin inherited; FCaption := "tstext"; height:=16; width:=50; end procedure Paint(); override; begin rect := clientrect; Canvas.font.height := 16; // Canvas.font.SetValues(array("height":-18,"width":0,"escapement":0,"orientation":0,"weight":400,"italic":0,"underline":0,"strikeout":0,"charset":134,"outprecision":3,"clipprecision":2,"quality":1,"pitchandfamily":2,"facename":"宋体","color":0)); Canvas.drawtext(FCaption,rect); end function SetCaption(v);override; begin inherited; if not(ifstring(v) and (FCaption<>v)) then exit; FCaption := v; end property caption read FCaption write SetCaption; end public function create(AOwner);override;begin inherited; FGrid := AOwner; FeditWindow:=nil; end function CellClick(grid,e,d);override;begin Fi := e.iitem; Fj := e.isubitem; if ifnil(FeditWindow) then begin FeditWindow:=new PairWindow(FGrid); FeditWindow.onOK:=function(o,e)begin Fgrid.CellChanged(Fi,Fj,"value",FeditWindow.getarr()); end end if ifnil(FeditWindow.parent) then begin FeditWindow.parent :=FGrid; end rec := grid.getSubItemRect(Fi,Fj); r:=grid.ClientToScreen(rec[0],rec[3]); FeditWindow.left:=r[0]; FeditWindow.top:=r[1]; FeditWindow.show(); end function CellDraw(grid,e,d);override;begin {** @explan(说明) 绘制格子 %% **} if FGrid is class(TDrawGrid) then begin str:=inttostr(d["value"][0])+":"+inttostr(d["value"][1]); e.canvas.drawtext(str,e.subItemRect,DT_CENTER); end end function CellLeave(grid);override;begin {** @explan(说明) 离开编辑格子 %% **} _wapi.PostMessageA(FeditWindow.handle,WM_CLOSE,0,0); end end type TGridCellPairSpliterTypeEdit=class(TOneSelectCell,TPropertySpliterType) function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertySpliterType).Create(); end private function SelPalRange();virtual; begin return SelRange; end end type TGridCellTreeViewDataEdit=class(TGridCellEditWithButton,TPropertyTreeViewData) private FeditWindow; Fgrid; fi; fj; FnodeNum; type tPopupEditorWindow=class(tpanel) private FtreeViewBox; FnewItemBtn; FnewSubItemBtn; FmoveUpBtn; FmoveDownBtn; FdeleteBtn; FclearBtn; Fstatictxt0; Fstatictxt1; Fstatictxt2; Fedit0; Fedit1; Fedit2; Fokbtn; Fcancelbtn; mok; editingNode; function setwindow(window,l,t,w,h);begin if l then window.left:=l; if t then window.top:=t; if h then window.height:=h; if w then window.width:=w; window.parent:=self; end type TreeViewEditorClass=class(TTreeView) private currentSelection; counter; fSelectionChanged; function createNode(aname,img,selimg);begin n:=new TTreeNode(self); n.caption:=aname; n.imgid:=img; n.selimgid:=selimg; return n; end type nameCounter=class private countNumber; countUp; public function create();begin countNumber:=0; countUp:=0; end function getName();begin if countUp<>1000000 then begin ++countNumber; return "项目"+inttostr(countUp++); end return "项目"; end function deleteName(n);begin if "项目"+inttostr(countUp-1)=n then --countUp; --countNumber; end function reset(n);begin countNumber:=n?:0; countUp:=n?:0; end end function getlastnode(node);begin t:=node.itemcount; if t then return getlastnode(node.indexof(t-1)); return node; end function setCurrentSelection(n,b);begin if b then currentSelection:=n; else setsel(n); end function getCurrentSelection();begin if ifnil(currentSelection) then currentSelection:=rootItem; return currentSelection; end public function initializewnd();override;begin inherited; getCurrentSelection(); end function create(aOwner);override;begin inherited; // counter:=new nameCounter(); self.OnSelChanged:=function(o,e)begin if e.itemnew is class(tTreeNode) then begin setCurrentSelection(e.itemnew,1); calldatafunction(fSelectionChanged,getCurrentSelection()); end end end function addNewItem();begin //添加新项 // if not currentSelection then currentSelection := RootItem; if getCurrentSelection()=RootItem then return addNewSubItem(); // d:=createNode(counter.getName(),-1,-1); d:=createNode("item",-1,-1); // p:=currentSelection.parent; getCurrentSelection().insertsibling(d); setCurrentSelection(d); end function addNewSubItem();begin //添加新子项 // d:=createNode(counter.getName(),-1,-1); d:=createNode("item",-1,-1); getCurrentSelection().insertNode(d); setCurrentSelection(d); end function move(b);begin //0下移,1上移。 if getCurrentSelection()=RootItem then return; t:=getCurrentSelection(); if b then getCurrentSelection().moveUp(); else getCurrentSelection().moveDown(); setCurrentSelection(t); end function deleteThis();begin if getCurrentSelection()=RootItem then return; // t:=currentSelection.getsibling(-1)?:currentSelection.parent; getCurrentSelection().recycling(); if RootItem.ItemCount<1 then setCurrentSelection(nil,1); // setCurrentSelection(t); end function clear();begin clean(); // counter.reset(); setCurrentSelection(nil,1); end function setTreeviewFigureData(arr,n);begin lazyitems:=arr; // counter.reset(n); setCurrentSelection(nil,1); end property selectionChanged read fSelectionChanged write fSelectionChanged; property selectedNode read currentSelection; end function flushInfo(n);begin if n then begin Fedit0.text:=n.caption; Fedit1.text:=tostn(n.imgid); Fedit2.text:=tostn(n.selimgid); return; end Fedit0.text:=""; Fedit1.text:=""; Fedit2.text:=""; end function charProc(o,e)begin ac:=e.wparam; if ac=VK_RETURN then return 1; if not((ac>=48 and ac<58) or ac=VK_BACK or (not length(o.text) and ac=45)) then e.skip:=1; return 0; end function saveEditingNode(o,e);begin editingNode:=FtreeViewBox.selectedNode; end public function create(aOwner);override;begin inherited; caption:="TreeViewEditor"; left:=300; top:=300; FtreeViewBox:=new TreeViewEditorClass(self); FtreeViewBox.selectionChanged:=function(n)begin flushInfo(n); end FnewItemBtn:=new tbtn(self); FnewItemBtn.onclick:=function(o,e)begin FtreeViewBox.addNewItem(); end FnewSubItemBtn:=new tbtn(self); FnewSubItemBtn.onclick:=function(o,e)begin FtreeViewBox.addNewSubItem(); end FmoveUpBtn:=new tbtn(self); FmoveUpBtn.onclick:=function(o,e)begin FtreeViewBox.move(1); end FmoveDownBtn:=new tbtn(self); FmoveDownBtn.onclick:=function(o,e)begin FtreeViewBox.move(); end FdeleteBtn:=new tbtn(self); FdeleteBtn.onclick:=function(o,e)begin FtreeViewBox.deleteThis(); end FclearBtn:=new tbtn(self); FclearBtn.onclick:=function(o,e)begin FtreeViewBox.clear(); flushInfo(nil); end Fedit0:=new tedit(self); Fedit0.onSetFocus:=thisfunction(saveEditingNode); // Fedit0.onKillFocus:=function(o,e)begin // if editingNode then // editingNode.caption:=o.text; // end FEdit0.onkeypress:=function(o,e)begin if e.wparam=VK_RETURN then if editingNode then editingNode.caption:=o.text; end Fedit1:=new tedit(self); Fedit1.onSetFocus:=thisfunction(saveEditingNode); // Fedit1.onKillFocus:=function(o,e)begin // if editingNode then // editingNode.ImgId:=strtoint(o.text); // end FEdit1.onkeypress:=function(o,e)begin if call("charProc",o,e) then editingNode.ImgId:=strtoint(o.text); end // Fedit1.onkeypress:= thisfunction(charProc); Fedit2:=new tedit(self); Fedit2.onSetFocus:=thisfunction(saveEditingNode); // Fedit2.onKillFocus:=function(o,e)begin // echo "[KillFocus]\n"; // if editingNode then // editingNode.SelImgId:=strtoint(o.text); // end Fedit2.onkeypress:=function(o,e)begin if call("charProc",o,e) then editingNode.SelImgId:=strtoint(o.text); end // Fedit2.onkeypress:=thisfunction(charProc); Fokbtn:=new tbtn(self); Fokbtn.onclick:=function(o,e)begin calldatafunction(mok,o,e); _send_(WM_CLOSE,0,0); end Fcancelbtn:=new tbtn(self); Fcancelbtn.onclick:=function(o,e)begin _send_(WM_CLOSE,0,0); end Fstatictxt0:=new TLabel(self); Fstatictxt1:=new TLabel(self); Fstatictxt2:=new TLabel(self); height:=358;//经过计算的完美尺寸。 width:=570; wscaption := true; wssysmenu := true; wspopup := true; visible := false; end function initializewnd();override;begin inherited; setwindow(FtreeViewBox,24,24,216,280); setwindow(FnewItemBtn,270,24,112); FnewItemBtn.caption:="新建项"; setwindow(FnewSubItemBtn,270,73,112); FnewSubItemBtn.caption:="新建子项"; setwindow(FmoveUpBtn,270,122,112); FmoveUpBtn.caption:="选中项上移"; setwindow(FmoveDownBtn,270,171,112); FmoveDownBtn.caption:="选中项下移"; setwindow(FdeleteBtn,270,220,112); FdeleteBtn.caption:="删除选中项"; setwindow(FclearBtn,270,270,112); FclearBtn.caption:="删除所有项"; Fstatictxt0.caption:="name:"; setwindow(Fstatictxt0,400,24,128,20); setwindow(Fedit0,400,47,128); Fstatictxt1.caption:="imageid:"; setwindow(Fstatictxt1,400,78,128,20); setwindow(Fedit1,400,101,128); Fstatictxt2.caption:="selimageid:"; setwindow(Fstatictxt2,400,132,128,20); setwindow(Fedit2,400,155,128); Fokbtn.caption:="确定"; setwindow(Fokbtn,400,269,65); Fcancelbtn.caption:="取消"; setwindow(Fcancelbtn,475,269,65); end function WMCLOSE(o,e):WM_CLOSE;override;begin o.visible:=false; e.skip:=1; inherited; end function getlazyitems();begin n:=FtreeViewBox.lazyitems; // echo ">>Origin Lazyitems:",tostn(n); if ifnil(n) then return array("type":"treenodes"); return n; end function updateEditorData(arr,n);begin if ifnil(arr) then arr:=array("type":"treenodes"); //echo ">>UPDATENUM:",n,"\n"; FtreeViewBox.setTreeviewFigureData(arr,n); flushInfo(nil); end property ok read mok write mok; end function getnodenum(arr);begin r:=mrows(arr); for i:=0 to r-1 do if arr[i]["nodes"] then r+=getnodenum(arr[i]["nodes"]["items"]); return r; end public function create(AOwner);override;begin inherited; Fgrid:=aOwner; FeditWindow:=nil; end function CellClick(grid,e,d);override;begin Fi := e.iitem; Fj := e.isubitem; inherited; end function CellLeave(grid);override;begin if FeditWindow then _wapi.PostMessageA(FeditWindow.handle,WM_CLOSE,0,0); end function ButtonClick(grid,e,d);override;begin if ifnil(FeditWindow) then begin FeditWindow:=new tPopupEditorWindow(FGrid); FeditWindow.ok:=function(o,e)begin t := FeditWindow.getlazyitems(); Fgrid.CellChanged(Fi,Fj,"value",t); end end if ifnil(FeditWindow.parent) then begin FeditWindow.parent :=FGrid; end rec := grid.getSubItemRect(Fi,Fj); FeditWindow.updateEditorData(d["value"],ifnil(FnodeNum)?0:FnodeNum); FeditWindow.show(); end function CellDrawLabel(dc,rect,d);override;begin // FnodeNum:=getnodenum(d["value"]["items"]); // str:="itemstats:"+(ifnil(d["value"])?"0":inttostr(FnodeNum)); str:="itemstrings"; dc.drawtext(str,rect,DT_LEFT); end end type tGridCellAlignPosBoxEdit = class(TOneSelectCell,TPropertyAlign9) function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertyAlign9).Create(); end private function SelPalRange();virtual; begin return SelRange; end end //////////////////////多选list////////////////////////////// type TMultiSelList = class(TCustomControl) function Create(AOwner); begin inherited; FList := new TListBox(self); FList.Multisel := 2; //FList.Appenditems(array("a","b","c")); FList.setCurrentSelection(array(0,1)); FList.parent := self; FOkBtn := new TBTN(self); FBtnWidth := 80; FOkBtn.width := FBtnWidth; FOkBtn.caption := "确定"; FOkBtn.parent := self; FCanceBtn := new TBTN(self); FCanceBtn.width := FBtnWidth; FCanceBtn.caption := "取消"; FCanceBtn.parent := self; FCanceBtn.onclick := thisfunction(CancelClick); FOkBtn.onclick := thisfunction(okClick); end function GetSelectdata(); begin idx := FList.getSelectedIndexes(); r := array(); for i,v in idx do begin r[i] := Fdata[v,1]; end return r; end function SetSelectData(d); begin idxs := array(); for i,v in d do begin for j,vj in Fdata do begin if v=vj[1] then begin idxs[i] := j; break; end end end FList.setCurrentSelection(idxs); end function SetListData(d); begin if ifarray(d) then begin FList.SetData(d[:,0]); Fdata := d; end end function Recycling();override; begin fOnokclick := 0; FOnCancelclick := 0; Fdata := 0; FBtnWidth:=0; FList:=0; FOkBtn:=0; FCanceBtn:=0; end function DoControlAlign();override; begin if FList and FOkBtn AND FCanceBtn then begin r := ClientRect; h := FOkBtn.height; c := r; c[3]-=h+4; FList.SetBoundsRect(c); bt := r[3]-h-1; FOkBtn.Top := bt; FOkBtn.Left := r[2]-FBtnWidth-5; FCanceBtn.top := bt; FCanceBtn.Left := r[2]-FBtnWidth-FBtnWidth-10; end end function CancelClick(o,e); begin calldatafunction(FOnCancelclick,self(true),e); end function okClick(o,e); begin calldatafunction(fOnokclick,self(true),e); end property OnCancelclick read FOnCancelclick write FOnCancelclick; property Onokclick read FOnokclick write fOnokclick; private fOnokclick; FOnCancelclick; Fdata; FBtnWidth; FList; FOkBtn; FCanceBtn; end type TMultiSelectCell = class(TGridCellEditWithButton) FListSel; private FPanel; FI; FJ; FCellv; function GetSelPanel();virtual; begin if not FPanel then begin FPanel := new TMultiSelList(Owner); FPanel.OnCancelclick := function(o,e)begin o.visible := false; end FPanel.wspopup := true; FPanel.SetListData(SelPalRange()); FPanel.Onokclick := thisfunction(SelChanged); end end function SelPalRange();virtual; public function SelChanged(o,e); begin if fi>=0 and fj>=0 and ifarray(FCellv) then begin o.visible := false; v := o.GetSelectdata(); Owner.CellChanged(FI,FJ,"value",V); end end function create(AOwner);override; begin inherited; end function ButtonClick(grid,e,d);override; begin {** @explan(说明) 格子点击 %% **} inherited; fi := e.iitem; fj := e.isubitem; FCellv := array(); GetSelPanel(); rec := GetPopRectByHeight(160); rec[3] := rec[1]+160; FPanel.SetBoundsRect(rec); FPanel.SetSelectData(FListSel); FPanel.Show(); end function CellLeave(grid);override; begin {** @explan(说明) 离开编辑格子 %% **} if FPanel then FPanel.visible := false; end; end //************red**propery********************************** type TOneSelectCell = class(TGridCellEditWithButton) private FPanel; FI; FJ; FCellv; function GetSelPanel();virtual; begin if not FPanel then begin FPanel := new UniCheckList(Owner); FPanel.wspopup := true; FPanel.SetList(SelPalRange()); FPanel.OnSelChanged := thisfunction(SelChanged); end end function SelPalRange();virtual; public function SelChanged(o,v); begin if fi>=0 and fj>=0 and ifarray(FCellv) then begin o.visible := false; Owner.CellChanged(FI,FJ,"value",v); end end function create(AOwner);override; begin inherited; end function ButtonClick(grid,e,d);override; begin {** @explan(说明) 格子点击 %% **} inherited; fi := e.iitem; fj := e.isubitem; FCellv := array(); GetSelPanel(); rec := GetPopRectByHeight(160); rec[3] := rec[1]+160; FPanel.SetBoundsRect(rec); FPanel.Show(); end end type TGridCellAnchorsEdit = class(TMultiSelectCell,TPropertyAnchors) {** @explan(说明)设置align属性%% **} function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin FListSel := d["value"]; dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertyAnchors).Create(); end private function SelPalRange();virtual; begin return SelRange; end end type TGridCellAlignEdit = class(TOneSelectCell,TPropertyAlign) {** @explan(说明)设置align属性%% **} function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertyAlign).Create(); end private function SelPalRange();virtual; begin return SelRange; end end type TGridCellTabAlignEdit = class(TOneSelectCell,TPropertyTabAlign) {** @explan(说明)设置align属性%% **} function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertyTabAlign).Create(); end private function SelPalRange();virtual; begin return SelRange; end end type TtextEditor = class(tpanel) {** @explan(说明)memo编辑器%% **} protected btn1; btn2; function SetItemStr(v);virtual; begin memo.text := v; end function GetItemStr();virtual; begin memo.text; end public itemData; memo; function DoControlAlign(); begin if btn1 and btn2 and memo then begin rc := ClientRect; rc2 := rc; rc2[3]-=38; memo.SetBoundsRect(rc2); btop := rc[3]-34; rt := rc[2]-5; btn2.top := btop; btn1.Top := btop; btn2.Left := rc2[0]+(rt-btn2.width); btn1.Left := rc2[0]+(rt-btn2.width*2-20); end end function create(AOwner);override; begin inherited; height := 400; width := 400; left := 500; top := 200; wspopup := true; wscaption := true; wssysmenu := true; caption := "text Editor Dialog"; memo := new tmemo(self); memo.OnKeyPress := thisfunction(MemoKeyPress); memo.parent :=self; btn1 := new tbtn(self); btn1.parent := self; btn2 := new tbtn(self); btn2.parent := self; btn1.caption := "取消"; btn2.caption := "确认"; btn1.onclick := thisfunction(cancelEdit); btn2.onclick := thisfunction(comfirmEdit); itemData:= ""; end function MemoKeyPress(o,e);virtual; begin end function textonumber(v);virtual; begin return v; end function comfirmEdit(o,e);virtual; begin itemData := memo.text; EndModalCode := 1; return EndModal(); end function WMClose(o,e):WM_CLOSE;override; begin memo.text := " "; e.skip := true; EndModalCode := 0; o.EndModal(); end function cancelEdit(o,e);virtual; begin //把memo上的数据清除,同时记录的数据设置到memo //关闭editor memo.text := " "; EndModalCode := 0; return EndModal(); end property ItemStr read GetItemStr write SetItemStr; end type TGridCellTextEdit = class(TGridCellEditWithButton,TPropertyText) {** @explan(说明)编辑字符串文本属性%% **} private isShow; FRbuttonWidth; screenbottom; protected Fowner; Fpanel; rowNum; colNum; Fgrid; public function create(AOwner);override; begin inherited; Fowner := AOwner; Fpanel := nil; FRbuttonWidth := 20; screenArr := _wapi.getscreenrect(); screenbottom := screenArr[3]; isShow := true; end function createEditObj();virtual; begin Fpanel := new TtextEditor(Fowner); end function ButtonClick(grid,e,d);override; begin {** @explan(说明) 格子点击 %% **} inherited; rowNum := e.iitem; colNum := e.isubitem; Fgrid := grid; pt := e.ptaction; rec := grid.getSubItemRect(rowNum,colNum); if pt[0]>=(rec[2]-FRbuttonWidth) then begin if ifnil(Fpanel) then begin createEditObj(); Fpanel.parent := Fowner; Fpanel.OnActivate := function(o,e) begin if e.lowparam = WA_INACTIVE then begin CellLeave(Fgrid); end end; end clickToText(d); if Fpanel.showmodal()=1 then begin textChange1(Fpanel.itemData); end end end function clickToText(d);virtual; begin if d["value"] <> " " then begin Fpanel.ItemStr := d["value"]; end end function CellName();virtual; begin return "text"; end function textChange1(data);virtual; begin Fgrid.CellChanged(rowNum,colNum,"value",data); end function CellDrawLabel(dc,rect,d);override; begin {** @explan(说明) 绘制格子 %% **} dc.drawtext(cellName(),rect); end end type TGridCellStringsEdit = class(TGridCellTextEdit) {** @explan(说明)编辑字符串数组属性%% **} protected function createEditObj();override; begin Fpanel := new TstringsEditor(Fowner); end function clickToText(d);override; begin if length(d["value"]) = 0 then Fpanel.ItemStr := ""; else Fpanel.ItemStr := Array2Str(d["value"],"\r\n"); end function CellName();Override; begin return ""; end public function EditType();override; begin return "strings"; end function Create(AOwner); begin inherited; end end type TstringsEditor = class(TtextEditor) {** @explan(说明)memo编辑器%% **} protected function textonumber(v);override; begin return v; end function comfirmEdit(o,e);override; begin itemData := array(); linecount := memo.getlinecount(); if linecount > 0 then begin for i:= 1 to linecount do begin str := memo.getline(i); itemData[i-1] := textonumber(str); end end EndModalCode := 1; return EndModal(); end public function create(AOwner);override; begin inherited; caption := "Strings Editor Dialog"; end end type TGridCellIntegersEdit = class(TGridCellStringsEdit) {** @explan(说明)编辑整形数组属性%% **} protected function createEditObj();override; begin Fpanel := new TIntegersEditor(Fowner); end function CellName();override; begin return "integers"; end public function Create(AOwner);override; begin inherited; end function EditType();override; begin return "integers"; end end type TIntegersEditor = class(TstringsEditor) {** @explan(说明)memo编辑器%% **} protected function textonumber(txt);override; begin return strtointdef(txt,0); end function MemoKeyPress(o,e);override; begin if e.wparam = ord("-") then begin end else begin if not(e.wparam >= ord("0") and e.wparam<= ord("9") or e.wparam = VK_BACK or e.wparam = 13) then e.skip := true; end end public function create(AOwner);override; begin inherited; caption := "Integers Editor Dialog"; end end type TGridCellEsAlignEdit = class(TOneSelectCell,TPropertyEsAlign) function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertyEsAlign).Create(); end private function SelPalRange();virtual; begin return SelRange; end end type TGridCellColorBoxEdit = class(TOneSelectCell,TPropertyColorList) function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertyColorList).Create(); end private function SelPalRange();virtual; begin return SelRange; end end type tGridCellMbbtnstyleEdit=class(TOneSelectCell,TPropertymbbtnstyle) function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertymbbtnstyle).Create(); end private function SelPalRange();virtual; begin return SelRange; end end type tGridCellMbiconstyleEdit=class(TOneSelectCell,TPropertymbicostyle) function CellDrawLabel(dc,rect,d);override; begin if ifarray(d) then begin dc.drawtext(FormatTMF(d["value"]),rect); end end function create(AOwner);override; begin inherited; class(TPropertymbicostyle).Create(); end private function SelPalRange();virtual; begin return SelRange; end end //属性编辑表格 type TPropGrid = class(TTSLDataGrid) {** @explan(说明)属性编辑器 %% **} protected FDesigner; private FCellEditers; FCurrentEditer; FCurrentIndex; FEventEditer; FVariabeEditer; static FCellRenders; function GetCellEditer(n); begin r := FCellEditers[n]; if not r then begin t := GetRegCellRender(n) ;//GetPropertyType(n); if not ifobj(t) then exit; r := t.CreateEditer(self(true)); FCellEditers[n] := r; end if r is class(TGridCellVariableEdit) then begin r.DataList := FVariabeEditer; //r.FVariabeEditer := FVariabeEditer; end else if r is class(TGridCellEventHandleEdit) then begin r.DataList := FEventEditer; FEventEditer.ColumnHeader := true; FEventEditer.OnColumnClick := thisfunction(clickediter); //r.FEventEdit := FEventEditer; end return r; return FCellEditers[n]; end function clickediter(o,e); begin if FComponent then FDesigner.AddAndOPenEvent(FComponent.TreeNode);//DBLClickComponent(); end function currentLeave(); begin if FCurrentEditer is class({TGridCellEdit}TGridPropertyRender) then begin FCurrentEditer.CellLeave(self(true)); FCurrentIndex := nil; FCurrentEditer := nil; end end protected FComponent; function SetComponent(v);virtual; begin FComponent := v; currentLeave(); end public class function RegCellRender(t); begin if not ifarray(FCellRenders) then FCellRenders := array(); FCellRenders[t.EditType()] := t; end class function GetRegCellRender(n); begin if not(FCellRenders and ifstring(n)) then return ; return FCellRenders[n]; end private FInsetvalue; public function CellChanged(i,j,index,d);virtual; begin indexs := 1; if FInsetvalue then exit; FInsetvalue := true; try od := getdata(i,j,cp,indexs); if not ifarray(od) then exit; if od[index]<>d then begin SetValue(indexs union array(index),d); rec := GetSubItemRect(i,j); InvalidateRect(rec,true); end currentLeave(); except end; FInsetvalue := false; end function SetValue(indexs,d); virtual;//修改对象 begin {** @explan(说明) 修改格子的内容,已经控件的内容%% **} if not (FComponent is class(TDComponent)) then exit; n := indexs[0]; {rfocus := false; if n in array("left","top","width","height") then begin ccwnd := FComponent.Cwnd; if ccwnd is class(TWincontrol) then begin if Designer then begin Designer.setcomponentfocus(ccwnd,false); rfocus := true; end end end //inherited; if (n="visible" and not(d)) or (n="wspopup" and d) or (n="align") then begin if Designer then begin Designer.setcomponentfocus(FComponent.Cwnd,false); end end } if FComponent.SetComponentProperties(n,d) then begin //echo "\r\ntrue"; inherited; end {if (n="visible" and d) or (n="wspopup" and not(d)) then begin if Designer then begin Designer.setcomponentfocus(FComponent.Cwnd,true); end end } end function SetGridValue(index,d,o); begin if (FComponent is class(TDComponent)) and FComponent.Cwnd = o then begin dt := TSLData; if ifarray(dt) then begin for i,v in mrows(dt,1) do begin if v=index then begin CellChanged(i,1,"value",d); return 1; end end end end return o.SetPublish(index,d); end function WMMove(o,e):WM_MOVE;override; begin inherited; currentLeave(); end function CellClick(o,e);virtual; begin i := e.iitem; j := e.isubitem; cellid := array(i,j); if not( i>=0 and j>=0) then begin return currentLeave(); end index := 1; d := getdata(i,j,cp,index); if ifarray(d) and d["type"]="object" then begin editer := GetCellEditer(d["class"]); if (cellid<>FCurrentIndex ) then begin currentLeave(); end if ifobj( editer) then begin FCurrentEditer := editer; FCurrentIndex := cellid; editer.CellClick(o,e,d); end end else begin if (cellid<>FCurrentIndex) then begin currentLeave(); FCurrentIndex := cellid; end end end function create(AOwner);override; begin inherited; ColumnHeader := false; color := rgb(255,255,255); onclick := thisfunction(CellClick); ColumnWidth := 150; FCellEditers := array(); //OndblClick := nil; FDesigner := AOwner; end function Recycling();override; begin FDesigner := nil; inherited; end function CNMEASUREITEM(O,E):CN_MEASUREITEM;override; begin e.height := 26; end function DoDrawSubItem(o,e);override; begin j := e.subitemid; dc := e.canvas; dc.font := font; if j=0 then return inherited; i := e.itemid; d := getdata(i,j); if ifstring(d) or ifnumber(d) then begin return inherited; end else if ifnil(d) then return ; src :=e.SubItemRect; if not(ifarray(d) and (d["type"] = "object" )) then exit; edit := GetCellEditer(d["class"]); if not(edit)then return inherited; edit.CellDraw(o,e,d); end property EventEditer write FEventEditer; property VariabeEditer write FVariabeEditer; property Component read FComponent write SetComponent; property Designer read FDesigner; {** @param(Component)(TDComponent) 控件设计对象 %% @param(Designer)(TVclDesigner) 设计器 %% **} 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(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 TComponentTreeNode = class(TTreeNode) {** @explan(说明)树节点 %% **} private FComponent; public function create(AOwner);override; begin inherited; end function Recycling();override; begin FComponent := nil; inherited; end property Component read FComponent write FComponent; end type TComponentTree = class(TTreeView) {** @explan(说明)控件树 %% **} private FEventGrid; FProGrid; FDesigner; FLoading; public function hasFocus();override; begin return true; end function SetSel(item);override; begin if not FLoading then inherited; end function CreateTreeNode();override; begin return new TComponentTreeNode(self(true)); end function Recycling();override; begin FDesigner := nil; inherited; end function create(AOwner);override; begin inherited; FDesigner := AOwner; end function GetRootNode();override; begin r := inherited; if not(r.Component) then begin c := new TDComponent(); c.Cwnd := owner; r.Component := c; end return r; end //ContextMenu(o,e) property EventGrid read FEventGrid write FEventGrid; property ProGrid read FProGrid write FProGrid; property Designer read FDesigner ; property Loading read FLoading write FLoading; {** @param(Designer)(TVclDesigner) 设计器 %% **} 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.ClassName; id := FIconMaps[n]; bmp := item.bitmap(); if (bmp is class(tbitmap)) 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.ClassName; end r := FIconMaps[n]; return r?r:0; if r then return r; //return FIconMaps["tvcform"]; end end type TListEidter = class(TPanel) {** @explan(说明) list编辑器 %% **} private FListControl; FBadd; FBdelete; FBup; FBdown; FBAplay; FOnApplay; FListWidth; public function WMCLOSE(o,e):WM_CLOSE;override; begin e.skip := true; inherited; end function ListCheck(v);virtual; begin {** @explan(说明) 检查 list类型 %% @param(v)(TWincontrol) %% **} return v is class(TGridList); end function SetListControl(v); begin if ifnil(v) then begin if FListControl then begin FListControl.Recycling(); FListControl:= nil; end end if ifnil(FListControl) and (ListCheck(v)) and v.parent = self then begin FListControl := v; DoControlAlign(); end end function SetListWidth(v); begin if v>100 and v<> FListWidth then begin FListWidth := v; DoControlAlign(); end end function Buttons();virtual; begin {** @explan(说明) 右侧 按钮 %% **} return array(FBadd,FBdelete,FBup,FBdown,FBAplay); end function DoControlAlign();override; begin if not HandleAllocated() then exit; sz := clientrect; if FListControl and FListControl.parent = self then begin sz[2] := FListWidth; FListControl.SetBoundsRect(sz); BTS := Buttons(); y := 30; x := FListWidth+10; for i,v in BTS do begin if v and (v is class(tcontrol)) and (v.parent=self) and v.visible then begin v.left := x; v.top := y; y+=v.height+10; end end end end function create(AOwner);override; begin inherited; caption := "Imagelist Editer"; minmaxbox := false; left := 400; height := 600; width := 350; FListWidth:=250; WsCaption := true; WsPopUp := true; WsSysmenu := true; wsSizeBox := false; FBadd := new tbtn(self); FBup := new tbtn(self); FBdown := new tbtn(self); FBAplay := new tbtn(self); FBdelete := new tbtn(self); FBadd.caption := "添加"; FBup.caption := "上移"; FBdown.caption := "下移"; FBAplay.caption := "应用"; FBdelete.caption := "删除"; FBAplay.onclick := thisfunction(applay); FBadd.parent := self; FBup.parent := self; FBdown.parent := self; FBAplay.parent := self; FBadd.onclick := thisfunction(addclick); FBdelete.onclick := thisfunction(delselect); FBup.onclick := thisfunction(moveup); FBdown.onclick := thisfunction(movedown); for i,v in Buttons() do begin if (v is class(tcontrol)) and v.visible then v.parent := self; end end function moveup(o,e);virtual; begin if FListControl then FListControl.moveup(); end function movedown(o,e);virtual; begin if FListControl then FListControl.movedown(); end function delselect(o,e);virtual; begin if FListControl then FListControl.deleteselect(); end function addclick(o,e);virtual; begin end function applay(o,e);virtual; begin calldatafunction(OnApplay,self(true)); end property ListWidth read FListWidth write SetListWidth; property OnApplay read FOnApplay write FOnApplay; property ListControl read FListControl write SetListControl; {** @param(OnApplay)(function[TListEidter]) 应用按钮回调 %% **} end type TvclFormManager = class(TListEidter) {** @explan(说明) 窗口管理 %% **} private FOnAddForm; FOnOpenFrom; FOnRemoveForm; FOnSetMainForm; FSaveEdition; FOpenEditon; FAddPanelForm; FRenameEdition; FOnSaveWindowEditon; FOnOpenWindowEditon; FOnRenameForm; FOnAddPanelForm; type TFormList = class(TGridList) FMainForm; function SetItem(idx,v); begin cs := self.SelectedValue; if FMainForm = cs then begin s := true; end inherited; if s then SetMainForm(v); end function SetMainForm(v); begin if FMainForm=v then exit; draw1 := finditemid(FMainForm); FMainForm := v; draw2 := finditemid(v); if draw1>=0 then begin GridDrawItem(draw1); end if draw2>=0 then begin GridDrawItem(draw2); end end function clean();override; begin inherited; FMainForm := nil; end function create(AOwner);override; begin inherited; Columns := array(("text":"id","width":40),("text":"窗口","width":150),("text":"main","width":50)); //FMainForm := "tform2"; end function DoDrawSubItem(o,e);override; begin j := e.subitemid; i := e.itemid; if j in array(1,2) then begin dc := e.canvas; src := e.subItemRect; fn := List[i]; if j=2 then begin if fn = FMainForm then fn := "**"; else fn := ""; end dc.DrawText(fn,src,DT_VCENTER .| DT_SINGLELINE); end else inherited; end property MainForm read FMainForm write SetMainForm; end public function clean(); begin ListControl.clean(); end function create(AOwner);override; begin inherited; caption := "窗口管理"; left := 300; top := 300; ed := new TFormList(self); FOpenEditon := new TBtn(self); FRenameEdition := new TBtn(self); FOpenEditon.parent := self; FAddPanelForm := new TBtn(self); FAddPanelForm.caption := "添加面板窗口"; FAddPanelForm.parent := self; FAddPanelForm.onclick := thisfunction(addpanelform); FRenameEdition.parent := self; btns := Buttons(); btns[0].caption := "添加窗口"; btns[0].OnClick := thisfunction(addform); btns[1].caption := "移除窗口"; btns[1].OnClick := thisfunction(removeform); btns[2].caption := "打开"; btns[2].OnClick := thisfunction(openform); btns[3].Caption := "设置为主窗口"; btns[3].width := btns[3].width+10; btns[3].OnClick := thisfunction(setMainForm); btns[4].Caption := "保存窗口版本"; btns[4].width := btns[4].width+10; btns[4].OnClick := thisfunction(SaveWindowEdition); btns[5].Caption := "还原版本"; btns[5].OnClick := thisfunction(openWindowEdition); btns[6].caption := "更名窗口"; btns[6].OnClick := thisfunction(RenameForm); //btns[5].visible := false; //btns[4].visible := false; ed.parent := self; ListControl := ed; OnClose := function(o,e) begin o.visible := false; e.skip := true; end width := 400; end function SaveWindowEdition(o,e); begin calldatafunction(OnSaveWindowEditon,self(true)); end function OpenWindowEdition(o,e); begin calldatafunction(OnOpenWindowEditon,self(true)); end function RenameForm(o,e); begin calldatafunction(FOnRenameForm,self(true)); end function addpanelform(o,e); begin calldatafunction(OnAddPanelForm,self(true)); end function addform(o,e); begin calldatafunction(OnAddForm,self(true)); end function removeform(o,e); begin calldatafunction(OnRemoveForm,self(true)); end function openform(o,e); begin calldatafunction(OnOpenFrom,self(true)); end function setMainForm(o,e); begin calldatafunction(OnSetMainForm,self(true)); end function Buttons();override; begin r := inherited; r[length(r)] := FOpenEditon; r[length(r)] := FRenameEdition; r[length(r)] := FAddPanelForm; for i,v in r do if v then v.width := 120; return r; end property OnRenameForm read FOnRenameForm write FOnRenameForm; property OnSaveWindowEditon read FOnSaveWindowEditon write FOnSaveWindowEditon; property OnOpenWindowEditon read FOnOpenWindowEditon write FOnOpenWindowEditon; property OnAddPanelForm read FOnAddPanelForm write FOnAddPanelForm; property OnAddForm read FOnAddForm write FOnAddForm; property OnRemoveForm read FOnRemoveForm write FOnRemoveForm; property OnOpenFrom read FOnOpenFrom write FOnOpenFrom; property OnSetMainForm read FOnSetMainForm write FOnSetMainForm; end type TStrFileer = class() {** @explan(说明)文本文件读写类 %% **} private FPath; FData; FLastError; function SetPath(v); begin if v<>FPath then begin FPath := v; FData := ""; if not FileExists("",v) then exit; size:=filesize("",FPath); //获取文件大小 if readFile(rwraw(),"",FPath,0,size,FData) then begin end else begin FLastError := FData; FData := ""; end end end public function create(); begin FOpenOk := false; end function clean(); begin FPath := nil; end function ReWrite(p,d,ch); begin {** @explan(说明) 文件写入 %% **} if not ifstring(p) then exit; if not ifstring(d) then exit; if not FileExists("",p) then begin return writefile(rwraw(),"",p,0,length(d),d); end SetPath(p); if FData<>d then begin if FData=d then exit; if ch and ifstring(ch) then begin r := writefile(rwraw(),"",ch,0,length(FData),FData); end if length(FData)>length(d) then begin FileDelete("",p); end return writefile(rwraw(),"",p,0,length(d),d); end return true; end property Path read FPath write SetPath; property LastError read FLastError; property Data read FData; {** @param(path)(string) 文件路径 %% @param(FData)(string) 文件内容 %% **} end type TToolbars = class(TPageControl) private FToolbars; FLabels ; fimg; function SetImageList(im); begin fimg := im; end public function Create(AOwner);override; begin inherited; align := alClient; FToolbars := array(); 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; end tb.imagelist := fimg; FToolbars[t] := tb; end btn.parent := tb; end property ImageList write SetImageList; end //*************设计器********************************* type TVclDesigner = class(tvcform) {** @explan(说明) 控件设计器 对象 %% **} private FChmHelper; tmpcanvas; //canvas FImageList; //图标 FViewBitmap; FCTrans; FVariableSelecter; FFunctionSelecter; Ftvclform; //**********菜单*************** FMenu0; FParser; //******************************** FToolBars; FTree; FCurrentTreeNode; FObjInspector; FPropGrid; FEventGrid; FTempCanvas; static FClassItems; //************************************ 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 FClassItems do begin FImageList.RegisterDitem(v); //if not v.InToolBar() then continue; tb := new TToolButton(self); tb.caption := v.HitTip; tb.Enabled := v.InToolBar(); ig := FImageList.GetImageId(V.ClassName); 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(); if FClassItems and ifarray(FClassItems) then begin for i,v in FClassItems 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; end else height := 90+32; end function TreeNode2tfmsub(lib,node,itemnames);//tmf文件字符串 begin if not(node) then begin it := FTree.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.ClassName; if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then raise "错误!"; r+= "object "+ tc.name +":"+tc.ClassName+"\r\n"; itemnames[length(itemnames)] := array(tc.name,tc.ClassName); 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; tree := Node.owner; node.Recycling(); if tree is class(TComponentTree) then begin tree.deleteitem(node); node.Recycling(); end 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 OpenFileFromTpjFile(); //从文件打开工程 begin FProjectFileOpener.caption := "打开"; if FProjectFileOpener.OpenDlg() then begin f := FProjectFileOpener.FileName; FProjectsManager.OpenFileFromTpjFile(f); for i := length(f) downto 3 do begin if f[i]="\\" 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 3 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 EnabledDesigner(f); begin {** @explan(说明) 设置designer是否可用 %% @param(f)(bool) **} FObjInspector.Visible := F; self.Enabled := f; rt := FTree.RootItem; if rt and rt.ItemCount>0 then it := (rt.items)[0]; if it then itt := it.Component; if itt then itt.Cwnd.Enabled := f; end function TreeNode2tfm(lib,itemnames); //转换文件 begin {** @explan(说明) 将结构转换为文件格式 %% **} r := TreeNode2tfmsub(lib,nil,itemnames); if itemnames then itemnames := itemnames[1:]; return r; end function saveCurrentForm(); //保存当前编辑 begin FProjectManager.saveCurrentEdit(); end function mainmenus();virtual; 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":"0502000000060400000074797065000203000000696D670006040000006461746 10002EA01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000017F49444154 484BCD944B4B02611885FB412DDBB4ED37740369D1C6F69110B5A89FD0A6562DA 4B21BB8C8F2921214840B4992C0109112BA58511048C55C4FF3CEF78DCE37CD94 CE2478E0C070E6F53CCEFBE90CA0C7EA23C0ED31101D049AF73CE84C22E0709C9 558BE5CE5370C95D658D628F0C0D0E9AC389F5FE637DA1201F661F2E70B2BC94C 3353665D9F2F02F59C384FB943DE80648865DBC3626ED92ADB1AFA99D9E40DB0D 6432BF132894A7D01F64718E42FD39C2F801FF727C06D2D969DB35D03E827FA9B A8D03EEFEB09E8435E769B75A80FCE80DE416EFF01B2F329CE22BCA8ADFF03D0A 11B52A217D05215F39A147C45F4AAB84901AF1FD0725548A39BA6B57CDDAC0C06 488C016FD7D0AF1A90E78E208776A0A52B26400EC7CD4AFF806CD8D8C71754631 DD244ACF5CD95F934D4833294BD9259E91F505C815E7A845E7E823C136F01A4A9 5DE8C5075E1804504B403BA94159C840BF7B87341983B29485FEDCE4654C22A04 BD141CA912494F502D48D224F45050274A21E03806FF2C7CA7516022D7D000000 0049454E44AE42608200") )), ("type":"menu","caption":"视图","items":( ("type":"menu","caption":"工程文件管理","checked":1,"bitmap":GetWindowMgrBmp(),"onclick":thisfunction(ShowProjectView)), ("type":"menu","caption":"对象浏览","checked":true,"onclick":thisfunction(Mobjinspect), "bitmap":GetDefaultIconInfo()) )), ("type":"menu","caption":"工程","items":( ("type":"menu","caption":"打开工程","onclick":thisfunction(OpenFileFromTpjFile), "bitmap":GetOpenFileBitmapInfo()), ("type":"menu","caption":"新建工程","onclick":thisfunction(CreateTpjFomFile), "bitmap":"0502000000060400000074797065000203000000696D670006040000006461746 10002BC02000089504E470D0A1A0A0000000D4948445200000010000000100806 0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000025149444154 384F7D924D48146118C7273C885D5D0A89920D84ECE2A5082F76D93DA478A8DDD 9D99DFD5EAB252AC465D94317B340BD545B4B1D0A619548292F8298618730F2D0 0795645E2A2F82C57E7F7FCCACFFE679DDA161C97DE0CFBC87F9FFDEF7F93F0F8 77DCAE373D7E582DBEB84CBA3C8ED80D36D87C325C2E1146177DAD014502E9751 A95498E85C2A9590CFE791CD66914EA7213AACCD002E66AC56AB4C2AA4582C229 7CB31804D149A00BC2E66942489A97394635201994C06828D6F00ECEE028B8B40 28C4FADE0F406D10C062353700A251C0EF0704818546CF568D8DA216788B49035 0A8CC6C3603BDBD0AC0C17AFE9F994400B3E58206B0B5C56E465F1FA0D7B371D1 732979926A54FB4FA55230F1E735005946666000525717A4B63665D676D66BA15 060520164A6DB93C9E43F40A12C63E5F31FBC8A3CC3B713DDD86C6D65CB42F3D6 4A6B4E24127B804F3F33B8FA78039E075F619958833D308325D1A76C99C89E490 6129D49648EC7E388C5620A40C960786A13F67BEB308C7EC0A9C02A7A2E3F87F1 DA13B6A6B46956655968DE16C1AC846662C19191C4421C8A7C81F1E647745F7F8 BA3BE6574F051740E4E22316F407AFA3876C22D58BFC561798443F4520B7EFF58 6391A9C58993AB38137C8363BE97382CCCA1BDFF3E0E19C7F06BFA2CB61FEA98F 97590C3CC450E61F10012DB1B75EB5E7181C80A4EFB6771849F82AE3F8C76C318 C41B4FF17D218477B73BB044370F29669BF20DF6EC6DABA6B8AA2463E4EE024EF 277A01F1CC7958979C8B59AF25F0DEFE702981DD6E191F7205E8C9F835C2DD76D 6A017F012E1003A76A3E2C680000000049454E44AE42608200"), ("type":"menu","caption":"打开历史","onclick":thisfunction(OpenProjectFromtpj), "bitmap":GetHostroyBimp()) , ("type":"menu","caption":"打包到","onclick":thisfunction(WrapProjectTo), "bitmap":"0502000000060400000074797065000203000000696D670006040000006461746 100022D04000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000003C249444154 484B9D95FF4FD34718C7F987F6C3DC9438E7343A750BC100A211182628884E98E CBB084215A16C859608A5A3A603265FC6280C1601A15A22158DB4AE0B66E88420 6E12A4D81629A57C31BC77F7F45A7AA538B25772F97C9EE79E7BDEF7B97BEE3E5 1F80F56565E63DEEB85CB3D0BC7CC4B385D2ECC793C585A5A12116F664381E5E5 65B8675F61DA3183B73E3E8743D95AA971BFD3E586CFE71323221351C0E399C79 0FD313E385A045D432F0E1C2FC38FF766826DCBC17C4CBD70E072553B1415AD18 7BFA1CABABAB62B4CC3A01AF770119B957A1D475925DACEDC0BB71059240F4210 592CF56A1ED86154FFF7160FFB152347658283E1C496060E811624EA830CE0685 C2972854606BBC0263CFA645AF9F6C453DCE14D6E2D1D8A4F0F8218129C72CEBA C434DF32D7286B3E3489124B02B45297A645E7916B025360FDA0693F03081E6DF EEE248D6152C2EAD08978CC33987E8C44B92C0FB4925D89EA88075785C44C9D41 A6F23FE940683B6BF1055A0312233CF20BA6476262BF10E5BFFF025E2F6CEA462 7AA67C5E2DA2D7E8EAB763172B9081A1C7FE25B258FD15C367CBD135DE4474422 12AEB7B915ED820250FB43C9D0916DB131CFF564F42FA9FCD34F62B6523D25991 787DFE7312DCE4B9390F761C568859698517B08F4C20ABD428254F3DFF136E581 E8A08B083B8C8F6E92276275D6693EA115E3F41819B771E62EF2725F49E94538D BDA9A598989C21BBA3CF86B3AA4E4A1E97FD037EE9B1929FC337765B7C0195F37 5B31DB1E965B8C3D63E0009D4349BB127A5981C01BAFAFFA0AFF9B4B09EEC7243 0F4E29DBA16FB94D362739478BB84C355D27A1F073A1BADA45EF513C095FF38D8 861338ACD50E39E7D14EADA3EF25DD0B492F8EF7F4E901D89D6EEFB14435FD069 B2E1C354259C6E0F7586D3697A40C10967AED03357D5227AD633F9C2C5F6F2627 0D2C13DF0787D54721B956C4BB715EFB1815CA0CE3820BC3227CF1BA8FE27A7DD C21322108027E0778FC5364AF6FCC2227235BFE2CBEA5B48FCBA8E363AABB40D0 9A72BA89FD3CE8A602BDBE8A3AC38C28928C093A45D6AC5C9826BD89756864AD3 04F90E7E56434FDEF20C168A8DCDAC407C8E9E7CE7CADB449635361488D43ECAA C94ECEF3B46A0EE1A0DDAC535DD22CB1AEB04F4C641E4EBCD52A240DB93561ED1 CF9BDA68A3C985B34E80C32B21BFEA3ABE6B1B9692F0BB29D4E64DD9741F9A867 EDAAB48441408D03738820C45130C771D942CF4562D6A1A8242D78DF1BFE57F47 386F14085071CD8C6FB47D789BFD2A4B8CC3F842D54E076F336C4A80F37CCA899 8D35530F63E109ECDB16981FF07F02FE5F4C30FC035A3F30000000049454E44AE 42608200" ) ) ), ("type":"menu","caption":"运行","items":( ("type":"menu","caption":"配置命令行","onclick":thisfunction(editcommandline)), ("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu", "bitmap":"0502000000060400000074797065000203000000696D670006040000006461746 10002DF01000089504E470D0A1A0A0000000D4948445200000010000000100806 0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000017449444154 384F85906B6F0151108657575489AD124B5C1AAC452D65DB529754DA34FD692D4 5DD4ADDBA71EBFF7CBB3889E8504F321FCECC9B674E86C31F5EB4289E3599BD8E 43044F33098F5309652DC83AFF43058B10CAF3008A531F4ADF3ED63D0C1194970 194165E14666EDC6B22B263179BEC87081E967E1496227273276E353BD4910075 6067530A11147F3CC82D1CC8CC045C6B1628A333A4FA16243B3696D8850A166ED CCCED484FAD502626C4873CE23D23AEDA66249B5696DA420485B9A80B04A43433 62231E72DF80708743E48347B47E0AA526B0E40622C8CF5C50A7B6F576796040A 4CD41AA7308E925D78C88572D2CB98108569757270212035DD033406A70085639 842BBAA872C2525B88203B16911E0A50FA66481D5DB0DAFEA6D72B89AEA13F18B A91F93A87D2B520DAE411AA6D048720935CDF03F5F302899615B1860991779E4D F64304F9AE176ADB895453BF437DF760FB208242C78FBBA6884CDDC13AFF4304A 5D625720D2F7B1D03F80599273DB222D313980000000049454E44AE42608200" ), ("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu", "bitmap":"0502000000060400000074797065000203000000696D670006040000006461746 100029301000089504E470D0A1A0A0000000D4948445200000010000000100806 0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000012849444154 384FCD92496B025110847353DC453DB880A888A888EBFFFF2781104446CC6602C 9E430F9D2E57B8679971CE2C11434BE81AEEAEA6A6FB810FF4C20D96C60B582E5 12E673984EF91A8F8947235EAD0EF6DE4E26BEDB217420F27AED6AB13809301C9 2F4FBBCF77A3C0D06ECEC3B8D504093CFE4D90C6C2A46A4D522B67AE97488BA5D DFEC100AC8F6996C76B1C9B4DB50AFF359AB71B4DF7DB3E99B1D4201595669B2C 8369146038A45E2528963A54264226904020A4C3B9F6C6BB22727B91C1F56CFF9 3C9189A41108286D05A69D65FB879CC9F066F560EF9D39492310D0A994B602D3C EB2ADC9223F66B344F6BE2F977DB74320A03BEB544A5B816967D9D66491B78502 77D5AAEF760804F427D19D752AA5ADC0B4B36C6BB2C8B7BF85F8175C5B00BE01F F2C4775DEA0B57A0000000049454E44AE42608200"), ("type":"menu","caption":"调试运行","onclick":thisfunction(debugproject)), )), ("type":"menu","caption":"工具","items":( ("type":"menu","caption":"打开图片","checked":0,"onclick":thisfunction(ViewBitmap)) )), ("type":"menu","caption":"帮助","items":( ("type":"menu","caption":"使用手册","onclick":thisfunction(OpenHelp), "bitmap":"0502000000060400000074797065000203000000696D670006040000006461746 10002E002000089504E470D0A1A0A0000000D4948445200000010000000100806 0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000027549444154 384FA590494F53611885FD6FC6C48D2B57BA21828808C4401C222444A26200A31 8A802020151204A903009AD76A02D63A194D2C26DCAD401E8A54C2DBD94C9C7AF A5704358194F727237E73CF73DDF15FE539700FB877F58D93C666C318E495230C CC5304B31BCEB7162F193544AD505801C39C6EC51F0860E585857F004A3497BD7 62B803317A2737F187E3A9F4A9CE01A1DD2374B35196E47DA617B76833F929EB9 CA7B4638E7ADD0223EE0DA4D5282DA6004BA158AA9502C40E4ED039775908290C CF872911A53A9D57FC4DC1178ED1391AA0A86D06EDD42A2EDFAE002EB1B377A80 212E7CDFAF798F46E53DCEEE269D3B4D87B247C9CF21125ED0E8ABED831BB6486 66130EA980AE7119496C6D14E4C74D760A1A27F16F88CD13010CCE35140130388 3E4D45878DFEB6666798B8A0EA70A68D0AD88C78A50DCEA20BFC1466EDD88085B E9B7F9D88AC659DF5268FE2D71BF7A88FC4F56DCBE1DF26B475440558F072910A 1F0AB839C5A2B0F3E5AC8FE6021A21CB22247C9D30C91F94ECF5DE13C8D11977F 9BAC4A930AD0F4483857B6D1F449E4D68C90AD31935565E25EA521E98C0A1D19E 583A4970F50DA3681CD2BF35040CF01BFECAB0CDA0258DD72F2B4B36278771F79 4721ADEC67D219657DE8A67CB48A396D7A49052482CF1AC6189B97D14EFAC9A93 692FE464B75973DE944F9CEEB6EBE193D181D016EBDE86735BCA702129A906451 D26371AD619809F2AA758CACB7036496F7F3BCD98AD6B68C7EDACFF5273F308AE F99CE01090D8B725A999616DD1CE39E108EE570D2A3F3EBD4F739B951D885DEEE 4BA54F75019050509CF659EBE6F6CB7EAE3DEAE06AC1776E16770BC00C7E39924 AA9BA04F837C15F4F46800A8EF8DEDF0000000049454E44AE42608200"), ("type":"menu","caption":"控件详情","onclick":thisfunction(OpenHelp), "bitmap":"0502000000060400000074797065000203000000696D670006040000006461746 10002E402000089504E470D0A1A0A0000000D4948445200000010000000100806 0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000027949444154 384F8D924B4C135118852B2AA046431150E303E26B455CB1D3953B162ED818A2C 6850B88441275A126269A687443A54AA251AC411E1B345414E461176881A260C4 5035D3875230410A0DB543FAB074EEF1DCCE34445CE849BEB4F77F9CB9FFCC6FC 25F1224423E00F35660F23CB064E7394012467E592B0C647216983E0D58D60167 5601D52CB9B21A682A02B40EE6A3E9CA8C5618C8275F036E6703554C5D261789F C2F8D9C5B997792A42C4E8BD18C52641C88950056861F93251227D2489AB4F126 A82461D99016A319C5492B3113193670911A226FE2E348D84766882E596548CE7 6876C22324CA6C9257295788D18B6113FD1C81F06BFC80B52488CE25BA49E848D 33E40865244874C928E6BCEFA0B49D42C05E81D87C118496A5A7AE938F996613B 4640E7E2A65987C5E8BB81A92ADBA81D2701089BA2CA4BA4A21C673F93AF824C1 7947990E1A061ACFE1B5D05EAF47AAB314BEE1A7B25537F8565F8AA82D1B9A733 FC4977C0875339B697496E90B6C9CC9E197CB830815424CE4437B6586BFFFA66E 90585CC00F6B09D4E65C88919D10937C07D11DC01B2E4E0D9BCFADE136EEE6AD4 8743B84AF00626023A6BAAB748339FF382296022CDCCB81E63043B87983792E4C B418F844A300F722BE87E75D10B35B38A2195ACF06843ACA918C2DC2E4733D43C A9A87196B31949643F0741E86C7510ECFD01178472BE0797F94BF95F0BA8EC13B 701CDEDE13F0D94FC2D35E85AF637D30298E46F8EAF62218FC9EBED2FFC8ED1E4 66B432D42D30A4C0B539FE1AE3B00555D5ECF7F696CCC019BA59A23A8FA57F03B EE62B0FD069C5DF731D8F50043DD8D187AF910C33D36B824BD8F30D2D794E66D7 F3369C1C0130BE291107E03B1BD47754EBE98780000000049454E44AE42608200 "), ("type":"menu","caption":"范例..","onclick":thisfunction(OpenExaple),"bitmap":"0502000000060400000074797065000203000000696D670006040000006461746 10002AA01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000013F49444154 484BBD940B4FC2301485F9FF7F49638C898F058C8293E81ECA18E1351C0C64899 179DDA9AEA9A3CDB8C03CC949BAFBFAB6765BE3E4E699EAF4FF01E2647D546B01 C79216E08591B43F98FDB9DEC75B80BA2C01AD6EF8EBFE81FE99B305A8FD0C760 1CC97A97095F606D8FE48B84A6CC0E72613775ED4628D98493B03DED30FBAEEF4 6471D9C8A1A62CD6139820A6E1100B00BD290D851133890D08270BD950183193D 880EECB98DC7E4459F6258C356226B101BABD36ED3FC40670C506C4494A4E30A5 CBFB5761AC1133A912808F681825F4E08DE8E2D697C56523871AD4AA1F9E11108 EE7D4768674D6746541E1BBA781C8C35897F3E8412FF25AC0A9E5C8207CDE72E9 31FFEF4CE3156D34BF05C490430D6AD55E759604C057ED5EBEBF11CD16FC03470 F7A31439DD9B0EC80BCFCBD56CFE0506116665A7640DF50A54EEE2F8BDA750000 000049454E44AE42608200") ), ) ); 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 EditerCodeChanged(); //代码改变 begin if FTree.Loading then return ; classinfo := FProjectManager.GetFormClassInfo(); 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 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(); 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 class function GetClassItem(n); begin return FClassItems[n]; end class function RegestorClassItems(its); begin {** @explan(说明) 注册组件 %% @param(its)(array of TDComponent) 组件数组 %% **} if not ifarray(FClassItems) then FClassItems := array(); for i,v in its do begin if (v is class(TDComponent) ) then begin n := v.ClassName(); if n and ifstring(n) then n := lowercase(n); FClassItems[n]:= createobject(v); //RegisterComponentType(n,FClassItems[n].ComponentClass()); end end end //**************************************** 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 RectToPoints(rc); begin {** @explan(说明)辅助函数 **} r := array(); r := array((rc[0],rc[1]),(rc[2],rc[1]),(rc[2],rc[3]),(rc[0],rc[3]),(rc[0],rc[1])); return r; end function setcomponentfocus(cwnd,fk); begin {** @explan(说明) 设计控件获得焦点 %% **} if not(cwnd is class(TWincontrol)) then exit ; if not cwnd.HandleAllocated() then exit; //if cwnd is class(tvcform) then exit; //if cwnd.WsPopUp then exit; return cwnd.DesigningSelect(fk); end function setcomponentfocus_bk(cwnd,fk); begin if not(cwnd is class(TWincontrol)) then exit ; if not cwnd.HandleAllocated() then exit; if cwnd.WsPopUp then exit; cp := cwnd.parent ; if not(cp is class(TWincontrol)) then exit; rec := array(cwnd.left-1,cwnd.top-1,cwnd.left+cwnd.width+1,cwnd.top+cwnd.height+1); if not fk then begin if cwnd is class(TTabSheet) then begin tmpcanvas.pen.color := rgb(255,255,255); goto abcef; //return o.DoControlAlign(); end t := 25; rec := array(rec[0]-t,rec[1]-t,rec[2]+t,rec[3]+t); return cp.InvalidateRect(rec,true); end tmpcanvas.pen.color := rgb(200,0,0); label abcef; tmpcanvas.pen.width := 2; //tmpcanvas.pen.Style := 1; pcp := _wapi.GetDC(cp.handle); if not pcp then exit; tmpcanvas.Handle := pcp; vw := RectToPoints(rec); tmpcanvas.draw("polyline",vw); tmpcanvas.Handle := 0; _wapi.ReleaseDC(cp.Handle,pcp); 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(); FTree.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; if FCurrentNode<>nd then begin FTree.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,self.handle,makeposition(xy[0],xy[1]),1); _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; if FCurrentNode<> nd then begin wd := o;//nd.Component.Cwnd; //if wd is class(TWincontrol) then _wapi.BringWindowToTop(wd.Handle); FTree.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 := (FTree.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; return ; fm := (FTree.RootItem.items)[0]; if not fm then exit; O1 := fm.Component.Cwnd; o1.show(); end function CloseShowForm(); //主窗口关闭 begin {** @explan(说明)关闭当前工程窗口%% **} FProjectManager.CloseCurrentEdit(); 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.Onclose := function(o,e)begin e.skip := true; CloseShowForm(); end ;} wnd.OnMinimize := thisfunction(CompClose); end end end function UnLoadTreeNode(); begin {** @explan(说明) 卸载tree的节点%% **} node := FTree.RootItem; if node.ItemCount>0 then begin DeleteNode((Node.items)[0]); end FVariableSelecter.clean(); FEventGrid.Component := array(); FPropGrid.Component := array(); end private FLoadInheritedName; public function LoadTreeNode(Ptfm,inh); begin {** @explan(说明) 加载tree节点 %% **} FLoadInheritedName := inh; UnLoadTreeNode(); FTree.Loading := true; try prs := array(); obarray := array(); loadtfmtotree(Ptfm,Ptfm.gettree,FTree.RootItem,FTree,prs,obarray); 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,owner,prs,obarray); begin {** @explan(说明) 导入tfm文件 %% **} if not ifarray(d) then exit; if not d["type"]=p.TT_COMP then exit; dcls := d["class"]; it := GetClassItem(dcls); if not it then begin if ("tdcreateform" in FLoadInheritedName) then begin it := NEW TDForm(); end else if "tdcreatepanel" in FLoadInheritedName then it := new TDPanelForm(); else return ; it.ClassName(d["class"]); it.Imgs := FImageList.GetImageId("tvcform"); FLoadInheritedName := array(); end comp := it.ComponentCreater(node,owner); 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 := 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); 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(); for i,vi in v do begin if vi in array("create","destroy","recycling","loadfromtfm") then continue; FFunctionSelecter.additem(vi); end end function create(AOwner); begin inherited; tmpcanvas := new tcanvas(AOwner); 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); 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 := "propertys"; 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); FImageList := new TDesigImageList(self); FTree.Imagelist := FImageList; //******************toolbar *************** FToolBars := new ttoolbars(self); FToolBars.parent := self; FToolBars.Imagelist := FImageList; addtoolbuttons(); //************菜单****************************** 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; 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+20; 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 type TGridList = class(TListView) {** @explan(说明) 用tlistview 模拟 list %% **} function clean(); begin DeleteAllItems(); end function CheckItem(v);override; begin {** @explan(说明) 检查项目 %% **} return List.indexof(v)<0; end function additem(v);virtual; begin appenditem(v); end function additems(v);virtual; begin appenditems(v); end function create(AOwner);override; begin inherited; end function DoDrawSubItem(o,e);override; begin dc := e.canvas; if not dc.Handle then exit; j := e.subitemid; if j = 0 then begin i := e.itemid; src := e.subItemRect; _wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,DFCS_BUTTONPUSH); dc.DrawText(inttostr(i),src,DT_VCENTER .| DT_SINGLELINE); end end end type TBitmapGrid = class(TGridList) {** @explan(说明) imagelist编辑 %% **} public function CheckItem(v);override; begin return (v is class(tbitmap)) and inherited; end function create(AOwner);override; begin inherited; cls := array(( "text":"id", "width":30 ), ( "text":"bmp", "width":60 ), ( "text":"size", "width":100 )); Columns := cls; end function CNMEASUREITEM(O,E):CN_MEASUREITEM;override; begin e.height := 40; end function DoDrawSubItem(o,e);override; begin dc := e.canvas; if not dc.Handle then exit; i := e.itemid; j := e.subitemid; src := e.subItemRect; it := List[i]; if not it then exit; if j = 0 then begin return inherited; end else if j = 1 and it.HandleAllocated() then begin src[2] := src[0]+40; dc.StretchDraw(src,it); end else if j = 2 then begin if it.HandleAllocated() then begin dc.DrawText(format("%d*%d",it.bmwidth, it.bmheight),src,DT_VCENTER .| DT_SINGLELINE); end end end end type TListVariableFilter = class(TListVariable) private FVlist; FFilter; FFirst; type ttypefilter = class FStyle; function filter(o); begin if o is class(TDComponent) then begin if not FStyle then return true; return o.ClassName() =FStyle ; end end end function SetFilter(v); begin FFilter.FStyle:=v; dofilter(); return ; if FFilter.FStyle <> v then begin FFilter.FStyle := v; dofilter(); end else if FFirst then begin FFirst := false; dofilter(); end end public function clean(); begin class(TListVariable).clean(); FVlist.clean(); FFirst := true; end function deletebyvalue(v);override; begin idx := FVlist.indexof(v); if idx>=0 then begin FVlist.deli(idx); inherited; end end function cleandestroy();//销毁不存在的控件 begin id := 0; while id0) and ifstring(v["text"]); else r := true; return r; end function MouseUp(o,e);override; begin inherited; y := GetRowIndexByPos(e.ypos); if y<0 then begin UnSelected(); CallDataFunction(self.SelectedChanged,self,e); end end function DoDrawSubItem(o,e);override; begin {** @explan(说明) 绘制子项 %% **} dc := e.canvas; if not dc.Handle then exit; j := e.subitemid; if j = 0 then begin return inherited; end else begin i := e.itemid; src := e.subItemRect; di := list[i]; if j=1 then begin wd := di["width"]; if ifstring(wd) then begin di := wd; end else di := tostn(wd); end else di := di["text"]; dc.DrawText(di,src,DT_VCENTER .| DT_SINGLELINE); end end end type TListStatusEdit = class(TListEidter) {** @explan(说明) 函数编辑器 %% **} private FEDITS; e1; e3; ed; e2; e4; public FCheckNumber; function clean(); begin if ListControl then ListControl.clean(); end function setitems(v); begin if not ListControl then exit; ListControl.clean(); ListControl.additems(v); end function Buttons();override; begin if FEDITS then return FEDITS union inherited; return inherited; end function addclick(o,e);virtual; begin if not ListControl then exit; v1 := FEDITS[1].text; FCurrentIndx := -1; if FCheckNumber then begin ListControl.FCheckNumber := true; v1 := StrToIntDef( v1,0) ; if not(v1>0) then begin return _wapi.MessageBoxA(self.Handle,"宽度错误!","错误",0); end end else ListControl.FCheckNumber := false; v2 := FEDITS[3].text ; FEDITS[1].text := ""; FEDITS[3].text := ""; ListControl.additem(array("width":v1,"text":v2)); end function Create(AOwner);override; begin inherited; caption := "statusbar 编辑器"; top := 300; height := 400; width := 430; FCheckNumber := true; ed := new TListStatusbarItem(self); e1 := new TGraphicControl(self); e1.caption := "宽度:"; e2 := new TEdit(self); e2.Width := 150; e3 := new TGraphicControl(self); e3.caption := "文本:"; e4 := new Tedit(self); e4.Width := 150; FEDITS := array(e1,e2,e3,e4); for i,v in FEDITS do v.parent := self; ed.parent := self; ListControl := ed; ListControl.SelectedChanged := thisfunction(onlistchanged); e2.OnChange := thisfunction(EditChanged); e4.OnChange := thisfunction(EditChanged); end function EditChanged(o,e); begin if not(FCurrentIndx>=0) then return ; if o=e4 then begin ListControl.SetsubItem(FCurrentIndx,"text", formatText1(O.text)); end else if o= e2 then begin ListControl.SetsubItem(FCurrentIndx,"width",formatText2(o.text)); end end function formatText1(txt);virtual; begin return txt; end function formatText2(txt);virtual; begin return strtointdef(txt,100); end function onEditClick(o,e);virtual; begin if not ListControl then exit; end function onlistchanged(o,e); begin v := o.SelectedValue; if ifarray(v) and v then begin FCurrentIndx := -1; e2.text := ifstring(v["width"])?v["width"]:tostn(v["width"]); e4.text :=v["text"]; FCurrentIndx := o.SelectedId; end else begin FCurrentIndx := -1; end end function SetColoumn(i,v); begin ed.SetColumnText(i,v); end function SetLable(id,v); begin if id =0 then begin e1.caption := v; end else e3.caption := v; end FCurrentIndx; end type TListStatusEdit2 = class(TListStatusEdit) function Create(AOwner); begin inherited; end function formatText2(txt);override; begin return txt; end end type TIconsEditer = class(TListEidter) private FFileopen; FIcons; FImage; public function clean(); begin if not ListControl then exit; ListControl.clean(); end function Create(AOwner);override; begin inherited; top := 400; left := 300; height := 400; ListWidth := 230; FFileopen := new TOpenFileADlg(self); FFileopen.wndowner := self; FFileopen.filter := array("all":"*.bmp;*.ico;*.png;*.jpg;*.jpeg","bmp":"*.bmp","ico":"*.ico","png":"*.png");; list := New TBitmapGrid(self); List.parent := self; List.border := true; ListControl := list; FImage := new timage(); end function addclick(o,e);override; begin if not ListControl then exit; if FFileopen.ChooseDlg() then begin fn := FFileopen.FileName; r := FImage.LoadFromFile(fn); if r=0 then begin ico := new tbitmap(); ico.handle := FImage.ToHBitmap; ListControl.additem(ico); end else _wapi.MessageBoxA(self.Handle,"打开文件失败","类型错误",0); end end function seticons(icons); begin //if FIcons=icons then exit; FIcons := icons; ListControl.clean(); for i,v in icons do begin ListControl.additem(v); end end function GetIcons(); begin r := ListControl.ListValues; return r; end function showmodal();override; begin inherited; return 1; end function applay(o,e);override; begin WMCLOSE(self,e); end function WMCLOSE(o,e):WM_CLOSE;override; begin e.skip := true; o.visible := false; o.EndModal(); end end implementation function includestate(u,s); begin {** @explan(说明) 状态扩展 %% **} if not ifarray(u) then u := array(); if ifarray(s) then u union2= s; else u union2= array( s); return u; end function CreateExtendEdit(AOwner); begin r := new tedit(AOwner); return r; end function GetFolderChooseBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002F601000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000018B49444154 484BB595CB4AC3401486FB56051114EB9BF8046E5DF800A2088D0FE02BB871D59 D1BC1B5206D166E6CD2DC9B26E92DEDB167E00CA733939A4833F0431639DF7732 B774A0E5210497371FD0BD7E3F6A902905A617FE1B313A1DF97C7CC10EDEAA806 74F4063BBDD8A6C361B28CB12D6EB35AC562B582E97B0582C44E6F33914450179 9E439665309BCD44D23485E9740A49921C1698E02450E124E0F0388ECD02139C7 7CFE1BC7B156E1470B8FDD483E14357C6B67A90873F02AE4E0D8793208A225D80 701220148A4F196F700BEEE0BE12CEBB4778188666014D8D10A46F32A5FB0A76F F7CEFABD48CAC0B09370AF8BC630104CF8D82352408824017F0451D3E9EEC7557 2BBB1A82FBBE5F2DC01D83057C0DEA046B08EE799E2EE0DB5108E29746F953407 02970EE1A056B083E994CAA05789884E0FBAA51B086E0AEEBEA027E5285E0EBB4 51B006E1950282636CEBF09E3765D43F9370C771AA05754F2A2D289F77828FC76 35D6082AB971887F31DC3E195020E572F3182ABDD7338EF5E13B4FED36F6F00FC 0241F784DD5ED660EB0000000049454E44AE42608200"; end function GetColorChooseBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002AB01000089504E470D0A1A0A0000000D4948445200000019000000190806 000000C4E98563000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000014049444154 484BBDD6CB4DC4301006607745015440177BE5C88D7AB8D2042BF6480B9BF7FBF D1E3296068D8D13041B63EB972225F127C7F124E2E2015C4BBBF942EE9FDEE1EE F1EDD0E0980A62BAE8AF914D08796C0F5901EB08CF3784DAB22C32F33CC3344D3 08E230CC3007DDF43D775326DDB42D33450D7355455056559CA144501799E4396 653F232680101D208403699A6E23088867A1849E31254DD568A725B089D00C8E4 092243123081C812010C7F13682EB702B82C026420B2D3ED61B59E07452030F4A F4D30844516446E84DBA1541200C43BB080241109811DA0F5611DA6CEBD04A87F 3590DBC2A79B98012047CDFB78B20E0799E19A192C101EC872254933880FDB708 02AEEBEE23BCB252D1E3858F7634BDAAB4D03403041CC731232640AFAC1C20440 77691BD6F0301FA2C38C0676144FEE547C266246237009F3C80A931F3C228EA00 00000049454E44AE42608200"; end function GetFontChooseBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100023C02000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000001D149444154 484BB595C96A02411086C5E7F0E83BE4ACE4A4375F40F0A65EF49A474A8E21470 D219018859CDC6E12C16546C7D9D471AF743794943DDD1282D3F0C380EDF71555 A51383888F10DC3FB4E0AEDAB86938F32C505DF86FC489C5CECFB7173078A4029 A0B019ED3E924723C1EE17038C07EBF87DD6E07DBED16369B8D481004B05EAF61 B55AC172B904DFF7453CCF03D775C1719CEB02151C05321C05146EDBB65AA0820 7EC8B76BF0F8B5E0FAC6E17E69D0ECCDA6D1193C5679FCB70A54086A3C01B8DE0 BB5A854736B8976412DE733991B76C169EE27130991CE128582C16610187EBFAE ECFE742D02A972FFA5E4BA7C161405A3D875B96A516E8864A05B4E7D670A8842B 05D786EACD6642D02C95941B837014CC59412101C269F5B831AE690AC1732201F 5544AE4239F3FC369F51C3E63056905329C0A3E0B05D19651A3013FF57AA83508 37D9FD904086D37D770C4308BE8A45D11655DF39FCAA00E1B47ADC1859A01A2A8 51BECBE5620C3F940A94037540A9F4EA761810A8E8261AD2604AF990C988381B6 EF1CAE15205CAEDE607F07AD4AE59C268BC560329C563F994CF4020AC75DD70D9 5C3E5D670F8783C0E0B5470D58F09E1AABE73B85640E1B4FABF0E95561F1244FE D28FEE00FC02B599AB32671AF3C00000000049454E44AE42608200"; end function GetInputquerysBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100020B04000089504E470D0A1A0A0000000D4948445200000030000000300806 0000005702F987000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000003A049444154 6843ED995B4F134118867B8DFE0F2FBC3046A31726466FFC05C61310349E1212B D43241A124550910818D468B840543C444D4C8C070820118D62A0A022B605DA05 0A2DD0A5F4243D90D7F9B64C335D5AE5B0D9B208C9936FE69D6F76E661D92B4C3 001464611E8E8E84561E10D4340774D1230D2E539A28489875D030143C0EF3B4F A0E5DBB4AE4C767CC778E583456769059E7FF2E8C6D4CB56449A3E23925F8E91E 2DB8BCAF87D9B9B5B93056A1BDDBAE129A8468C5D2ABA350FC373672F34130588 8440C50BA7AE48C5B7E02CAB5D749656E05CBD6408D20A188DD52760949FD52F6 0B7DB5624FCC26B029962D102269329E90199664D80671CDAACCE8885F4F13955 0E9F2B9752F5F29C589680887A9DE6F44031E3B958D5B97AAECE399A08281B58C E1133AA7FEBE395936E2EEE553F9358968098F1F152FBFE3557674B1210E10F51 67E29C67E9FAA872D43D621F877AC47E62C1022B8D35814CB32690693413700C5 870F9CE136417DC406ED14DE414D5FC954367AA19557355A40AD9ECDC9CB335C8 3B7F0B6D1FBFC0294929CF243413385D568FC2BBEF51FEC28C8B8FCD2879DABD7 49E9851CAEA85475D3871A901365B7FCA3309CD04F6143C42DFE82CE4DFC04400 980CCEC7ED8BC3D7C7FDF37B085A77B3355F04C8AF6EC1DBB6CE9467129A09EC3 8F5008E893066636104C351FC8EC4E69845281C273B274F419C530DCE4484FE18 CBA208B08C9E75B4A211EF3E74A53C93D04C605BFE7D0CBA66109999C5B42F0A7 F20A6E09D0E2B952ECB331A07827101AA84CF1F532AADFBFC51B62F2E9057FE0E 8D1F7478035B4ED6A37F6C06A1600C1E3982296F54617C22A4409715C71E393CA F12B447664CB23109E45E6102ED3ABC81CDC7EFC1EA0C419603708EF930C6FE88 89A11159812E298E5DEC03A0CAC7C4A82BBE8718767A1581ECB2B74C408737B0E 9D83DFC1A0EC1EDF262D0E18134242BD806DC0A7451716C774C62FF81DCC498C3 F7F50F4E2802074B99801EDFC0C62375E895821896C6D1671983D5E652B058461 3F0DFB8C5CAE60C1A4B43DEA48CA07DBD3F4714817D256FD0D46E4E7926A199C0 86C375F8391482B54F4267D720BABBED4998CD2CEBB1A3A7C7111FF32CB1E648E AEFF86A453010C6DE12FA88757803DB8FDFC6D9DA5E5C7FECC5B587322A1A88A9 2522B3677850F3CC8FDDA71BD0F9C39AF24C423381D72DEDD87EB412593B4B90B 5AB74D9AC63ACDF7D0957EB5EA53C8FA39940A6F87F04F8C24A65F50A188DD523 C0FFE3CD03A3911030A6442BFE00B24E924CE37F2F940000000049454E44AE426 08200"; end function GetTsIconBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100021E02000089504E470D0A1A0A0000000D4948445200000020000000200806 000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000001B349444154 5847ED97DB4B024114C6FD0BFB1B7AE8257AED217C28E802DD91422308B388B47 A903093EE0891614AB145BD88A61851A64268D18D93DFD0C8AE8DEEAC924BB01F 7CECEE396738BF1DCE2CAC8D2A9A751F5147E75C5B8D9E90CD8CE6DCE86D1325D A690BC002F8DF004E4F982E6FEE686426548D45CF6FE9389AD0D43572D300ABFE 33F621413368CCB9CBE2B842B2104D0174F5AEB0269178923DB702D1F40E4089D 423F5D87DEC5904113CB8D2AC11D93080673D422FAFEFAC1994CE16EA42C8581A C0B514A6EC7D913548A673D43F1120EFCF1CB402A10B30EC0891529974285F28D 1D4FCBE26CF87510431381DD4D48AAC0B902F96E9E3F38BDCBE13611EAE078123 5A5B5B6B5D00085B2DCAA9CD213098381D50ED6E896C18C01FBAA09DF035D9473 7357503935BAC964B061A3604C0870E5ADE38D5D4A5324F542ABFB1FBEE3EAF26 D7C88600F870418B6B916A8D63E190C57052784CD6D200BC39EE391037063559D 901754CD65200BC79604FF995C74E40E32EF98F8FDA5200504C4957DF5E6D1CD1 B89211AE95B134403D3DE49E69C8B12D5C2B635D80BFB6056001980F60FACF29C EB21910E84944F40D9996C7E196BAE5D60000000049454E44AE42608200"; end function GetOpenFileBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002FE01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000019349444154 484BB5954B4EC33010867BAB4A8004528FC209107B0E8040482D9BEEB802AAC4A A3B365C000941166C68D2A479346D1E4DD20E1D8B318EED240D2223FDABDADF37 766CB7B72FE8383D38BE7C81FEC5FF06995CA01BF0D7B0FA617623D8F33A15882 909A876BB1DCB76BB85A22820CF73C8B20C369B0DA469CA922409C4710C5114C1 7ABD86D56AC51286212C974B0882A05EA083934086934084FBBEAF17E8E062F70 81F8FC7B541B85620C3E5ADA1CE11525524F03C4F15201C63DC0FE0FDB6CF638C 0610B95F8A603299948285BF21DC755DBD00BB4728C4AF3CF6F40AACE90DDFF7A 615205C2BA0AD6182F099A7B09EC0189EF11535AD00E18BC54215D09E3381F350 99A61520DC719C1AC1DD11EFF6D0E0772301C26DDB560574627082F80D0E099BD 324A0E3C806FB8FAD220A103E9FCF1B04E675AB8802845B96A50AE832B1C19FE7 AD8273105E2BA08BC4046F27AD8273686B106E9A66B5C018FD9EF943F3313C2DC 167B3992AA09B2ABE8EF20B49CF009E753AEF72E79582BAB79DE0A240868BDD2B 82CEFFF4BB4B0FBE011F9D6134A0D7ECFF0000000049454E44AE42608200"; end function GetTrayBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002D401000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000016949444154 484BED933D4BC3501486FB83FC01BAB83A7510E9225D0A0E4504ED20BA77A9A83 838A483830D181C5C623A085182592B4832086A5CD42182D83616ABFDE0D5739A 2B972692A55DA40F5C2EE7BDE13C9C9B248531331124321124F20F04F92D13538 B876359334B1A52778F6F98CD1FE3E1B9113A470749F88A8ECE6EB0B6677128E3 BA2E72B95C580D68369BA8D56AB02C8BF72008C293018661F0227E05F5F74F1E4 7869A67B359A4D369AEDBED362A950A0A8502CAE532344D83A2285C534EE744AC E0FEA98EB9D5130E755DE7A6994C862542609A26376DB55A701C8727A09D6ACAE 99C8815ACEC5CE0407739A48769098480A0EB28168B28954A50559577AAE9DA04 11816E7B58D83C45A7DBE7F0AF09049EE7C1F77DD8B6CD3BD53211C1FC868EEBD B170E6486DF814CB55AE5094423998860FAE7E5BE363E381826EE2B4A2222D8D5 AEB0BC7D8EAF4E8FC351C2826EAF8FF5FD4B2E46BDF84F0E656363224800F8065 E0D34316036A3840000000049454E44AE42608200"; end function GetImageListBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100026001000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000F549444154 484BD58F310AC2301486BB4BEFE101D40BB87988BAF5060E1EC0414767A91E40E 9A082B3D845D04170165C159776504462FE426C62EA5BF2163FF848783CF8122F 0C43C1E93779800B32A05EC0A5C20870410670725A1AE0820CD47B6E0232D01AB A09C8407BEC2620039DA96994CCC5F956178F67253FA3CDC2DAD1056460B02A9C EDE672E259C6FBD8D8D305646092145ED39A9CD8814BDA30F6740119581E0A9F2 F5F4EEC00E6FA9E2E2003DB5361762FFF41766F187BBA800CF87DDF494006AAA3 AA93E01350AA2168C64D27411EC86F92EF40B00E9C04564009BAC7AE93C008285 480839F014EAD0037FF1E10E20DEF9AF049B9ED69F90000000049454E44AE4260 8200"; end function GetTimerBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100020903000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000029E49444154 484BC594D96AA24110857D9E79C9C99D51AF024188883E8106340A2E37C625370 ADE08921830242EE08EB8E0420D5F619B36696784619803C5DF7F2F75AA4E55B7 47FE312E22B8BBBB936AB52A8D464392C9A4DCDCDC1C56FE8CFF4FB0DD6EE5E5E 545AEAEAE8ED66AB574FE129C25188D46128BC5E4FAFA5AC2E1B08E53A994DCDF DF4B241211AFD72BF1785CC6E3F1E1841B4E8272B92C3E9F4F32998C7C7C7CC86 03090E170A8A4D3E954E6F3B97E0B8582040201DD7F0EDF08D0F8F6F65665E876 BBD2E974D418FFF8294A34994C9464BD5EEB38140AE939174E088824180CCAFBF BBB46FEF6F626ED765B8DB1C7E3915EAFA72464B0582C64B3D9A8D108954AE5E0 E9134702B4F4FBFDF2FAFAAACE714A1644FDFCFCAC630858EBF7FB3A6FB2D8EFF 7329BCDF43C32DA381250C46C36AB52102D0E9BCDA6B626C61802D6D84316385D 2E97B2DBEDD4C7E3E3A316DE8612D072740BD1A137D113218EEBF5BA1A6308586 30F854726F69996858CEE42320325205A5A91438600592E21C0A97D27A2D1A8CA 6CA004DC522422EDBF9108241209F567A004C56251D2E9B416889431536432B18 B6C9B29B23903F2F9BCFA333866C00D256522A3155D6DCA9CAB4D6D9041AD563B FC5935E0FA1311170707B42252A037C69839D6EC8B66CB039C35A048549FA8386 8BA036714D3F554AC562B3D67A401D4836EB48BAE0480FEE56D212A52C70945C4 21C69839D6D8633B31E03C52DB381290360F17371A5D71424444C817638E3564B 12307E6267F7D5D8F0480B7883705275C7F1C1129E6726AC07ECE3D3D3D1D663E 7142007815D94C445FE122601FFB1F1E1E0E33A7F8460078154997B705695C609 E75F6B92237701200B4A4F07417AD477FE77239FDF2CF3C05A576BFC3590203F4 A7AFB93CA55249BFFCBBBAE83B447E01A5FB392686E583230000000049454E44A E42608200"; end function GetSaveFileBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100021702000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000001AC49444154 484BB5954B4E024114455994891B70C63A5C8013062E4017E0CC814E9C191DB80 09D9A4048909020100C10A0F9FFFF9FABAFE2EDBCFE6A3A50C94D57D255E77477 55BD8EE1C8CD08CE2E9338BD783F6884690BFC06448D69B198DD3FBCE0077E548 18E43C0B6DFEF4D76BB1DB6DB2D369B0DD6EB3556AB1596CBA5C962B1C07C3EC7 6C36C3743AC5643231198FC7188D46180E87E1023F38056E38051A3E180CFC058 49F9C3FD849A55248A7D3C86432C866B3C8E572B8BA7BC5F5FD1B8AC522E28967 7C7E590EB8AF403FB916109ACFE7512814502A95EC7BD56AD55CE3892703A7A0D FEF7B0502F713105A2E9751A95450ABD5EC7BAD56CBEE6B78AFD7F317F0BB7392 84D07ABD0ECBB2D06EB71D50F635DC57A0179593248476BB5D03916F7DF398349 185E538815320633D02C2DD82FF46C33B9D4EB040B62327DDBE7CFC198ED57079 638F8070D9EB9CF49FC6B1020F15E8931A5540B8ECAE40819CD428020D978DE11 1E83210454078A0807087E0B7F486C52D1078B3D90C1648118B22D0F046A3E115 E80AC9EAE8AE907AAFBB1795F04041586D27DC7D98345C3FBD4770F49FFEF11AF 00DCA98480ED0E0E3350000000049454E44AE42608200"; end function GetMainMenuBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100021E01000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000B349444154 484BD591310AC4201000FDA0D8D859E547FE48EC03127D809D8F48B3870B064F3 DD45C725C06A688849DAC21703318608C01A5F432A594383C7204D675ED1A42E8 EABD876559C018530708211F4D81F2BC3C534A8110029C7375A067FEA52DB5D63 87CDB361C1EC140EB1ECFC839076B2D0E4E1C815166DE8DBC05F2BB4C967C1518 E1F20DA239CFDAA0C5B336686D713AB0EFFB90A70333CEF0BB0DF0E1CE7F30CAF F06669CA1BEE48B797A00E00533D0A5754BB70F010000000049454E44AE426082 00"; end function GetActionListBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002D200000089504E470D0A1A0A0000000D4948445200000020000000200806 000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000006749444154 5847ED92510A002108053BA8D7F18A5EC768E185D8A750C2BE818190A0811CFE1 8063080010C380254750BE2AC6AE6081091CF78799D31AF9AE917709B7E0166B6 05715635C325ECF705B7E91780BFFAEF12AEC72088B3AA192E210318C080C701E E13DA99A6670A4C99A90000000049454E44AE42608200"; end function GetPopUpMenuBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002F401000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000018949444154 484BDD944FCB015114C6E74B8D448842A6B1F401E43358284B7B4B2B595958B05 3B250B2D3A0AC486489324929911EDD33476E8C3FEF782DDEF757A7EE79EEDC9E 79EE9946C197F98706F178FC47F50A5B8377F9C8405194BBBAE5EF251025F3950 4A7D309954A85D6BF9A40465555D46AB5EF2410B85C2EC4623184C361561EF376 023985DBEDC6743A45281442BD5E67D51E5B83C3E1F0B43C1E0FF6FB3DE6F3392 569341A7CFA1E5B83572512EC763B7A7E3299D055359B4DEA6F719420100860BB DDF209603C1E231289A0DD6EB372C5D10C82C120369B0D7716A3D1884C3A9D0E2 B160F0D9E21AE64BD5E7377653018C0E7F3A1DBEDB2E2D0201A8D62B55A716751 AD56A1691A52A9145AAD16AB0F0C5E95DFEFC762B140AFD743BFDFA773A552099 94C86D6327706EF7031126F9C4C2649334D9366230F5FE0C8209FCFC3300CFA2F E9BA4E5F91209BCDA25C2ED3FA8223039962B1885C2E87D96C86743A8D4422C13 B161F1B88AFC9EBF5D2E00B850296CB25EF587C6C20180E87381E8FDCC90067A0 D1EA483E13801D0000000049454E44AE42608200"; end function GetMessageBoxBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100023F02000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000001D449444154 484BB5954D4B024118C7FD0675280882A0BA77ED0B04D90788A053DF203A44509 720F3E02D48D0F410E5A9A0023B061D1414B2022F7AC98378F2FDDD5D77D77F3B 23B38C3BA344EC0EFC60F719FDFF1E9E19D1039717156C9D7E60F328ED2824D31 2C83EF05FE8F278AC67E70566B8AB029E09015BA3D188621806745D87A669180E 875055158AA250068301FAFD3E7ABD1EBADD2E3A9D0EA5DD6EA3D56AA1D96CCE1 61866B0118D423383593813D8C399800F6F341A7201EBDC88C5E81CF5FBBB89EE C3E1F054F870A9C01A8BD91D569781930D606509AAF945BE73FB68F8CE99A05EA F8B02DA39C1EF03BCEBC0CF2EB0BD06EDF2828613649DF32493491A5EABD5E402 BD5C0616E78137EF58F0BE032CCC412995A49DDBE7CEC2A50272638C5088CEDEC E3018A4E1B2AE197CF7D56A5514B0EBC81F2A7F63A6CD9D1D2A1F5EA954A60BEC E17F3D543EBC6C8E5A10D8C3F9EEEDE1B2B993F099824C26E32882209BCD3A8A2 0C8E7F3C8E572787AB8C1F363843E93DA9E2F85E3EB84C5BE3F25ADF37B044150 2814F0FD95C655E090F2F539AE9D851288C7E316E45D56E7F70882A064FE988AC 5225E5F6E29E499D40E02699C471216E45D56E7F70882809CBC93080276AF9D62 42E0FA9FBE7B0BF805EA9D74EABD7884450000000049454E44AE42608200"; end function GetClientBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100024803000089504E470D0A1A0A0000000D4948445200000020000000200806 000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000002DD49444154 5847E5974D48625114C7FD2C050D5A0D6582BB206D5704BA2FB086D9369B16D14 A0884419C4D9B8A362DFA90C036B3ACE508439160B3B195820E2444398892227E 64A5D5301FF59FCE9DB9F5F469D4F4D2C5083FDEC377DFB9BF7BDF79EFDC2BBBF DA116B95C0E8BC502ABD58ACECE4EA452298C8C8CC06432E1E2E202575757FFCC B7EFBFA01AF3DD219B9B9BC3432C2C2CA0582CBE9CC0F9F9391EC3F0F0F0CB08F 4F5F58133383888A1A1A1BA747575C16C364B2FA0D7EBC1D9DEDE463C1E6F4822 91C0E5E565DDC08F452470747404CED9D919C2E13056575725C7E3F12093C9880 5767676C0C9E7F3585C5C646F415B5B9B64A8542A16331289880584AF5F281462 021A8D067B7B7BD8DFDF9784E5E56516FF4902E974BAEE337C2A94339B9B9B8D0 57A7A7AC0A106520B100F0A944A2510272727A8542ACD17585B5B03E7F8F8B8F9 02949D9C97C801E24181959515705A3203A7A7A720280FE833DB7401FE06188D4 6D6A0E9027481D3921C502814E0B444C0EFF783C36B41530584E596AA61D305DA DBDB4150A7548AFFBF246CB9C0ECEC2C38C9649209A8D56ACCCFCF63696949122 627271B0B704BAADB04090867454A1A0A50C7548EE9787878C816A742B6B6B6AA CE0D068328B8DD6EAF6A578F42A1D058C0ED76231A8DB2733E2BFC1AD5886C36C BAEEFEEEEA2BBBB5B2440FB06120806836C10545FE85E1E8F1F494039FA512CE0 F57AD1DBDB8B582C76D798A0458ACBE562A3D66AB56C8159DB3941E55CA954B2F CE9E8E8407F7F3F028140552C8204D4AF7D508EFD9190E5723936C2838303F63D A01B690442736A4323DBD8D8600BCC99991926353D3D0D87C301A7D3C96690127 77D7D1D3E9F8F2D46CBE5B248E0C7CF6BBC7AFBE96E166434EA8989094C4D4D41 A7D3B1D10C0C0C546D42E8584BA3FF85083BE65CDFDCC0F6EEF3FD0C08A75188C D66639BD27A419EC3CDADC0FB0F5FA01AFD9B03F4DC6A3BA7E7393E3ECE36A5F5 823C0712887C2D42FB86047CF80D6DF21A10823FEDBD0000000049454E44AE426 08200"; end function GetClipboardBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100020802000089504E470D0A1A0A0000000D4948445200000020000000200806 000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000019D49444154 5847ED97BDAE82401085EF3B51FB083C02ADBDF1052809893D3DB1B1A4A72194D 426141616143674985861CEC4F1EEAE2BFBE35ADCE49EE42430333B7E597659FC 991D753C1EE7AEEB249F4EA747D65D4E00C330CC511469ED0BE10C10C7F1CB8F2 3869C8F9C1F4168BD004CD3243DDFEBF54AF1CBE522C575E659C018317EBBDD28 AE930470381C5EA6B82C4BCAE9A65E356A208C11E3ABD56AAEAA8A72AA2480ED7 64B03D6EBF5D36DDB520ED762539DD334A55A8C117B20C770AA24002EC6B48512 7A31A04EFF005F07C08EC0A2B45A842680F3F94C395FEBB6A33500E73EB16E3B5 A01F47D4F71E43F317AA8DBD10A00F70CE02BEE018BFABB005C6B729665541F1C 20499267C3256F361BAA0F0E80930F7193C771A47A5C070570557000ECE7A2288 CE6D3343800373399C70407C0EAC6BDC94DD3507D7000570507A8EB5AFBCC61E4 54390188CD201D00377B67555600EAC724BCDFEFB5004B6B80DF7EA2AC0050B4D BEDA466D8463A00575901BC9308806B5F7B03E04B061F13DCE013F3D9C0B20280 F0E6B3F973B2E43CCF1FDD7E650DF01DCDF31D7DD4021C9110D40A00000000494 54E44AE42608200"; end function GetServerBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100022402000089504E470D0A1A0A0000000D4948445200000020000000200806 000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000001B949444154 5847E596DF2B436118C7FD916EB840AE2853DBA424AD2C62C50DA1B9212D4949B 9A024CACAC5507EDCB8922DE7D8D62CC6C4D2C3F7FD9173CE76F2EE6CEF99F2A9 A7534FE73CEFE7BCEFA9F36DA316F3F7057266856EAEDF3C55FAF65D4C71C7556 07DB940A3FDF7D4D77ED75005BB33B418CB53D6A888C9766A0A0CF566D8C381CE 3445C326CD46B29E6A7AE481C23D7C16442E5265B1C20F55028978813D3037916 3DBDF0CE233793613524E6C0297A76576231E68049C3D16C37720D95A2BB2D9A9 E48BE8706C02477B2576D3E1EEB3E878437E3B0B5339D1E152E8E1DBB26213D8D 9E09656732FACCEF363C45B5B41CF790C5A04DCA84B4047290BE82C25015C7594 B200B64B07BE09C839B85AF14D00336A2DE69B40CB77C00D65015C7594B280CE5 23E021D5597800E7C13907F43E7AFD7370119E99CC1E65781E37D1E48920725D1 F106022816B2BE8891F960B39D19C1267075C62319C264B391B9F0FCE45574383 6010073DCB8B9F248A5A74FD16D0C79B4CEED075502606C80673AC4F2F1A0C11E F45293C32685BEE33866219E2BC572C976A248D19041C12E3EC04B053AD214193 46829E61EF15D05FCE2BF0B107D0115A294818AC7913B0000000049454E44AE42 608200"; end function GetQuotationBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100023B02000089504E470D0A1A0A0000000D4948445200000020000000200806 000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000001D049444154 5847ED97394B03511485FD0D76D636967682A56025F692CAD6522C1414042B2DE C44105404C115D1464923445C10255868E112251A09D9D4108C216872CD992579 73677C6FB24814F2C1859777CF3D3903F3669226624C9E25A879F6EE570ADE1C5 B00A7C15A16E76F07A81532CF4680FF1DA073ED512B1532CF8A0388CF0BA7F32D 22F36C04701D20F399A7F193380D1DC4B4EADA7C2AEAB036F7C78EE394CAE68C2 99D9F3C81EB00FDDEB0A5272BCF6ED898D2117B1CD701860F63969EAC067D5163 4A47EC71CABA07D66F52B47895D4AAAF7095A60E6B737FF53A65A84BC83C2BBE0 9A7CE5F8ABABA9C82BA0798BF4C167558CB9079561C00CC5CBC6AA542E6595500 B7C83C1B01AA0A10497F69A542E65976805C5E3F82BD3BCF451DD6388AE83921F 32C2B802F94A69EED904523167AD070440DC755808FC29B70E2D4FE87A57D39A8 15DF87163326628FA30CE00DBE53F796F5AA5BE60234ED2F9D7FACB1276A30835 920EE73A401468FE296CF28CF5E98FCD18CA12E813DF4B89E7B70A401C46A5B7A 503E720134D03A79A038AE020CEC4728F09635146AA0C58C9317471AA06325481 BB7F6F7BB5B300B0FD193630B8033DEBA704F23855F40898CFA21A3021EF0C297 DB5FDB44DF6B0BDB1A1CD1EFD70000000049454E44AE42608200"; end function GetLoginBitmapInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100020803000089504E470D0A1A0A0000000D4948445200000020000000200806 000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000029D49444154 5847C5963D6B15411486FD1DFE004150886015514965974604D122428CA0A0060 B3F8BA0285824A098221288123544441182A2588AA820162204AC2408C61051F0 A3D89D99E37D8E334BEE8733736F72F10903CB99F3BEFBEEEECCDCAC93FFCCAA0 27C740B3A5643DB01C6ECB80C9647A5A7DC21EB8B8D3AB8A6366AAEF9AE7CB203 3C772FA5B7D8A537DC5C6C93DDE5809C311774704D8D397AE8CD252BC03DFBB07 ADA13E69CAF36C35CE843934332C0922C57A6B7EC5D5FFD37F4847EB42992018E 99536A366D677D250DBD68D0A6880678E49EAAD1FE72C857F24183168F18D1009 7EC989A4CD9DBBE920F1AB478C48806D8531E509317F6B5AFE483062D1E31A201 36145BD5E487FBE92BF9A0418B478C6880BEB25F4D3A39EDD0A0C5234634C0493 3A2268FDD335FC9070D5A3C62440384EDD4C911CB918D36B57DA301DEBBF96A1D B4B310C302448B478C68001837936AB6A5DCE92B69E84583364532000C99E36AD 8536C9757EE8DAF36C31C3DF4A2C9212B00CCBA076ACC183087E5B43D2F57CC84 0EAEA985797A73C90EB02C5F65B4B6B03615BDD58D1A074F3F61A7E49B7CF7AA3 4C9005F6ABF69ACE8F05D19FCFEEF2B0FCADE725007D7D4C23CBDEC1CB429A201 E6EC93EAC67D45BF4CDA6959709FFC6C339FDDA2DCB077B43704E9781BDEB773D 5135DB5D7E597FCF63369E84513F4B173A465000441FCD6BDF3D5F6E10D061F1E A8154D01C2E9C7582B821F811AA90BC0A209DFBC5573A7F016F1C4BB7161D6050 8AF9EEFB7D68435C18E5A491580BD4B4256703B0B2E173CF1E61E9C29812A4058 F56CA36EC136E61E37ED8CAFAC0830608EE8247BB95B7086700F0EAD800628A46 C9AE816E1C42C6B7FA00116DD92160F99612D76936173B6EE4D6B8079F7418B23 E6B216BBC9453BAAF7FAFB8F8AC81F0139E1CCDA06E76D0000000049454E44AE4 2608200 "; end function registerproperties(ps); begin //dser := class(TVclDesigner); for i,v in ps do begin it := createobject( v,0); //RegComponentPropertyType(it); class(TPropGrid).RegCellRender(it); //dser.REGEditType(v); end end //*************red**register************************ function redregister(); begin classes := array( class(TDipaddr), class(TDmessagebox), class(TDEdit), // class(TDtrackbar), class(TDcomboBox), class(TDradiobtn), class(TDmemo), class(TDpassword), class(TDColorComboBox), ); class(TVclDesigner).RegestorClassItems(classes); ps := array( class(TGridCellEsAlignEdit), class(TGridCellTextEdit), class(TGridCellAlignEdit), class(TGridCellAnchorsEdit), class(TGridCellTabAlignEdit), class(TGridCellStringsEdit), class(TGridCellIntegersEdit), class(TGridCellColorBoxEdit), class(tGridCellMbbtnstyleEdit), class(tGridCellMbiconstyleEdit) ); registerproperties(ps); end function zhregister();begin classes := array( class(TDListBox), class(TDColorBox), class(TDCalendar), class(TDProgressBar), class(TDCheckBtn), class(TDDateTimePicker), class(TDTimePicker), ); o := class(TVclDesigner); o.RegestorClassItems(classes); ps := array( class(tGridCellDayOfWeekBoxEdit), class(TGridCellPairIntEdit), class(TGridCellPairSpliterTypeEdit), class(tGridCellAlignPosBoxEdit), class(TGridCellTreeViewDataEdit) ); registerproperties(ps); end function tablelines(str,n); begin lines := str2array(str,"\r\n"); r := ""; for i,v in lines do begin if not v then continue; r+=n; r+= v; r+="\r\n"; end return r; end function compileTsl(tsl); begin rts := ""; havekg := 0; for i := 1 to length(tsl) do begin vi := tsl[i]; if vi in array(" ","\t","\n","\r") then begin if havekg then begin end else begin havekg := true; rts+=vi; end end else begin rts+=vi; havekg := false; end end return rts; end function GetDCompObject(n); begin return class(TVclDesigner).GetClassItem(n); end function staticInit(); begin its := array(class(TDGroupBox){,class(TDCheckGroupBox),class(TDRadioGroupBox)}, class(TDForm),class(TDPanelForm), class(TDPanel),class(TDTimer),class(TDSpinEdit), class(TDPairSplitter),class(TDPairSplitterSide), class(TDPage),class(TDTabSheet), {class(TDHotKey),} class(TDImageList),class(TDMainMenu),class(TDPopUpMenu), class(TDMenu),class(TDBtn){,class(TDPopMenuBtn)},class(TDTreeView), class(TDOpenFileADlg),class(TDSaveFileADlg),class(TDInputQuerys), class(TDColorChoose),class(TDFontChoose),class(TDFolderChoose), class(TDToolBar),class(TDListView){,class(TDTSLDataGrid)},class(TDToolButton),{class(TDtoolsepbutton),}class(TDStatusBar), class(TDTray), class(TDActionList),class(TDAction),class(TDLabel), //class(TDSocketServer),class(TDSocketClient), class(TDClipBoard),class(TDQuotations),class(TDtlogincontrol) ); o := class(TVclDesigner); o.RegestorClassItems(its); ps := array( class(TGridCellBoolEdit), class(TGridCellColorEdit), class(TGridCellDirectoryEdit), class(TGridCellFileNameEdit), class(TGridCellNaturalEdit), class(TGridCellIntegerEdit), class(TGridCellLazyIntegerEdit), class(TGridCellStringEdit), class(TGridCellEventHandleEdit), class(TGridCellVariableEdit), class(TGridCellVariableTactionEdit), class(TGridCellVariableTrayEdit), class(TGridCellVariabletimagelistEdit), class(TGridCellVariabletmainmenuEdit), class(TGridCellVariabletpopupmenuEdit), class(TGridCellImagesEdit), class(TGridCellBitmapEdit), class(TGridCellIconEdit), class(TGridCellFontEdit), class(TGridCellhotkeyEdit), class(TGridCellSysCursorEidt), class(TGridCellStatusItemsEdit), class(TGridCellFileFilterEdit) ); registerproperties(ps); redregister(); zhregister(); 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 "0502000000060400000074797065000203000000696D670006040000006461746 10002AE04000089504E470D0A1A0A0000000D4948445200000040000000400806 000000AA6971DE000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000044349444154 785EED97794F135B1887FD307E00FFF25B98F811AE1A1313638C8991B82626AE1 4D9B4A514011716254A29B4A58085D28D0285B66C054190CB2D704590AD2082BE F64CCF603BF356A733530BD3F9254F1A867366DEDFD3E9148E408E4715405F733 6AA00FABA9FB5A54D45C30D2AA0B7694491A802D2151076CF1C48469A1C3052DF 0C43CF1B60B8A611865F5960B42D80AE2548127090F2FDCB02AC159C84E58B475 1A2D612BAF2571425206ABC8B166759C93B067B0B9374753C8A1140DE7DAC3497 68E31DBA231EC508D80958D1C25C56F34FD01DF12846C057570D5A98CBCAF5E37 4473C8A11403EDB58612E9BF557E98E7814238064A3FA025A3A916F61275D1D8F A204ECCE0CA2A559B8EF3E89A20490EC45C661BDEC1F5EF96D7B055D911CC5096 043BE16C91D419E0D3FB637E8517E142B40685401AA0055802AE0D008D8D9DB81 C8C622835C3934026656E7E0ED442B1882750CC14F63F437D2722804CCAE45F68 B27E25F18A22BC4E7C00B20B73B569E85DC195272A0057C8A7E464B73598C2ED1 1DE94776014B5BCB609A6C67066B9CB031B76974779BFE3639FA400BE4751AA02 AD40A8ED9203D1ACFDCFA3CAF682A1AC6CDB0F92D4A77A617590544D617A166D4 C81BB036768C2B82943E65CE4FE2BEB70E7AE7C3108A3DE0B8E7F8139EFFFCF4C CE9453601D3ABFF4265E8353A1C4BFD980926963F802160E69567B9E9D4A37B85 E098F5C33D4FEDFEB92EDBF5B163213A211ED90498A7ECE85018773D1570AEB53 0A9F8596B01DC761BD0F542D1F8AA92CEC95219B4D229F99145C0FF021F568994 0DD6407E6CE01BDD6590D7A5055DEC676C5DBA9073611274032666566E6411D03 71F4487C9069ADE6A5400A1E9BD87993731B20868089BD161B2C5A577A5A80082 71C2CDCCCC46B280A5AD1574886C72CFFB142D4F38632980A995086D238300E6A 98E0C916DCED9921FB28914F7BDA16D6410E09EEB4707C836A91E862C9D1F034C 1FC902DE8C5BD101B2CDEF3E06846B8E4AD8DAFD2A4DC0987B1ABD3841D7FF024 ABD5550D86D80626705687B9F4379A0165D9B09B4032FD1E289B44C7AA50918F2 4CF22E5CE67F098F3ACBE181ED098F87ED5A28EA8ECBE0EECB04173B4AD0E22C5 762FF878CBAA6C50B18F486932E48DE71AC38C613DFB3A4BD99E096B31C2D9E48 5FE7A87801FDDEE1FD8B153A0C68D1DF916909857DCFD0D289D86D7EF1027C3D2 1E6428F7BAAD18242201F19EEE07272C6A2418BB3989A5DD204E807627FD3B7EB D07242287157A283CBC5F9B622B4388BD1D42D5E80B767088A5D4FD16242D174E 832FAED70D9AE85D3E64729796B728A175067F781C62EFCC1978A22570394FA2C 19E181C30B579B6753526DEA172FA0A3EB23DCB7E9D152E970DB624387FB1B900 EA205B4754DA185D2E58EF5153ADCDF409200A37D006EB60CCAC2F5963174C04C 234900D98C9DF430A10A5005A8025401AA002902948068014A431520548092E18 62720D7A20AA0AF399B1C1700F01309B59D2D832D152F0000000049454E44AE42 608200"; 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 GetHostroyBimp(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 100021901000089504E470D0A1A0A0000000D4948445200000010000000100806 0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA864000000AE49444154 384FB591B10A83301884FBFE90277010CCE412870412F00D9C5DB2677472C816A EFC2196BF1A6AB5F4839FBB1B7204EE01C6388EC57DCFFF0B628C98E719D33465 A5CC392DA087DE7BA494B252E61C0AF6A794C2BAAEAFA3CC792BD8B0D616070CC 300E71C4208592973AA055AEBE2806559D0751D8410592973AA05FB6F7EA25AD0 F77D71E7540BA494C55D9C71A36DDBE22ECEB8618C41D334F96ECDC8B93523E7D 68C57F8B1007802C798CF8E2876C2280000000049454E44AE42608200"; end function GetDefaultIconInfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 10002F802000089504E470D0A1A0A0000000D4948445200000018000000180806 000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 BFC6105000000097048597300000EC300000EC301C76FA8640000028D49444154 484BED936F4813611CC785DEF5AE971115F45230712B36A6DBDCD6A84D4D72B69 486EFCA188D70A1D339655638DC422D6C36470441043333882010234248BBD38D 52DA91FFF722E8DED93004F1DBF35C3BB9C50D37B057F5852FF7F0BBDFEFFBB97 BEEB922FC65FD238034C7617D680889DA5AC1744D6BF9282760736909A9911124 EAEA10B75AB1EA74626360009BE130526E37123535885757633514C2462201ECE C6426B3250BF8DAD58569950A8C5E8FEFDDDD402C266B7A8FF6D05E3A23275940 2A1A45923CE102797246ABC5ACD18875970B69BA35C4743D67328125F716341A2 4954A61464E3901298703F0FB05F3CDCD9827301AC85454605EAD065F5A0A1417 0B4E9595E50F98FB96C4E38E2B5900D1F48D6898185C10E0FCB3161CE93F87A38 316F4B7D6EF3FE0C0ADD338D8ABC1A1A01EBD3E3B3E9A2AB1E6B88C343931B900 E99212AC284E916DD362EDC9D34C52B67601457E2502CB0134BC75E244D882939 E72B4365560D2ACC3944187C5C6467C329BB1A85060454942355A7C309DC57357 1FDAEF4CC2D8C1C2359CC46B86C78F9FDB99541980D41446EBB66B6308D8BC98D 21A30A3ABC444E77D8CBFE41063C969CDF8D1FB2D34849250B54C4373732693BA 07809AD6E990FDEE328C9DB3C2707DDF67F48CF24228BD5E0A7E4139A91BBC719 CE95916FA4565015CAC2727C0FF8A7C06E2F6D12D0166F0B2024C0CBDF0600B17 23102C0BF0BF8BE0F860150E0F98611A6BDA85FD09909AD6C550A96501A2E87FD 036710FC706AD026CDF01525198E3850F7A0FDD770E57A33C7CE3DBB200DBF036 AA823C2CB73918DA994CC21E00516972ECDEB03C6E44380263600FFD86518018A A6B6370FD2127F4D17E517901A492C2D4EE19D950A90A0614AAFF803D04FC02CB EAA6F9D1CC6EB10000000049454E44AE42608200"; end function createtslfunction(f); begin n := f["name"]; p := f["param"]; b := f["body"]; ps := ""; if ifarray(p) then begin len := length(p); for i:= 0 to len-1 do begin v := p[i]; if ifstring(v) then ps+=v; if i