秋·风

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::
  278 随笔 :: 0 文章 :: 308 评论 :: 20万 阅读
< 2025年3月 >
23 24 25 26 27 28 1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31 1 2 3 4 5
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   秋·风  阅读(347)  评论(0编辑  收藏  举报
相关博文:
阅读排行:
· TypeScript + Deepseek 打造卜卦网站:技术与玄学的结合
· Manus的开源复刻OpenManus初探
· AI 智能体引爆开源社区「GitHub 热点速览」
· 从HTTP原因短语缺失研究HTTP/2和HTTP/3的设计差异
· 三行代码完成国际化适配,妙~啊~
历史上的今天:
2022-09-05 lazarus 修改linux文件权限
点击右上角即可分享
微信分享提示