界面库

编辑器设计器采用coolbar
This commit is contained in:
JianjunLiu 2022-09-17 16:16:07 +08:00
parent 476be4b95c
commit 54ef7e59f1
3 changed files with 111 additions and 19 deletions

View File

@ -881,9 +881,9 @@ type TVclDesigner = class(tvcform)
end end
mx := 0; mx := 0;
for i,v in clc do mx := max(mx,v); for i,v in clc do mx := max(mx,v);
height := (integer(mx*32/twidth)+1)*32+60+30+24+5; height := (integer(mx*32/twidth)+1)*32+60+30{+24}+5;
end else end else
height := 90+32+24+5; height := 90+32{+24}+5;
end end
function TreeNode2tfmsub(lib,node,itemnames);//tmf文件字符串 function TreeNode2tfmsub(lib,node,itemnames);//tmf文件字符串
@ -1870,7 +1870,7 @@ type TVclDesigner = class(tvcform)
end; end;
end } end }
tlbar := FProjectManager.FTslEditer.gettoolbar(); tlbar := FProjectManager.FTslEditer.gettoolbar();
savebtn := array( tlbar.getbtnbyindex(1),tlbar.getbtnbyindex(2)); savebtn := FProjectManager.FTslEditer.gettoolbarbtn();
for i,v in savebtn do //处理一下保存工程 for i,v in savebtn do //处理一下保存工程
begin begin
v._tag := array(thisfunction(saveCurrentForm),v.onclick); v._tag := array(thisfunction(saveCurrentForm),v.onclick);
@ -1882,7 +1882,13 @@ type TVclDesigner = class(tvcform)
end end
end end
end end
tlbar.Align := alLeft;
tlbar.width :=440;
tlbar.parent := self; tlbar.parent := self;
tlbar.arrange :="0;1";
sp1 := new tsplitter(self);
sp1.Align := alLeft;
sp1.parent := self;
FToolBars := new TDesignertoolbars(self); FToolBars := new TDesignertoolbars(self);
FToolBars.parent := self; FToolBars.parent := self;
FToolBars.Imagelist := FImageList; FToolBars.Imagelist := FImageList;
@ -1890,6 +1896,7 @@ type TVclDesigner = class(tvcform)
FToolBars.Font.height := 18; FToolBars.Font.height := 18;
addtoolbuttons(); addtoolbuttons();
FToolBars.Align := alClient;
//************菜单****************************** //************菜单******************************
createmainmenubyarray(mainmenus(),FMenu0,self); createmainmenubyarray(mainmenus(),FMenu0,self);
Mainmenu := FMenu0; Mainmenu := FMenu0;
@ -1907,6 +1914,7 @@ type TVclDesigner = class(tvcform)
FProjectFileOpener := new TOpenFileADlg(self); FProjectFileOpener := new TOpenFileADlg(self);
FProjectFileOpener.filter := array("tvcl工程":"*.tpj"); FProjectFileOpener.filter := array("tvcl工程":"*.tpj");
FProjectFileOpener.parent := self; FProjectFileOpener.parent := self;
FProjectManager.FTslEditer.setdbugruncall(thisfunction(debugproject)); //ÉèÖõ÷ÊԻص÷
end end
property VariableSelecter read FVariableSelecter; property VariableSelecter read FVariableSelecter;

View File

