编辑器
修复
This commit is contained in:
@@ -0,0 +1,80 @@
|
||||
object extcompclassadder:textcompclassadder
|
||||
caption="添加"
|
||||
height=406
|
||||
left=474
|
||||
minmaxbox=false
|
||||
onclose=extcompclassadder_close
|
||||
top=316
|
||||
width=402
|
||||
wssizebox=false
|
||||
object e_classname:tedit
|
||||
caption="edit1"
|
||||
height=25
|
||||
left=91
|
||||
readonly=true
|
||||
top=28
|
||||
width=255
|
||||
end
|
||||
object label1:tlabel
|
||||
left=20
|
||||
top=28
|
||||
width=50
|
||||
height=25
|
||||
caption="控件类"
|
||||
end
|
||||
object b_classfile:tbtn
|
||||
caption="..."
|
||||
height=24
|
||||
left=354
|
||||
onclick=b_classfile_clk
|
||||
top=29
|
||||
width=21
|
||||
end
|
||||
object label2:tlabel
|
||||
left=20
|
||||
top=72
|
||||
width=64
|
||||
height=25
|
||||
caption="图标"
|
||||
end
|
||||
object p_imgshow:tpanel
|
||||
caption="img"
|
||||
height=187
|
||||
left=91
|
||||
top=120
|
||||
width=245
|
||||
wsdlgmodalframe=false
|
||||
end
|
||||
object b_img:tbtn
|
||||
caption="添加图标"
|
||||
height=25
|
||||
left=91
|
||||
onclick=b_img_clk
|
||||
top=73
|
||||
width=94
|
||||
end
|
||||
object b_ok:tbtn
|
||||
caption="确定"
|
||||
enabled=true
|
||||
height=31
|
||||
left=133
|
||||
onclick=b_ok_clk
|
||||
top=317
|
||||
width=72
|
||||
end
|
||||
object b_cancel:tbtn
|
||||
caption="取消"
|
||||
height=31
|
||||
left=283
|
||||
onclick=b_cancel_clk
|
||||
top=317
|
||||
width=73
|
||||
end
|
||||
object f_open:topenfileadlg
|
||||
left=22
|
||||
top=146
|
||||
height=30
|
||||
width=30
|
||||
caption="文件选择"
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,64 @@
|
||||
object extcompclassmgr:textcompclassmgr
|
||||
caption="注册控件-管理"
|
||||
height=467
|
||||
left=447
|
||||
minmaxbox=false
|
||||
onclose=extcompclassmgr_close
|
||||
top=272
|
||||
width=477
|
||||
wssizebox=true
|
||||
object listbox1:tlistbox
|
||||
caption="listbox1"
|
||||
height=345
|
||||
left=4
|
||||
onselchanged=listbox1_sel
|
||||
top=38
|
||||
width=344
|
||||
end
|
||||
object b_del:tbtn
|
||||
caption="删除"
|
||||
enabled=false
|
||||
height=31
|
||||
left=364
|
||||
onclick=b_del_clk
|
||||
top=248
|
||||
width=88
|
||||
end
|
||||
object b_add:tbtn
|
||||
caption="添加"
|
||||
height=31
|
||||
left=364
|
||||
onclick=b_add_clk
|
||||
top=299
|
||||
width=88
|
||||
end
|
||||
object b_ok:tbtn
|
||||
caption="完成"
|
||||
height=31
|
||||
left=364
|
||||
onclick=b_ok_clk
|
||||
top=346
|
||||
width=88
|
||||
wssizebox=false
|
||||
wssysmenu=false
|
||||
end
|
||||
object statusbar1:tstatusbar
|
||||
caption="statusbar1"
|
||||
height=25
|
||||
items= [<
|
||||
width=500
|
||||
text="控件管理"
|
||||
>
|
||||
]
|
||||
left=0
|
||||
top=403
|
||||
width=461
|
||||
end
|
||||
object label1:tlabel
|
||||
left=8
|
||||
top=10
|
||||
width=80
|
||||
height=25
|
||||
caption="控件列表"
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,151 @@
|
||||
type textcompclassadder=class(tdcreateform)
|
||||
uses tslvcl;
|
||||
e_classname:tedit;
|
||||
label1:tlabel;
|
||||
b_classfile:tbtn;
|
||||
label2:tlabel;
|
||||
p_imgshow:tpanel;
|
||||
b_img:tbtn;
|
||||
|
||||
b_ok:tbtn;
|
||||
b_cancel:tbtn;
|
||||
f_open:topenfileadlg;
|
||||
function Create(AOwner);override; //构造
|
||||
begin
|
||||
inherited;
|
||||
end
|
||||
|
||||
|
||||
function extcompclassadder_close(o;e);virtual;
|
||||
begin
|
||||
e.skip := true;
|
||||
Visible := false;
|
||||
EndModal(0);
|
||||
inherited;
|
||||
|
||||
end
|
||||
|
||||
function b_cancel_clk(o;e);virtual;
|
||||
begin
|
||||
EndModal(0);
|
||||
end
|
||||
function b_ok_clk(o;e);virtual;
|
||||
begin
|
||||
s := e_classname.text;
|
||||
if fclasshash and fclasshash[s] then
|
||||
begin
|
||||
messageboxa("该控件已经注册","提示",0,self);
|
||||
return ;
|
||||
end
|
||||
o := findclass(s);
|
||||
if not (o is class(TWinControl)) then
|
||||
begin
|
||||
messageboxa("组件类型错误,或者组件不存在","提示",0,self);
|
||||
return ;
|
||||
end
|
||||
if not fbmp then
|
||||
begin
|
||||
messageboxa("请选择合适的图标","提示",0,self);
|
||||
return ;
|
||||
end
|
||||
EndModal(1);
|
||||
end
|
||||
function b_img_clk(o;e);virtual;
|
||||
begin
|
||||
f_open.filter := array("图片文件":"*");
|
||||
if not(f_open.OpenDlg()) then return ;
|
||||
fbmp := new TBitmap();
|
||||
fbmp.id := f_open.filename;
|
||||
p_imgshow.BKBitmap := fbmp;
|
||||
if fbmp.HandleAllocated() then return ;
|
||||
fbmp := nil;
|
||||
end
|
||||
|
||||
function b_classfile_clk(o;e);virtual;
|
||||
begin
|
||||
f_open.filter := array("控件类文件":"*.tsf");
|
||||
e_classname.text := "";
|
||||
if not(f_open.OpenDlg()) then return ;
|
||||
iof := iofileseparator();
|
||||
fn := f_open.filename;
|
||||
nf := fn[1:length(fn)-4];
|
||||
n := "";
|
||||
for i:= length(nf) downto 1 do
|
||||
begin
|
||||
vi := nf[i];
|
||||
if vi=iof then
|
||||
begin
|
||||
|
||||
break;
|
||||
end
|
||||
n := vi+n;
|
||||
end
|
||||
ln := lowercase(n);
|
||||
e_classname.text := ln;
|
||||
end
|
||||
function DoControlAlign();override;//对齐子控件
|
||||
begin
|
||||
//当窗口大小改变时,该函数会被调用,
|
||||
//可以通过 clientrect 获取客户区大小,设置子控件的位置以及大小
|
||||
//如果自己处理了子控件的对齐,就可以去掉 inherited
|
||||
inherited;
|
||||
end
|
||||
function Recycling();override; //回收变量
|
||||
begin
|
||||
inherited;
|
||||
ci := self.classinfo(); //将成员变量赋值为nil避免循环引用
|
||||
for i,v in ci["members"] do
|
||||
begin
|
||||
if v["static"] then continue;
|
||||
invoke(self,v["name"],nil);
|
||||
end
|
||||
end
|
||||
function createdclass();
|
||||
begin
|
||||
ra := %% type %s =class(TDComponent)
|
||||
uses utslvcldcomponents;
|
||||
function create(AOwner);
|
||||
begin
|
||||
inherited;
|
||||
end
|
||||
function classification();override;
|
||||
begin
|
||||
return "自定义";
|
||||
end
|
||||
function bitmapinfo();override;
|
||||
begin
|
||||
return "%s";
|
||||
end
|
||||
function WndClass();override;
|
||||
begin
|
||||
return Class(%s);
|
||||
end
|
||||
end
|
||||
%%;
|
||||
r := format(ra,"td_a_"+e_classname.text,TslToHexFormatStr(fbmp.tovcon()),e_classname.text);
|
||||
return r;
|
||||
end
|
||||
function getreginfo();
|
||||
begin
|
||||
r := array();
|
||||
r["name"] := e_classname.text;
|
||||
r["dclassname"] := "td_a_"+e_classname.text;
|
||||
r["dclassbody"] := createdclass();
|
||||
return r;
|
||||
end
|
||||
property classhash read fclasshash write setclasshash;
|
||||
fclasshash;
|
||||
fbmp;
|
||||
private
|
||||
function setclasshash(v);
|
||||
begin
|
||||
if v<>fclasshash then
|
||||
begin
|
||||
fclasshash := array();
|
||||
for i,vi in v do
|
||||
begin
|
||||
fclasshash[vi] := true;
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
@@ -0,0 +1,97 @@
|
||||
type textcompclassmgr=class(tdcreateform)
|
||||
uses tslvcl;
|
||||
listbox1:tlistbox;
|
||||
b_del:tbtn;
|
||||
b_add:tbtn;
|
||||
b_ok:tbtn;
|
||||
statusbar1:tstatusbar;
|
||||
label1:tlabel;
|
||||
function Create(AOwner);override; //构造
|
||||
begin
|
||||
inherited;
|
||||
end
|
||||
function extcompclassmgr_close(o;e);virtual;
|
||||
begin
|
||||
|
||||
{**
|
||||
@explan(说明) 主窗口关闭回调 %%
|
||||
@param(e)(tuievent) 消息对象 %%
|
||||
@param(o)(ttimer) 当前主窗口 %%
|
||||
**}
|
||||
e.skip:= true;
|
||||
Visible := false;
|
||||
inherited;
|
||||
|
||||
end
|
||||
|
||||
function b_ok_clk(o;e);virtual;
|
||||
begin
|
||||
Visible := false;
|
||||
end
|
||||
function b_del_clk(o;e);virtual;
|
||||
begin
|
||||
idx := listbox1.ItemIndex;
|
||||
if idx>=0 and parent then
|
||||
begin
|
||||
p := parent;
|
||||
p.delexttypeclass(listbox1.getItemText(idx));
|
||||
relisttypeclass();
|
||||
end
|
||||
end
|
||||
function b_add_clk(o;e);virtual;
|
||||
begin
|
||||
if not fadder then
|
||||
begin
|
||||
fadder := new textcompclassadder(self);
|
||||
fadder.Visible := false;
|
||||
fadder.parent := self;
|
||||
fadder.Left := left-10;
|
||||
fadder.top := top-10;
|
||||
end
|
||||
fadder.classhash := ftypelist;
|
||||
if fadder.ShowModal() then
|
||||
begin
|
||||
//echo tostn(fadder.getreginfo());
|
||||
p := parent;
|
||||
if p then
|
||||
begin
|
||||
p.addexttypeclass(fadder.getreginfo());
|
||||
end
|
||||
relisttypeclass();
|
||||
end
|
||||
end
|
||||
function relisttypeclass();
|
||||
begin
|
||||
p := parent;
|
||||
if p then
|
||||
begin
|
||||
ts := p.getexttypeclass();
|
||||
r := array();
|
||||
idx := 0;
|
||||
for i,v in ts do
|
||||
begin
|
||||
r[idx++] := v.dclassname();
|
||||
end
|
||||
if r<>ftypelist then
|
||||
begin
|
||||
listbox1.Items := r;
|
||||
ftypelist := r;
|
||||
end
|
||||
end
|
||||
end
|
||||
function showmgr();
|
||||
begin
|
||||
relisttypeclass();
|
||||
show();
|
||||
end
|
||||
function listbox1_sel(o;e);virtual;
|
||||
begin
|
||||
idx := o.ItemIndex;
|
||||
if idx>=0 then
|
||||
begin
|
||||
b_del.Enabled := true;
|
||||
end
|
||||
end
|
||||
[weakref]fdesginer;
|
||||
ftypelist;
|
||||
end
|
||||
Reference in New Issue
Block a user