tslediter/designer/tslvcldesigner.tsf

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