升级设计器

This commit is contained in:
liujianjun 2024-09-24 17:48:01 +08:00
parent cc72d4c6fc
commit 6d2f348019
10 changed files with 301 additions and 133 deletions

View File

@ -0,0 +1,124 @@
object fm_inheritedwnd:tfm_inheritedwnd
caption="通过继承构造窗口"
height=543
left=526
minmaxbox=false
onclose=fm_inheritedwnd_close
top=288
visible=false
width=433
object statusbar1:tstatusbar
caption="statusbar1"
height=25
left=0
top=479
width=417
end
object panel2:tpanel
align=albottom
caption="panel2"
height=31
left=0
top=448
width=417
wsdlgmodalframe=false
object label1:tlabel
left=399
top=0
width=18
height=31
caption=""
align=alright
end
object ed_ok:tbtn
align=alright
caption="确定"
enabled=false
height=31
left=308
onclick=ed_ok_clk
top=0
width=91
end
object label2:tlabel
left=283
top=0
width=25
height=31
caption=" "
align=alright
end
object bt_cancel:tbtn
align=alright
caption="取消"
height=31
left=195
onclick=bt_cancel_clk
top=0
width=88
end
end
object panel1:tpanel
align=altop
caption="panel1"
height=27
left=0
top=0
width=417
wsdlgmodalframe=false
object label3:tlabel
left=0
top=0
width=85
height=27
caption="可以继承:"
align=alleft
end
object ed_search:tedit
align=alclient
caption="edit1"
height=27
left=85
onchanged=ed_search_onchanged
onkeyup=ed_search_keyup
placeholder="搜索"
top=0
width=332
end
end
object panel3:tpanel
align=albottom
caption="panel1"
height=35
left=0
top=413
width=417
wsdlgmodalframe=false
object label4:tlabel
left=0
top=0
width=85
height=35
caption=" 名称:"
align=alleft
end
object ed_name:tedit
align=alclient
caption="edit1"
height=35
left=85
placeholder="名称"
top=0
width=332
end
end
object lbx_pal:tlistbox
align=alclient
caption="listbox1"
height=386
left=0
onselchanged=lbx_pal_sel
top=27
width=417
end
end

View File

@ -0,0 +1,133 @@
type tfm_inheritedwnd=class(tdcreateform)
uses tslvcl;
statusbar1:tstatusbar;
panel1:tpanel;
panel2:tpanel;
ed_ok:tbtn;
label1:tlabel;
label2:tlabel;
bt_cancel:tbtn;
label3:tlabel;
ed_search:tedit;
panel3:tpanel;
label4:tlabel;
ed_name:tedit;
lbx_pal:tlistbox;
function Create(AOwner);override; //构造
begin
fnds := array();
fnds2 := array();
fns := array();
inherited;
rc := _wapi.GetScreenRect();
left :=(rc[2]-rc[0])/2-280;
top :=(rc[3]-rc[1])/2-230;
end
function ed_search_keyup(o;e);
begin
case e.charcode of
VK_UP:
begin
idx := lbx_pal.ItemIndex;
if idx>0 then lbx_pal.ItemIndex := idx-1;
else lbx_pal.ItemIndex := length(fnds2)-1;
end
VK_DOWN:
begin
len := length(fnds2);
idx := lbx_pal.ItemIndex;
if idx<(len-1) then lbx_pal.ItemIndex := idx+1;
else lbx_pal.ItemIndex := 0;
end
end ;
end
function ed_ok_clk(o;e);
begin
EndModal(1);
end
function bt_cancel_clk(o;e);
begin
EndModal(0);
end
function lbx_pal_sel(o;e);
begin
idx := o.getCurrentSelection();
if idx>=0 then
begin
s := o.getItemText(idx);
n := 1;
while true do
begin
ns := s+inttostr(n);
if not(fns[ns]) then break;
n++;
end
ed_name.text := ns;
end else ed_name.text := "";
ed_ok.Enabled := (idx>=0);
end
function fm_inheritedwnd_close(o;e);
begin
e.skip := true;
o.EndModal(0);
end
function ed_search_onchanged(o;e); //搜索改变
begin
//if not fsearchok then return ;
set_to_list();
end
function getinfo();
begin
return array(fnds2[lbx_pal.getCurrentSelection()],ed_name.text);
end
function setinfo();
begin
ActiveControl := ed_search;
if parent then
begin
tr := parent.tree;
fnds := array();
tr.GetNodesBytype(fnds,array("form","panel"));
end
set_to_list();
end
function set_to_list();
begin
s := lowercase(trim( ed_search.text));
ss := array();
ssl := 0;
fnds2 := array();
fns := array();
for i,v in fnds do
begin
ssi := v.Fname;
fns[ssi] := true;
if not( s) or (s and pos(s,ssi)) then
begin
fnds2[ssl] := v;
ss[ssl++] := ssi;
end
end
lbx_pal.Items := ss;
ed_name.ExecuteCommand("ecselall");
end
function Recycling();override; //回收变量
begin
inherited;
ci := self.classinfo(); //将成员变量赋值为nil避免循环引用
for i,v in ci["members"] do
begin
if v["const"] then continue;
if v["static"] then continue;
invoke(self,v["name"],nil);
end
end
private
fsearchok;
fnds;
fnds2;
fns;
end