@ -1640,8 +1640,16 @@ type TEditer=class(TCustomcontrol) //
FCurrentItemCode := array(); FCurrentItemCode := array();
FGoBackA := new TMyarrayB(); FGoBackA := new TMyarrayB();
FGoBackB := new TMyarrayB(); FGoBackB := new TMyarrayB();
FToolbar := new TToolBar(self); //¹¤¾ßÀ¸ //FToolbar := new TToolBar(self); //¹¤¾ßÀ¸
ftoolbara := new TToolBar(self); //¹¤¾ßÀ¸
ftoolbarb := new TToolBar(self); //¹¤¾ßÀ¸
FStatus := new TStatusBar(self); //状态栏 FStatus := new TStatusBar(self); //状态栏
fcoolbar := new tcoolbar(self);
ftoolbara.Align := alNone;
ftoolbarb.Align := alNone;
ftoolbara.Width := 400;
ftoolbarb.Width := 250;
fcoolbar.autosize := true;
FInfoShowWnd := new TEditerAuxiliary(self); FInfoShowWnd := new TEditerAuxiliary(self);
FPageEditer := new TPageEditer(self); FPageEditer := new TPageEditer(self);
//FPageEditer.CloseBtn := true; //FPageEditer.CloseBtn := true;
@ -1752,7 +1760,8 @@ type TEditer=class(TCustomcontrol) //
FToolbtns[i]:= bt; FToolbtns[i]:= bt;
if v=0 then if v=0 then
begin begin
bt.stylesep := true; //bt.stylesep := true;
continue;
end else end else
begin begin
bmp.Readvcon(HexFormatStrToTsl(v)); bmp.Readvcon(HexFormatStrToTsl(v));
@ -1762,17 +1771,25 @@ type TEditer=class(TCustomcontrol) //
bt.imageid := id; bt.imageid := id;
id++; id++;
end end
BT.parent := FToolbar;
if i in array("添加/删除断点F5","暂停","继续","进入","跳出","单步","下一行(F8)","终止","刷新符号表","刷新当前符号")then if i in array("添加/删除断点F5","暂停","继续","进入","跳出","单步","下一行(F8)","终止","刷新符号表","刷新当前符号")then
begin begin
dbgbtns[i]:= bt; dbgbtns[i]:= bt;
end bt.Parent := ftoolbarb;
end else
begin
BT.parent := ftoolbara;//FToolbar;
end
end end
FImages.DrawBimpFirst := true; FImages.DrawBimpFirst := true;
Fdbgbtns := dbgbtns; Fdbgbtns := dbgbtns;
FTslDebug.addbtns(dbgbtns); FTslDebug.addbtns(dbgbtns);
FToolbar.ImageList := FImages; //FToolbar.ImageList := FImages;
ftoolbara.ImageList := FImages;
ftoolbarb.ImageList := FImages;
ftoolbara.Parent := fcoolbar;
ftoolbarb.Parent := fcoolbar;
FInfoShowWnd.Visible := false; FInfoShowWnd.Visible := false;
//FInfoShowWnd.WsSysMenu := true; //FInfoShowWnd.WsSysMenu := true;
FInfoShowWnd.WSsizebox := true; FInfoShowWnd.WSsizebox := true;
@ -1789,7 +1806,9 @@ type TEditer=class(TCustomcontrol) //
///////////////////////////////////////// /////////////////////////////////////////
//FInfoShowWnd.Caption := "信息:"; //FInfoShowWnd.Caption := "信息:";
////构造节点//////////////////////////////////////////////////// ////构造节点////////////////////////////////////////////////////
FToolBar.Parent := self; //FToolBar.Parent := self;
fcoolbar.arrange := "0,1";
fcoolbar.Parent := self;
FStatus.Parent := self; FStatus.Parent := self;
FInfoShowWnd.Parent := self; FInfoShowWnd.Parent := self;
FPageEditer.Parent := self; FPageEditer.Parent := self;
@ -1994,6 +2013,10 @@ type TEditer=class(TCustomcontrol) //
o.SetStatusText("功能开发中...."); o.SetStatusText("功能开发中....");
EndFind(); EndFind();
end end
function setdbugruncall(drc);
begin
FTslDebug.runbtncall := drc;
end
function DebugPageItem(it,h); function DebugPageItem(it,h);
begin begin
if not it then return; if not it then return;
@ -2126,7 +2149,11 @@ type TEditer=class(TCustomcontrol) //
end end
function gettoolbar(); function gettoolbar();
begin begin
return FToolbar; return fcoolbar;//FToolbar;
end
function gettoolbarbtn();
begin
return array(ftoolbara.getbtnbyindex(1),ftoolbara.getbtnbyindex(2));
end end
function ShowLogWnd(flg); function ShowLogWnd(flg);
begin begin
@ -2943,15 +2970,20 @@ type TEditer=class(TCustomcontrol) //
if not(FPageEditer and FPageEditer.parent=self)then return; if not(FPageEditer and FPageEditer.parent=self)then return;
rr := ClientRect; rr := ClientRect;
r := rr; r := rr;
if FToolbar.Parent = self then if fcoolbar.Parent = self then
begin begin
htoolbar := true; htoolbar := true;
end end
if htoolbar then if htoolbar then
begin begin
th := FToolbar.CalcHeightFixWidth(rr[2]-rr[0]); //th := FToolbar.CalcHeightFixWidth(rr[2]-rr[0]);
r[3]:= r[0]+th; //r[3]:= r[0]+th;
FToolBar.SetBoundsRect(r); //FToolBar.SetBoundsRect(r);
fcoolbar.DoControlAlign();
r[3]:= r[0]+fcoolbar.Height;
fcoolbar.SetBoundsRect(r);
end end
r := rr; r := rr;
r[1]:= r[3]-FStatus.Height; r[1]:= r[3]-FStatus.Height;
@ -2959,7 +2991,7 @@ type TEditer=class(TCustomcontrol) //
rr := rr; rr := rr;
if htoolbar then if htoolbar then
begin begin
rr[1]:= FToolbar.Height+1; rr[1]:= fcoolbar.Height+1;
end end
rr[3]:= rr[3]-FStatus.Height-1; rr[3]:= rr[3]-FStatus.Height-1;
{if ffolderdlg and ffolderdlg.Visible then {if ffolderdlg and ffolderdlg.Visible then
@ -3373,6 +3405,9 @@ type TEditer=class(TCustomcontrol) //
FSynHCS := nil; FSynHCS := nil;
FCurrentItemCode := array(); FCurrentItemCode := array();
FPageEditer := nil; FPageEditer := nil;
fcoolbar := nil;
ftoolbara := nil;
ftoolbarb := nil;
FToolbar := nil; FToolbar := nil;
FStatus := nil; FStatus := nil;
FInfoShowWnd := nil; FInfoShowWnd := nil;
@ -3871,6 +3906,9 @@ type TEditer=class(TCustomcontrol) //
FGoBackB; // := new TMyarrayB(); FGoBackB; // := new TMyarrayB();
FRebackFlag; FRebackFlag;
FPageEditer; FPageEditer;
fcoolbar;
ftoolbara;
ftoolbarb;
FToolbar; FToolbar;
FStatus; FStatus;
FInfoShowWnd; FInfoShowWnd;

View File

@ -261,6 +261,7 @@ type tagCOMPOSITIONFORM=class(tslcstructureobj)
end end
type TTslDebuga=class(TCustomControl) type TTslDebuga=class(TCustomControl)
private //成员变量 private //成员变量
frunbtncall;
//Frundirect; //Frundirect;
FRuningfile; //执行脚本文件名 FRuningfile; //执行脚本文件名
FRuningItem; //执行的pageitem FRuningItem; //执行的pageitem
@ -426,6 +427,7 @@ type TTslDebuga=class(TCustomControl)
end end
end end
public public
property runbtncall read frunbtncall write frunbtncall;
function addbtns(btns); //添加菜单 function addbtns(btns); //添加菜单
begin begin
FBtns := btns; FBtns := btns;
@ -433,6 +435,7 @@ type TTslDebuga=class(TCustomControl)
begin begin
v.onClick := thisfunction(Dbgtooldo); v.onClick := thisfunction(Dbgtooldo);
if v.Caption="添加/删除断点F5" then continue; if v.Caption="添加/删除断点F5" then continue;
if v.Caption="继续" then continue;
v.Visible := false; v.Visible := false;
end end
end end
@ -527,7 +530,8 @@ type TTslDebuga=class(TCustomControl)
//if flg then return ; //if flg then return ;
if FConnectchannel then if FConnectchannel then
begin begin
return MessageboxA("正在调试中...","提示",0,self.Handle); //return MessageboxA("正在调试中...","提示",0,self.Handle);
return debugrunredo();
end end
end end
if not fdbgselwnd then if not fdbgselwnd then
@ -554,14 +558,33 @@ type TTslDebuga=class(TCustomControl)
fdbgselwnd.show(); fdbgselwnd.show();
return; return;
end end
function debugrunredo();
begin
if FBtns["终止"].Visible then
begin
Dbgtooldo(new ttempclass("继续"),nil);
end else
begin
Dbgtooldo(new ttempclass("暂停"),nil);
end
end
function Debuglocal(item); //调试脚本 function Debuglocal(item); //调试脚本
begin begin
{$ifdef linux} {$ifdef linux}
//return MessageboxA("linux目前不支持调试","提示",0,self.Handle); //return MessageboxA("linux目前不支持调试","提示",0,self.Handle);
{$endif} {$endif}
if not item then return 0; if not item then return 0;
if FConnectchannel then return MessageboxA("正在调试中","提示",0,self.Handle); if FConnectchannel then
if FRemoteWait then return MessageboxA("远程调试等待中...","提示",0,self.Handle); begin
//return MessageboxA("正在调试中","提示",0,self.Handle);
return debugrunredo();
end
if FRemoteWait then
begin
//return MessageboxA("远程调试等待中...","提示",0,self.Handle);
return debugrunredo();
end
FDebugtype := "local"; FDebugtype := "local";
if checkconnected()then disconnectserver(); //断开连接 if checkconnected()then disconnectserver(); //断开连接
FAttchedid := 0; FAttchedid := 0;
@ -676,6 +699,14 @@ type TTslDebuga=class(TCustomControl)
dbwnd.addwnds(FStackList,FVaraiblesList,FCommandtext,FShowText); dbwnd.addwnds(FStackList,FVaraiblesList,FCommandtext,FShowText);
ExecuteCommand("clearall"); ExecuteCommand("clearall");
getdefaultdbger(); getdefaultdbger();
frunbtncall := function(o,e)begin
ow := owner;
if ow then
begin
ow.DebugPageItem(ow.GetCurrentItem());
end
end
end end
function addbreak(item,idx,n); //添加断点 function addbreak(item,idx,n); //添加断点
begin begin
@ -761,6 +792,12 @@ type TTslDebuga=class(TCustomControl)
end end
"继续": "继续":
begin begin
if not(FConnectchannel or FRemoteWait) then
begin
//return MessageboxA("正在调试中","提示",0,self.Handle);
return CallMessgeFunction(frunbtncall,nil,nil);
end
toolbtnState("继续"); toolbtnState("继续");
if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil); if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
ExecuteCommand("dbgrun"); ExecuteCommand("dbgrun");
@ -1170,6 +1207,7 @@ type TTslDebuga=class(TCustomControl)
FBtns := nil; FBtns := nil;
g_tsldbgcallback_handle := nil; g_tsldbgcallback_handle := nil;
fdbgselwnd := nil; fdbgselwnd := nil;
frunbtncall := nil;
end end
//property rundirect read Frundirect write Frundirect; //property rundirect read Frundirect write Frundirect;
private private
@ -1432,7 +1470,7 @@ type TTslDebuga=class(TCustomControl)
"继续": "继续":
begin begin
//运行 //运行
FBtns["继续"].Visible := false; //FBtns["继续"].Visible := false;
FBtns["进入"].Visible := false; FBtns["进入"].Visible := false;
FBtns["跳出"].Visible := false; FBtns["跳出"].Visible := false;
FBtns["下一行(F8)"].Visible := false; FBtns["下一行(F8)"].Visible := false;
@ -1461,6 +1499,7 @@ type TTslDebuga=class(TCustomControl)
for i,v in FBtns do for i,v in FBtns do
begin begin
if v.Caption="添加/删除断点F5" then continue; if v.Caption="添加/删除断点F5" then continue;
if v.Caption="继续" then continue;
v.Visible := false; v.Visible := false;
end end
//FToolbar.Visible := false; //FToolbar.Visible := false;
@ -1770,6 +1809,13 @@ type TTslDebuga=class(TCustomControl)
FShowText; FShowText;
fimgelist; fimgelist;
end end
type ttempclass = class()
function create(c);
begin
Caption := c;
end
caption;
end
type tdbgselwnd=class(tdcreateform) type tdbgselwnd=class(tdcreateform)
uses tslvcl; uses tslvcl;
label1:tlabel; label1:tlabel;