unit utslvcldcomponents; interface uses utslvcldesignerresource, tslvcl; function registercomponenttodesigner(cls); function createtslfunction(f); type TDComponent = class() {** @explan(说明) 设计控件基类 **} protected static const cst_m_opentsf = "打开tsf文件"; static const cst_m_opentfm = "打开tfm文件"; static const cst_m_delete = "删除"; static const cst_m_copy = "复制"; static const cst_m_cut = "剪切"; static const cst_m_paste = "粘贴"; static const cst_m_moveup = "上移"; static const cst_m_movedown = "下移"; static const cst_m_closewindow = "关闭窗口"; static const cst_m_addmenu = "添加子菜单"; static const cst_m_addaction = "add action"; static const cst_m_savewindow = "保存窗口"; static const cst_tip_willcut = "即将剪切:"; static const cst_tip_willdelete = "即将删除:"; public //注册设计控件 class function GetClassItem(n); begin if ifnil(n) then return fdcomponentobjects; return fdcomponentobjects[n]; end class function GetClassItemext(n); begin if ifnil(n) then return fdcomponentobjectsext; return fdcomponentobjectsext[n]; end class function RegestorClassItems(its); begin {** @explan(说明) 注册组件 %% @param(its)(array of TDComponent) 组件数组 %% **} if not ifarray(fdcomponentobjects) then fdcomponentobjects := array(); for i,v in its do begin if (v is class(TDComponent) ) then begin o := createobject(v); n := o.dclassname(); if n and ifstring(n) then begin n := lowercase(n); fdcomponentobjects[n]:= o; end end end end class function RegestorClassItemsext(its); begin if not ifarray(fdcomponentobjectsext) then fdcomponentobjectsext := array(); if not ifarray(fdcomponentobjects) then fdcomponentobjects := array(); for i,v in its do begin if (v is class(TDComponent) ) then begin try o := createobject(v); n := o.dclassname(); except continue; end if n and ifstring(n) then begin n := lowercase(n); if fdcomponentobjects[n] then continue; fdcomponentobjectsext[n] := o; fdcomponentobjects[n]:= o; end end end end class function unregestorclassitemsext(n); begin if not fdcomponentobjectsext then return 0; reindex(fdcomponentobjectsext,array(n:nil)); reindex(fdcomponentobjects,array(n:nil)); end private Fexcludepropertys; fisiherted; finheritedparent; static fdcomponentobjects; static fdcomponentobjectsext; protected fiscontainerdcmp; fcomponentclassname; private //基础数据 feventnametable; //消息处理表 FTreeNode; //树结点 FCwnd; //对应控件 FMenus; //菜单 FBitmap; FImgs; function setexclude(r); begin //if r = Fexcludepropertys then return ; Fexcludepropertys := array(); if ifarray(r) then begin for i,v in r do begin Fexcludepropertys[v] := nil; end end end function excludepro(r); begin if ifarray(r) and Fexcludepropertys then reindex(r,Fexcludepropertys); return r; end function SetImgs(id); begin FImgs := id; end function GetImgs(); begin return FImgs; end function SetName(v); //设置componentname begin SetComponentName(v); end function GetName(v); //获得componentname 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 private //默认事件 FDefaultEvent; function GetDefalutEvent(); begin return feventnametable[FDefaultEvent]; 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 function opentfm(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.opentfm(); end end public function libs();virtual; begin {** @explan(说明)关联的unit ; **} return array("tslvcl"); end function InToolBar();virtual; begin {** @explan(说明) 工具栏按钮是否可用 **} return true; end function dclassname();virtual; begin {** @explan(说明) 控件类名称 该函数必须override%% **} if fcomponentclassname then return fcomponentclassname; fcomponentclassname := ComponentClass().classinfo()["classname"]; return fcomponentclassname; end function ComponentClass();virtual; begin {** @explan(说明) 控件类 %% **} return WndClass(); end function HitTip();virtual; begin {** @explan(说明)工具栏提示 该函数必须override%% **} return dclassname(); 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(f);virtual; begin {** @explan(说明) 是否可以容纳其他控件 %% **} return fiscontainerdcmp; 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();virtual; //bitmap信息 begin return getdefaultbmpinfo(); 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 GetDCompObject(n);//获得节点设计器 begin return GetClassItem(n); end function copyclick(o,e);virtual; //复制节点 begin cp:=o.Component; if not cp then exit; nd := cp.TreeNode; If not nd then exit; d := nd.owner.Designer; d.copynode(nd); end function deleteorcut(o,f); begin cp:=o.Component; if not cp then exit; nd := cp.TreeNode; If not nd then exit; tip := ""; if cp.isinherited then //继承而来的控件 begin tip := "\r\n该控件从继承而来,本次操作只能删除当前的属性设置\r\n要删除该控件需要从其所在的基类窗口中操作!"; end ndp := nd.parent; if ndp then begin if f=1 then begin dm := MessageBoxA(cst_tip_willcut+nd.Caption+tip,cst_m_delete,(0x1 .| 0x30),nd.owner);// end else if f=2 then begin dm := 1; end else dm := MessageBoxA(cst_tip_willdelete+nd.Caption+tip,cst_m_delete,(0x1 .| 0x30),nd.owner);// if dm<>1 then exit; if not nd.owner then exit; d := nd.owner.Designer; if f then d.cutnode(nd); else d.delnode(nd); wd := nd.Component.Cwnd; ds := nd.owner.Designer; 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); return true; end end function cutclick(o,e);virtual; //剪切节点 begin global g_script_can_set_not_focus := true; deleteorcut(o,1); g_script_can_set_not_focus := false; end function pasteclick(o,e);virtual; //粘贴节点 begin cp:=o.Component; if not cp then begin MessageBoxA("容器节点错误!","粘贴",0,nd.owner); exit; end nd := cp.TreeNode; If not nd then begin MessageBoxA("容器节点错误!","粘贴",0,nd.owner); exit; end global g_script_can_set_not_focus := true; d := nd.owner.Designer; case d.pasttonode(nd) of -1: begin MessageBoxA("粘贴内容为空!","粘贴",0,nd.owner); end 1: begin MessageBoxA(("粘贴控件到"$nd.Caption$"成功"),"粘贴",0,nd.owner); end else begin MessageBoxA(("粘贴控件到"$nd.Caption$"失败!\r\n请注意该节点是否能容纳粘贴控件"),"粘贴",0,nd.owner); end end ; g_script_can_set_not_focus := false; end function deleteclick(o,e);virtual; //控件删除操作 begin global g_script_can_set_not_focus := true; deleteorcut(o,(e=2)?2:0); g_script_can_set_not_focus := false; 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 ; //旧方法是三次节点重新插入 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 ; //旧方法是三次节点重新插入 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"]; 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 r := array( ("type":"menu","caption":cst_m_opentsf,"onclick":thisfunction(OpenClass)), ("type":"menu","caption":cst_m_opentfm,"onclick":thisfunction(opentfm)), ("type":"menu","caption":cst_m_delete,"id":"delete","onclick":thisfunction(deleteclick)), ("type":"menu","caption":cst_m_copy,"id":"copy","onclick":thisfunction(copyclick)), ("type":"menu","caption":cst_m_cut,"id":"cut","onclick":thisfunction(cutclick)), ("type":"menu","caption":cst_m_paste,"id":"paste","onclick":thisfunction(pasteclick)), ("type":"menu","caption":cst_m_moveup,"onclick":thisfunction(MoveComponentUp)), ("type":"menu","caption":cst_m_movedown,"onclick":thisfunction(MoveComponentDown)) ); if not IsContainer() then r := select * from r where ["caption"]<>cst_m_paste end; return r; 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 ifnil(o.dclassname()) then o.dclassname(self(true).dclassname()); o.imgs := imgs; 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(说明) 构造控件的构造函数 %% **} fisiherted := false; Fexludepropertys := array(); fiscontainerdcmp := true; feventnametable := array(); /////////////////////////////////////////////////////////////// pm := array(); pm[0] := ComponentClass(); pm[1] := new unit(utslvclevent).TMMouse(); ev := array( "event":"onmouseup", "name":"mouseup", "param":pm, "body":" {** @explan(说明) 鼠标弹起 %% **}"); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////////////// ev := array( "event":"onmousedown", "name":"mousedown", "param":pm, "body":" {** @explan(说明) 鼠标按下 %% **}"); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////////////// pm[1] := new unit(utslvclevent).tmm_move(); ev := array( "event":"onmousemove", "name":"mousemove", "param":pm, "body": " {** @explan(说明) 鼠标移动 %% **}"); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////////////// pm[1] := new unit(utslvclevent).TMKEY(); ev := array( "event":"onkeyup", "name":"keyup", "param":pm, "body": " {** @explan(说明) 按键弹起 %% **}"); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////////////// ev := array( "event":"onkeydown", "name":"keydown", "param":pm, "body": " {** @explan(说明) 按键按下 %% **}"); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////////////// pm[1] := new unit(utslvclevent).tmk_press(); ev := array( "event":"onkeypress", "name":"keypress", "param":pm, "body": " {** @explan(说明) 字符消息 %% **}"); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////////////// pm[1] := new unit(utslvclevent).tmmousewheel(); ev := array( "event":"onmousewheel", "name":"mousewheel", "param":pm, "body":""); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////////////// pm[1] := new unit(utslvclevent).tmnotif(); ev := array( "event":"onnotification", "name":"notification", "param":pm, "body": " {** @explan(说明) 通知消息 %% @param(msg)(any) 通知的内容 %% **}"); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////////////// pm[1] := new unit(utslvclevent).tmmeasuresize(); ev :=array( "event":"ongetpreferredsize", "name":"getpreferredsize", "param":pm, "body": " {** @explan(说明) 获取最佳的尺寸 %% **} ht := 100; wd := 200; " ); SetDefalutEvent(ev,true); ////////////////////////////////////////////////////// ev :=array( "event":"onclick", "name":"clk", "param":array(pm[0]), "body": " {** @explan(说明) 点击回调 %% **} " ); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////////////// ev :=array( "event":"onrclick", "name":"rclk", "param":array(pm[0]), "body": "" ); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////// ev :=array( "event":"ondblclick", "name":"dblclk", "param":array(pm[0]), "body":"" ); SetDefalutEvent(ev,true); /////////////////////////////////////////////////////// ev :=array( "event":"onkillfocus", "name":"killfocus", "param":array(pm[0]), "body":"" ); SetDefalutEvent(ev,true); ////////////////////////////////////////////////////// ev :=array( "event":"onsetfocus", "name":"setfocus", "param":array(pm[0]), "body":"" ); SetDefalutEvent(ev,true); //////////////////////////////////////////////////////// ev :=array( "event":"onfontchanged", "name":"fontchanged", "param":array(pm[0]), "body":""); SetDefalutEvent(ev,true); ////////////////////////////////////////////////////////// ev :=array( "event":"onpaint", "name":"paint", "param":array(pm[0]), "body": " {** @explan(说明) 自绘制 %% **} " ); SetDefalutEvent(ev,true); //////////////////////////////////////////////////////////////////////////// ev :=array( "event":"oncreated", "name":"crt", "param":array(pm[0]), "body": " {** @explan(说明) 构造 %% **} " ); SetDefalutEvent(ev,true); ////////////////////////////////////////////////////////////////////////// ev :=array( "event":"ondestroy", "name":"destroy", "param":array(pm[0]), "body": " {** @explan(说明) 销毁 %% **} " ); SetDefalutEvent(ev,true); //////////////////////////////////////////////////////////////////////// pm[1] := new unit(utslvclevent).tmcontextpop(); ev :=array( "event":"onpopupmenu", "name":"popmenu", "param":pm, "body": " {** @explan(说明) 弹出右键菜单 %% **} " ); SetDefalutEvent(ev,true); ////////////////////////////////////////////////////////////////// pm[1] := new unit(utslvclevent).tminqurequit(); ev :=array( "event":"oninqurequit", "name":"inqurequit", "param":pm, "body": " {** @explan(说明) 询问退出 %% **} "); SetDefalutEvent(ev,true); ////////////////////////////////////////////////////////////// pm[1] := new unit(utslvclevent).tmactivate(); ev :=array( "event":"onactivate", "name":"activate", "param":pm, "body": " {** @explan(说明) 窗口activate状态切换 %% **} "); SetDefalutEvent(ev,true); ////////////////////////////////////////////////////////////// ev :=array( "event":"onsize", "name":"size", "param":array(pm[0]), "body":" {** @explan(说明) 窗口大小改变 %% **}"); SetDefalutEvent(ev,true); ////////////////////////////////////////////////////////////////////// ev :=array( "event":"onmove", "name":"move", "param":array(pm[0]), "body":" {** @explan(说明) 位置改变 %% **}"); SetDefalutEvent(ev,true); ////////////////////////////////////////////////////////////////////// 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(f);virtual; begin {** @explan(说明)获得改变的属性%% **} if FCwnd then return FCwnd.GetChangedPublish(f); return array(); end function GetPublishProperties();virtual; begin {** @explan(说明)获得所有的属性%% **} if FCwnd then begin ps := FCwnd.GetPublishProperties(); r := excludepro(ps); if inheritedparent then return r; if fisiherted then reindex(r,array("name":nil)); return r; end return array(); end function GetPublishEvents();virtual; begin {** @explan(说明)获得改变事件回调属性%% **} if FCwnd then return excludepro(FCwnd.GetPublishEvents()); end function DefaultAlign();virtual; begin return false; end function destroy();virtual; begin FTreeNode := nil; FCwnd := nil; end function SetComponentProperties(n,v,pp); begin {** @explan(说明)修改属性%% **} if FCwnd then begin if n="name" then begin return SetComponentName(v); end else return FCwnd.SetPublish(n,v,pp); 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 := dclassname(); obj.name := v; if v=(obj.name) then begin if TreeNode then begin pcn :=""; if inheritedparent then begin pcn := "("+inheritedparent+")"; end else begin if fisiherted then pcn := "<"; end TreeNode.caption := v+":"+cn+pcn; end 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(说明) 设置控件节点被选择时候的操作 %% **} ///////////////处理节点为page的情况/////////////////////////////////////////// acwnd := FCwnd; while (acwnd is class(TWincontrol)) and acwnd.parent do begin p := acwnd.parent; if (p is class(TPageControl)) then begin p.cursel := acwnd; end acwnd := p; end /////////////////////////////////////////////////////// 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 := dclassname(); 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; if obj.Name<>nn then continue; SetComponentProperties("caption",nn); oname := nn;//obj.name; end end if TreeNode then begin if not(inheritedparent) and fisiherted then begin cn := cn+"<"; end TreeNode.caption := oname+":"+cn; end end return nn; end function SetDefalutEvent(ev,ndf); begin if ifarray(ev) then hs := createtslfunction(ev); if not(hs) and not(ndf) then //清除默认 begin FDefaultEvent := nil; return ; end r := "type ca = class\r\n "$hs$"\r\nend"; if CheckTslCode(r,err) then begin feventnametable[ev["event"]] := ev; if not ndf then FDefaultEvent := ev["event"]; end else begin //echo tostn(ev),"\r\n",r; end 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(ComponentClass(),new tuieventbase()); r["body"] := format(" {** @explan(说明) %s消息回调 %% **} ",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) 图标序号,不需要使用 %% **} private published property isinherited read fisiherted write set_isinherted;//为继承做准备 property inheritedparent read finheritedparent write finheritedparent; property excludepropertys read Fexcludepropertys write setexclude; private function set_isinherted(v); begin fisiherted := v; end 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 //************TImageList*********************** type TDVirutalWindow = class(TCustomControl) //无窗口控件的虚拟窗口 {** @explan(说明) 非可视控件的窗口容器 %% **} private fminusfileds; 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 fminusfileds := array(); FWindowFileds := array("left","top","height","width"); inherited; ignore_childsizing := true; width := 30; height := 30; end function paint();override; begin //canvas.draw("polyline",array((0,0),(20,0),(20,20),(0,20))); canvas.StretchDraw(array(1,1,width-3,height-3),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); r := (r union r2); end return minus_fileds(r); end function GetPublishEvents();override; //获得消息处理函数 begin r := array(); if FBindComponent then begin r := FBindComponent.GetPublishEvents(); return r; end return r; end function GetChangedPublish(f);override; //获得改变的属性 begin r := getnotnil(inherited); if not FBindComponent then exit; r2 :=FBindComponent.GetChangedPublish(f); if r2 then begin deletefiled(r2); r union= r2; end return minus_fileds(r); return r; end function SetPublish(n,v,pp);override; //设置属性 begin if n in FWindowFileds then begin return inherited; end if FBindComponent then begin return FBindComponent.SetPublish(n,v,pp); end end function DesigningSizer();override; //鼠标改变大小 begin return false; end function Recycling();override; begin inherited; FBindComponent := nil; end property BindComp read FBindComponent write SetBindComponent; property WindowFileds read FWindowFileds write FWindowFileds; property minusfileds read fminusfileds write fminusfileds; {** @param(BindComp)(tcomponent) 绑定的控件 %% @param(WindowFileds)(array of string) 容器控件替代的属性 %% **} private function minus_fileds(r); begin ds := array(); for i,v in fminusfileds do begin if ifstring(v) and v then ds[lowercase(v)] := nil; end if ds then begin reindex(r,ds); end return r; 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 Recycling();override; //回收 begin FDesigner := nil; inherited; end function create(AOwner);override; begin inherited; asdomain := true; FDesigner := AOwner; nodecreator := class(TComponentTreeNode); 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 function getndbyname(n,nd); begin if not nd then nd := GetRootNode(); if n=nd.Component.name then return nd; for i := 0 to nd.ItemCount-1 do begin r := getndbyname(n,nd.GetNodeByIndex(i)); if r then return r; end return nil; 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 TDForm = class(TDComponent) {** @explan(说明) 主窗口 %% **} private function closecurrentform(o,e); //关闭当前窗口 begin cp := o.Component; cp.Cwnd._send_(o.WM_CLOSE,0,0,1); end 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(); end end public function menus();override; begin r := array(); r := inherited; r := select * from r where ["caption"] in array(cst_m_opentfm,cst_m_opentsf,cst_m_paste) end; idx := length(r); //r[idx++] := array("type":"menu","caption":cst_m_opentsf,"onclick":thisfunction(OpenClass)); r[idx++] := array("type":"menu","caption":cst_m_closewindow,"onclick":thisfunction(closecurrentform)); r[idx++] := array("type":"menu","caption":cst_m_savewindow,"onclick":thisfunction(savecurrentform)); //r[2] := array("type":"menu","caption":"打开工程目录","onclick":thisfunction(openProjectDir)); return r; end function CheckParent(dcomp,Pwnd);override; begin pwnd := 0;//initializeapplication().GetApplicationWindow();; return 1; 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 function HitTip();override; begin return "主窗口\r\n在工具栏file\r\nfile manager中管理"; end function dclassname(v);override; begin if ifstring(v) and v then begin fcomponentclassname := v; end return fcomponentclassname; end function bitmapinfo();override; begin return getformbitmapinfo(); end function WndClass();override; begin return class(tdcreateform); end function create(AOwner);override; begin inherited; pm := array(); pm[0] := ComponentClass(); pm[1] := new unit(utslvclevent).tmclose(); DefaultEvent := array( "event":"onclose", "name":"close", "param":pm, "body":" {** @explan(说明) 主窗口关闭回调 %% **}"); end end type TDPanelForm = class(TDForm) {** @explan(说明) 主窗口 %% **} function WndClass();override; begin return class(TDCreatePanel); end function create(AOwner);override; begin inherited; end end type TDMenu = class(TDMenuBase) {** @explan(说明) 普通菜单设计器控件 %% **} function HitTip();override; begin return inherited; return "menu通过右键添加"; end function classification();override; begin return "隐藏" ; end function InToolBar();override; begin return false; end function WndClass();override; begin return class(tmenu); 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 implementation 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 TDFileWindow = class(TDVirutalWindow) {** @explan(说明) 文件选择容器 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TOpenFileADlg(self);; 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 bitmapinfo();override; begin return GetSaveFileBitmapInfo(); end end type TDColorChooseWindow = class(TDVirutalWindow) {** @explan(说明) 颜色选择控件窗口 %% **} public function Create(AOwner);override; begin inherited; BindComp := new TColorChooseADlg(self);; 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 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 bitmapinfo();override; begin return GetFolderChooseBitmapInfo(); end end type TImageListWindow = class(TDVirutalWindow) {** @explan(说明) imagelist 容器窗口 %% **} public function Create(AOwner);override; begin inherited; width := 30; height := 30; WindowFileds := array("left","top","width","height"); BindComp := new TControlImageList(self);; end function bitmapinfo();override; begin return GetImageListBitmapInfo(); end end type TDImageList = class(TDRootComponent) {** @explan(说明)imagelist 设计控件 %% **} function HitTip();override; begin return inherited; return "图像列表"; end function bitmapinfo();override; begin return GetImageListBitmapInfo(); end function IsContainer();override; begin return false; end function ComponentClass();override; begin return class(TControlImageList); end function WndClass();override; begin return Class(TImageListWindow); end function Create(AOwner);override; begin inherited; end function GetPublishProperties();override; begin r := inherited; r := r[ array("name","top","left","images","imgwidth","imgheight")]; return r; end end //******************label******************* type TGraphicLabelWindow = class(TDVirutalWindow) {** @explan(说明) label 控件替代窗口 %% **} function paint();override; begin bd := BindComp; if not bd then return ; cvs := canvas; //if not bd.ParentFont then cvs.Font := bd.Font; bd.canvas.Handle := cvs.Handle; bd.Font := Font; bd.width := width; bd.height := height; bd.paint(); //canvas.Font := font; //al := BindComp.TextAlign; //BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al); end function GetPreferredSize(w,h);override; begin bd :=BindComp; if not bd then return ; c := bd.Caption; ft := Font; w := length(c)*ft.width+2; h := ft.height+2; end function SetPublish(n,v,pp);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; ignore_childsizing := false; Parentcolor := true; BindComp := new tlabel(self); width := BindComp.width; height := BindComp.Height; WindowFileds := array("left","top","width","height","autosize","color","parentcolor","font","parentfont","border","visible","align","anchors"); end function DesigningSizer();override; begin return true; end end type TGraphicbevelWindow = class(TDVirutalWindow) {** @explan(说明) tbevel 控件替代窗口 %% **} function paint();override; begin cv := canvas; bd := BindComp; if not bd.Parentcolor then begin c := ClientRect; cv.brush.color := bd.color; cv.fillrect(c); end bd.width := width; bd.height := height; bd.canvas.Handle := cv.Handle; bd.paint(); end function FontChanged(o);override; begin if autosize then AdjustSize(); end function SetPublish(n,v,pp);override; begin r := inherited; if n="bkbitmap" then bkbitmap := v; if (n="font" or n="bkbitmap" or n="style" or n="shape") then InvalidateRect(nil,true); return r; end function Create(AOwner);override; begin inherited; ignore_childsizing := false; Border := false; Parentcolor := true; bd := new tbevel(self); bd.Caption := ""; width := bd.width; height := bd.Height; BindComp := bd; WindowFileds := array("left","top","width","height","font","parentfont","visible","align");//,"parentcolor" minusfileds := array("caption","popupMenu","action","border","anchors"); end function DesigningSizer();override; begin return true; end end type TGraphicsplitterWindow = class(TDVirutalWindow) {** @explan(说明) label 控件替代窗口 %% **} function paint();override; begin //canvas.Font := font; //al := BindComp.TextAlign; //BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al); dc := canvas; r := ClientRect; clr := 0x123232; x := integer(r[0]+(r[2]-r[0])/2); y := integer(r[1]+(r[3]-r[1])/2); sz := 4; sp := 5; for j :=(0 -sz) to sz do begin for i:=(0 -sz) to sz do begin x1 := x+sp*i; y1 := y+sp*j; if x1>r[0] and x1r[1] and y1 cst_m_paste end ; end function Create(AOwner);override; begin inherited; excludepropertys := array("childsizing","wssizebox","wscaption","wspopup","wssysmenu","onclose","onactivate"); fiscontainerdcmp := false; DefaultEvent := array( "event":"onclick", "name":"clk", "param":array(ComponentClass()), "body":" {** @explan(说明) 点击回调 %% @param(sender)(tbtn)按钮对象 %% **}"); end end //*****************TPairSplitter******************************* type TDPairSplitterSide = class(TDComponent) function HitTip();override; begin return inherited; return "PairSplitterSide\r\n在splitter控件中右键添加"; end function classification();override; begin return "隐藏" ; end function menus();override; begin r := inherited; return select * from r where ["caption"] in array(cst_m_delete,cst_m_paste,cst_m_cut,cst_m_opentsf,cst_m_opentfm) end ; end function InToolBar();override; begin return false; end function bitmapinfo();override; begin return getsplitersiderbitmapinfo(); 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; excludepropertys := array("childsizing","wssizebox","wscaption","wspopup","wssysmenu","onclose","onactivate"); end end type TDPairSplitter = class(TDComponent) function HitTip();override; begin return inherited; return "成对分配器"; 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 WndClass();override; begin return Class(TPairSplitter); end function CheckChild(dcmp);override; begin return dcmp is Class(TDPairSplitterSide); end function Create(AOwner);override; begin inherited; excludepropertys := array("autosize"); 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 function HitTip();override; begin return inherited; return "pagesheet\r\n在page控件中右键添加"; end function classification();override; begin return "隐藏"; end function SelectedNode();override; begin return inherited; 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 getsheetbitmapinfo(); end function menus();override; begin r := inherited; return r; //return select * from r where ["caption"] in array(cst_m_delete,cst_m_paste,cst_m_cut) end ; end function InToolBar();override; begin return false; end function WndClass();override; begin return Class(TTabSheet); end function Create(AOwner);override; begin inherited; excludepropertys := array("autosize","wssizebox","wscaption","wspopup","wssysmenu","onclose","onactivate"); end end type TDtabctl = class(TDComponent) function HitTip();override; begin return inherited; end function bitmapinfo();override; begin return "900200000000000000020000000200000001000000900100003C0000000000000 004000000040000000400000008000000030000000B0000004901000074797065 64617461696D6789504E470D0A1A0A0000000D494844520000003000000030080 60000005702F987000000017352474200AECE1CE90000000467414D410000B18F 0BFC6105000000097048597300000EC300000EC301C76FA864000000DE4944415 46843ED974B0A84301005E782AE3D8A37F602FEF193C1452443C274DA9179ADBC 82DA3D2585A0F872378701681880E639015555B9A22854EED7A039025207CC114 D14904B187195679EA8A9805D2D3F07D475FD55ED4ECBF302B66DCBD2EF538709 D5EEB44401EBBA66E9F7A9C3846A775AA2806559B2F47B84E1DB2A0A98E739CBB 22C3F6EFA6F3D51C0344DA61503C67134AD18300C8369C580BEEF4D2B06745D67 5A31A06D5BD38A014DD398560CB88B9E23E0CC1F19CAE497F8AE30000D03D0300 00D03D030000D03D030000D03D030000D03D030008B736F04D94E768181B63200 00000049454E44AE426082"; end function WndClass();override; begin return Class(ttabcontrol); end function Create(AOwner);override; begin inherited; pm := array(ComponentClass()); //teventdrawtab DefaultEvent := array( "event":"onselchanged", "name":"selchanged", "param":pm, "body":" {** @explan(说明) 标签成功切换 %% **}"); /////////////////////////////////////////// ev := array( "event":"onclosebtnclick", "name":"cbtnclk", "param":pm, "body":" {** @explan(说明) 关闭按钮点击 %% **}"); SetDefalutEvent(ev,1); /////////////////////////////////////////// pm[1] := new unit(utslvclpage).tmtabmeasure(); ev := array( "event":"onmeasuretabwidth", "name":"measuretabwidth", "param":pm, "body":" {** @explan(说明) 测量标签宽度 %% **}"); SetDefalutEvent(ev,1); /////////////////////////////////////////// pm[1] := new unit(utslvclpage).teventdrawtab(); ev := array( "event":"ondrawtab", "name":"drawtab", "param":pm, "body":" {** @explan(说明) 绘制标签 %% **}"); SetDefalutEvent(ev,1); /////////////////////////////////////////// pm[1] := new unit(utslvclpage).tmtabselchanging(); ev := array( "event":"onselchanging", "name":"selchging", "param":pm, "body":" {** @explan(说明) 切换标签 %% @param(nselidx)(integer) 新选入的标签 %% **}"); SetDefalutEvent(ev,1); end end type TDPage = class(TDtabctl) function HitTip();override; begin return inherited; 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 WndClass();override; begin return Class(TPageControl); end function Create(AOwner);override; begin inherited; excludepropertys := array("childsizing"); end end function c1param(v); ////var alias ,type begin r := ""; if not ifarray(v) then return r; a := v["alias"]; if not ifstring(a) then a := v["name"]; if not ifstring(a) then return r; if v["var"] then r := "var "$a; else r := a; t := v["type"]; if ifstring(t) then r+=":"$t; return r; end function createtslfunction(f); begin n := f["name"]; p := f["param"]; b := f["body"]; ps := ""; if ifarray(p) and p then begin ps := array(); len := length(p); sd := false; vd := false; for i := 0 to len-1 do begin v := p[i]; if (v is class(tuieventbase)) and (vd=false) then //消息 begin vd := true; vi := "evnt:"$v.classinfo()["classname"]; ps[length(ps)] := vi; for j,vj in v.expandinfo() do begin pvj := c1param(vj); if pvj then ps[length(ps)] := pvj; end end else if (v is class(tcomponent)) and (sd=false) then //控件 begin sd := true; vi := "sender:"$v.classinfo()["classname"]; ps[length(ps)] := vi; end else if ifstring(v) and v then ps[length(ps)] := v; //其他 end ps := array2str(ps,"; "); end hs := nil; vt := ""; if f["virtual"] then vt := "virtual;"; if ifstring(n) and ifstring(b) then begin if n="destroy" or n="create" then n := "_"+n; hs := "\r\n function "+n+"("+ps+");"+vt+"\r\n begin\r\n"+b+"\r\n\ end\r\n"; end return hs; end function registercomponenttodesigner(cls); begin {** @explan(说明) 注册控件到设计器 %% @param(cls)(TDComponent) 设计控件 %% **} if ifarray(cls) then return class(TDComponent).RegestorClassItems(cls); return class(TDComponent).RegestorClassItems(array(cls)); end function staticinit(); begin its := array( class(TDForm),class(TDPanelForm), class(TDPanel),class(TDGroupBox), class(TDPairSplitter),class(TDPairSplitterSide), class(TDPage),class(TDTabSheet),class(TDtabctl), class(TDTimer), class(tdworkerctl), class(TDImageList), class(TDClipBoard), class(tdgraphicsctl), class(TDMainMenu),class(TDPopUpMenu),class(TDMenu), class(TDOpenFileADlg),class(TDSaveFileADlg), class(TDColorChoose),class(TDFontChoose),class(TDFolderChoose), class(TDcoolBar),class(TDToolBar),class(TDStatusBar),class(TDToolButton), class(TDTray), class(TDActionList),class(TDAction), //class(TDQuotations),class(TDtlogincontrol), class(TDmessagebox), class(TDBtn), class(TDLabel), class(TDbevel), class(tdsplitter), class(TDEdit), class(TDpassword), class(TDmemo), class(tdwrapmemo), class(tdhighlighter), class(TDradiobtn), class(TDCheckBtn), class(TDcomboBox), class(TDListBox), class(TDListView), class(TDTreeView), class(TDgridctl), class(TDProgressBar), class(TDDateTimePicker), class(TDTimePicker), class(TDCalendar), class(TDSpinEdit), class(TDipaddr), class(TDColorComboBox), class(TDColorBox), ); o := class(TDComponent); o.RegestorClassItems(its); end initialization staticinit(); end.