lazarus不支持delphi的mdi模式,经测试可以用ATTabs控件来实现这个功能比较简单。
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,//在Tab显示的文字 Form1, False ); Form1.Parent := Panel1; Form1.Align := alClient; 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;
在unit1 close时要注意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