编辑器

修复
This commit is contained in:
JianjunLiu
2023-05-22 15:36:07 +08:00
parent d71f0753f1
commit 7f8ea00181
15 changed files with 970 additions and 702 deletions
@@ -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
+151
View File
@@ -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
+97
View File
@@ -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