liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

界面库 

优化gtkactivate
This commit is contained in:
JianjunLiu 2023-01-05 17:36:51 +08:00
parent 5c87f678d6
commit 8ed3ce6baa
5 changed files with 126 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
designer/tslvcldesigner.tsf
View File

@ -308,6 +308,7 @@ type TVclDesigner = class(tvcform)
return r;
end
public //设计器工程
ffilemenu;
function OpenFileFromTpjFile(); //从文件打开工程
begin
FProjectFileOpener.caption := "打开";
@ -461,7 +462,7 @@ type TVclDesigner = class(tvcform)
@explan(说明) 菜单
**}
return array(
("type":"menu","caption":"文件","onclick",nil,"items":(
("type":"menu","caption":"Îļþ","filed":"ffilemenu","onclick",nil,"items":(
("type":"menu","caption":"保存","onclick":thisfunction(saveCurrentForm),
"bitmap":getsaveallbitmapinfo()),
("type":"menu","caption":"代码编辑","onclick":thisfunction(openclassfile),
@ -1315,6 +1316,8 @@ type TVclDesigner = class(tvcform)
FProjectFileOpener.filter := array("tvcl工程":"*.tpj");
FProjectFileOpener.parent := self;
FProjectManager.FTslEditer.setdbugruncall(thisfunction(debugproject)); //设置调试回调
FProjectManager.newmenu.parent := ffilemenu;//
//fnewmenu
end
property VariableSelecter read FVariableSelecter; //当前控件树的变量对象

114
designer/udesignerproject.tsf
View File

@ -476,6 +476,17 @@ type TProjectView = class(TVCForm) //
end
FWrapFolder := new TFolderChooseADlg(self);
FWrapFolder.Caption := "打包工程到目录";
fnewmenu := new TMenu(self);
fnewmenu.Enabled := false;
fnewmenu.caption := "新建";
for i,v in array("form","panel","script","tsf") do
begin
it := new TMenu(self);
it.caption := v;
it.parent := fnewmenu;
it.OnClick := thisfunction(newadd);
end
return;
end
function setnodesel(nd);
@ -574,6 +585,30 @@ type TProjectView = class(TVCForm) //
end
//OpenTreeNode();
end
function newadd(o,e);
begin
cnd := getdefaultdir();
if not cnd then return ;
case o.caption of
"tsf":
begin
AddTsfToCurrentDir(createnamea("func"),"tsf",cnd);
end
"script":
begin
AddTsfToCurrentDir(createnamea("tsl"),"tsl",cnd);
end
"panel":
begin
AddPanelToCurrentDir(createnamea("pal"),cnd);
end
"form":
begin
AddFormToCurrentDir(createnamea("form"),cnd);
end
end
end
function Add_dir(); //添加目录
begin
if not FCProjectPath then return Messageboxa("工程没打开","提示",0,self);
@ -918,11 +953,13 @@ type TProjectView = class(TVCForm) //
FDesigner.caption := "TVCL界面设计器 "+FprojName;
FTree.ProjectNode.Expand();
FTree.PopUpMenu := FTreePopUpMenu;
fnewmenu.Enabled := true;
end else
begin
FTree.PopUpMenu := nil;
FOpenProjectFile := "";
messageboxa("打开工程文件错误:"+f,"提示",0,self);
fnewmenu.Enabled := false;
return;
end
FTslEditer.TslSearchDir := array(p,Getfuncextdir());
@ -1033,7 +1070,7 @@ type TProjectView = class(TVCForm) //
if cn then FTree.InvalidateItem(cn);
SaveProjInfo();
end
function AddinheritdToCurrentDir(info);
function AddinheritdToCurrentDir(info,cnd);
begin
n := info[1];
if not(LegalVariableName(n))then return MessageboxA("名字不合法,请重试","提示",0,self);
@ -1055,7 +1092,13 @@ type TProjectView = class(TVCForm) //
us := "";
end
///////////
ph := FTree.CurrentNode.FPath;
if cnd then
begin
ph := cnd.FPath;
end else
begin
ph := FTree.CurrentNode.FPath;
end
fio := ioFileseparator();
fn := array("name":n,"type":nd.FType,"dir":ph);
cprojpath := FCProjectPath;
@ -1102,11 +1145,17 @@ end
SaveProjInfo();
nd.parent.expand();
end
function AddFormToCurrentDir(n); //添加窗口
function AddFormToCurrentDir(n,cnd); //添加窗口
begin
if not(LegalVariableName(n))then return MessageboxA("名字不合法,请重试","提示",0,self);
if FTree.NameInTree(lowercase(n),nil,true)then return MessageboxA("重复的文件名","提示",0,self);
ph := FTree.CurrentNode.FPath;
if cnd then
begin
ph := cnd.FPath;
end else
begin
ph := FTree.CurrentNode.FPath;
end
fio := ioFileseparator();
fn := array("name":n,"type":"form","dir":ph);
cprojpath := FCProjectPath;
@ -1138,14 +1187,21 @@ end
end
end else fn["type"]:= "tsf";
end
FTree.SetFileToNode(fn);
nd := FTree.SetFileToNode(fn);
SaveProjInfo();
FTree.SetSel(nd);
end
function AddPanelToCurrentDir(n); //添加面板
function AddPanelToCurrentDir(n,cnd); //添加面板
begin
if not LegalVariableName(n)then return MessageboxA("名字不合法,请重试","提示",0,self);
if FTree.NameInTree(lowercase(n),nil,true)then return MessageboxA("重复的文件名","提示",0,self);
ph := FTree.CurrentNode.FPath;
if cnd then
begin
ph := cnd.FPath;
end else
begin
ph := FTree.CurrentNode.FPath;
end
fio := ioFileseparator();
fn := array("name":n,"type":"panel","dir":ph);
cprojpath := FCProjectPath;
@ -1178,8 +1234,9 @@ end
end else fn["type"]:= "tsf";
end
FTree.SetFileToNode(fn);
nd := FTree.SetFileToNode(fn);
SaveProjInfo();
FTree.SetSel(nd);
end
function RenameCurrentDir(n); //修改目录名
begin
@ -1248,11 +1305,18 @@ end
end else
return MessageboxA("更名错误","提示",0,self);
end
function AddTsfToCurrentDir(n,t); //添加文件
function AddTsfToCurrentDir(n,t,cnd); //添加文件
begin
if not LegalVariableName(n)then return MessageboxA("名字不合法,请重试","提示",0,self);
if FTree.NameInTree(lowercase(n),nil,true)then return MessageboxA("重复的文件名","提示",0,self);
fn := array("name":n,"type":t,"dir":FTree.CurrentNode.FPath);
if cnd then
begin
p := cnd.FPath;
end else
begin
p := FTree.CurrentNode.FPath;
end
fn := array("name":n,"type":t,"dir":p);
nnd := FTree.SetFileToNode(fn);
ph := nnd.geteditfilename();
if not FileExists("",ph)then
@ -1262,6 +1326,7 @@ end
ReWriteString(ph,r);
end
SaveProjInfo();
FTree.SetSel(nnd);
end
function ShowExeEditer(); //显示调试窗口
begin
@ -1452,12 +1517,35 @@ end
private
FMoveMnus;
FMoveMenu;
function getdefaultdir();
begin
cnd := FTree.CurrentNode;
while cnd and cnd<>ftree.RootNode and cnd.FType<>"dir" do
begin
cnd := cnd.parent;
end
return cnd;
end
function createnamea(pre);
begin
idx := 1;
n := pre;
while idx>0 do
begin
n := pre+inttostr(idx);
idx++;
if not LegalVariableName(n) then continue;
if FTree.NameInTree(n,nil,true) then continue;
break;
end
return n;
end
function MoveCurrentFileto(o,e);
begin
nd := FTree.CurrentNode;
if nd then
d := nd.FFileInfo;
d := nd.FFileInfo;
cp := nd.caption;
fio := ioFileseparator();
if not ifarray(d) then return ;
@ -1686,7 +1774,9 @@ end
FAddMenuTsf;
FAddMenuTsl;
FOpenMenu;
fnewmenu;
public
property newmenu read fnewmenu;
FTslEditer;
property tree read ftree;
private

12
funcext/tvclib/twincontrol.tsf
View File

@ -1662,7 +1662,7 @@ type TWinControl = class(tcontrol)
end
function setactive(); virtual;
begin
if WsPopUp and HandleAllocated() then
if not(factivated) and WsPopUp and HandleAllocated() then
begin
_wapi.SetActiveWindow(self.Handle);
end
@ -1879,7 +1879,12 @@ type TWinControl = class(tcontrol)
tcn := P.WinClassName;
f := _wapi.CreateWindowExA(p.ExStyle,tcn,tcc,stl,x,y,sx,sy,p.WndParent,id,p.happ,selfid);
InitializeWnd();
if HandleAllocated()then ControlCreateWnd();
if HandleAllocated()then
begin
ControlCreateWnd();
//处理初始化active的问题
if factivated and factivecontrol and ContainsControl(factivecontrol) then factivecontrol.SetFocus();
end
end
function Notification(ac,op);override;
begin
@ -2523,10 +2528,9 @@ type TWinControl = class(tcontrol)
property onSetFocus:eventhandler read FonSetFocus write fonSetFocus;
property oncreated:eventhandler read foncreated write foncreated;
property ActiveControl read getactivecontrol write setactivecontrol;
property Active read factivated;//是否获活动窗口
private //模态相关
property Modaling read FModaling;
{**
@param(BorderStyle)(bsNone|bsSingle) 边框样式 %%
@param(Handle)(pointer) 窗口句柄 %%

17
funcext/tvclib/ugtkinterface.tsf
View File

@ -4963,14 +4963,17 @@ type tgtk_ctl_object = class(_gtkeventtype)
if st .& (2^7) then
begin
//CallTslVclProc(_const.WM_SETFOCUS ,0,0);
hwd := handle;
hwd := _wapi.gtk_widget_is_toplevel(hwd)?hwd:_wapi.gtk_widget_get_toplevel(hwd);
if G_GTK_WINDOW_ACTIVATE<>hwd then
begin
if G_GTK_WINDOW_ACTIVATE then
AddMessageToGtkMessageQueue(G_GTK_WINDOW_ACTIVATE,0x6,0,0,0);
end
hwd := handle;
hwd := _wapi.gtk_widget_is_toplevel(hwd)?hwd:_wapi.gtk_widget_get_toplevel(hwd);
if G_GTK_WINDOW_ACTIVATE<>hwd then
begin
if G_GTK_WINDOW_ACTIVATE then
begin
AddMessageToGtkMessageQueue(G_GTK_WINDOW_ACTIVATE,0x6,0,0,0);
end
end
AddMessageToGtkMessageQueue(hwd,0x6,1,0,0);
G_GTK_WINDOW_ACTIVATE := hwd;
//CallTslVclProc(_const.WM_ACTIVATE ,2,0,0);
end
{GDK_WINDOW_STATE_WITHDRAWN = 1 << 0,

2
funcext/tvclib/utslvclstdctl.tsf
View File

@ -4012,6 +4012,8 @@ type TCustomComboBoxbase=class(TCustomControl)
if csDesigning in ComponentState then return;
x := e.xpos;
y := e.ypos;
if x>1 and y>1 then return ShowDropDown(true);
return ;
if x>FBtnRect[0]and x<FBtnRect[2]and y>FBtnRect[1]and y<FBtnRect[3]then
begin
ShowDropDown(true);