秋·风

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::
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,
        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

posted on 2024-09-05 09:51  秋·风  阅读(213)  评论(0编辑  收藏  举报