tslediter/designer/tslvcldesigner.tsf

9559 lines
258 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit tslvclDesigner;
{**
@explan(说明)设计器库 %%
**}
interface
uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclbase,utslvclgdi,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 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
return array(
("type":"menu","caption":"删除","id":"delete","onclick":thisfunction(deleteclick)),
("type":"menu","caption":"上移","onclick":thisfunction(MoveComponentUp)),
("type":"menu","caption":"下移","onclick":thisfunction(MoveComponentDown))
);
end
function CreateNode(tnode,owner,tree,Pwnd);virtual;
begin
{**
@explan(说明) 构造节点 %%
@return(TComponentTreeNode|false) 节点 %%
**}
if not NodeOk(tnode,owner,tree,Pwnd) then return false;
return tnode.insertnode(array("type":"treenode"),tnode.TVI_LAST);
end
function SetViewParent(wnd,pwnd);virtual;
begin
{**
@explan(说明)控件的父窗口%%
**}
wnd.parent := Pwnd;
end
function ComponentCreater(tnode,owner);virtual;
begin
{**
@explan(说明) 构建新节点窗口 %%
@param(tnode)(TComponentTreeNode) 父节点 %%
@param(owner)(TWincontrol) 窗口所有者 %%
@return(TDComponent|0)成功返回对象失返回0%%
**}
tn := CreateNode(tnode,owner,tree,Pwnd);
if not tn then return 0;
if Imgs >=0 then
begin
tn.ImgId := Imgs;
tn.SelImgId := Imgs;
end
o := createobject({ClassObject()}self(true).classinfo(1),owner);
if not o then return 0;
o.TreeNode := tn;
SetViewParent(o.Cwnd,Pwnd);
o.Cwnd._tag := tn;
//tree.SetSel(tn);
return o;
end
function create(AOwner);virtual;
begin
{**
@explan(说明) 构造控件的构造函数 %%
**}
feventnametable := array();
if not(AOwner is class(TComponent)) then exit;
c := WndClass();
if c is class(TComponent) then
begin
FCwnd := createobject(c,AOwner);
FCwnd.SetDesigning(true);
end
else raise "类型错误!";
end
function GetChangedPropertiesn(n);
begin
if FCwnd then return FCwnd.GetChangedPropertiesn(n);
return nil;
end
function GetChangedPublish();virtual;
begin
{**
@explan(说明)获得改变的属性%%
**}
if FCwnd then return FCwnd.GetChangedPublish();
return array();
end
function GetPublishProperties();virtual;
begin
{**
@explan(说明)获得所有的属性%%
**}
if FCwnd then return FCwnd.GetPublishProperties();
return array();
end
function GetPublishEvents();virtual;
begin
{**
@explan(说明)获得改变事件回调属性%%
**}
if FCwnd then return FCwnd.GetPublishEvents();
end
function DefaultAlign();virtual;
begin
return false;
end
function destroy();virtual;
begin
FTreeNode := nil;
FCwnd := nil;
end
function SetComponentProperties(n,v);
begin
{**
@explan(说明)修改属性%%
**}
if FCwnd then
begin
if n="name" then
begin
return SetComponentName(v);
end else
return FCwnd.SetPublish(n,v);
end
end
function GetTrueComponent();virtual;
begin
{**
@explan(说明) 获得真实的控件%%
**}
if FCwnd is class(TDVirutalWindow) then return FCwnd.BindComp;
return FCwnd;
end
function SetComponentName(v);
begin
{**
@explan(说明) 修改控件name %%
**}
obj := GetTrueComponent();
if obj and ifstring(v) then
begin
odn := obj.name;
v := lowercase(v);
if v=odn then return false;
if v in TemporaryNotName then return false;
cn := 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();override;
begin
r := getnotnil(inherited);
if not FBindComponent then exit;
r2 :=FBindComponent.GetChangedPublish();
if r2 then
begin
deletefiled(r2);
r union= r2;
end
return r;
end
function SetPublish(n,v);override;
begin
if n in FWindowFileds then
begin
return inherited;
end
if FBindComponent then
begin
return FBindComponent.SetPublish(n,v);
end
end
function DesigningSizer();override;
begin
return false;
end
function Recycling();override;
begin
inherited;
if FBindComponent is class(TComponent) then
begin
FBindComponent.Recycling();
FBindComponent := nil;
end
end
property BindComp read FBindComponent write SetBindComponent;
property WindowFileds read FWindowFileds write FWindowFileds;
{**
@param(BindComp)(tcomponent) 绑定的控件 %%
@param(WindowFileds)(array of string) 容器控件替代的属性 %%
**}
end
type 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
FChmHelper;
tmpcanvas; //canvas
FImageList; //图标
FViewBitmap;
FCTrans;
FVariableSelecter;
FFunctionSelecter;
Ftvclform;
//**********菜单***************
FMenu0;
FParser;
//********************************
FToolBars;
FTree;
FCurrentTreeNode;
FObjInspector;
FPropGrid;
FEventGrid;
FTempCanvas;
static FClassItems;
//************************************
FCurrentNode;
FCurrentClikPos;
FComponentCreater;
FRounMenu;
FStopMenu;
FProjectsManager;
FProjectManager;
//***************************
function WrapProjectTo();
begin
FProjectManager.WrapTo();
end
function OpenProjectFromtpj(); //工程选择
begin
SetWndPostWithMouse(FProjectsManager);
FProjectsManager.Show();
return ;
end
function ShowProjectView(o,e); //工程文件打开
begin
FProjectManager.visible := not FProjectManager.visible;
if o then
begin
FProjectManager._tag := o;
o.Checked := FProjectManager.visible;
end
//FProjectManager.show();
end
function addtoolbuttons();//添加工具栏
begin
{**
@explan(说明)添加工具栏 %%
**}
for i,v in FClassItems do
begin
FImageList.RegisterDitem(v);
//if not v.InToolBar() then continue;
tb := new TToolButton(self);
tb.caption := v.HitTip;
tb.Enabled := v.InToolBar();
ig := FImageList.GetImageId(V.dclassname);
tb.imageid := ig;
v.Imgs := ig;
tb._tag := v;
tb.onclick := thisfunction(OnToolButtonCick);
FToolBars.addbtn(tb,v.classification);
end
end
function calcheight(twidth); //高度计算
begin
//extheight := CaptionHeight()+MenuBarHeight();
clc := array();
if FClassItems and ifarray(FClassItems) then
begin
for i,v in FClassItems do
begin
cli := v.classification;
if not(cli and ifstring(cli)) then cli := "常用";
if ifnil(clc[cli]) then clc[cli] := 0;
clc[cli]+=1;
end
mx := 0;
for i,v in clc do mx := max(mx,v);
height := (integer(mx*32/twidth)+1)*32+60+30+24+5;
end else
height := 90+32+24+5;
end
function TreeNode2tfmsub(lib,node,itemnames);//tmf文件字符串
begin
if not(node) then
begin
it := FTree.RootItem;
node := (it.items)[0];
end
if not ifarray(itemnames) then itemnames := array();
if not ifarray(lib) then lib := array();
if not node then exit;
tc := node.Component;
wlibs := tc.libs();
tlibs := array();
for i,v in wlibs do if v and ifstring(v) then tlibs[length(tlibs)] := lowercase(v);
tclib := lowercase(tc.libs());
lib union2= tlibs;
r := "";
tab := " ";
if tc is class(TDComponent) then
begin
tcname := tc.name;
tcclassname := tc.dclassname;
if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then raise "错误!";
r+= "object "+ tc.name +":"+tc.dclassname+"\r\n";
itemnames[length(itemnames)] := array(tc.name,tc.dclassname);
cr := tc.GetChangedPublish();
for i,v in cr do
begin
if not(v and ifstring(i) and ifstring(v) ) then continue; //严格判断
r+=tab;
r+= i + "=" + v +"\r\n";
end
for i := 0 to node.ItemCount-1 do
begin
r += tablelines( call(thisfunction,lib,(node.items)[i],itemnames),tab);
end
r += "end";
end
return r;
//GetChangedPublish
end
function DeletComponent(comp); //删除控件
begin
if comp is class(TDComponent) then
begin
DeleteNode(comp.TreeNode);
end
end
function DeleteNode(node); //删除节点
begin
if node Is class(TComponentTreeNode) then
begin
comp := node.Component;
tree := Node.owner;
node.Recycling();
if tree is class(TComponentTree) then
begin
tree.deleteitem(node);
node.Recycling();
end
if comp is class(TDComponent) then
begin
wd := comp.Cwnd;
if wd is class(TComponent) then wd.Recycling();
end
end
end
function createmainmenubyarray(ms,pm,oer);
begin
if not(ifarray(ms) and ms) then exit;
if ms["type"]="menu" then
begin
if not pm then pm := new TMainmenu(oer);
if ifstring(ms["caption"]) then
begin
mu := new tmenu(oer);
mu.caption := ms["caption"];
o := ms["onclick"];
mu.onclick := ms["onclick"];
mu.parent := pm;
if ms["checked"] =1 then
begin
mu.Checked := true;
end
field := ms["filed"];
if ms["checked"]=true then
begin
mu.Checked := true;
end else
begin
bp := ms["bitmap"];
if bp and ifstring(bp) then
begin
bpp := new tbitmap();
bpp.Readvcon(HexFormatStrToTsl( bp));
mu.bitmap := bpp;
end
end
if ms["enabled"]=0 then
begin
mu.Enabled := false;
end
if ifstring(field) then
begin
try
invoke(oer,lowercase(field),1,mu);
except
end ;
end
call(thisfunction,ms["items"],mu,oer);
end
end
else for i,v in ms do
begin
call(thisfunction,v,pm,oer);
end
end
public
function OpenFileFromTpjFile(); //从文件打开工程
begin
FProjectFileOpener.caption := "打开";
if FProjectFileOpener.OpenDlg() then
begin
f := FProjectFileOpener.FileName;
FProjectsManager.OpenFileFromTpjFile(f);
fio := ioFileseparator();
for i := length(f) downto 2 do
begin
if f[i]=fio then
begin
FProjectFileOpener.initialDir := f[1:(i-1)];
break;
end
end
end
end
function OpenExaple();
begin
FProjectFileOpener.caption := "打开范例....";
f := 0;// tslfilename();
fio := ioFileseparator();
if f then
begin
for i := length(f) downto 2 do
begin
if f[i]=fio then
begin
ef := f[1:i]+"examples";
if filelist("",ef) then
begin
FProjectFileOpener.initialDir := ef;
end
else
begin
FProjectFileOpener.initialDir := f[1:(i-1)];
end
break;
end
end
end else
begin
f := sysexecname();
for i := length(f) downto 3 do
begin
if f[i]=fio then
begin
ef := f[1:i]+"designer"+fio+"examples";
if filelist("",ef) then
begin
FProjectFileOpener.initialDir := ef;
end
else
begin
FProjectFileOpener.initialDir := f[1:(i-1)];
end
break;
end
end
end
if FProjectFileOpener.OpenDlg() then
begin
//echo ,"\r\n";
FProjectsManager.OpenFileFromTpjFile(FProjectFileOpener.FileName);
end
end
function CreateTpjFomFile();//新建工程
begin
FProjectFileOpener.caption := "新建";
if FProjectFileOpener.OpenDlg() then
begin
f := FProjectFileOpener.FileName;
if parseregexpr(".tpj$",f,"",pp1,pp2,pp3)<>1 then f+=".tpj";
FProjectsManager.CreateTpjFomFile(f);
end
end
function db(o,e): WM_NCLBUTTONDBLCLK;virtual;//最大化处理
begin
e.skip := true;
end
function openclassfile(); //打开编辑器
begin
FProjectManager.ShowCurrentFormCode();//ShowEditor();
end
Function EnabledDesigner(f);
begin
{**
@explan(说明) 设置designer是否可用 %%
@param(f)(bool)
**}
FObjInspector.Visible := F;
self.Enabled := f;
rt := FTree.RootItem;
if rt and rt.ItemCount>0 then
it := (rt.items)[0];
if it then itt := it.Component;
if itt then itt.Cwnd.Enabled := f;
end
function TreeNode2tfm(lib,itemnames); //转换文件
begin
{**
@explan(说明) 将结构转换为文件格式 %%
**}
r := TreeNode2tfmsub(lib,nil,itemnames);
if itemnames then itemnames := itemnames[1:];
return r;
end
function saveCurrentForm(); //保存当前编辑
begin
FProjectManager.saveCurrentEdit();
end
function mainmenus();virtual;
begin
{**
@explan(说明) 菜单
**}
return array(
("type":"menu","caption":"文件","onclick",nil,"items":(
("type":"menu","caption":"保存","onclick":thisfunction(saveCurrentForm),
"bitmap":GetSaveFileBitmapInfo()),
("type":"menu","caption":"代码编辑","onclick":thisfunction(openclassfile),
"bitmap":geteditcodebitmapinfo())
)),
("type":"menu","caption":"视图","items":(
("type":"menu","caption":"工程文件管理","checked":1,"bitmap":GetWindowMgrBmp(),"onclick":thisfunction(ShowProjectView)),
("type":"menu","caption":"对象浏览","checked":true,"onclick":thisfunction(Mobjinspect),
"bitmap":getdefaultbmpinfo())
)),
("type":"menu","caption":"工程","items":(
("type":"menu","caption":"打开工程","onclick":thisfunction(OpenFileFromTpjFile),
"bitmap":GetOpenFileBitmapInfo()),
("type":"menu","caption":"新建工程","onclick":thisfunction(CreateTpjFomFile),
"bitmap":getcreateprojectbmpinfo()),
("type":"menu","caption":"打开历史","onclick":thisfunction(OpenProjectFromtpj),
"bitmap":GetHostroyBimp()),
//("type":"menu","caption":"打包到","onclick":thisfunction(WrapProjectTo),"bitmap":getwrapprojectbmpinfo())
)
),
("type":"menu","caption":"运行","items":(
("type":"menu","caption":"配置命令行","onclick":thisfunction(editcommandline)),
//{$ifdef linux}
//("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu","bitmap":getrunbmpinfo()),
//("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu","bitmap":getstopbmpinfo()),
//{$else}
("type":"menu","caption":"运行","bitmap":getrunbmpinfo(),"onclick":thisfunction( debugproject)), //之前的调试运行
//{$endif}
)),
("type":"menu","caption":"工具","items":(
("type":"menu","caption":"打开图片","checked":0,"onclick":thisfunction(ViewBitmap))
)),
("type":"menu","caption":"帮助","items":(
("type":"menu","caption":"使用手册","onclick":thisfunction(OpenHelp),
"bitmap":getmanubmpinfo()),
("type":"menu","caption":"控件详情","onclick":thisfunction(OpenHelp),
"bitmap":getctlsbmpinfo()),
("type":"menu","caption":"范例..","onclick":thisfunction(OpenExaple),
"bitmap":getexamplesbmpinfo())
),
)
);
end
public
function DeleFiledFromEdit(n,nn);
begin
if FTree.Loading then return ;
FProjectManager.DeleteAFiled(n,nn);
end
function AddFiledFromEdit(n);
begin
if FTree.Loading then return ;
FProjectManager.AddAFiled(n);
end
function AddusesFromEdit(lbs);
begin
if FTree.Loading then return ;
FProjectManager.adduses(lbs);
end
function EditerCodeChanged(); //代码改变
begin
if FTree.Loading then return ;
classinfo := FProjectManager.GetFormClassInfo();
if classinfo and ifarray(classinfo) then
begin
class(TDComponent).TemporaryNotName := classinfo["members"];
SetFunctionList(classinfo["funcs"]);
end
end
function LoadProject(n);
begin
FProjectManager.SetProjectInfo(n);
end
private
function tablelines(str,n);
begin
lines := str2array(str,"\r\n");
r := "";
for i,v in lines do
begin
if not v then continue;
r+=n;
r+= v;
r+="\r\n";
end
return r;
end
function OpenHelp(o,e);
begin
if not FChmHelper then
begin
FChmHelper := new unit(UtslCodeEditor).TTslChmHelp();
end
case o.caption of
"使用手册":
begin
FChmHelper.ChmName := "help\\designerUserGuid.CHM";
// p := "C:\\Program Files\\Tinysoft\\Analyse.NETplug\\help\\designerUserGuid.pdf" ;//pluginpath()+"..\\help\\designerUserGuid.pdf";
//_wapi.WinExec(format('cmd.exe /C call "start %s"',p),0); //http://bzjj.sinaapp.com/tslvclhelp/index.html
//_wapi.WinExec(format('start "%s"',p),0);
//_wapi.WinExec('cmd.exe /C start http://bzjj.sinaapp.com/tslvclhelp/index.html',0);
//_wapi.WinExec('cmd.exe /C "start http://bzjj.sinaapp.com/tvcldesignerhelp/tvcldesigner.pdf"',0);
end
"常用控件":
begin
FChmHelper.ChmName := "help\\vclNormalControls.CHM";
end
"控件详情":
begin
FChmHelper.ChmName := "help\\tslvclhelp.chm";
end
end
FChmHelper.ShowTslLangChm();
//_wapi.WinExec('cmd.exe /C start http://bzjj.sinaapp.com/tslvclhelp/index.html',0);
end
function ComponentMove(o,e); //移动
begin
{**
@explan(说明) 移动 控件 %%
**}
//setcomponentfocus(o,false);
FPropGrid.SetGridValue("left",O.left,O) ;
FPropGrid.SetGridValue("top",o.top,O);
end
function ComponentSize(o,e);//大小改变
begin
{**
@explan(说明) 调整控件大小 %%
**}
FPropGrid.SetGridValue("width",o.width,O);
FPropGrid.SetGridValue("height",o.height,O);
//setcomponentfocus(o,false);
end
function DesignerClose(o,e) //关闭
begin
{**
@explan(说明)保存 %%
**}
if _wapi.MessageBoxA(self.Handle,"退出应用","提示", MB_YESNO.| MB_ICONWARNING) = IDNO then
begin
e.skip := true;
end
else
begin //工程处理
FProjectManager.StopProject();
FProjectManager.CloseCurrentEdit();
end
end
function CompClose(o,e); //隐藏控件
begin
{**
@explan(说明) 控件关闭 %%
**}
e.skip := true;
end
function OnDesignerActivate(o,e);
begin
{**
@explan(说明) 设计器被激活 %%
**}
return ;
if e.wparam = WA_CLICKACTIVE then
begin
end
end
public
class function GetClassItem(n);
begin
return FClassItems[n];
end
class function RegestorClassItems(its);
begin
{**
@explan(说明) 注册组件 %%
@param(its)(array of TDComponent) 组件数组 %%
**}
if not ifarray(FClassItems) then FClassItems := array();
for i,v in its do
begin
if (v is class(TDComponent) ) then
begin
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
{**
@explan(说明) 构造组件 %%
@return (TDComponent)
**}
if FComponentCreater and FCurrentNode and FCurrentClikPos then
begin
par := FCurrentNode.Component.Cwnd;
r := FComponentCreater.ComponentCreater(FCurrentNode,FCurrentNode.Component.Cwnd);
if not r then exit;
r.CreateName();
FVariableSelecter.additem(r);
BindCwndMessage(r.Cwnd);
if ifarray(FCurrentClikPos) and (r.Cwnd is class(TControl)) then
begin
if r.Cwnd.Align<>alnone then
begin
//par.DoControlAlign();
end else
begin
x := FCurrentClikPos[0];
y := FCurrentClikPos[1];
if r.Cwnd is class(TControl) then
begin
if ifnumber(x) then r.Cwnd.left := x;
if ifnumber(y) then r.Cwnd.top := y;
end
end
end
FTree.SetSel(r.TreeNode);
end
FCurrentClikPos := nil;
FComponentCreater := nil;
FCurrentNode := nil;
FTree.PopupMenu := nil;
//echo "\r\n 添加控件";
return r;
end
function RectToPoints(rc);
begin
{**
@explan(说明)辅助函数
**}
r := array();
r := array((rc[0],rc[1]),(rc[2],rc[1]),(rc[2],rc[3]),(rc[0],rc[3]),(rc[0],rc[1]));
return r;
end
function setcomponentfocus(cwnd,fk);
begin
{**
@explan(说明) 设计控件获得焦点 %%
**}
if not(cwnd is class(TWincontrol)) then exit ;
if not cwnd.HandleAllocated() then exit;
//if cwnd is class(tvcform) then exit;
//if cwnd.WsPopUp then exit;
return cwnd.DesigningSelect(fk);
end
function setcomponentfocus_bk(cwnd,fk);
begin
if not(cwnd is class(TWincontrol)) then exit ;
if not cwnd.HandleAllocated() then exit;
if cwnd.WsPopUp then exit;
cp := cwnd.parent ;
if not(cp is class(TWincontrol)) then exit;
rec := array(cwnd.left-1,cwnd.top-1,cwnd.left+cwnd.width+1,cwnd.top+cwnd.height+1);
if not fk then
begin
if cwnd is class(TTabSheet) then
begin
tmpcanvas.pen.color := rgb(255,255,255);
goto abcef;
//return o.DoControlAlign();
end
t := 25;
rec := array(rec[0]-t,rec[1]-t,rec[2]+t,rec[3]+t);
return cp.InvalidateRect(rec,true);
end
tmpcanvas.pen.color := rgb(200,0,0);
label abcef;
tmpcanvas.pen.width := 2;
//tmpcanvas.pen.Style := 1;
pcp := _wapi.GetDC(cp.handle);
if not pcp then exit;
tmpcanvas.Handle := pcp;
vw := RectToPoints(rec);
tmpcanvas.draw("polyline",vw);
tmpcanvas.Handle := 0;
_wapi.ReleaseDC(cp.Handle,pcp);
end
function TreeNodeSelected(n);
begin
{**
@explan(说明) 节点被选择 %%
@param(n)(TComponentTreeNode) 被选择节点 %%
**}
if FCurrentNode=n then exit;
FCurrentNode := n;
if not ifobj(n) then exit;
t := n.Component;
if not t then exit;
mu := t.CreateMenu();
FTree.PopupMenu := mu;
FPropGrid.Component := t;
FEventGrid.Component := t;
wd := t.cwnd ;
setcomponentfocus(wd,true);
return t.SelectedNode();
end
private
function RClickComponent(o,e);
begin
{**
@explan(说明)右键菜单 %%
**}
nd := o._tag;
if FCurrentNode<>nd then
begin
FTree.SetSel(nd);
TreeNodeSelected(nd);
end
cp := nd.Component;
if cp then
begin
mu := cp.CreateMenu();
if mu then
begin
//直接将弹出菜单赋值给控件,修正gtk窗口焦点导致弹出菜单的问题
cwnd := cp.Cwnd;
cwnd.PopupMenu := mu;
xy := o.ClientToScreen(e.lolparamsigned,e.hilparamsigned);
_send_(WM_CONTEXTMENU,cwnd.handle,makeposition(xy[0],xy[1]),1);
return ;
uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
_wapi.TrackPopupMenu(mu.Handle,uf,xy[0],xy[1],0,self.Handle,nil);
end
end
end
//FClickTime;
public
function addandopeneventbyname(nd,n);
begin
if nd then
begin
cp := nd.Component;
if cp then
begin
pe := cp.GetPublishEvents();
if ifstring(n) and n then
begin
de := cp.geteventfunctionbyname(n);
end else
de := cp.DefaultEvent;
if ifarray(de) and de then
begin
dei := de["event"];
dvs := pe[dei];
if ifarray(dvs) then
begin
dv := dvs["value"];
if not dv then
begin
td := de;
td["name"] := cp.Name+"_"+td["name"];
if FProjectManager.AddAFunction(td) then
begin
FEventGrid.SetGridValue(dei,td["name"],cp.Cwnd);
FProjectManager.GoToAFunction(td["name"]);
return ;
end
end else
begin
FProjectManager.GoToAFunction(dv);
return ;
end
end
end
end
end
FProjectManager.ShowEditor();
end
function AddAndOPenEvent(nd);
begin
{**
@explan(说明)通过节点打开函数编辑器 %%
**}
addandopeneventbyname(nd,n);
end
function DBLClickComponent(o,e);//双击组件
begin
{**
@explan(说明) 组件被双击 %%
**}
if o then AddAndOPenEvent(o._tag);
if e then e.skip := true;
end
private
function ClickComponent(o,e); //点击组件选择
begin
{**
@explan(说明) 组件被点击 %%
**}
nd := o._tag;
if FCurrentNode<> nd then
begin
wd := o;//nd.Component.Cwnd;
//if wd is class(TWincontrol) then _wapi.BringWindowToTop(wd.Handle);
FTree.SetSel(nd);
TreeNodeSelected(nd);
end;
setcomponentfocus(o,true);
if FComponentCreater and FCurrentNode then
begin
//SetSysParam("cpos_screan",array(e.lolparam,e.hilparam));
if FComponentCreater is class(TDRootComponent) then
begin
FCurrentNode := (FTree.RootItem.items)[0];
if not FCurrentNode then exit;
O1 := FCurrentNode.Component.Cwnd;
if not o1 then exit;
end else o1 := o;
xy := array(0,0);
_wapi.GetCursorPos(xy);
FCurrentClikPos := o.ScreenToClient(xy[0],xy[1]);
//FCurrentClikPos := array(e.lolparam,e.hilparam);//o1.screentoclient(e.lolparam,e.hilparam);
r := CreateComponent();
end
return ;
end
function ClickTreeNode(o,e);//点击树选择
begin
{**
@explan(说明) 通过点击选择节点 %%
**}
od := e.itemold;
if od then
begin
cp := od.Component;
if cp then
begin
setcomponentfocus(cp.Cwnd,false);
end
end
TreeNodeSelected(e.item);
end
function SpectorClose(o,e);//objectspector 关闭
begin
{**
@explan(说明) 目录树关闭 %%
**}
e.skip := true;
o.visible := false;
if o._Tag is class(tmenu) then o._tag.Checked := false;
end
function OnToolButtonCick(o,e); //工具栏
begin
{**
@explan(说明) 选择工具按钮 %%
**}
cct := o._tag;
//if FComponentCreater=cct then exit;
FComponentCreater := cct;
return ;
fm := (FTree.RootItem.items)[0];
if not fm then exit;
O1 := fm.Component.Cwnd;
o1.show();
end
function CloseShowForm(); //主窗口关闭
begin
{**
@explan(说明)关闭当前工程窗口%%
**}
FProjectManager.CloseCurrentEdit();
end
public
function BindCwndMessage(wnd);
begin
{**
@explan(说明) 为控件添加事件 %%
**}
if wnd is class(tmenu) then wnd.OnDesignClick := thisfunction(ClickComponent);
if wnd is class(TWincontrol) then
begin
wnd.OnDesignClick := thisfunction(ClickComponent);
wnd.OnDesigndblClick := thisfunction(DBLClickComponent);
wnd.OnDesignrClick := thisfunction(RClickComponent);
//wnd.onmove := thisfunction(ComponentMove);
//wnd.onsize := thisfunction(ComponentSize);
//wnd.Onclose := thisfunction(CompClose); //只是忽略
wnd.Onclose := function(o,e)begin
e.skip := true;
CloseShowForm(); //并保存窗口信息
end ;
wnd.bindmessage(wnd.WM_NCLBUTTONDOWN,thisfunction(ClickComponent));
//WM_NCLBUTTONUP wnd.
if (wnd is class(TVCForm)) then
begin
{wnd.Onclose := function(o,e)begin
e.skip := true;
CloseShowForm();
end ;}
wnd.OnMinimize := thisfunction(CompClose);
end
end
end
function UnLoadTreeNode();
begin
{**
@explan(说明) 卸载tree的节点%%
**}
node := FTree.RootItem;
if node.ItemCount>0 then
begin
DeleteNode((Node.items)[0]);
end
FVariableSelecter.clean();
FEventGrid.Component := array();
FPropGrid.Component := array();
//清除TemporaryNotName
class(TDComponent).TemporaryNotName := array();
end
private
FLoadInheritedName;
public
function LoadTreeNode(Ptfm,inh);
begin
{**
@explan(说明) 加载tree节点 %%
**}
FLoadInheritedName := inh;
UnLoadTreeNode();
FTree.Loading := true;
try
prs := array();
obarray := array();
loadtfmtotree(Ptfm,Ptfm.gettree,FTree.RootItem,FTree,prs,obarray);
for i,v in prs do
begin
va := obarray[v[2]];
if va then
begin
v[0].SetComponentProperties(v[1],va.GetTrueComponent());
end
end
except
end ;
FTree.Loading := nil;
end
function loadtfmtotree(p,d,node,owner,prs,obarray);
begin
{**
@explan(说明) 导入tfm文件 %%
**}
if not ifarray(d) then exit;
if not d["type"]=p.TT_COMP then exit;
dcls := d["class"];
it := GetClassItem(dcls);
if not it then
begin
if ("tdcreateform" in FLoadInheritedName) then
begin
it := NEW TDForm();
end else
if "tdcreatepanel" in FLoadInheritedName then
begin
it := new TDPanelForm();
end else return ;
it.dclassname(d["class"]);
it.Imgs := FImageList.GetImageId("tdcreateform");
FLoadInheritedName := array();
end
comp := it.ComponentCreater(node,owner);
comp.name := d["name"];
obarray[d["name"]] := comp;
FVariableSelecter.additem(comp);
BindCwndMessage(comp.Cwnd);
pubs := comp.GetPublishProperties() union comp.GetPublishEvents();
dprop := d["property"];
ddp := array();
for i,v in dprop do
begin
ddp[v["name"]] :=v;
end
if comp.DefaultAlign() then
begin
if ifarray(ddp["align"]) and (ddp["align"]["value"]="alnone") then
begin
comp.Cwnd.align := alnone;
end
end
lazy := array();
for i,v in pubs do
begin
n := i;
ddpv := ddp[n];
if not ifarray(ddpv) then continue;
cls := v["class"];
et := GetComponentPropertyType(cls);//GetPropertyType(cls);
if not et then continue;
setddpv := et.TmfToNode(p.SampleValue(ddpv));
if et.IfComponent() then
begin
prs[length(prs)]:= array(comp,n,setddpv);
continue;
end
if et.LazyProperty() then
begin
lazy[length(lazy)] := array(n,setddpv);
continue;
end
comp.SetComponentProperties(n,setddpv);
end
for i,v in d["object"] do
begin
call(thisfunction,p,v,comp.TreeNode,comp.Cwnd,prs,obarray);
end
for i,v in lazy do
begin
comp.SetComponentProperties(v[0],v[1]);
end
//comp.DoControlAlign();
end
function SetFunctionList(v);
begin
{**
@explan(说明) 设置当前类使用的函数名称 %%
**}
FFunctionSelecter.clean();
FFunctionSelecter.additem("(none)");
for i,vi in v do
begin
if vi in array("create","destroy","recycling","loadfromtfm") then continue;
FFunctionSelecter.additem(vi);
end
end
function create(AOwner);
begin
inherited;
tmpcanvas := new tcanvas(AOwner);
top := 10;
left := 10;
rect := _wapi.GetScreenRect();
twidth := (rect[2]-50);
width := twidth;
calcheight(twidth);
caption := "TVCL界面设计器";
FProjectsManager := new TProjectManagerForm(self);
ico := new tbitmap();
ico.Readvcon(HexFormatStrToTsl( GetHostroyBimp()));
FProjectsManager.FormICon := ico.ToIcon();
FProjectsManager.parent := self;
FProjectManager := new TProjectView(self);
FProjectManager.height := rect[3]-top-height-20;
FProjectManager.left := left;
FProjectManager.top := top+height;
ico := new tbitmap();
ico.Readvcon(HexFormatStrToTsl(GetWindowMgrBmp()));
FProjectManager.FormICon := ico.ToIcon();
FProjectManager.parent := self;
//FTempCanvas := new
//***********************************************
FObjInspector := initobjinspector();
FObjInspector.height := rect[3]-top-height-20;
tparent := new TPairSplitterSide(self);
tparent.border := false;
pparent := new TPairSplitterSide(self);
//**********树************************
FTree := new TComponentTree(self);
FTree.onselchanged := thisfunction(ClickTreeNode);
FTree.align := alClient;
//*************属性修改器**********************
pedits := new TPageControl(self);
pedits.align := alclient;
FProp := new TTabSheet(self);
FProp.caption := "properties";
FEvent := new TTabSheet(self);
FEvent.caption := "events";
FPropGrid := new TPropEditGrid(self);
FPropGrid.border := false;
FPropGrid.Component := self;
FEventGrid := new TEventEditGrid(self);
FVariableSelecter := new TListVariableFilter(self);
FVariableSelecter.visible := false;
FVariableSelecter.parent := FPropGrid;
FFunctionSelecter := new TListStr(self);
FFunctionSelecter.visible := false;
FFunctionSelecter.parent := FEventGrid;
FEventGrid.EventEditer := FFunctionSelecter;
FPropGrid.VariabeEditer := FVariableSelecter;
//**************父窗口关系*********************
FObjInspector.parent := self;
tparent.parent := FObjInspector;
pparent.parent := FObjInspector;
FTree.parent := tparent;
pedits.parent := pparent ;
FProp.parent := pedits;
FEvent.parent := pedits;
FPropGrid.align := alclient;
FEventGrid.align := alclient;
FPropGrid.parent := FProp;
FEventGrid.parent := FEvent;
Mobjinspect();
onactivate := thisfunction(OnDesignerActivate);
FImageList := new TDesigImageList(self);
FTree.Imagelist := FImageList;
//******************toolbar ***************
{fdebugtoolbar := new TToolBar(self);
btns := FProjectManager.FTslEditer.getdbugtoolbtns();
idx := 0;
for i,v in btns do
begin
if idx = 0 then fdebugtoolbar.ImageList := v.parent.ImageList;
idx++;
if v.caption = "添加/删除断点F5" then continue;
v.parent := fdebugtoolbar;
v._tag := v.onclick;
v.onclick := function(o,e)begin
cp := o.caption;
CallMessgeFunction(o._tag,o,e);
if cp<>"终止" then
begin
FProjectManager.ShowEditor();
end
end;
end }
tlbar := FProjectManager.FTslEditer.gettoolbar();
savebtn := array( tlbar.getbtnbyindex(1),tlbar.getbtnbyindex(2));
for i,v in savebtn do //处理一下保存工程
begin
v._tag := array(thisfunction(saveCurrentForm),v.onclick);
v.onclick := function(o,e)
begin
for i,v in o._tag do
begin
CallDataFunction(v,o,e);
end
end
end
tlbar.parent := self;
FToolBars := new TDesignertoolbars(self);
FToolBars.parent := self;
FToolBars.Imagelist := FImageList;
FToolBars.Font.width := 9;
FToolBars.Font.height := 18;
addtoolbuttons();
//************菜单******************************
createmainmenubyarray(mainmenus(),FMenu0,self);
Mainmenu := FMenu0;
self.onclose := thisfunction(DesignerClose);
ic := new Ticon();
ic.Readvcon(HexFormatStrToTsl(GetTsIconBitmapInfo()));
self.FormICon := ic;
{fdebugtoolbar.Align := alnone;
fdebugtoolbar.left := FToolBars.Flabelcharlen* 10;
fdebugtoolbar.top := 0;
fdebugtoolbar.parent := FToolBars;}
//文件打窗口
FProjectFileOpener := new TOpenFileADlg(self);
FProjectFileOpener.filter := array("tvcl工程":"*.tpj");
FProjectFileOpener.parent := self;
end
property VariableSelecter read FVariableSelecter;
private
function ViewBitmap(o,e);
begin
if not FViewBitmap then
begin
FViewBitmap := new TViewBitmap(self);
FViewBitmap.minmaxbox := FALSE;
FViewBitmap.visible := 0;
FViewBitmap.visible := false;
FViewBitmap.onclose := thisfunction(SpectorClose);
FViewBitmap.parent := self;
FViewBitmap._Tag := o;
//FViewBitmap.show(0);
end
FViewBitmap.visible := not FViewBitmap.visible;
if o then o.Checked := FViewBitmap.visible;
end
function StopProject(o,e);
begin
//FRounMenu.Enabled := true;
//FStopMenu.Enabled := false;
FProjectManager.StopProject();
end
function RunProject(o,e); //运行
begin
FRounMenu.Enabled := false;
FStopMenu.Enabled := true;
FProjectManager.RunProject();
FRounMenu.Enabled := true;
FStopMenu.Enabled := false;
end
function editcommandline();
begin
FProjectManager.ShowExeEditer();
end
function debugproject(o,e);
begin
FProjectManager.debugproject();
end
function Mobjinspect(o,e); //切换属性展示器
begin
{**
@explan(说明) 属性修改器 %%
**}
FObjInspector.Visible := not FObjInspector.Visible;
if FObjInspector.Visible then
begin
FObjInspector.left := width+ Left-FObjInspector.width;
FObjInspector.top := top+height;
end
if o then
begin
FObjInspector._tag := o;
o.Checked := FObjInspector.Visible
end
end
function initobjinspector();
begin
project := new TPairSplitter(self);
project.visible := false;
project.caption := "object inspector";
project.Onclose := thisfunction(spectorclose);
project.WsPopUp := true;
project.Visible := false;
project.Width := 300;//
project.height := 800;
project.WsCaption := true;
project.WsSysmenu := true;
project.WSSizebox := true;
project.SplitterType := pstVertical;
project.position := 250;
return project;
end
function GetWindowMgrBmp();
begin
return "0502000000060400000074797065000203000000696D670006040000006461746
10002DA01000089504E470D0A1A0A0000000D4948445200000010000000100806
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000016F49444154
384FA593EB4EC2401484F7790595702FC59710451451047C0C140C218410EA637
0BFDF2119CF54DA748DBFA0C964DBCDCC7732BBA9C2998F4A96DA48962C24DFBF
65A52C98450B89621BC65B0BF17C13B19706A2B93A22D91AC24F5FC7E8EF23000
B370C1F650A242100A3D0465C00B1D726A202883CD7255C43E8F11F8016161902
880B20966F212A8070AE8150B68EA00082993F005300FBFD1E87C3C115BF77BB1
D369B0D96CB25E6F33926930986C321020F55AD8E32A52BCD1483DEF07ABDB601
B3D9CC055CA72B5A1D9528B46CF376BB75E50D73FA743AC56834C26030C0E57D4
5ABA30C39651A57AB951DE2CA6F27CCE9E3F1D806F4FB7DF8EF3EB53A8A5744A3
A3C562E10639D909737AAFD783CF03601DC503E106CD14DF1D39619A39DD06A43
EB43A8AA7C90DAF18A0686290EA76BBE8743AF0DD966D8F5347F12A789A415120
53C5B5F4BA4A57E1173A0D9C485D1C575FAAACD5D1FE8553EA688053EA688053E
A9CF93B033F9EA579B5AA7EC4E00000000049454E44AE42608200";
end
FProjectFileOpener;
end
implementation
type 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 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
//****************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 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 inherited;
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 TDTray = class(TDRootComponent)
{**
@explan(说明) statusbar设计器控件 %%
**}
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[0]or r[0]>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("<Array[%d]>",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("<TSL Object>",src);
class(TLabel).CanvasDrawAlignText(dc,src,"<TSL Object>",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
dna := dn;
dn := GetPopRect(1);
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 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 "<ARRAY>";
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(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(说明) 属性编辑 %%
**}
protected
function SetComponent(v);override;
begin
if v=FComponent then exit;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishProperties();
end else
begin
TSLData := array();//array(NIL);
end
inherited;
end
public
function Create(AOwner);
begin
inherited;
end
end
type TEventEditGrid = class(TPropGrid)
{**
@explan(说明) 事件编辑 %%
**}
protected
function SetComponent(v);override;
begin
if v=FComponent then exit;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishEvents();
//echo tostn(TSLData);
end else
begin
TSLData := array(NIL);
end
inherited;
end
public
function Create(AOwner);
begin
inherited;
OndblClick := thisfunction(GridCellDblClick);
end
function GridCellDblClick(o,e);override;
begin
i := e.iitem;
j := e.isubitem;
cellid := array(i,j);
if not(i >= 0 and j >= 0)then
begin
exit;
end
d := getdata(i,j);
if ifarray(d)and d["type"]="object" then
begin
rd := GetRegCellRender(d["class"]);
if rd is class(TGCellRender)then //处理双击
begin
if FComponent then
begin
FDesigner.addandopeneventbyname(FComponent.TreeNode,getdata(i,0));//DBLClickComponent();
end
end
end
end
end
type TDesigImageList = class(TControlImageList)
{**
@explan(说明) 设计器imagelist %%
**}
private
FIconMaps;
public
function Create(AOwner);override;
begin
inherited;
Width := 24;
Height := 24;
FIconMaps := array();
end
function RegisterDitem(item);virtual;
begin
{**
@explan(说明) 注册图标 %%
@param(item)(TDComponent) %%
**}
if item is Class(TDComponent) then
begin
n := item.dclassname;
id := FIconMaps[n];
bmp := item.bitmap();
if (bmp is class(TcustomBitmap)) and bmp.HandleAllocated() then
begin
if id>=0 then
begin
Replaceimge(id,bmp) ;
end else
begin
addbmp(bmp);
FIconMaps[n] := ImageCount-1;
end
end
end
end
function GetImageId(v);
begin
if ifstring(v) then
begin
n := v;
end
if v is class(TDComponent) then
begin
n := V.dclassname;
end
r := FIconMaps[n];
return r?r:0;
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;
FLabels ;
fimg;
function SetImageList(im);
begin
fimg := im;
end
public
Flabelcharlen;
function Create(AOwner);override;
begin
inherited;
align := alClient;
FToolbars := array();
Flabelcharlen := 0;
end
Procedure Notification(AComponent,Operation);virtual;
begin
if Operation=opRemove then
begin
if AComponent=fimg then
begin
fimg := nil;
end else
begin
for i,v in FToolbars do
begin
if v=AComponent then
begin
idx := i;
end
end
if idx then
begin
reindex(FToolbars,array(idx:nil));
end
end
end
inherited;
end
function CrossCursor(f);
begin
for i,v in FToolbars do
begin
if f then
v.Cursor := OCR_CROSS;
else v.Cursor := OCR_NORMAL;
end
end
function addbtn(btn,t);
begin
if not(t and ifstring(t)) then
begin
t := "常用";
end
tb := FToolbars[t];
if not tb then
begin
st := new TTabSheet(self);
st.caption := t;
tb := new ttoolbar(self);
tb.align := alClient;
if t<>"非点击添加控件" then
begin
st.parent := self;
tb.parent := st;
Flabelcharlen+= length(t)+2;
end
tb.imagelist := fimg;
FToolbars[t] := tb;
end
btn.parent := tb;
end
property ImageList write SetImageList;
end
//*************设计器*********************************
type 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 id<FVlist.Count-1 do
begin
oa := FVlist[id];
if oa.name then
begin
id++;
end else
begin
FVlist.deli(id);
end
end
end
function dofilter();
begin
class(TListVariable).clean();
cleandestroy();
vs := array();
for i:= 0 to FVlist.count-1 do
begin
vi := FVlist[i];
if FFilter.filter(vi) then
begin
vs[length(vs)] := vi;
end
end
additems(array(new tnone()) union vs);
end
function create(AOwner);override;
begin
inherited;
FDesigner := AOwner;
FFilter := new ttypefilter();
FVlist := new TFpList();
clean();
end
function delitem(v);override;
begin
for i := 0 to FVlist.Count-1 do
begin
if v=FVlist[i] then return FVlist.deli(i);
end
end
function additem(v);override;
begin
if not(v is class(TDComponent)) then exit;
FFirst := true;
for i := 0 to FVlist.Count-1 do
begin
if v=FVlist[i] then return ;
end
FVlist.add(v);
FDesigner.AddusesFromEdit(v.libs());
FDesigner.AddFiledFromEdit(v.name+":"+v.dclassname);
FDesigner.EditerCodeChanged();
//echo "\r\nadd:",v.name;
//echo "\r\n variable count:",FVlist.Count;
end
property Filter Write SetFilter;
private
FDesigner;
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 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
//**********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(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 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"]="删除" 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"]="删除" 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(说明) 图片信息采集%%
**}
private
FFileopen;
FBmp;
FText;
FOldSize;
Fimage;
FMU;
FMopen;
FMhelp;
FMCopy;
FClipBoard;
FLB;
public
function paint();override;
begin
if FBmp and FBmp.Handle then
begin
if FBmp.bmwidth<200 and FBmp.bmheight<300 then
FBmp.draw(self.canvas,650,100);
else
FBmp.StretchDraw(self.canvas,array(650,100,650+200,100+300));
end
end
function GetBimpOpenBmp();
begin
return getbitmapviewerbitmapinfo();
end
function Create(AOwner);override;
begin
inherited;
ico := new tbitmap();
ico.Readvcon(HexFormatStrToTsl( GetBimpOpenBmp()));
FormICon := ico.ToIcon();
caption := "图片信息提取,支持bmp,ico,png,jpg,jpeg格式";
FFileopen := new TOpenFileADlg(self);
FClipBoard := new TClipBoard(self);
FMU := new TMainmenu(self);
FMopen := new TMenu(self);
FMopen.caption := "打开图片";
FMhelp := new TMenu(self);
FMCopy := new TMenu(self);
FMhelp.caption := "帮助";
FMCopy.caption := "拷贝信息到粘贴板";
FMopen.parent := FMU;
FMCopy.parent := FMu;
FMhelp.parent := FMu;
FMhelp.OnClick := thisfunction(OnHelp);
FMCopy.OnClick := thisfunction(OnCopy);
FMopen.onclick := thisfunction(OpenBmp);
FFileopen.wndowner := self;
FFileopen.filter := array("all":"*.bmp;*.ico;*.png;*.jpg;*.jpeg","bmp":"*.bmp","ico":"*.ico","png":"*.png");
FBmp := new TBitmap();
FText := new TSynMemoNorm(self);
FText.border := true;
FText.readonly := true;
FText.parent := self;
FText.top := 15;
FText.width := 600;
FText.Height := 430;
lb := new TLabel(self);
FLB := lb;
lb.caption := "浏览图片:";
lb.left := 650;
lb.top := 20;
lb.width := 200;
lb.parent := self;
Fimage := new timage();
FOldSize := array(0,0);
Mainmenu := FMU;
end
function OnHelp(o,e);
begin
_wapi.MessageBoxA(self.Handle,"将图片信息转换为16进制字符串\r\nHexFormatStrToTsl 函数可以将该信息转换为tsl数组\r\n然后btmap对象通过Readvcon读入该数组得到bitmap","帮助",0);
end
function Oncopy(o,e);
begin
r := FText.text;
if r then
begin
FClipBoard.text := r;
_wapi.MessageBoxA(self.Handle,"拷贝到粘贴板成功!","提示",0);
end else _wapi.MessageBoxA(self.Handle,"数据为空!","提示",0);
end
function OpenBmp(o,e);virtual;
begin
IF FFileopen.ChooseDlg() then
begin
r := 3;
r := Fimage.LoadFromFile(FFileopen.FileName);
if r<>0 then
begin
_wapi.MessageBoxA(0,"打开失败","错误",0);
return ;
end
FBmp.Handle := Fimage.ToHBitmap();
size := array(FBmp.bmwidth,FBmp.bmheight);
Flb.caption := format("浏览图片:%d*%d",size[0],size[1]);
rsize := array(min(300,max(size[0],FOldSize[0])),min(300,max(size[1],FOldSize[1])));
FText.text := TSLToHexFormatStr(FBmp.TOvcon);
Invalidaterect(array(650,100,650+rsize[0],100+rsize[1]));
FOldSize := size;
end
end
end
function 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 i<len-1 then ps+=";";
end
end
hs := nil;
vt := "";
if f["virtual"] then vt := "virtual;";
if ifstring(n) and ifstring(b) then
hs := "\r\n\tfunction "+n+"("+ps+");"+vt+"\r\n\tbegin\r\n"+b+"\r\n\tend\r\n";
return hs;
end
function staticInit();
begin
//class(TDSocketServer),class(TDSocketClient),
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(TDEdit),
class(TDpassword),
class(TDmemo),
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(TVclDesigner);
o.RegestorClassItems(its);
ps := 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(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(ps);
////////////////////////////////////////////////////////////
//注册的componet
vclini := pluginpath()+"tslvcldesigner.ini";
if fileexists("",vclini) then
begin
ini := new TIniFileExta("",vclini);
ini.LowerKey := true;
its := array();
for i,v in ini.ReadSectionValues("components") do //控件
begin
if v then
begin
cv := findclass(v);
if cv then
begin
//RegisterComponentType(i,cv);
its[length(its)] := cv;
end
end
end
o := class(TVclDesigner);
o.RegestorClassItems(its);
its := array();
for i,v in ini.ReadSectionValues("properties") do //属性
begin
if v then
begin
cv := findclass(v);
if cv then
begin
its[length(its)] := cv;
end
end
end
registerproperties(its);
end
end
function registereditpropertytodesigner(cls);
begin
{**
@explan(说明) 注册编辑属性 %%
@param(cls)(TDComponent) 设计控件 %%
**}
if ifarray(cls) then return registerproperties(cls);
return registerproperties(array(cls));
end
function registercomponenttodesigner(cls);
begin
{**
@explan(说明) 注册控件到设计器 %%
@param(cls)(TDComponent) 设计控件 %%
**}
if ifarray(cls) then return class(TVclDesigner).RegestorClassItems(cls);
return class(TVclDesigner).RegestorClassItems(array(cls));
end
////5108321
function initlib();
begin
{**
@explan(说明) 该函数采用静态方式初始化 %%
**}
a := static staticInit();
end
initialization
initlib();
end.