View File

@ -0,0 +1,11 @@
array("name":"vcldesginer","version":"1.1.2","dir":
(),"files":
("textcompclassadder":
("name":"textcompclassadder","type":"form","dir":""),"textcompclassmgr":
("name":"textcompclassmgr","type":"form","dir":""),"tfm_inheritedwnd":
("name":"tfm_inheritedwnd","type":"form","dir":""),"t_bconfig_cmd_shower":
("name":"t_bconfig_cmd_shower","type":"form","dir":""),"t_compile_config":
("name":"t_compile_config","type":"form","dir":""),"t_dir_list":
("name":"t_dir_list","type":"form","dir":""),"t_m_list_editor":
("name":"t_m_list_editor","type":"form","dir":"")),"mainform":"textcompclassmgr")

View File

@ -319,7 +319,7 @@ type TProjectView = class(TVCForm) //
width := 300; //350 width := 300; //350
height := max(400,rc[3]-200); height := max(400,rc[3]-200);
FInput := new TNameInput(self); FInput := new TNameInput(self);
finheritedinput := new tinheritedimput(self); finheritedinput := new tfm_inheritedwnd(self);
finheritedinput.parent := self; finheritedinput.parent := self;
FInput.visible := false; FInput.visible := false;
FInput.parent := self; FInput.parent := self;
@ -2904,132 +2904,6 @@ type TKeyValueList = class(TListBox) //kvalue list
private private
FCurrentIndex; FCurrentIndex;
end end
type tinheritedimput = class(TVCForm)
function Create(AOwner);override;
begin
inherited;
info := %%
object tinheritedinput1:tinheritedinput
visible = false
caption="通过继承构建窗口"
height=328
left=420
top=232
width=300
minmaxbox=false
object label3:tlabel
left=6
top=9
caption="可继承父类:"
end
object listbox1:tlistbox
caption="listbox1"
height=178
left=6
top=40
visible=true
width=280
onselchanged=listselchanged
end
object btn1:tbtn
caption="取消"
height=25
left=79
top=262
end
object btn2:tbtn
caption="确定"
height=27
left=187
top=261
end
object label1:tlabel
left=7
top=225
width=53
height=24
caption="名称:"
end
object edit1:tedit
caption="edit1"
left=62
top=226
width=218
end
end
%%;
WSSizebox := false;
loader.LoadFromTfmScript(self,info);
rc := _wapi.GetScreenRect();
left :=(rc[2]-rc[0])/2-280;
top :=(rc[3]-rc[1])/2-230;
Onclose := thisfunction(CloseEndModalForm);
btn1.onClick := function(o,e)
begin
Endmodal(0);
end
btn2.onClick := function(o,e);
begin
Endmodal(1);
end
end
function CloseEndModalForm(o,e);
begin
e.skip := true;
o.Endmodal(0);
end
function listselchanged(o,e);
begin
idx := o.getCurrentSelection();
if idx>=0 then
begin
s := o.getItemText(idx);
n := 1;
while true do
begin
ns := s+inttostr(n);
if not(fns[ns]) then break;
n++;
end
edit1.text := ns;
end
end
function getinfo();
begin
return array(fnds[listbox1.getCurrentSelection()],edit1.text);
end
function setinfo();
begin
ss := array();
fns := array();
if parent then
begin
tr := parent.tree;
fnds := array();
tr.GetNodesBytype(fnds,array("form","panel"));
for i,v in fnds do
begin
s := v.Fname;
ss[i] := s;
fns[s] := true;
end
end
listbox1.Items := ss;
edit1.ExecuteCommand("ecselall");
end
public //成员变量
fnds;
fns;
label3;
listbox1;
btn1;
btn2;
label1;
edit1;
end
type TNameInput=class(TCustomControl) //输入文件名窗口 type TNameInput=class(TCustomControl) //输入文件名窗口
function Create(AOwner);override; function Create(AOwner);override;
begin begin

