unit utslvcldcomponents; interface uses utslvcldesignerresource, tslvcl; function registercomponenttodesigner(cls); type TDComponent = class() {** @explan(说明) 设计控件基类 **} public //注册设计控件 class function GetClassItem(n); begin if ifnil(n) then return fdcomponentobjects; return fdcomponentobjects[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 private fisiherted; finheritedparent; static fdcomponentobjects; protected fiscontainerdcmp; private //基础数据 fcomponentclassname; feventnametable; //消息处理表 FTreeNode; //树结点 FCwnd; //对应控件 FMenus; //菜单 FBitmap; FImgs; 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 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; ndp := nd.parent; if ndp then begin if f then begin dm := MessageBoxA("即将剪切:"+nd.Caption,"删除",(0x1 .| 0x30),nd.owner);// end else dm := MessageBoxA("即将删除:"+nd.Caption,"删除",(0x1 .| 0x30),nd.owner);// if dm<>1 then exit; d := nd.owner.Designer; if f then d.cutnode(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); end end function cutclick(o,e);virtual; //剪切节点 begin deleteorcut(o,1); end function pasteclick(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.pasttonode(nd); end function deleteclick(o,e);virtual; //控件删除操作 begin deleteorcut(o,0); 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":"删除","id":"delete","onclick":thisfunction(deleteclick)), ("type":"menu","caption":"复制","id":"copy","onclick":thisfunction(copyclick)), ("type":"menu","caption":"剪切","id":"cut","onclick":thisfunction(cutclick)), ("type":"menu","caption":"粘贴","id":"paste","onclick":thisfunction(pasteclick)), ("type":"menu","caption":"上移","onclick":thisfunction(MoveComponentUp)), ("type":"menu","caption":"下移","onclick":thisfunction(MoveComponentDown)) ); if not IsContainer() then r := select * from r where ["caption"]<>"粘贴" 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); 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(说明) 构造控件的构造函数 %% **} fiscontainerdcmp := true; 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(f);virtual; begin {** @explan(说明)获得改变的属性%% **} if FCwnd then return FCwnd.GetChangedPublish(f); 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,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 if inheritedparent then begin pcn := "("+inheritedparent+")"; end else pcn := ""; 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(说明) 设置控件节点被选择时候的操作 %% **} 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 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 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["virtual"] := true; r["param"] := array("o","e"); r["body"] := format(" {** @explan(说明) %s消息回调 %% @param(e)(tuievent) 消息对象 %% @param(o)(tcomponent) 组件 %% **} inherited; ",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 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 iIDYES then e.skip := true; inherited; "); end end type TDPanelForm = class(TDForm) {** @explan(说明) 主窗口 %% **} function WndClass();override; begin return class(TDCreatePanel); //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 GetPublishEvents();override; begin return array();//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();//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();//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();//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();//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();//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 设计控件 %% **} 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; 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,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; 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 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 "粘贴" end ; end function Create(AOwner);override; begin inherited; fiscontainerdcmp := false; 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); inherited; " ); 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("删除","粘贴","剪切") 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; 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; 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 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("删除","粘贴","剪切") end ; end function InToolBar();override; begin return false; end function WndClass();override; begin return Class(TTabSheet); end function Create(AOwner);override; begin inherited; end end type TDPage = class(TDComponent) function HitTip();override; begin return inherited; return "页面控件"; 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; end 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(TDTimer), class(TDImageList), class(TDClipBoard), class(TDMainMenu),class(TDPopUpMenu),class(TDMenu), class(TDOpenFileADlg),class(TDSaveFileADlg),class(TDInputQuerys), 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(tdsplitter), class(TDEdit), class(TDpassword), class(TDmemo), class(tdhighlighter), class(TDradiobtn), class(TDCheckBtn), class(TDcomboBox), class(TDListBox), class(TDListView), class(TDTreeView), 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.