diff --git a/designer/tslvcldesigner.tsf b/designer/tslvcldesigner.tsf index 4ff9f1d..47bb440 100644 --- a/designer/tslvcldesigner.tsf +++ b/designer/tslvcldesigner.tsf @@ -3,855 +3,17 @@ unit tslvclDesigner; @explan(说明)设计器库 %% **} interface -uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclbase,utslvclgdi,tslvcl,UVCPropertyTypesPersistence,utslmemo,UDesignerProject; +uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclbase,utslvclgdi,utslvcldcomponents,utslvcldpropertytypes,tslvcl,UVCPropertyTypesPersistence,utslmemo,UDesignerProject; //*******设计控件基类********************** //**********设计控件类************ -function registereditpropertytodesigner(cls); -function registercomponenttodesigner(cls); -type TDComponent = class() -{** - @explan(说明) 设计控件基类 -**} - private //基础数据 - feventnametable; - FMenuDel; - 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%% - **} - r := ComponentClass().classinfo()["classname"]; - return r; - 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();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 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 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 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 cutclick(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 := MessageBoxA("即将剪切:"+nd.Caption,"删除",(0x1 .| 0x30),nd.owner);// - if dm<>1 then exit; - d := nd.owner.Designer; - d.cutnode(nd); - 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 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 - cp:=o.Component; - if not cp then exit; - nd := cp.TreeNode; - If not nd then exit; - ndp := nd.parent; - if ndp then - begin - dm := MessageBoxA("即将删除:"+nd.Caption,"删除",(0x1 .| 0x30),nd.owner);// - 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 - 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(说明) 构造控件的构造函数 %% - **} - 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); - 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 := dclassname(); - 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 := 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; - 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["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 - -//************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(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); - 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();//array(1:nil); - 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 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; - FBindComponent := nil; - end - property BindComp read FBindComponent write SetBindComponent; - property WindowFileds read FWindowFileds write FWindowFileds; - {** - @param(BindComp)(tcomponent) 绑定的控件 %% - @param(WindowFileds)(array of string) 容器控件替代的属性 %% - **} - -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 TVclDesigner = class(tvcform) {** @explan(说明) 控件设计器 对象 %% **} private - fcutcopyinfo;// - FChmHelper; + fcutcopyinfo;//复制的信息 + FChmHelper; //帮助文档 tmpcanvas; //canvas FImageList; //图标 FViewBitmap; @@ -907,7 +69,7 @@ type TVclDesigner = class(tvcform) {** @explan(说明)添加工具栏 %% **} - for i,v in FClassItems do + for i,v in class(TDComponent).GetClassItem() do begin FImageList.RegisterDitem(v); //if not v.InToolBar() then continue; @@ -927,9 +89,9 @@ type TVclDesigner = class(tvcform) begin //extheight := CaptionHeight()+MenuBarHeight(); clc := array(); - if FClassItems and ifarray(FClassItems) then - begin - for i,v in FClassItems do + //if FClassItems and ifarray(FClassItems) then + //begin + for i,v in class(TDComponent).GetClassItem() do begin cli := v.classification; if not(cli and ifstring(cli)) then cli := "常用"; @@ -939,8 +101,8 @@ type TVclDesigner = class(tvcform) mx := 0; for i,v in clc do mx := max(mx,v); height := (integer(mx*32/twidth)+1)*32+60+30{+24}+5; - end else - height := 90+32{+24}+5; + //end else + // height := 90+32{+24}+5; end function TreeNode2tfmsub(lib,node,itemnames);//tmf文件字符串 @@ -1011,7 +173,6 @@ type TVclDesigner = class(tvcform) end end end - function createmainmenubyarray(ms,pm,oer); begin if not(ifarray(ms) and ms) then exit; @@ -1423,33 +584,6 @@ type TVclDesigner = class(tvcform) 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 - o := createobject(v); - n := o.dclassname(); - if n and ifstring(n) then - begin - n := lowercase(n); - FClassItems[n]:= o; - end - //RegisterComponentType(n,FClassItems[n].ComponentClass()); - end - end - - end //**************************************** function CreateComponent(); //构造句柄 begin @@ -1510,39 +644,6 @@ type TVclDesigner = class(tvcform) //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 {** @@ -1817,7 +918,7 @@ type TVclDesigner = class(tvcform) if not ifarray(d) then exit; if not d["type"]=p.TT_COMP then exit; dcls := d["class"]; - it := GetClassItem(dcls); + it := class(TDComponent).GetClassItem(dcls); if not it then begin if ("tdcreateform" in FLoadInheritedName) then @@ -2113,5292 +1214,6 @@ 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 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 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 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 dclassname();override; - begin - return "tcontrolimagelist"; - end - function menus();override; - begin - r := inherited; - //r[length(r)] := array("type":"menu","caption":"编辑","onclick":nil); - return r; - 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 TGraphicsplitterWindow = 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="color" then color := v; - //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 tsplitter(self); - width := BindComp.width; - height := BindComp.Height; - color := BindComp.color; - WindowFileds := array("left","top","width","height","color","parentcolor","visible","enabled","border","align"); - end - - function DesigningSizer();override; - begin - return true; - end -end - -type TDLabel = class(TDComponent) -{** - @explan(说明) label控件 %% -**} - function HitTip();override; - begin - return inherited; - return "静态文本框"; - end - function IsContainer();override; - begin - return false; - end - function ComponentClass();override; - begin - return class(tlabel); - end - function dclassname();override; - begin - return "tlabel"; - end - - function WndClass();override; - begin - return Class(TGraphicLabelWindow); - end - function bitmapinfo();override; - begin - return getlabelbitmapinfo(); - end - function Create(AOwner);override; - begin - inherited; - end -end -type tdsplitter = class(TDComponent) -{** - @explan(说明) label控件 %% -**} - function HitTip();override; - begin - return inherited; - end - function IsContainer();override; - begin - return false; - end - function ComponentClass();override; - begin - return class(tsplitter); - end - function dclassname();override; - begin - return "tsplitter"; - end - - function WndClass();override; - begin - return Class(TGraphicsplitterWindow); - end - function bitmapinfo();override; - begin - return getsplitterbitmapinfo(); - 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 设计器控件 %% -**} - function HitTip();override; - begin - return inherited; - return "定时器"; - end - - function bitmapinfo();override; - begin - return GetTimerBitmapInfo(); - end - function IsContainer();override; - begin - return false; - end - function ComponentClass();override; - begin - return class(TTimer); - end - function dclassname();override; - begin - return "ttimer"; - end - function menus();override; - begin - r := inherited; - //r[length(r)] := array("type":"menu","caption":"编辑","onclick":nil); - return r; - 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 ThighlighterWindow = class(TDVirutalWindow) -{** - @explan(说明) 主菜单容器窗口 %% -**} - public - function Create(AOwner);override; - begin - inherited; - BindComp := new thighlighter(self); - end - function bitmapinfo();override; - begin - return gethighlighterbitmapinfo(); - 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(说明) 文件打开控件 %% -**} - function HitTip();override; - begin - return inherited; - 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 - function dclassname();override; - begin - return "topenfileadlg"; - end - - function WndClass();override; - begin - return Class(TDFileWindow); // - end - function Create(AOwner);override; - begin - inherited; - end - -end -//***********savefile*************************** -type TDSaveFileADlg = class(TDRootComponent) -{** - @explan(说明) 文件打开控件 %% -**} - 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 - function dclassname();override; - begin - return "tsavefileadlg"; - 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(说明) 文件打开控件 %% -**} - function HitTip();override; - begin - return inherited; - 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 - function dclassname();override; - begin - return "tinputquerys"; - end - - function WndClass();override; - begin - return Class(TDInputQuerysWindow); // - end - function Create(AOwner);override; - begin - inherited; - end - -end - -//***********colorchoose******************************* -type TDColorChoose = class(TDRootComponent) -{** - @explan(说明) 文件打开控件 %% -**} - 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 - function dclassname();override; - begin - return "tcolorchooseadlg"; - end - - function WndClass();override; - begin - return Class(TDColorChooseWindow); // - end - function Create(AOwner);override; - begin - inherited; - end -end -//*************font choose ********************************** -type TDFontChoose = class(TDRootComponent) -{** - @explan(说明) 文件打开控件 %% -**} - 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 - function dclassname();override; - begin - return "tfontchooseadlg"; - end - - function WndClass();override; - begin - return Class(TDFontChooseWindow); // - end - function Create(AOwner);override; - begin - inherited; - end -end -//**************folder********************* -type TDFolderChoose = class(TDRootComponent) -{** - @explan(说明) 文件打开控件 %% -**} - 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 - function dclassname();override; - begin - return "tfolderchooseadlg"; - end - - function WndClass();override; - begin - return Class(TDFolderChooseWindow); // - end - function Create(AOwner);override; - begin - inherited; - end -end - -//****************toolbar*********************************** -type TDToolButton = class(TDComponent) -{** - @explan(说明) toolbar 按钮设计控件 %% -**} - function HitTip();override; - begin - return "toolbutton"; - end - function classification();override; - begin - return "非点击添加控件" ; - end - function dclassname();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 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 - function HitTip();override; - begin - return inherited; - return "工具栏"; - end - function DefaultAlign();override; - begin - return true; - end - function dclassname();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 bitmapinfo();override; - begin - return gettoolbarbitmapinfo(); - 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 TDcoolBar = class(TDComponent) -{** - @explan(说明) toolbar 设计器控件 %% -**} - public - function HitTip();override; - begin - return inherited; - end - function DefaultAlign();override; - begin - return true; - end - function dclassname();override; - begin - return "tcoolbar"; - end - - function menus();override; - begin - r := inherited; - return r; - end - function CheckChild(CD);override; - begin - return true; - //return cd is class(TDToolButton); - end - - function bitmapinfo();override; - begin - return getcoolbarbitmapinfo(); - end - function WndClass();override; - begin - return Class(TcoolBar); - 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设计器控件 %% -**} - function HitTip();override; - begin - return inherited; - return "状态栏"; - end - function dclassname();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 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 tdhighlighter = class(TDRootComponent) -{** - @explan(说明) 语法高亮设计器控件 %% -**} - function dclassname();override; - begin - return "thighlighter"; - end - function bitmapinfo();override; - begin - return gethighlighterbitmapinfo(); - end - function ComponentClass();override; - begin - return class(thighlighter); - end - function WndClass();override; - begin - return Class(ThighlighterWindow); - end - function Create(AOwner);override; - begin - inherited; - end - -end -type TDTray = class(TDRootComponent) -{** - @explan(说明) 托盘设计器控件 %% -**} - function HitTip();override; - begin - return inherited; - return "托盘"; - end - function dclassname();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 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(说明) 主菜单设计器控件 %% -**} - function HitTip();override; - begin - return inherited; - return "主菜单"; - end - function ComponentClass();override; - begin - return class(tmainmenu); - end - function dclassname();override; - begin - return "tmainmenu"; - end - - function bitmapinfo();override; - begin - return GetMainMenuBitmapInfo(); - end - function CheckParentWnd(Pwnd);override; - begin - return (Pwnd is class(TVCForm)) ; - end - - function WndClass();override; - begin - return Class(TMainMenuWindow); - 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 dclassname();override; - begin - return "tmenu"; - 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 -type TDAction = class(TDComponent) -{** - @explan(说明) action设计器控件 %% -**} - function HitTip();override; - begin - return inherited; - return "taction通过右键添加"; - 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 - - function dclassname();override; - begin - return "taction"; - 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 设计器控件 %% -**} - 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 - function dclassname();override; - begin - return "tactionlist"; - 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(说明) 弹出菜单控件 %% -**} - function HitTip();override; - begin - return inherited; - return "右键菜单"; - end - function libs();override; - begin - return array("tslvcl"); - end - function ComponentClass();override; - begin - return class(tpopupmenu); - end - function dclassname();override; - begin - return "tpopupmenu"; - end - function bitmapinfo();override; - begin - return GetPopUpMenuBitmapInfo(); - end - function WndClass();override; - begin - return Class(TPopUpMenuWindow); - end - function Create(AOwner);override; - begin - inherited; - end - -end - -//*****************clipboard******************** -type TDClipBoard = class(TDRootComponent) - function HitTip();override; - begin - return inherited; - return "剪切板"; - end - function libs();override; - begin - return array(); - end - function classification();override; - begin - return "常用"; - end - function ComponentClass();override; - begin - return class(TClipBoard); - end - function dclassname();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) - function HitTip();override; - begin - return inherited; - return "行情订阅"; - end - function libs();override; - begin - return array(); - end - function ComponentClass();override; - begin - return class(TQuotations); - end - function classification();override; - begin - return "天软"; - end - function dclassname();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) - 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 - function dclassname();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(说明) 弹出菜单控件 %% -**} - 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 - function dclassname();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(说明) 弹出菜单控件 %% -**} - 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 - function dclassname();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(说明) 树形设计控件 %% -**} - function HitTip();override; - begin - return inherited; - return "树控件"; - end - function dclassname();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 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 设计器控件 %% -**} - function HitTip();override; - begin - return "SpinEdit"; - end - function IsContainer();override; - begin - return false; - end - function dclassname();override; - begin - return "tspinedit"; - 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 设计器控件 %% -**} - function HitTip();override; - begin - return inherited; - return "列表视图控件"; - end - function IsContainer();override; - begin - return false; - end - function dclassname();override; - begin - return "tlistview"; - end - - function bitmapinfo();override; - begin - return getlistviewbitmapinfo(); - 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 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 -type TTSLDataGrid=class(TDrawGrid) - {** - @ignore(忽略) %% - @explan(说明)TSL数组和对象展示 %% - **} - private - - 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); - 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 .| DT_VCENTER .| DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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 .| DT_VCENTER .| DT_SINGLELINE); - 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 .| DT_VCENTER .| DT_SINGLELINE); - 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_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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 TGridCellVariablehgtEdit = class(TGridCellVariabletimagelistEdit) - Function EditType();override; - begin - return "thighlighter"; - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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(TcustomBitmap) )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(tcustomicon)) 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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 -type TGridCellLazystrEdit = class(TGridCellStringEdit) //后处理信息 - function CreateEditer(AOwner);override; - begin - return new TGridCellLazystrEdit(AOwner); - end - function EditType();override; - begin - return "lazystr"; - 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 - - -//*************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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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.|DT_VCENTER); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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();override; - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); - 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 - return FDesigner.openclassfile();// - 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 Notification_rename(o,op);override; - begin - inherited; - if {HandleAllocated() and} ifarray(op) and (op["type"]="possize") and (FComponent is class(TDComponent)) and (FComponent.Cwnd = o) then - begin - dt := TSLData; - - flg := op["flag"]; - if ifarray(dt) then - begin - for i,v in mrows(dt,1) do - begin - if (flg .& 1) and v="left" then - begin - CellChanged(i,1,"value",op["data"][0]); - end - if (flg .& 2) and v="top" then - begin - CellChanged(i,1,"value",op["data"][1]); - end - if (flg .& 4) and v="width" then - begin - CellChanged(i,1,"value",op["data"][2]); - end - if (flg .& 8) and v="height" then - begin - CellChanged(i,1,"value",op["data"][3]); - end - end - return 1; - 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(说明) 属性编辑 %% @@ -7507,7 +1322,7 @@ type TDesigImageList = class(TControlImageList) begin addbmp(bmp); FIconMaps[n] := ImageCount-1; - end + end end end end @@ -7523,165 +1338,8 @@ type TDesigImageList = class(TControlImageList) 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 TDesignertoolbars = class(TPageControl) private FToolbars; @@ -7762,1726 +1420,10 @@ type TDesignertoolbars = class(TPageControl) end -//*************设计器********************************* - -type TBitmapGrid = class(TGridList) -{** - @explan(说明) imagelist编辑 %% -**} - public - function CheckItem(v);override; - begin - return (v is class(TcustomBitmap)) 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 tnone = class() - function create(); - begin - name := "(none)"; - end - name; - -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.dclassname() =FStyle ; - end - end - end - function SetFilter(v); - begin - FFilter.FStyle:=v; - dofilter(); - return ; - 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 -//**********red**DControl***************************** - -type TDedit= class(TDComponent) - function HitTip();override; - begin - return inherited; - return "文本框控件"; - end - function bitmapinfo();override; - begin - return "0502000000060400000074797065000203000000696D670006040000006461746 -10002D201000089504E470D0A1A0A0000000D4948445200000018000000180806 -000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA8640000016749444154 -484BED93B18AC2401445D30BDAA51214044997C6D680A2A435D8DB59FA0D0BFE4 -26C52588B9FB06065C02A453A0B9580A50A12B5D03477796F278B59571CC16CE5 -8107F74E60CE304314A4CC5BF090FF117C0C3F539984E0D53C2598CD6668B7DBA -225511485E7777E4A309D4E619AA6687F136F1C735710451156AB1576BB9D5849 -0A96CB25C230E47C8D9460B15840D775B45A2D94CB650C06035E2741B55A85655 -93C854201B66DF3B71829C17EBFC7F178E44CB252A9C49904994C06411070DF6C -36505515DBED963B2125A0EB711C079D4E874F9CCBE5789D048661708EA9D56A7 -05D57344941AFD743B7DBC57C3EC7E1704808EAF53AE7984AA502DFF7459314D0 -29279309E7F1789C1064B359ACD76BEE9EE7A1582CE272B97027A404A3D108F97 -C1ECD6613FD7E9F1F93A0FFA0D168F0E3D3D5699A96B81E424A40D0A9CEE7B368 -B79C4E2791BEA18DE3CDAFF35DC1ABB811A4313F8234790B1E92B200F80266B31 -3963A1FCCDB0000000049454E44AE42608200"; - 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) - function HitTip();override; - begin - return inherited; - 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; - function dclassname();override; - begin - return "tmemo"; - 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) - function HitTip();override; - begin - return inherited; - return "密码框"; - end - function bitmapinfo();override; - begin - return "0502000000060400000074797065000203000000696D670006040000006461746 -10002F300000089504E470D0A1A0A0000000D4948445200000024000000240806 -000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA8640000008849444154 -5847ED91010A80300845BD795DA48374BA859065C36644A163FFC18789321E4A2 -51910F2809007843CF20A4DCB1A1AE12214C5D8424474C4AA99B00D69094DBF42 -44F3FEBABE6B9ECF41C89B7B29C49FB622583D9D1A9C8CF945883F6D45B07A3A3 -538193396D0D7A4106209895533611BBAA31FA1C808E7219300210F087940A84D -291BB496CCEA5B2547890000000049454E44AE42608200"; - end; - function dclassname();override; - begin - return "tpassword"; - 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) - 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; - function dclassname();override; - begin - return "ttrackbar"; - 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) - function HitTip();override; - begin - return inherited; - return "下拉选择框"; - end - function bitmapinfo();override; - begin - return "0502000000060400000074797065000203000000696D670006040000006461746 -100023501000089504E470D0A1A0A0000000D4948445200000024000000240806 -000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA864000000CA49444154 -5847ED92C109C42010452D45F094A385A4A65461135660375EEC220797C92ABBD -90C314AD4ECE0838F8387CF6318E61FC6104AB1139AE7B969300E427772D6D755 -C839B7BD409CB3859665294E04FAD675F5D33479A5D41698E1AF9B1060ADF59CF -32D3003D94277F0DD07225106E82EF4CB65A196C1A8BAA13386508A2221C6D82D -D15A87C60F343654131A42D83D5C8D3126B4E0D0D8504D680861B791132965683 -A42634335A12184DD45698410A1F50D8D0DD5E47F855A066327F40486508A2174 -8EF72FB778FABEB46AB5F60000000049454E44AE42608200"; - end; - function dclassname();override; - begin - return "tcombobox"; - 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) - function HitTip();override; - begin - return "颜色下拉选择框"; - end - function bitmapinfo();override; - begin - return "0502000000060400000074797065000203000000696D670006040000006461746 -100023001000089504E470D0A1A0A0000000D4948445200000024000000240806 -000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA864000000C549444154 -5847EDD1DF09C32010C77147F13513640AD7C81A9DC2453A45B7F0C52D7CB039F -1A0A1FEC9859C49E03EF02392807C6955BC1909EAD904196386AEE42FE84CADFB -E841EFD7F165789FF73E3D019EE941CBFAE9E832B82F8410A7698AD6DA3438C3B -BCB8280732E6AADD3E00CE841A5BF62EFB2DFFB200463003DE804ADFB76078D5C -09EB2FD4F2FC20B5F00C49506D881CC44D827AE8416AFDC4B14C82AACBE841CC2 -4A8871C347F66962109AA0D9183B84950CF738346AE6413740712D416E317FE0C -479C51B569C20000000049454E44AE42608200"; - end; - function dclassname();override; - begin - return "tcolorcombobox"; - end - - function WndClass();override; - begin - return Class(tcolorcombobox); - end - function Create(AOwner);override; - begin - inherited; - end -end -type TDradiobtn = class(TDComponent) - - function HitTip();override; - begin - return inherited; - 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; - - function dclassname();override; - begin - return "tradiobtn"; - end - - function WndClass();override; - begin - return Class(tradiobtn); - end - function Create(AOwner);override; - begin - inherited; - end -end -type TDipaddr= class(TDComponent) -{** - @explan(说明)ip设计控件%% -**} - function HitTip();override; - begin - return inherited; - 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; - function dclassname();override; - begin - return "tipaddr"; - end - - function WndClass();override; - begin - return Class(tipaddr); - end - function Create(AOwner);override; - begin - inherited; - end - -end -type TDmessagebox = class(TDRootComponent) - function HitTip();override; - begin - return "提示框"; - end - function bitmapinfo();override; - begin - return GetMessageBoxBitmapInfo(); - end; - - function classification();override; - begin - return "对话框"; - end - function dclassname();override; - begin - return "tmessageboxadlg"; - end - function ComponentClass();virtual; - begin - {** - @explan(说明) 控件类 %% - **} - return class(tmessageboxadlg); - 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();//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 - function HitTip();override; - begin - return inherited; - return "列表框"; - end - function dclassname();override; - begin - return "tlistbox"; - 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 - function HitTip();override;begin - return "颜色列表框"; - end - function dclassname();override;begin - return "tcolorbox"; - 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) - public - function isContainer();override; - begin - return 0; - end - function HitTip();override; - begin - return inherited; - return "日历"; - end - function dclassname();override;begin - return "tmonthcalendar"; - 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 - function HitTip();override;begin - return inherited; - return "进度条"; - end - function dclassname();override;begin - return "tprogressbar"; - 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 - function HitTip();override;begin - return inherited; - return "复选框"; - end - function dclassname();override;begin - return "tcheckbtn"; - 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 - function HitTip();override;begin - return inherited; - return "时间日期选择"; - end - function dclassname();override;begin - return "tdatetimepicker"; - 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 - function HitTip();override;begin - return inherited; - return "时间选择"; - end - function dclassname();override;begin - return "ttimepicker"; - end - - function WndClass();override;begin - return Class(ttimepicker); - end - function Create(AOwner);override;begin - inherited; - end - function bitmapinfo();override;begin - r := gettimepickerbitmapinfo(); - 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(pasteclick)); - //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 - function HitTip();override; - begin - return "主窗口\r\n在工具栏file\r\nfile manager中管理"; - end - function dclassname(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 getformbitmapinfo(); - 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 WndClass();override; - begin - return class(TpanelForm); - //return class(TDCreatePanel); - end - function create(AOwner);override; - begin - inherited; - end -end -//**************TPanel************************** -type TDPanel = class(TDComponent) - function HitTip();override; - begin - return inherited; - return "容器控件"; - end - - function dclassname();override; - begin - return "tpanel"; - end - function bitmapinfo();override; - begin - return "0502000000060400000074797065000203000000696D670006040000006461746 -10002CA00000089504E470D0A1A0A0000000D4948445200000024000000240806 -000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA8640000005F49444154 -5847EDD7B109C0300C05D1ECBF812AADA94EC1453A91AB4C1CB80F571ABDD6571 -F36413441B41194991D115B5B37A68DA0F5A0AAB6B66E4C13F42488124409A204 -5182284194204A1025881244FD1B74DC47F1CB09A2097A5FF70DF185865E9BB41 -DE30000000049454E44AE42608200"; - 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控件 -**} - function HitTip();override; - begin - return inherited; - return "分组框"; - end - function dclassname();override; - begin - return "tgroupbox"; - end - - function bitmapinfo();override; - begin - return "0502000000060400000074797065000203000000696D670006040000006461746 -100020B01000089504E470D0A1A0A0000000D4948445200000018000000180806 -000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 -BFC6105000000097048597300000EC300000EC301C76FA864000000A049444154 -484BCD91510A83301044BD92782B2F90DF9CA11F3D8FED358A7894C8424736B0A -43B89A11978B0129D67922975CE7F04EB732FC2E41284F0B8B04A35FA5D0B9D4C -8058A59A52A4E7BDBDBE4F86E0383ED548F138821863F6B107B740CAE5AC2199E -7E527940012CC5E28410DE3EC80BD035A0009662F94A0867176C0DE81400920C1 -EC8512D4E012C8620B45C15D980289FE9356904CD0239D05299D037BBA604E978 -76D0000000049454E44AE42608200"; - end - - function WndClass();override; - begin - return Class(tgroupbox); - end - function Create(AOwner);override; - begin - inherited; - end - -end -//*****************Check GroupBox************************ -type TDBtn = class(TDComponent) - function HitTip();override; - begin - return inherited; - return "按钮"; - end - function IsContainer();override; - begin - return false; - end - function dclassname();override; - begin - return "tbtn"; - end - function bitmapinfo();override; - begin - return getbtnbitmapinfo(); - end; - function WndClass();override; - begin - return Class(tbtn); - end - function menus();override; - begin - r := inherited; - return select * from r where ["caption"] <> "粘贴" end ; - 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) - function HitTip();override; - begin - return inherited; - return "PairSplitterSide\r\n在splitter控件中右键添加"; - end - function dclassname();override; - begin - return "tpairsplitterside"; - 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 dclassname();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 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 dclassname();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 getsheetbitmapinfo(); - 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 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 dclassname();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 WndClass();override; - begin - return Class(TPageControl); - end - function Create(AOwner);override; - begin - inherited; - end -end type TViewBitmap = class(TvcForm) {** @explan(说明) 图片信息采集%% @@ -9591,135 +1533,11 @@ type TViewBitmap = class(TvcForm) end end end -function GetDCompObject(n); -begin - return class(TVclDesigner).GetClassItem(n); -end -///////////////////图片资源代码////////////////// -function registerproperties(ps); -begin - for i,v in ps do - begin - it := createobject( v,0); - class(TPropGrid).RegCellRender(it); - end -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 iv 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); + 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 := dclassname(); + 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 := 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; + 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["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) 图标序号,不需要使用 %% + **} + 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; +"); + end +end +type TDPanelForm = class(TDForm) +{** + @explan(说明) 主窗口 %% +**} + + function WndClass();override; + begin + return class(TpanelForm); + //return class(TDCreatePanel); + end + function create(AOwner);override; + begin + inherited; + 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);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); + end + function SetPublish(n,v);override; + begin + r := inherited; + //if n="color" then color := v; + //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 tsplitter(self); + width := BindComp.width; + height := BindComp.Height; + color := BindComp.color; + WindowFileds := array("left","top","width","height","color","parentcolor","visible","enabled","border","align"); + end + + function DesigningSizer();override; + begin + return true; + end +end + +type TDLabel = class(TDComponent) +{** + @explan(说明) label控件 %% +**} + function HitTip();override; + begin + return inherited; + end + function IsContainer();override; + begin + return false; + end + function ComponentClass();override; + begin + return class(tlabel); + end + function WndClass();override; + begin + return Class(TGraphicLabelWindow); + end + function bitmapinfo();override; + begin + return getlabelbitmapinfo(); + end + function Create(AOwner);override; + begin + inherited; + end +end +type tdsplitter = class(TDComponent) +{** + @explan(说明) label控件 %% +**} + function HitTip();override; + begin + return inherited; + end + function IsContainer();override; + begin + return false; + end + function ComponentClass();override; + begin + return class(tsplitter); + end + function WndClass();override; + begin + return Class(TGraphicsplitterWindow); + end + function bitmapinfo();override; + begin + return getsplitterbitmapinfo(); + 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 设计器控件 %% +**} + function HitTip();override; + begin + return inherited; + return "定时器"; + end + + function bitmapinfo();override; + begin + return GetTimerBitmapInfo(); + end + function IsContainer();override; + begin + return false; + end + function ComponentClass();override; + begin + return class(TTimer); + 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 ThighlighterWindow = class(TDVirutalWindow) +{** + @explan(说明) 主菜单容器窗口 %% +**} + public + function Create(AOwner);override; + begin + inherited; + BindComp := new thighlighter(self); + end + function bitmapinfo();override; + begin + return gethighlighterbitmapinfo(); + 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(说明) 文件打开控件 %% +**} + function HitTip();override; + begin + return inherited; + 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 + function WndClass();override; + begin + return Class(TDFileWindow); // + end + function Create(AOwner);override; + begin + inherited; + end + +end +//***********savefile*************************** +type TDSaveFileADlg = class(TDRootComponent) +{** + @explan(说明) 文件打开控件 %% +**} + function HitTip();override; + begin + return "文件保存选择"; + end + function bitmapinfo();override; + begin + return GetSaveFileBitmapInfo(); + end + function classification();override; + begin + return "对话框"; + end + function ComponentClass();override; + begin + return class(TSavefileADlg); + 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; + fiscontainerdcmp := false; + end + +end +//************querys************************************** +type TDInputQuerys = class(TDRootComponent) +{** + @explan(说明) 文件打开控件 %% +**} + function HitTip();override; + begin + return inherited; + return "数据输入对话框"; + end + function bitmapinfo();override; + begin + return GetInputquerysBitmapInfo(); + end + function classification();override; + begin + return "对话框"; + end + function ComponentClass();override; + begin + return class(TInPutQuerys); + end + function WndClass();override; + begin + return Class(TDInputQuerysWindow); // + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end + +end + +//***********colorchoose******************************* +type TDColorChoose = class(TDRootComponent) +{** + @explan(说明) 文件打开控件 %% +**} + function HitTip();override; + begin + return "颜色选择"; + end + function bitmapinfo();override; + begin + return GetColorChooseBitmapInfo(); + end + function classification();override; + begin + return "对话框"; + end + function ComponentClass();override; + begin + return class(TColorChooseADlg); + end + function WndClass();override; + begin + return Class(TDColorChooseWindow); // + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end +end +//*************font choose ********************************** +type TDFontChoose = class(TDRootComponent) +{** + @explan(说明) 文件打开控件 %% +**} + function HitTip();override; + begin + return "字体选择"; + end + function classification();override; + begin + return "对话框"; + end + function bitmapinfo();override; + begin + return GetFontChooseBitmapInfo(); + end + + function ComponentClass();override; + begin + return class(TFontChooseADlg); + end + function WndClass();override; + begin + return Class(TDFontChooseWindow); // + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end +end +//**************folder********************* +type TDFolderChoose = class(TDRootComponent) +{** + @explan(说明) 文件打开控件 %% +**} + function HitTip();override; + begin + return "目录选择"; + end + function classification();override; + begin + return "对话框"; + end + function bitmapinfo();override; + begin + return GetFolderChooseBitmapInfo(); + end + function ComponentClass();override; + begin + return class(TFolderChooseADlg); + end + function WndClass();override; + begin + return Class(TDFolderChooseWindow); // + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end +end + +//****************toolbar*********************************** +type TDToolButton = class(TDComponent) +{** + @explan(说明) toolbar 按钮设计控件 %% +**} + function HitTip();override; + begin + return "toolbutton"; + end + function classification();override; + begin + return "非点击添加控件" ; + 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 WndClass();override; + begin + return Class(TToolButton); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + 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 + function HitTip();override; + begin + return inherited; + return "工具栏"; + end + function DefaultAlign();override; + begin + return true; + 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)); + return r; + end + function CheckChild(CD);override; + begin + return cd is class(TDToolButton); + end + + function bitmapinfo();override; + begin + return gettoolbarbitmapinfo(); + 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 TDcoolBar = class(TDComponent) +{** + @explan(说明) toolbar 设计器控件 %% +**} + public + function HitTip();override; + begin + return inherited; + end + function DefaultAlign();override; + begin + return true; + end + function menus();override; + begin + r := inherited; + return r; + end + function CheckChild(CD);override; + begin + return true; + //return cd is class(TDToolButton); + end + + function bitmapinfo();override; + begin + return getcoolbarbitmapinfo(); + end + function WndClass();override; + begin + return Class(TcoolBar); + 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设计器控件 %% +**} + function HitTip();override; + begin + return inherited; + return "状态栏"; + 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 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 Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end + +end +type tdhighlighter = class(TDRootComponent) +{** + @explan(说明) 语法高亮设计器控件 %% +**} + function bitmapinfo();override; + begin + return gethighlighterbitmapinfo(); + end + function ComponentClass();override; + begin + return class(thighlighter); + end + function WndClass();override; + begin + return Class(ThighlighterWindow); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end + +end +type TDTray = class(TDRootComponent) +{** + @explan(说明) 托盘设计器控件 %% +**} + function HitTip();override; + begin + return inherited; + return "托盘"; + end + function menus();override; + begin + r := inherited; + //r[length(r)] := array("type":"menu","caption":"添加工具栏按钮","onclick":thisfunction(addtoolbutton)); + return r; + 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; + fiscontainerdcmp := false; + 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(说明) 主菜单设计器控件 %% +**} + function HitTip();override; + begin + return inherited; + return "主菜单"; + end + function ComponentClass();override; + begin + return class(tmainmenu); + end + function bitmapinfo();override; + begin + return GetMainMenuBitmapInfo(); + end + function CheckParentWnd(Pwnd);override; + begin + return (Pwnd is class(TVCForm)) ; + end + + function WndClass();override; + begin + return Class(TMainMenuWindow); + 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 +type TDAction = class(TDComponent) +{** + @explan(说明) action设计器控件 %% +**} + function HitTip();override; + begin + return inherited; + return "taction通过右键添加"; + 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 + 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; + fiscontainerdcmp := false; + end +end +type TDActionList = class(TDRootComponent) +{** + @expand(说明)actionlist 设计器控件 %% +**} + 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 + 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(说明) 弹出菜单控件 %% +**} + function HitTip();override; + begin + return inherited; + return "右键菜单"; + end + function ComponentClass();override; + begin + return class(tpopupmenu); + end + function bitmapinfo();override; + begin + return GetPopUpMenuBitmapInfo(); + end + function WndClass();override; + begin + return Class(TPopUpMenuWindow); + end + function Create(AOwner);override; + begin + inherited; + end + +end + +//*****************clipboard******************** +type TDClipBoard = class(TDRootComponent) + function HitTip();override; + begin + return inherited; + return "剪切板"; + end + function classification();override; + begin + return "常用"; + end + function ComponentClass();override; + begin + return class(TClipBoard); + end + function bitmapinfo();override; + begin + return GetClipboardBitmapInfo(); + end + function WndClass();override; + begin + return Class(TClipBordWindow); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end + + +end +//***********订阅************************ +type TDQuotations = class(TDRootComponent) + function HitTip();override; + begin + return inherited; + return "行情订阅"; + end + function ComponentClass();override; + begin + return class(TQuotations); + end + function classification();override; + begin + return "天软"; + end + function bitmapinfo();override; + begin + return GetQuotationBitmapInfo(); + end + function WndClass();override; + begin + return Class(TQuotationWindow); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end + + +end +//**************************** +type TDtlogincontrol = class(TDRootComponent) + function HitTip();override; + begin + return "登陆天软"; + end + function classification();override; + begin + return "天软"; + end + function ComponentClass();override; + begin + return class(tlogincontrol); + end + function bitmapinfo();override; + begin + return GetLoginBitmapInfo(); + end + function WndClass();override; + begin + return Class(TLoginWindow); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end + + +end + +//*************Server************************* +type TDSocketServer = class(TDRootComponent) +{** + @explan(说明) 弹出菜单控件 %% +**} + function HitTip();override; + begin + return "socket服务端"; + end + function classification();override; + begin + return "天软"; + end + function ComponentClass();override; + begin + return class(TSocketServer); + end + function bitmapinfo();override; + begin + return GetServerBitmapInfo(); + end + + function WndClass();override; + begin + return Class(TSocketServerWindow); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end + +end + +//*************client********************** + +type TDSocketClient = class(TDRootComponent) +{** + @explan(说明) 弹出菜单控件 %% +**} + function HitTip();override; + begin + return "socket客户端"; + end + function classification();override; + begin + return "天软"; + end + function ComponentClass();override; + begin + return class(TSocketClient); + end + function bitmapinfo();override; + begin + return GetClientBitmapInfo(); + end + + function WndClass();override; + begin + return Class(TSocketClientWindow); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end + +end + +//*************TTreeView*************************** +type TDTreeView = class (TDComponent) +{** + @explan(说明) 树形设计控件 %% +**} + function HitTip();override; + begin + return inherited; + return "树控件"; + end + function bitmapinfo();override; + begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +100027101000089504E470D0A1A0A0000000D4948445200000018000000180806 +000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA8640000010649444154 +484BB595CB0D83400C05530725A44ADAE0C43DF55009FFCF61A387F422AFB3364 +B084823451C668C7DC823DCFCEC81BAAE4355557F05CE4F002FB66D8B58D73562 +599688799E23A6698A80F32B109AE7CE55F9388EE940F37A44FC2ACF0E4058144 +516529E0C701D65595E9A3C2B40296F72563E0C831F207A65B972332057027400 +C2D4FE819427035ACE75E04BCE4C0EFABEF703943340296F7224770352CE80751 +34B6E06B41C53CB2FD00148F52DCC404ACE95E077CE5A48D7757EC09A3857EE06 +28B7027A2544CACD80940308718333939B81945C0620E54D8EE46DDBFA01CA192 +07A6596DC0D4839906BD10108F52DDC8027CF598B240ADCFEA77FDF13C21B71B1 +C6D53F7109130000000049454E44AE42608200"; + end + function WndClass();override; + begin + return Class(ttreeview); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + 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 设计器控件 %% +**} + function HitTip();override; + begin + return "SpinEdit"; + 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; + fiscontainerdcmp := false; + end + +end + +//************tlistview****************************** +type TDListView = class(TDComponent) +{** + @explan(说明) TTSLDataGrid 设计器控件 %% +**} + function HitTip();override; + begin + return inherited; + return "列表视图控件"; + end + function bitmapinfo();override; + begin + return getlistviewbitmapinfo(); + end + function WndClass();override; + begin + return Class(TListView); + end + + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + fiscontainerdcmp := false; + 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 TDedit= class(TDComponent) + function HitTip();override; + begin + return inherited; + return "文本框控件"; + end + function bitmapinfo();override; + begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +10002D201000089504E470D0A1A0A0000000D4948445200000018000000180806 +000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA8640000016749444154 +484BED93B18AC2401445D30BDAA51214044997C6D680A2A435D8DB59FA0D0BFE4 +26C52588B9FB06065C02A453A0B9580A50A12B5D03477796F278B59571CC16CE5 +8107F74E60CE304314A4CC5BF090FF117C0C3F539984E0D53C2598CD6668B7DBA +225511485E7777E4A309D4E619AA6687F136F1C735710451156AB1576BB9D5849 +0A96CB25C230E47C8D9460B15840D775B45A2D94CB650C06035E2741B55A85655 +93C854201B66DF3B71829C17EBFC7F178E44CB252A9C49904994C06411070DF6C +36505515DBED963B2125A0EB711C079D4E874F9CCBE5789D048661708EA9D56A7 +05D57344941AFD743B7DBC57C3EC7E1704808EAF53AE7984AA502DFF7459314D0 +29279309E7F1789C1064B359ACD76BEE9EE7A1582CE272B97027A404A3D108F97 +C1ECD6613FD7E9F1F93A0FFA0D168F0E3D3D5699A96B81E424A40D0A9CEE7B368 +B79C4E2791BEA18DE3CDAFF35DC1ABB811A4313F8234790B1E92B200F80266B31 +3963A1FCCDB0000000049454E44AE42608200"; + 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) + function HitTip();override; + begin + return inherited; + 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; + function WndClass();override; + begin + return Class(tmemo); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + DefaultEvent := array( + "event":"onchange", + "name":"change", + "param":array("o","e"), + "virtual":true, + "body": +" + {** + @explan(说明) 文本改变回调 %% + @param(e)(tuievent) 消息对象 %% + @param(o)(tmemo) 多行文本框对象 %% + **} +" + ); + end +end +type TDpassword= class(TDComponent) + function HitTip();override; + begin + return inherited; + return "密码框"; + end + function bitmapinfo();override; + begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +10002F300000089504E470D0A1A0A0000000D4948445200000024000000240806 +000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA8640000008849444154 +5847ED91010A80300845BD795DA48374BA859065C36644A163FFC18789321E4A2 +51910F2809007843CF20A4DCB1A1AE12214C5D8424474C4AA99B00D69094DBF42 +44F3FEBABE6B9ECF41C89B7B29C49FB622583D9D1A9C8CF945883F6D45B07A3A3 +538193396D0D7A4106209895533611BBAA31FA1C808E7219300210F087940A84D +291BB496CCEA5B2547890000000049454E44AE42608200"; + end; + function WndClass();override; + begin + return Class(tpassword); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end +end +(** +type TDtrackbar= class(TDComponent) + 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; + 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) + function HitTip();override; + begin + return inherited; + return "下拉选择框"; + end + function bitmapinfo();override; + begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +100023501000089504E470D0A1A0A0000000D4948445200000024000000240806 +000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA864000000CA49444154 +5847ED92C109C42010452D45F094A385A4A65461135660375EEC220797C92ABBD +90C314AD4ECE0838F8387CF6318E61FC6104AB1139AE7B969300E427772D6D755 +C839B7BD409CB3859665294E04FAD675F5D33479A5D41698E1AF9B1060ADF59CF +32D3003D94277F0DD07225106E82EF4CB65A196C1A8BAA13386508A2221C6D82D +D15A87C60F343654131A42D83D5C8D3126B4E0D0D8504D680861B791132965683 +A42634335A12184DD45698410A1F50D8D0DD5E47F855A066327F40486508A2174 +8EF72FB778FABEB46AB5F60000000049454E44AE42608200"; + end; + function WndClass();override; + begin + return Class(tcomboBox); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + 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 +end +type TDColorComboBox= class(TDComponent) + function HitTip();override; + begin + return "颜色下拉选择框"; + end + function bitmapinfo();override; + begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +100023001000089504E470D0A1A0A0000000D4948445200000024000000240806 +000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA864000000C549444154 +5847EDD1DF09C32010C77147F13513640AD7C81A9DC2453A45B7F0C52D7CB039F +1A0A1FEC9859C49E03EF02392807C6955BC1909EAD904196386AEE42FE84CADFB +E841EFD7F165789FF73E3D019EE941CBFAE9E832B82F8410A7698AD6DA3438C3B +BCB8280732E6AADD3E00CE841A5BF62EFB2DFFB200463003DE804ADFB76078D5C +09EB2FD4F2FC20B5F00C49506D881CC44D827AE8416AFDC4B14C82AACBE841CC2 +4A8871C347F66962109AA0D9183B84950CF738346AE6413740712D416E317FE0C +479C51B569C20000000049454E44AE42608200"; + end; + + function WndClass();override; + begin + return Class(tcolorcombobox); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end +end +type TDradiobtn = class(TDComponent) + + function HitTip();override; + begin + return inherited; + 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; + function WndClass();override; + begin + return Class(tradiobtn); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end +end +type TDipaddr= class(TDComponent) +{** + @explan(说明)ip设计控件%% +**} + function HitTip();override; + begin + return inherited; + 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; + function WndClass();override; + begin + return Class(tipaddr); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + end + +end +type TDmessagebox = class(TDRootComponent) + function HitTip();override; + begin + return "提示框"; + end + function bitmapinfo();override; + begin + return GetMessageBoxBitmapInfo(); + end; + + function classification();override; + begin + return "对话框"; + end + function ComponentClass();virtual; + begin + {** + @explan(说明) 控件类 %% + **} + return class(tmessageboxadlg); + end + + function WndClass();override; + begin + return Class(TDMessageboxWindow); + end + function Create(AOwner);override; + begin + inherited; + fiscontainerdcmp := false; + 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();//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 + function HitTip();override; + begin + return inherited; + return "列表框"; + end + function WndClass();override;begin + return Class(tlistbox); + end + function Create(AOwner);override;begin + inherited; + fiscontainerdcmp := false; + 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 HitTip();override;begin + return "颜色列表框"; + end + function WndClass();override;begin + return Class(tcolorBox); + end + function Create(AOwner);override;begin + + inherited; + fiscontainerdcmp := false; + end + function bitmapinfo();override;begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +100025B01000089504E470D0A1A0A0000000D4948445200000024000000240806 +000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA864000000F049444154 +5847ED96B10D833010451985969A822958838D3C49164813295BD0B00585C3593 +AC9266793B33E06059EF48485A5F32B5CB8B227E30EDA2208EAFBBEA8125F4148 +52F30E0F1AC7D1C9E8838665CB37039E4721755D3B390A16D4B6EDA60CCD9BE7D +9364D638D314E5AD3BFC38288699ADC97E0352C4843EC50421F0480E6A594D83D +E8F57C88AA83AA2134872241D22566D75C3348033408C19F0755CB966F064582A +4CBBC96B96690066C10805306A594880675EF2E3087D8A1042C48BAC4BE3E3C0F +F2404305C19EB0B1200D3C0FF3C807E0CFA3108E210E0F5AF37350492582A0337 +0076D7107A5B1F6034F9699CCB1141CEB0000000049454E44AE42608200"; + end +end +type TDCalendar=class(TDComponent) + public + function HitTip();override; + begin + return inherited; + return "日历"; + end + function WndClass();override;begin + return Class(tmonthcalendar); + end + function Create(AOwner);override;begin + inherited; + fiscontainerdcmp := false; + 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 HitTip();override;begin + return inherited; + return "进度条"; + end + function WndClass();override;begin + return Class(tprogressbar); + end + function Create(AOwner);override;begin + inherited; + fiscontainerdcmp := false; + 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 HitTip();override;begin + return inherited; + return "复选框"; + end + function WndClass();override;begin + return Class(tcheckbtn); + end + function Create(AOwner);override;begin + inherited; + fiscontainerdcmp := false; + 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 HitTip();override;begin + return inherited; + return "时间日期选择"; + end + function WndClass();override;begin + return Class(tdatetimepicker); + end + function Create(AOwner);override;begin + inherited; + fiscontainerdcmp := false; + end + function bitmapinfo();override;begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +100020E01000089504E470D0A1A0A0000000D4948445200000018000000180806 +000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA864000000A349444154 +484BD58FD10D83300C44D9285B650D6FD14DFACD10198221F2E1F62C8C5C29941 +80C88279D8C2C398F1BF864AE13E49CC362F91178D19B5AAB046C0A88C6AE00DC +945238A524C177B8001091046C0A3CB46EFE0AA26239D4A04597E0F59EDC51BA0 +57B260869C0C3F76CCEB29B0969208F9BB94B20478D3F5DDB2BAE06F28899BA5F +9B20A4412B8AAB81770257034F942EC111EE1544C5B208CEE2E902E60FE420D1B +CC541E3100000000049454E44AE42608200"; + end +end +type TDTimePicker=class(TDComponent) + public + function HitTip();override;begin + return inherited; + return "时间选择"; + end + function WndClass();override;begin + return Class(ttimepicker); + end + function Create(AOwner);override;begin + inherited; + fiscontainerdcmp := false; + end + function bitmapinfo();override;begin + r := gettimepickerbitmapinfo(); + return r; + end + +end + + + + +//**************TPanel************************** +type TDPanel = class(TDComponent) + function HitTip();override; + begin + return inherited; + return "容器控件"; + end + function bitmapinfo();override; + begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +10002CA00000089504E470D0A1A0A0000000D4948445200000024000000240806 +000000E1009898000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA8640000005F49444154 +5847EDD7B109C0300C05D1ECBF812AADA94EC1453A91AB4C1CB80F571ABDD6571 +F36413441B41194991D115B5B37A68DA0F5A0AAB6B66E4C13F42488124409A204 +5182284194204A1025881244FD1B74DC47F1CB09A2097A5FF70DF185865E9BB41 +DE30000000049454E44AE42608200"; + 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控件 +**} + function HitTip();override; + begin + return inherited; + return "分组框"; + end + function bitmapinfo();override; + begin + return "0502000000060400000074797065000203000000696D670006040000006461746 +100020B01000089504E470D0A1A0A0000000D4948445200000018000000180806 +000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F0 +BFC6105000000097048597300000EC300000EC301C76FA864000000A049444154 +484BCD91510A83301044BD92782B2F90DF9CA11F3D8FED358A7894C8424736B0A +43B89A11978B0129D67922975CE7F04EB732FC2E41284F0B8B04A35FA5D0B9D4C +8058A59A52A4E7BDBDBE4F86E0383ED548F138821863F6B107B740CAE5AC2199E +7E527940012CC5E28410DE3EC80BD035A0009662F94A0867176C0DE81400920C1 +EC8512D4E012C8620B45C15D980289FE9356904CD0239D05299D037BBA604E978 +76D0000000049454E44AE42608200"; + end + + function WndClass();override; + begin + return Class(tgroupbox); + end + function Create(AOwner);override; + begin + inherited; + end + +end +//*****************Check GroupBox************************ +type TDBtn = class(TDComponent) + function HitTip();override; + begin + return inherited; + return "按钮"; + end + function bitmapinfo();override; + begin + return getbtnbitmapinfo(); + end; + function WndClass();override; + begin + return Class(tbtn); + end + function menus();override; + begin + r := inherited; + return select * from r where ["caption"] <> "粘贴" 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); +" + ); + 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. \ No newline at end of file diff --git a/designer/utslvcldpropertytypes.tsf b/designer/utslvcldpropertytypes.tsf new file mode 100644 index 0000000..4d2591f --- /dev/null +++ b/designer/utslvcldpropertytypes.tsf @@ -0,0 +1,4330 @@ +unit utslvcldpropertytypes; +interface +{** + @explan(说明) 设计器属性编辑库,继承该库,定义属性编辑类 %% +**} +uses utslvclauxiliary,utslvclbase,utslvclgdi,uvcpropertytypespersistence,tslvcl,utslvcldcomponents; +function registereditpropertytodesigner(cls); +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 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 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 + + +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_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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 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 TListVariable = class(TGridList) +{** + @explan(说明) 变量选择 %% +**} + private + FOnClickSelected; + public + function show(f);override; + begin + inherited; + if ifnil(f) or f then + begin + //echo "width:",Width-11; + SetColumnWidth(0,Width-11); + end + end + + function create(AOwner);override; + begin + inherited; + WsPopUp := true; + OnActivate := thisfunction(GridActivate); + ColumnHeader := false; + Columns := array( + ("text":"variable","width":180) + ); + end + function SetSelectedByValue(v);override; + begin + if ifnil(v) then return inherited; + vi := nil; + for i := 0 to List.count-1 do + begin + if v=list[i].name then + begin + vi := list[i]; + break; + end + end + inherited SetSelectedByValue(vi); + end + function additem(v);override; + begin + if not(v is class(TDComponent)) then exit; + inherited; + end + function ClickedGridItem(o,e);override; + begin + id := e.iitem; + inherited; + if id<0 or (SelectedValue is class(tnone)) or (SelectedValue = "(none)") then + begin + UnSelected(); + end + calldatafunction(FOnClickSelected,o); + o.visible := false; + end + function GridActivate(o,e);virtual; + begin + if e.wparam = WA_INACTIVE then O.Visible := false; + 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 + i := e.itemid; + src := e.subItemRect; + dc.DrawText(List[i].name,src,DT_VCENTER .| DT_SINGLELINE); + end + end + property OnClickSelected read FOnClickSelected write FOnClickSelected; +end +type TListStr = class(TListVariable) + function create(AOwner);override; + begin + inherited; + Columns := array(("text":"打开编辑器","width":160)); + end + function additem(v);override; + begin + if ifstring(v) then class(TGridList).additem(v); + end + function SetSelectedByValue(v);override; + begin + return class(TGridList).SetSelectedByValue(v); + 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 + i := e.itemid; + src := e.subItemRect; + dc.DrawText(List[i],src,DT_VCENTER .| DT_SINGLELINE); + 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.dclassname() =FStyle ; + end + end + end + function SetFilter(v); + begin + FFilter.FStyle:=v; + dofilter(); + return ; + 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 idd 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 Notification_rename(o,op);override; + begin + inherited; + if {HandleAllocated() and} ifarray(op) and (op["type"]="possize") and (FComponent is class(TDComponent)) and (FComponent.Cwnd = o) then + begin + dt := TSLData; + + flg := op["flag"]; + if ifarray(dt) then + begin + for i,v in mrows(dt,1) do + begin + if (flg .& 1) and v="left" then + begin + CellChanged(i,1,"value",op["data"][0]); + end + if (flg .& 2) and v="top" then + begin + CellChanged(i,1,"value",op["data"][1]); + end + if (flg .& 4) and v="width" then + begin + CellChanged(i,1,"value",op["data"][2]); + end + if (flg .& 8) and v="height" then + begin + CellChanged(i,1,"value",op["data"][3]); + end + end + return 1; + 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; +implementation +type TTSLDataGrid=class(TDrawGrid) + {** + @ignore(忽略) %% + @explan(说明)TSL数组和对象展示 %% + **} + private + + 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 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 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); + 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 .| DT_VCENTER .| DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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 .| DT_VCENTER .| DT_SINGLELINE); + 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 .| DT_VCENTER .| DT_SINGLELINE); + end + DrawButton(dc,src,dv); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + end + end + function create(AOwner);override; + begin + inherited; + class(TPropertyTypeSysCursor).Create(); + end + private + function SelPalRange();virtual; + begin + return SelRange; + 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_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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 TGridCellVariablehgtEdit = class(TGridCellVariabletimagelistEdit) + Function EditType();override; + begin + return "thighlighter"; + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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(TcustomBitmap) )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(tcustomicon)) 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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 +type TGridCellLazystrEdit = class(TGridCellStringEdit) //后处理信息 + function CreateEditer(AOwner);override; + begin + return new TGridCellLazystrEdit(AOwner); + end + function EditType();override; + begin + return "lazystr"; + 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 + + +//*************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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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.|DT_VCENTER); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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();override; + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + 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,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + end + end + function create(AOwner);override; + begin + inherited; + class(TPropertymbicostyle).Create(); + end + private + function SelPalRange();virtual; + begin + return SelRange; + 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 TBitmapGrid = class(TGridList) +{** + @explan(说明) imagelist编辑 %% +**} + public + function CheckItem(v);override; + begin + return (v is class(TcustomBitmap)) 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 tnone = class() + function create(); + begin + name := "(none)"; + end + name; + +end + + + + +type TListStatusbarItem = class(TGridList) + public + FCheckNumber; + function create(AOwner);override; + begin + inherited; + Columns := array( + ("text":"id","width":40), + ("text":"width","width":60) + ,("text":"text","width":100) + ); + end + function CheckItem(v);override; + begin + if FCheckNumber then + r := ifarray(v) and (v["width"]>0) 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 +function registereditpropertytodesigner(cls); +begin +{** + @explan(说明) 注册编辑属性 %% + @param(cls)(TDComponent) 设计控件 %% +**} + if ifarray(cls) then return registerproperties(cls); + return registerproperties(array(cls)); +end +function registerproperties(ps); +begin + o := class(TPropGrid); + for i,v in ps do + begin + it := createobject( v,0); + o.RegCellRender(it); + end +end +function staticinit(); +begin + psi := (array( + class(TGridCellBoolEdit), + class(TGridCellColorEdit), + class(TGridCellDirectoryEdit), + class(TGridCellFileNameEdit), + class(TGridCellNaturalEdit), + class(TGridCellIntegerEdit), + class(TGridCellLazyIntegerEdit), + class(TGridCellLazystrEdit), + class(TGridCellStringEdit), + class(TGridCellEventHandleEdit), + class(TGridCellVariableEdit), + class(TGridCellVariableTactionEdit), + class(TGridCellVariableTrayEdit), + class(TGridCellVariabletimagelistEdit), + class(TGridCellVariablehgtEdit), + class(TGridCellVariabletmainmenuEdit), + class(TGridCellVariabletpopupmenuEdit), + class(TGridCellImagesEdit), + class(TGridCellBitmapEdit), + class(TGridCellIconEdit), + class(TGridCellFontEdit), + class(TGridCellhotkeyEdit), + class(TGridCellSysCursorEidt), + class(TGridCellStatusItemsEdit), + class(TGridCellFileFilterEdit), + + class(TGridCellEsAlignEdit), + class(TGridCellTextEdit), + class(TGridCellAlignEdit), + class(TGridCellAnchorsEdit), + class(TGridCellTabAlignEdit), + class(TGridCellStringsEdit), + class(TGridCellIntegersEdit), + class(TGridCellColorBoxEdit), + class(tGridCellMbbtnstyleEdit), + class(tGridCellMbiconstyleEdit), + + class(tGridCellDayOfWeekBoxEdit), + class(TGridCellPairIntEdit), + class(TGridCellPairSpliterTypeEdit), + class(tGridCellAlignPosBoxEdit), + class(TGridCellTreeViewDataEdit) + )); + registerproperties(psi); +end +initialization + staticinit(); +end. \ No newline at end of file diff --git a/funcext/tvclib/tcomponent.tsf b/funcext/tvclib/tcomponent.tsf index cde05e5..25de941 100644 --- a/funcext/tvclib/tcomponent.tsf +++ b/funcext/tvclib/tcomponent.tsf @@ -12,6 +12,7 @@ uses utslvclauxiliary,UVCPropertyTypesPersistence,utslvclbase; @param(FComponentStyle)( array of integer) 节点样式 %% @param(FFreeNotifies)( TFpList) 销毁通知节点 %% **} + fasdomain; FOwner; FName; FComponents; @@ -303,6 +304,7 @@ public end function RootOwner(); begin + if fasdomain then return self(true); if not(FOwner is class(TComponent))then return self(true); return FOwner.RootOwner(); end @@ -648,5 +650,6 @@ public property ComponentStyle read FComponentStyle; property Name:string read FName write SetName; property Parent read ComponentGetParent write ComponentSetParent; + property asdomain read fasdomain write fasdomain; property Loader read GetLoader; end \ No newline at end of file diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 0162b69..6f62cda 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -6781,204 +6781,21 @@ type tlogincontrol=class(tpanel) end -type TIniFileExta=class() +type TIniFileExta=class(TIniFileExter) {** @explan(说明) ini文件读写封装 %% - **} - private - FTStringa; - Fini; - FVtype; - FLowerKey; - FLowerValue; - function CheckSK(s,k); - begin - return ifstring(s) and s and ifstring(k) and k; - end - function ChangeV(V); - begin - vv := v; - case Vtype of - 1:vv := vv="0"?false:true; - 2:vv := StrToIntDef(vv,0); - else - begin - if FLowerValue then vv := lowercase(vv); - end - end - return vv; - end - function STNVA(); - begin - {** - @explan(说明) 转换为name,value 列的二维数组 %% - **} - r := array(); - for i := 0 to FTStringa.Count-1 do - begin - n := FTStringa.Names(i); - if n then - begin - if FLowerKey then n := lowercase(n); - vv := FTStringa.Values(n); - r[length(r)]:= array("name":n,"value":ChangeV(vv)); - end - end - FTStringa.Clear(); - return r; - end - function STNV(); - begin - {** - @explan(说明) 转换为name:value 一维数组 %% - **} - nr := STNVA(); - r := array(); - for i,v in nr do - begin - r[v["name"]]:= v["value"]; - end - return r; - end - function STA(); - begin - {** - @explan(说明) 转换为一维数组 %% - **} - r := array(); - for i := 0 to FTStringa.Count-1 do - begin - vi := FTStringa.Strings(i); - r[i]:= FLowerKey?lowercase(vi):vi; - end - FTStringa.Clear(); - return r; - end - public - function create(al,Fname);override; + **} + function create(al,Fname); begin {** @explan(说明) 构造函数 %% @param(al)(string) 别名 %% @param(name)(string) 文件名 %% **} - if ifstring(al)and ifstring(Fname)then - begin - FIni := new TIniFile(al,Fname); - FTStringa := new TStringlist(); - end else - raise "ini对象读写构造参数错误"; - end - function readSection(sn);virtual; - begin - {** - @explan(说明) 读取section 下面key %% - **} - if ifstring(sn)and sn then Fini.readSection(sn,FTStringa); - return STA(); - end - function ReadSections();virtual; - begin - {** - @explan(说明) 读取所有section名字 %% - **} - FIni.ReadSections(FTStringa); - return STA(); - end - function ReadSectionValues(sn);virtual; - begin - {** - @explan(说明) 读取section下面的所有key:value %% - **} - if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa); - return STNV(); - end - function RenameSection(sn1,sn2);virtual; - begin - {** - @explan(说明) 重命名section %% - @param(sn1)(string) 旧名字 %% - @param(sn2)(string) 新名字 %% - **} - if not(sn1 and sn2 and ifstring(sn1))and ifstring(sn2)then exit; - vs1 := ReadSectionValues(sn1); - EraseSection(sn1); - for i,v in vs1 do - begin - WriteKey(sn2,i,v); - end - end - function RenameKey(sec,k1,k2);virtual; - begin - {** - @explan(说明) 重命名key %% - @param(sec)(string) section名称 %% - @param(k1)(string) 旧名字 %% - @param(k2)(string) 新名字 %% - **} - if(sec and k2 and k1 and ifstring(sec)and ifstring(k1)and ifstring(k2))then exit; - v := ReadKey(sec,k1); - DeleteKey(sec,k1); - WriteKey(sec,k2,v); - end - function ReadSectionValues2(sn); - begin - {** - @explan(说明) 获得section 数据,二维表,name,value 列 - **} - if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa); - return STNVA(); - end - function ReadSectionValues3(sn); - begin - {** - @explan(说明) 获得section 数据,二维表,0列为key,1列为value - **} - d := ReadSectionValues2(sn); - r := array(); - for i,v in d do - begin - r[length(r)]:= array(v["name"],v["value"]); - end - return r; - end - function ReadKey(sn,key,def);virtual; - begin - {** - @explan(说明) 读取key %% - **} - if CheckSK(sn,key)then return FIni.ReadString(sn,key,ifstring(def)?def:""); - return nil; - end - function WriteKey(sn,key,v);virtual; - begin - {** - @explan(说明) 写入key %% - **} - if ifnil(v)then v := ""; - if CheckSK(sn,key)then return FIni.WriteString(sn,key,ifstring(v)?v:tostn(v)); - return 0; - end - function DeleteKey(sn,key);virtual; - begin - if CheckSK(sn,key)then return FIni.DeleteKey(sn,key); - end - function EraseSection(sn);virtual; - begin - {** - @explan(说明)删除section %% - **} - if ifstring(sn)and sn then return FIni.EraseSection(sn); - end - function Destroy();virtual; - begin - FIni := nil; - FTStringa := nil; - end - property VType read FVtype write FVtype; - property LowerKey read FLowerKey write FLowerKey; - property LowerValue read FLowerValue write FLowerValue; - _tag; + inherited create(); + filename := fname; + Alias := al; + end end type TCreateProcessA = class() diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index 73adf23..af0c7e3 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/funcext/tvclib/utslmemo.tsf @@ -254,16 +254,17 @@ type TTslMenoUndoList=class() //undolist PushItem(CreateATslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode)); end; end - procedure Clear; + procedure Clear(); begin - fItems.splices(nil,nil,array()); + if fItems.length()>0 then + fItems.splices(nil,nil,array()); fFullUndoImposible := FALSE; end - procedure Lock; + procedure Lock(); begin fLockCount++; end - procedure Unlock; + procedure Unlock(); begin if fLockCount>0 then fLockCount--; return fLockCount; @@ -302,6 +303,7 @@ type TTslMenoUndoList=class() //undolist pit.FLinkItem := it; end end + property LockCount read fLockCount; property CanUndo:boolean read GetCanUndo; property ItemCount:integer read GetItemCount; property MaxUndoActions:integer read fMaxUndoActions write SetMaxUndoActions; @@ -630,6 +632,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) @explan(说明) 带滚动条的编辑控件 %% **} private + fundoing; + fredoing; fselectbkcolor;//rgb(192,192,192); fcurrentLineColor;//rgb(232,232,255); fguttercolor; @@ -1095,6 +1099,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) end function MouseDown(o,e);override; begin + if class(tmemlocker).haslocker then return ; inherited; if e.skip then return ; IncPaintLock(); @@ -1141,6 +1146,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) end function MouseUp(o,e);override; begin + if class(tmemlocker).haslocker then return ; inherited; if e.skip then return; UnClipCursor(); @@ -1167,6 +1173,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) end function keypress(o,e);override; begin + if class(tmemlocker).haslocker then return ; if e.skip then return; c := e.wparam; if ReadOnly then return; @@ -1207,11 +1214,11 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) fUndoList.AddChange(crInsert,bb,r,s,0); SetCaretXY(r); UpdateCaret(); - DoTextChanged(bb); + memtextchanged(bb); end function DoTextChanged(p);virtual; begin - //改变 + //改变 end function DoCaretPosChanged();virtual; begin @@ -1228,18 +1235,23 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) FSelBegin := array(1,1); FSelEnd := array(1,1); ClearUndo(); - DoTextChanged(array(1,1)); + memtextchanged(array(1,1)); end function Undo(); begin if fUndoList.CanUndo then begin + lk := new tmemlocker(); UndoItem(); end end function Redo(); begin - if fRedoList.CanUndo then RedoItem(); + if fRedoList.CanUndo then + begin + lk := new tmemlocker(); + RedoItem(); + end end function CharInput(c);virtual; begin @@ -1663,7 +1675,14 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) return array(cy,cx+(ci?(0):1)); end private - + function memtextchanged(p); + begin + if not(fundoing or fredoing) then + begin + fRedoList.Clear(); + end + return DoTextChanged(p); + end function setcurrentLineColor(c); begin if ifnumber(c) and c<>fcurrentLineColor then @@ -1860,6 +1879,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) end end fUndoList.Lock(); + fundoing := true; for i := length(tarr)-1 downto 0 do begin item := tarr[i]; @@ -1881,6 +1901,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) end end fUndoList.UnLock(); + fundoing := false; DecPaintLock(); //处理 end @@ -1897,6 +1918,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) item := item.FLinkItem; idx++; end + fredoing := true; for i := length(tarr)-1 downto 0 do begin item := tarr[i]; @@ -1918,6 +1940,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) fUndoList.MergeReplaceItem(); end end + fredoing := false; DecPaintLock(); end function GetLineText(); @@ -2235,7 +2258,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) //if up then UpDateScroll(); //UpDateCaret(); DecPaintLock(); - DoTextChanged(bb); + memtextchanged(bb); end end function DeleteSel(); //删除选择 @@ -3466,6 +3489,7 @@ type TSynCustomMemo = class(TCustomMemo) **} function DoTextChanged(p);override;//文本改变 begin + inherited; if Highlighter then Highlighter.SetInValidateIndex(p[0]); end @@ -3994,6 +4018,17 @@ type TSynMemoNorm = class(TsynCustomMemo) // FSheetTabFlage; end Implementation +type tmemlocker = class() //锁定对象 + static haslocker; + function create(); + begin + haslocker++; + end + function destroy(); + begin + haslocker--; + end +end function CreateATslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode); begin return new TTslMemoUndoItem(AReason,AStart,AEnd,ChangeText,SelMode); diff --git a/funcext/tvclib/utslvclauxiliary.tsf b/funcext/tvclib/utslvclauxiliary.tsf index 23d3669..8a4a0ae 100644 --- a/funcext/tvclib/utslvclauxiliary.tsf +++ b/funcext/tvclib/utslvclauxiliary.tsf @@ -1773,6 +1773,240 @@ type tpairstate =class // FType; end +type TIniFileExter=class() + {** + @explan(说明) ini文件读写封装 %% + **} + private + FTStringa; + FVtype; + FLowerKey; + FLowerValue; + function CheckSK(s,k); + begin + return ifstring(s) and s and ifstring(k) and k; + end + function ChangeV(V); + begin + vv := v; + case Vtype of + 1:vv := vv="0"?false:true; + 2:vv := StrToIntDef(vv,0); + else + begin + if FLowerValue then vv := lowercase(vv); + end + end + return vv; + end + function STNVA(); + begin + {** + @explan(说明) 转换为name,value 列的二维数组 %% + **} + r := array(); + for i := 0 to FTStringa.Count-1 do + begin + n := FTStringa.Names(i); + if n then + begin + if FLowerKey then n := lowercase(n); + vv := FTStringa.Values(n); + r[length(r)]:= array("name":n,"value":ChangeV(vv)); + end + end + FTStringa.Clear(); + return r; + end + function STNV(); + begin + {** + @explan(说明) 转换为name:value 一维数组 %% + **} + nr := STNVA(); + r := array(); + for i,v in nr do + begin + r[v["name"]]:= v["value"]; + end + return r; + end + function STA(); + begin + {** + @explan(说明) 转换为一维数组 %% + **} + r := array(); + for i := 0 to FTStringa.Count-1 do + begin + vi := FTStringa.Strings(i); + r[i]:= FLowerKey?lowercase(vi):vi; + end + FTStringa.Clear(); + return r; + end + public + function create(); + begin + {** + @explan(说明) 构造函数 %% + @param(al)(string) 别名 %% + @param(name)(string) 文件名 %% + **} + FTStringa := new TStringlist(); + FAlias := ""; + ffilename := ""; + + end + function readSection(sn);virtual; + begin + {** + @explan(说明) 读取section 下面key %% + **} + if ifstring(sn)and sn then Fini.readSection(sn,FTStringa); + return STA(); + end + function ReadSections();virtual; + begin + {** + @explan(说明) 读取所有section名字 %% + **} + FIni.ReadSections(FTStringa); + return STA(); + end + function ReadSectionValues(sn);virtual; + begin + {** + @explan(说明) 读取section下面的所有key:value %% + **} + if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa); + return STNV(); + end + function RenameSection(sn1,sn2);virtual; + begin + {** + @explan(说明) 重命名section %% + @param(sn1)(string) 旧名字 %% + @param(sn2)(string) 新名字 %% + **} + if not(sn1 and sn2 and ifstring(sn1))and ifstring(sn2)then exit; + vs1 := ReadSectionValues(sn1); + EraseSection(sn1); + for i,v in vs1 do + begin + WriteKey(sn2,i,v); + end + end + function RenameKey(sec,k1,k2);virtual; + begin + {** + @explan(说明) 重命名key %% + @param(sec)(string) section名称 %% + @param(k1)(string) 旧名字 %% + @param(k2)(string) 新名字 %% + **} + if(sec and k2 and k1 and ifstring(sec)and ifstring(k1)and ifstring(k2))then exit; + v := ReadKey(sec,k1); + DeleteKey(sec,k1); + WriteKey(sec,k2,v); + end + function ReadSectionValues2(sn); + begin + {** + @explan(说明) 获得section 数据,二维表,name,value 列 + **} + if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa); + return STNVA(); + end + function ReadSectionValues3(sn); + begin + {** + @explan(说明) 获得section 数据,二维表,0列为key,1列为value + **} + d := ReadSectionValues2(sn); + r := array(); + for i,v in d do + begin + r[length(r)]:= array(v["name"],v["value"]); + end + return r; + end + function ReadKey(sn,key,def);virtual; + begin + {** + @explan(说明) 读取key %% + **} + if CheckSK(sn,key)then return FIni.ReadString(sn,key,ifstring(def)?def:""); + return nil; + end + function WriteKey(sn,key,v);virtual; + begin + {** + @explan(说明) 写入key %% + **} + if ifnil(v)then v := ""; + if CheckSK(sn,key)then return FIni.WriteString(sn,key,ifstring(v)?v:tostn(v)); + return 0; + end + function DeleteKey(sn,key);virtual; + begin + if CheckSK(sn,key)then return FIni.DeleteKey(sn,key); + end + function EraseSection(sn);virtual; + begin + {** + @explan(说明)删除section %% + **} + if ifstring(sn)and sn then return FIni.EraseSection(sn); + end + function Destroy();virtual; + begin + finiobj := nil; + FTStringa := nil; + end + property VType read FVtype write FVtype; + property LowerKey read FLowerKey write FLowerKey; + property LowerValue read FLowerValue write FLowerValue; + property Alias read FAlias write setalias; //目录别名 + property filename read ffilename write setfilename; //文件名 + _tag; + private + property Fini read getiniobj write finiobj; + private + function getiniobj(); + begin + if not(finiobj) then + begin + if ifstring(FAlias) and ifstring(ffilename) then + begin + finiobj := new TIniFile(FAlias,ffilename); + end else + begin + raise "ini读写文件错误"; + end + end + return finiobj; + end + function setfilename(v); + begin + if ifstring(v) and v<>ffilename then + begin + ffilename := v; + finiobj := nil; + end + end + function setalias(v); + begin + if ifstring(v) and v<>FAlias then + begin + FAlias := v; + finiobj := nil; + end + end + FAlias; + ffilename; + finiobj; +end implementation function includestate(u,s); begin diff --git a/funcext/tvclib/utslvclcoolbar.tsf b/funcext/tvclib/utslvclcoolbar.tsf index f1bcc39..40c6a32 100644 --- a/funcext/tvclib/utslvclcoolbar.tsf +++ b/funcext/tvclib/utslvclcoolbar.tsf @@ -31,7 +31,7 @@ type tcustomcoolbar=class(tcustomcontrol) function Notification(o,op);override; begin r := inherited; - if class(tflag).haslocker then return r; + if class(tcoolbarlocker).haslocker then return r; if (o is class(TWinControl)) and o.WsPopUp then return r; if HandleAllocated() and ifarray(op) and (op["type"]="possize") then //位置大小发送变化 begin @@ -182,7 +182,7 @@ type tcustomcoolbar=class(tcustomcontrol) return ; end end - lk := new tflag(); + lk := new tcoolbarlocker(); for i,v in fcoolbands.data2 do begin x := 0; @@ -663,7 +663,7 @@ type tcoolbarlines = class() // end flines; end -type tflag = class() //锁定对象 +type tcoolbarlocker = class() //锁定对象 static haslocker; function create(); begin