View File

@ -318,7 +318,7 @@ type TVclDesigner = class(tvcform)
public //设计器工程 public //设计器工程
ffilemenu; ffilemenu;
fviewmenu; fviewmenu;
function OpenFileFromTpjFile(f); //从文件打开工程 function OpenFileFromTpjFile(f,e); //从文件打开工程
begin begin
FProjectFileOpener.caption := "打开"; FProjectFileOpener.caption := "打开";
@ -326,6 +326,7 @@ type TVclDesigner = class(tvcform)
begin begin
f := FProjectFileOpener.FileName; f := FProjectFileOpener.FileName;
end end
if not ifstring(f) then return ;
if not fileexists("",f) then return ; if not fileexists("",f) then return ;
FProjectsManager.OpenFileFromTpjFile(f); FProjectsManager.OpenFileFromTpjFile(f);
fio := ioFileseparator(); fio := ioFileseparator();

Binary file not shown.

View File

@ -679,7 +679,9 @@ type TWinControl = class(tcontrol)
if it then if it then
begin begin
ev := new TMMouse(e.msg,e.wparam,e.lparam); ev := new TMMouse(e.msg,e.wparam,e.lparam);
return it.Perform(ev); r := it.Perform(ev);
e.Result := ev.Result;
e.skip := ev.skip;
end end
return inherited; return inherited;
end end

View File

