编辑器

优化
This commit is contained in:
JianjunLiu
2022-07-15 22:50:46 +08:00
parent 8c69761acc
commit d833e12ca6
11 changed files with 325 additions and 93 deletions
+55 -14
View File
@@ -885,9 +885,9 @@ type TVclDesigner = class(tvcform)
end
mx := 0;
for i,v in clc do mx := max(mx,v);
height := (integer(mx*32/twidth)+1)*32+60+30;
height := (integer(mx*32/twidth)+1)*32+60+30+24;
end else
height := 90+32;
height := 90+32+24;
end
function TreeNode2tfmsub(lib,node,itemnames);//tmf文件字符串
@@ -1147,21 +1147,18 @@ type TVclDesigner = class(tvcform)
("type":"menu","caption":"新建工程","onclick":thisfunction(CreateTpjFomFile),
"bitmap":getcreateprojectbmpinfo()),
("type":"menu","caption":"打开历史","onclick":thisfunction(OpenProjectFromtpj),
"bitmap":GetHostroyBimp())
,
("type":"menu","caption":"打包到","onclick":thisfunction(WrapProjectTo),
"bitmap":getwrapprojectbmpinfo()
)
"bitmap":GetHostroyBimp()),
//("type":"menu","caption":"打包到","onclick":thisfunction(WrapProjectTo),"bitmap":getwrapprojectbmpinfo())
)
),
("type":"menu","caption":"运行","items":(
("type":"menu","caption":"配置命令行","onclick":thisfunction(editcommandline)),
("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu",
"bitmap":getrunbmpinfo()
),
("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu",
"bitmap":getstopbmpinfo()),
("type":"menu","caption":"调试运行","onclick":thisfunction(debugproject)),
{$ifdef linux}
("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu","bitmap":getrunbmpinfo()),
("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu","bitmap":getstopbmpinfo()),
{$else}
("type":"menu","caption":"运行","bitmap":getrunbmpinfo(),"onclick":thisfunction( debugproject)), //之前的调试运行
{$endif}
)),
("type":"menu","caption":"工具","items":(
@@ -1850,9 +1847,46 @@ type TVclDesigner = class(tvcform)
FImageList := new TDesigImageList(self);
FTree.Imagelist := FImageList;
//******************toolbar ***************
{fdebugtoolbar := new TToolBar(self);
btns := FProjectManager.FTslEditer.getdbugtoolbtns();
idx := 0;
for i,v in btns do
begin
if idx = 0 then fdebugtoolbar.ImageList := v.parent.ImageList;
idx++;
if v.caption = "添加/删除断点F5" then continue;
v.parent := fdebugtoolbar;
v._tag := v.onclick;
v.onclick := function(o,e)begin
cp := o.caption;
CallMessgeFunction(o._tag,o,e);
if cp<>"终止" then
begin
FProjectManager.ShowEditor();
end
end;
end }
tlbar := FProjectManager.FTslEditer.gettoolbar();
savebtn := array( tlbar.getbtnbyindex(1),tlbar.getbtnbyindex(2));
for i,v in savebtn do //处理一下保存工程
begin
v._tag := array(thisfunction(saveCurrentForm),v.onclick);
v.onclick := function(o,e)
begin
for i,v in o._tag do
begin
CallDataFunction(v,o,e);
end
end
end
tlbar.parent := self;
FToolBars := new TDesignertoolbars(self);
FToolBars.parent := self;
FToolBars.Imagelist := FImageList;
FToolBars.Font.width := 9;
FToolBars.Font.height := 18;
addtoolbuttons();
//************菜单******************************
createmainmenubyarray(mainmenus(),FMenu0,self);
@@ -1861,6 +1895,10 @@ type TVclDesigner = class(tvcform)
ic := new Ticon();
ic.Readvcon(HexFormatStrToTsl(GetTsIconBitmapInfo()));
self.FormICon := ic;
{fdebugtoolbar.Align := alnone;
fdebugtoolbar.left := FToolBars.Flabelcharlen* 10;
fdebugtoolbar.top := 0;
fdebugtoolbar.parent := FToolBars;}
//文件打窗口
@@ -7307,16 +7345,19 @@ type TDesignertoolbars = class(TPageControl)
FToolbars;
FLabels ;
fimg;
function SetImageList(im);
begin
fimg := im;
end
public
Flabelcharlen;
function Create(AOwner);override;
begin
inherited;
align := alClient;
FToolbars := array();
Flabelcharlen := 0;
end
Procedure Notification(AComponent,Operation);virtual;
begin
@@ -7362,13 +7403,13 @@ type TDesignertoolbars = class(TPageControl)
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;
Flabelcharlen+= length(t)+2;
end
tb.imagelist := fimg;
FToolbars[t] := tb;
+3 -1
View File
@@ -1469,7 +1469,7 @@ type TProjectView = class(TVCForm) //
FOpenBtn;
FInput;
FScriptHandle;
FTslEditer;
FTmfParser;
FTslParser;
FTreeTool;
@@ -1487,6 +1487,8 @@ type TProjectView = class(TVCForm) //
FAddMenuTsf;
FAddMenuTsl;
FOpenMenu;
public
FTslEditer;
end
type TTslEditer = class(TEditer)
+41 -12
View File
@@ -1748,21 +1748,29 @@ type TEditer=class(TCustomcontrol) //
dbgbtns := array();
for i,v in imgs do
begin
bmp.Readvcon(HexFormatStrToTsl(v));
FImages.addbmp(bmp);
bt := new TToolButton(self);
FToolbtns[i]:= bt;
bt.OnClick := thisfunction(ToolClick);
bt.Caption := i;
bt.imageid := id;
id++;
if v=0 then
begin
bt.stylesep := true;
end else
begin
bmp.Readvcon(HexFormatStrToTsl(v));
FImages.addbmp(bmp);
bt.OnClick := thisfunction(ToolClick);
bt.Caption := i;
bt.imageid := id;
id++;
end
BT.parent := FToolbar;
if i in array("添加/删除断点F5","暂停","继续","进入","跳出","单步","下一行(F8)","终止","刷新符号表","刷新当前符号")then
begin
dbgbtns[i]:= bt;
end
end
FImages.DrawBimpFirst := true;
Fdbgbtns := dbgbtns;
FTslDebug.addbtns(dbgbtns);
FToolbar.ImageList := FImages;
FInfoShowWnd.Visible := false;
@@ -2111,6 +2119,14 @@ type TEditer=class(TCustomcontrol) //
begin
return FFindWnd.GetHistory();
end
function getdbugtoolbtns();
begin
return Fdbgbtns;
end
function gettoolbar();
begin
return FToolbar;
end
function ShowLogWnd(flg);
begin
n :=(ifnil(flg)or flg)?true:false;
@@ -2598,13 +2614,14 @@ type TEditer=class(TCustomcontrol) //
begin
if filenameIsTheSame(v,vi)then
begin
fcadd := false;
//fcadd := false;
FOpenHistory.Splice(i,1); //删除原来的记录
break;
end
end
if fcadd then
begin
FOpenHistory.Push(v);
FOpenHistory.push(v);
if FOpenHistory.Length()>30 then FOpenHistory.shift();
end
end
@@ -2651,7 +2668,8 @@ type TEditer=class(TCustomcontrol) //
end
if FOpenHistory.Length()>0 then
begin
FHistoryWnd.SetData(FOpenHistory.Data);
d := FOpenHistory.Data;
FHistoryWnd.SetData(d);
InitShowWndPos(FHistoryWnd,"history",100,100);
FHistoryWnd.ShowModal();
end
@@ -2924,15 +2942,24 @@ type TEditer=class(TCustomcontrol) //
if not(FPageEditer and FPageEditer.parent=self)then return;
rr := ClientRect;
r := rr;
if FToolbar.Parent = self then
begin
htoolbar := true;
end
if htoolbar then
begin
th := FToolbar.CalcHeightFixWidth(rr[2]-rr[0]);
//FToolbar.Height := th;
r[3]:= r[0]+th;
FToolBar.SetBoundsRect(r);
end
r := rr;
r[1]:= r[3]-FStatus.Height;
FStatus.SetBoundsRect(r);
rr := rr;
if htoolbar then
begin
rr[1]:= FToolbar.Height+1;
end
rr[3]:= rr[3]-FStatus.Height-1;
{if ffolderdlg and ffolderdlg.Visible then
begin
@@ -2946,7 +2973,7 @@ type TEditer=class(TCustomcontrol) //
begin
r := rr;
r[1]:= r[3]-min(FInfoShowWnd.Height,integer(r[3] * 0.6));
r[1]:= r[3]-min(FInfoShowWnd.Height,integer(r[3] * 0.8)); //0.6 靠扩大到 0.8
rr[3]:= r[1]-1;
{fwd := min(FInfoShowWnd.Width,integer(r[2] * 0.6)); //右侧
@@ -3825,6 +3852,7 @@ type TEditer=class(TCustomcontrol) //
if ifobj(c[0])and ifobj(c[1])then return array(CreateObject(c[0],ow),CreateObject(c[1],ow));
end
end
Fdbgbtns;
static FSynClasses;
FCodeFormatInfo;
FTslChmHelp;
@@ -4979,7 +5007,7 @@ type TMouseMoveList=class(TListBox)
function getItemText(i);override;
begin
r := inherited;
return " "+r;
return "["$ i $"]" $ r;
end
function PaintIdx(idx,rc_,cvs);virtual;
begin
@@ -5068,6 +5096,7 @@ B85C4055CF250DD2251015779AC1ABF4E121390D3FE5BFF436D9BA680DFE3B533
AE42608200";
r["快捷键说明"]:= getquickkeybitmapinfo();
r["代码地图(alt+m)"]:= gettslcodemapbitmapinfo();
r["分隔符"] := 0;
return r union dbugicos();
end
function dbugicos();
+42 -4
View File
@@ -262,10 +262,12 @@ type tagCOMPOSITIONFORM=class(tslcstructureobj)
end
type TTslDebuga=class(TCustomControl)
private //成员变量
//Frundirect;
FRuningfile; //执行脚本文件名
FRuningItem; //执行的pageitem
FCurrentgotoitem; //当前运行到的pageitem
FDebughandle; //调试的句柄
FDebughandle; //调试的句柄
Fdebugedwhandle ;//调试的窗口
FDebugExe; //调试功能的exe
FConnectchannel; //调试的 通道
FDebugaddr; //地址
@@ -577,7 +579,7 @@ type TTslDebuga=class(TCustomControl)
getdebuger(pms);
exestr := format('"%s" "%s" -DEBUGSERVER -DEBUGLOGIN 0 -WAITATTACH -DEBUGPORT %d -libpath "%s" ',FDebugExe,FRuningfile,FDebugport,dirs);
exestr += pms;
FDebughandle := sysexec(FDebugExe,exestr,nil,0,rcode,0);
FDebughandle := sysexec(FDebugExe,exestr,nil,0,rcode,0);
if FDebughandle then
begin
ExecuteCommand("dbgcreatechannel");
@@ -617,6 +619,7 @@ type TTslDebuga=class(TCustomControl)
function Create(AOwner);
begin
inherited;
//Frundirect := false;
FCmdHistory := array();
FCmdHistoryid := 0;
FCmdHistorycount := 10;
@@ -678,6 +681,26 @@ type TTslDebuga=class(TCustomControl)
dbgunsetbreak(FConnectchannel,usr,n,idx+1);
end
end
function GetWindowHandleByPID(dwProcessID,api) //通过进程ID获取窗口句柄
begin
h := api.GetTopWindow(0);
while(h) do
begin
pid := 0;
dwTheardId := api.GetWindowThreadProcessId(h,pid);
if(dwTheardId <> 0)then
begin
if(pid=dwProcessID)then
begin
// here h is the handle to the window
while(api.GetParent(h)<> 0) do h := api.GetParent(h);
return h;
end
end
h := api.GetNextWindow(h,2);
end
return 0;
end
function Dbgtooldo(o,e)
begin
cp := o.Caption;
@@ -699,6 +722,10 @@ type TTslDebuga=class(TCustomControl)
"暂停":
begin
ExecuteCommand("dbgpause");
if Fdebugedwhandle then
begin
_Wapi.postmessagea(Fdebugedwhandle,WM_NULL,0,0);
end
end
"进入":
begin
@@ -721,6 +748,15 @@ type TTslDebuga=class(TCustomControl)
toolbtnState("继续");
if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
ExecuteCommand("dbgrun");
{$ifdef linux}
{$else}
if not Fdebugedwhandle then
Fdebugedwhandle := GetWindowHandleByPID(_wapi.GetProcessId(FDebughandle),_wapi);
if Fdebugedwhandle then
begin
_wapi.SetForegroundWindow(Fdebugedwhandle);
end
{$endif}
end
"终止":
begin
@@ -757,7 +793,7 @@ type TTslDebuga=class(TCustomControl)
FConnectchannel := 0;
g_tsldbgcallback_handle := nil;
if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
FDebughandle := 0;
FDebughandle := 0;Fdebugedwhandle := 0;
toolbtnState("停止");
return;
end
@@ -841,6 +877,7 @@ type TTslDebuga=class(TCustomControl)
FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",stk[0,"LINE"]-1);
end
end
//_wapi.SetForegroundWindow(self.Handle); //移动到前端 SetForegroundWindow BringWindowToTop
return;
end
"detached":
@@ -1116,6 +1153,7 @@ type TTslDebuga=class(TCustomControl)
g_tsldbgcallback_handle := nil;
fdbgselwnd := nil;
end
//property rundirect read Frundirect write Frundirect;
private
function getdefaultdbger();
begin
@@ -1403,7 +1441,7 @@ type TTslDebuga=class(TCustomControl)
if FDebughandle then
begin
SysTerminate(-1,FDebughandle);
FDebughandle := 0;
FDebughandle := 0; Fdebugedwhandle := 0;
end
end
function parseriteminfo(item,idx,n,usr);