lazarus不支持delphi的mdi模式,经测试可以用ATTabs控件来实现这个功能比较简单。
1、安装ATTabs控件(https://github.com/Alexey-T/ATFlatControls/)
2、mainform FormCreate的代码:
1、安装ATTabs控件(https://github.com/Alexey-T/ATFlatControls/)
2、mainform FormCreate的代码:
procedure TMainForm.FormCreate(Sender: TObject); begin //默认的是深色,如果需要,可按以下方法设置ATTabs的颜色 ATTabs1.ColorBg:=clWhite; ATTabs1.ColorTabActive:=clMoneyGreen; ATTabs1.ColorTabPassive:=clWhite; ATTabs1.ColorFont:=clBlack; ATTabs1.ColorFontActive:=clBlack; ATTabs1.ColorTabOver:=clred; ATTabs1.ColorFontHot:=clwhite;
MainForm生成及调用tab
procedure TMainForm.N142Click(Sender: TObject); var NIndex: integer; d: TATTabData; begin if ATTabs1.FindTabByObject(Form1)=-1 Then begin Form1 := TForm1.Create(self); NIndex := ATTabs1.TabIndex; Dec(NIndex); ATTabs1.AddTab(NIndex, N142.Caption, Form1, False ); Form1.Parent := Panel1; Form1.Align := alClient; Form1.BorderStyle:=bsNone; //不显示form标题栏 Form1.Show; ATTabs1.TabIndex:=ATTabs1.FindTabByObject(Form1); end else begin ATTabs1.TabIndex:=ATTabs1.FindTabByObject(Form1); d := ATTabs1.GetTabData(ATTabs1.TabIndex); (d.TabObject as TForm).show; end; end;
main close时的处理:
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: boolean); var i:Integer; begin if ATTabs1.TabCount>0 Then begin if application.messagebox( '有项目已打开!是否退出?', '讯息', MB_YESNO) = idNo then canclose := False else Begin if ATTabs1.TabCount>-1 then begin for i:=ATTabs1.TabCount-1 downto 0 do begin tform(ATTabs1.GetTabData(i).TabObject).close; end; end; end; end; end;
在其他form的onClose要注意mainform.ATTabs1.DeleteTab(mainform.ATTabs1.TabIndex,False,false)的用法。
unit Unit1; {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls; type { TForm1 } TForm1 = class(TForm) Button1: TButton; Label1: TLabel; procedure Button1Click(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); private public ButtonClose:Boolean; end; var Form1: TForm1; implementation {$R *.lfm} uses main; { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin ButtonClose:=False; end; procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin if ButtonClose then//注意:只有按Button1按键时才执行以下代码 mainform.ATTabs1.DeleteTab(mainform.ATTabs1.TabIndex,False,false); end; procedure TForm1.Button1Click(Sender: TObject); begin ButtonClose:=true; Close; end; end.
demo完整代码及控件下载:
https://www.123pan.com/s/6OFxjv-LWdu3?提取码:oxrN
分类:
Lazarus
【推荐】国内首个AI IDE,深度理解中文开发场景,立即下载体验Trae
【推荐】编程新体验,更懂你的AI,立即体验豆包MarsCode编程助手
【推荐】抖音旗下AI助手豆包,你的智能百科全书,全免费不限次数
【推荐】轻量又高性能的 SSH 工具 IShell:AI 加持,快人一步
· TypeScript + Deepseek 打造卜卦网站:技术与玄学的结合
· Manus的开源复刻OpenManus初探
· AI 智能体引爆开源社区「GitHub 热点速览」
· 从HTTP原因短语缺失研究HTTP/2和HTTP/3的设计差异
· 三行代码完成国际化适配,妙~啊~
2022-09-05 lazarus 修改linux文件权限