@ -1540,6 +1540,7 @@ type tsgtkapi = class(tgtkapis)
if not hwnd then return ; if not hwnd then return ;
if not IsGtkWidget(hwnd) then return ; if not IsGtkWidget(hwnd) then return ;
p1 := g_object_get_data(hwnd,"motion_xy"); p1 := g_object_get_data(hwnd,"motion_xy");
if not ifarray(p1) then p1 := g_object_get_data(1000,"motion_xy");
if ifarray(p1) then if ifarray(p1) then
begin begin
dx := p1["x_r"]-p1["x"]; dx := p1["x_r"]-p1["x"];
@ -2948,8 +2949,8 @@ type tsgtkapi = class(tgtkapis)
begin begin
global g_Caret_Blink_Time,g_caret_object; global g_Caret_Blink_Time,g_caret_object;
if not(hwnd>0 or hwnd<0) then return 0; if not(hwnd>0 or hwnd<0) then return 0;
if gtk_widget_is_toplevel(hwnd) then pw := hwnd; //if gtk_widget_is_toplevel(hwnd) then pw := hwnd;
else pw := gtk_widget_get_toplevel(hwnd); //else pw := gtk_widget_get_toplevel(hwnd);
if not g_gtk_caret_cache_timer then if not g_gtk_caret_cache_timer then
begin begin
Fscrolltimedo := makeinstance(thisfunction(docarettime)); Fscrolltimedo := makeinstance(thisfunction(docarettime));
@ -2974,7 +2975,7 @@ type tsgtkapi = class(tgtkapis)
gtk_widget_set_size_request(h,nWidth,nHeight); gtk_widget_set_size_request(h,nWidth,nHeight);
gtk_window_resize(h,nWidth,nHeight); gtk_window_resize(h,nWidth,nHeight);
end end
gtk_window_set_transient_for(h,pw); //gtk_window_set_transient_for(h,pw);
return h; return h;
end end
function DestroyCaret():integer; function DestroyCaret():integer;
@ -3003,6 +3004,12 @@ type tsgtkapi = class(tgtkapis)
gtk_object_set_data(hwnd,"caret_y_pos",y); gtk_object_set_data(hwnd,"caret_y_pos",y);
p := array(x,y); p := array(x,y);
ClientToScreen(hwnd,p); ClientToScreen(hwnd,p);
if gtk_widget_is_toplevel(hwnd) then pw := hwnd;
else pw := gtk_widget_get_toplevel(hwnd);
if GTK_IS_WINDOW(pw) then
begin
gtk_window_set_transient_for(crt,pw);
end
gtk_window_move(crt,p[0],p[1]); gtk_window_move(crt,p[0],p[1]);
end end
if xy[0]<>x then if xy[0]<>x then
@ -4153,6 +4160,11 @@ type tgtkapis = class() //gtk
return ##_f_(s); return ##_f_(s);
end end
//////////////gdk window /////// //////////////gdk window ///////
procedure gdk_window_get_geometry(w,x,y,sz1,sz2);
begin
_f_ := static procedure(w:pointer;var x :integer;var y:integer;var sz1:integer;var sz2:integer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(w,x,y,sz1,sz2);
end
procedure gdk_window_show_unraised(w:pointer); procedure gdk_window_show_unraised(w:pointer);
begin begin
_f_ := static procedure(w:pointer);cdecl;external getfuncptrbyname(0,functionname()); _f_ := static procedure(w:pointer);cdecl;external getfuncptrbyname(0,functionname());
@ -6031,6 +6043,11 @@ type tgtkapis = class() //gtk
_f_ := static procedure(w:pointer;c:pointer);cdecl;external getfuncptrbyname(0,functionname()); _f_ := static procedure(w:pointer;c:pointer);cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(w,c); return ##_f_(w,c);
end end
function gtk_widget_get_root_window(g:pointer):pointer;
begin
_f_ := static function(g:pointer):pointer;cdecl;external getfuncptrbyname(0,functionname());
return ##_f_(g);
end
function gtk_widget_get_window(g:pointer):pointer; function gtk_widget_get_window(g:pointer):pointer;
begin begin
_f_ := static function(g:pointer):pointer;cdecl;external getfuncptrbyname(0,functionname()); _f_ := static function(g:pointer):pointer;cdecl;external getfuncptrbyname(0,functionname());
@ -8059,6 +8076,12 @@ type tgtk_ctl_object = class(_gtkeventtype)
end end
GS_BUTTON_PRESS_EVENT: GS_BUTTON_PRESS_EVENT:
begin begin
id := a.handle;
if not _wapi.g_object_get_data(id,"motion_xy") then
begin
e := new _GdkEventButton(c);
_wapi.g_object_set_data(id,"motion_xy",array("x":e.x,"y":e.y,"x_r":e.x_root,"y_r":e.y_root));
end
return GSBUTTONPRESSEVENT(a,b,c,d); return GSBUTTONPRESSEVENT(a,b,c,d);
end end
GS_MOTION_NOTIFY_EVENT: GS_MOTION_NOTIFY_EVENT:

Binary file not shown.

Binary file not shown.