首页 > 其他分享 >lazarus模拟MDI Form

lazarus模拟MDI Form

时间：2023-08-28 09:24:08浏览次数：36  
标签：MDI end TMenuItem Form object Caption lazarus Font Sender

从delphi转到lazarus，发现lazarus不支持MDI窗体，我们可以用PageContorl实现，不过发现使用ATTabs component更简单方便。
关键在ATTabs添加:

    procedure ATTabs1TabClick(Sender: TObject);
    procedure ATTabs1TabClose(Sender: TObject; ATabIndex: integer;
直接上代码：
form：
object MainForm: TMainForm
  Left = -12
  Height = 1628
  Top = -12
  Width = 1363
  Caption = 'lazarus MDI Form Demo'
  ClientHeight = 1564
  ClientWidth = 1363
  Color = clBtnFace
  DesignTimePPI = 168
  Font.Color = clWindowText
  Font.Height = -19
  Font.Name = 'MS Sans Serif'
  FormStyle = fsMDIForm
  HelpFile = 'acs.hlp'
  Menu = MainMenu1
  OnClose = FormClose
  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  OnResize = FormResize
  OnShow = FormShow
  WindowState = wsMaximized
  object Panel4: TPanel
    Left = 0
    Height = 47
    Top = 1517
    Width = 1363
    Align = alBottom
    BevelOuter = bvLowered
    ClientHeight = 47
    ClientWidth = 1363
    Font.CharSet = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -21
    Font.Name = '宋体'
    ParentBackground = False
    ParentFont = False
    TabOrder = 0
    object Panel2: TPanel
      Left = 1
      Height = 45
      Top = 1
      Width = 712
      Align = alLeft
      BevelOuter = bvSpace
      Font.CharSet = ANSI_CHARSET
      Font.Color = clWindowText
      Font.Height = -21
      Font.Name = '宋体'
      ParentBackground = False
      ParentFont = False
      TabOrder = 0
    end
    object ShowM: TPanel
      Left = 713
      Height = 45
      Top = 1
      Width = 649
      Align = alClient
      ClientHeight = 45
      ClientWidth = 649
      Font.CharSet = ANSI_CHARSET
      Font.Color = clBlue
      Font.Height = -21
      Font.Name = '宋体'
      ParentBackground = False
      ParentFont = False
      TabOrder = 1
      object Label6: TLabel
        Left = 574
        Height = 1
        Top = 9
        Width = 1
        Anchors = [akTop, akRight]
        ParentColor = False
      end
    end
  end
  object ATTabs1: TATTabs
    AnchorSideBottom.Control = Panel1
    Left = 0
    Height = 30
    Top = 0
    Width = 1363
    Align = alTop
    Anchors = [akTop, akLeft, akRight, akBottom]
    Font.CharSet = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -21
    Font.Name = 'MS Sans Serif'
    Font.Pitch = fpVariable
    Font.Quality = fqDraft
    ParentColor = False
    ParentFont = False
    Tabs = <>
    DoubleBuffered = True
    TabIndex = -1
    OptButtonLayout = '<>,v'
    OptVarWidth = True
    OptTruncateCaption = acsmNone
    OptTabWidthMaximal = 500
    OptShowXRounded = False
    OptShowXButtons = atbxShowActive
    OptShowPlusTab = False
    OptShowPinnedText = '!'
    OptHintForX = 'Close tab'
    OptHintForPlus = 'Add tab'
    OptHintForArrowLeft = 'Scroll tabs left'
    OptHintForArrowRight = 'Scroll tabs right'
    OptHintForArrowMenu = 'Show tabs list'
    OptHintForUser0 = '0'
    OptHintForUser1 = '1'
    OptHintForUser2 = '2'
    OptHintForUser3 = '3'
    OptHintForUser4 = '4'
    OnTabClick = ATTabs1TabClick
    OnTabClose = ATTabs1TabClose
  end
  object Panel1: TPanel
    Left = 0
    Height = 1487
    Top = 30
    Width = 1363
    Align = alClient
    ParentBackground = False
    TabOrder = 2
  end
  object MainMenu1: TMainMenu
    Left = 744
    Top = 160
    object N12: TMenuItem
      Caption = '数据处理'
      object N142: TMenuItem
        Caption = '回弹法检测砼强度'
        OnClick = N142Click
      end
      object N169: TMenuItem
        Caption = '新回弹法检测砼强度'
        Visible = False
      end
      object N199: TMenuItem
        Caption = '砂浆强度(回弹法检测)'
        Visible = False
      end
    end
    object N15: TMenuItem
      Caption = '系统管理'
      object N5: TMenuItem
        Caption = '权限设置'
      end
      object N48: TMenuItem
        Caption = '技术指标'
      end
      object N62: TMenuItem
        Caption = '系统参数设置'
        OnClick = N62Click
      end
      object MenuItem1: TMenuItem
        Caption = '报告模板管理'
      end
      object N78: TMenuItem
        Caption = '报告编号样式管理'
      end
    end
    object N16: TMenuItem
      Caption = '帮助'
      object N58: TMenuItem
        Caption = '使用说明'
      end
      object N10: TMenuItem
        Caption = '软件注册'
        Visible = False
      end
      object N187: TMenuItem
        Caption = '公司名称及地址设置'
      end
      object N8: TMenuItem
        Caption = '-'
      end
      object N108: TMenuItem
        Caption = '软件版权声明'
      end
      object Separator1: TMenuItem
        Caption = '-'
      end
      object MenuItem2: TMenuItem
        Caption = '退出'
        OnClick = MenuItem2Click
      end
    end
  end
end

 


unit main;

{$mode objfpc}
{$H+}

interface

uses
  LCLIntf, LCLType, LMessages, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, Menus,

  ExtCtrls,
  ComCtrls, inifiles, StdCtrls
 {$ifdef LINUX}
  , FileUtil
  , process
  , BaseUnix
 {$endif LINUX}
  ,attabs;

type

  { TMainForm }

  TMainForm = class(TForm)
    ATTabs1: TATTabs;
    Label6: TLabel;
    MainMenu1: TMainMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    Panel1: TPanel;
    Separator1: TMenuItem;
    N12: TMenuItem;
    N15: TMenuItem;
    N62: TMenuItem;
    N16: TMenuItem;
    N58: TMenuItem;
    N108: TMenuItem;
    N8: TMenuItem;
    N10: TMenuItem;
    N5: TMenuItem;
    N48: TMenuItem;
    N78: TMenuItem;
    N142: TMenuItem;
    N169: TMenuItem;
    N187: TMenuItem;
    N199: TMenuItem;
    Panel4: TPanel;
    Panel2: TPanel;
    ShowM: TPanel;
    procedure ATTabs1TabClick(Sender: TObject);
    procedure ATTabs1TabClose(Sender: TObject; ATabIndex: integer;
      var ACanClose, ACanContinue: boolean);
    procedure FormCreate(Sender: TObject);
    procedure MenuItem2Click(Sender: TObject);
    procedure RxSpeedButton1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure N62Click(Sender: TObject);
    procedure N142Click(Sender: TObject);
    procedure DateMenuDrawItem(Sender: TObject; ACanvas: TCanvas;
      ARect: TRect; Selected: boolean);
    procedure FormResize(Sender: TObject);
    function findChildwindow(s: TForm): boolean;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    //    procedure formmaximum(var msg: Tmessage); message wm_getminmaxinfo;
  public
    { Public declarations }
    start: integer;
  end;

var
  MainForm: TMainForm;

implementation

uses SetSys, HTCS_pas;

{$R *.lfm}

function TMainForm.findChildwindow(s: TForm): boolean;
var
  i: integer;
begin
  i := 0;
  findChildwindow := False;
  while i <= MDIChildCount - 1 do
  begin
    if MDIChildren[i].Caption = s.Caption then
    begin
      findChildwindow := True;
      break;
    end;
    Inc(i);
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  WindowState:=wsMaximized;
end;

procedure TMainForm.MenuItem2Click(Sender: TObject);
begin
  close;
end;

procedure TMainForm.ATTabs1TabClick(Sender: TObject);
var
  d: TATTabData;
begin
  d := ATTabs1.GetTabData(ATTabs1.TabIndex);
  (d.TabObject as TForm).Show;
end;

procedure TMainForm.ATTabs1TabClose(Sender: TObject; ATabIndex: integer;
  var ACanClose, ACanContinue: boolean);
var
  d: TATTabData;
begin
  if ATTabs1.TabIndex=ATabIndex Then
  begin
  d := ATTabs1.GetTabData(ATabIndex);
  (d.TabObject as tform).close;
  end
  ELSE
  Begin
     ACanClose:=False;
  end;
end;

procedure TMainForm.RxSpeedButton1Click(Sender: TObject);
begin
  Close;
end;

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;

procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  if SetSysFrm<>nil Then
    (SetSysFrm):=nil;
  if htcsform<>nil Then
    (htcsform):=nil;
end;

procedure TMainForm.N62Click(Sender: TObject);
var
  NIndex: integer;
  d: TATTabData;
begin
    if ATTabs1.FindTabByObject(SetSysFrm)=-1 Then
    begin
      SetSysFrm := TSetSysFrm.Create(self);
      if ATTabs1.TabIndex > -1 then
        NIndex := ATTabs1.TabIndex + 1;
      Dec(NIndex);
      ATTabs1.AddTab(NIndex,//标签编号
        SetSysFrm.Caption,  //标签名称
        SetSysFrm,          //标签对象
        False
        );
      SetSysFrm.Parent := Panel1;
      SetSysFrm.Align := alClient;
    end
    else
    begin
      ATTabs1.TabIndex:=ATTabs1.FindTabByObject(SetSysFrm);
      d := ATTabs1.GetTabData(ATTabs1.TabIndex);
      (d.TabObject as TForm).show;
    end;
end;

procedure TMainForm.N142Click(Sender: TObject);
var
  NIndex: integer;
  d: TATTabData;
begin
    if ATTabs1.FindTabByObject(htcsform)=-1 Then
    begin
      htcsform := ThtcsForm.Create(self);
      if ATTabs1.TabIndex > -1 then
        NIndex := ATTabs1.TabIndex + 1;
      Dec(NIndex);
      ATTabs1.AddTab(NIndex,
        htcsform.Caption,
        htcsform,
        False
        );
      htcsForm.Parent := Panel1;
      htcsForm.Align := alClient;
    end
    else
    begin
      ATTabs1.TabIndex:=ATTabs1.FindTabByObject(htcsform);
      d := ATTabs1.GetTabData(ATTabs1.TabIndex);
      (d.TabObject as TForm).show;
    end;
end;

procedure TMainForm.DateMenuDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: boolean);
begin
  Acanvas.brush.Color := clblue;
  Acanvas.Font.size := 11;
  Acanvas.Font.Color := clyellow;
  Acanvas.TextOut(arect.left + 5, arect.top, tmenuitem(Sender).Caption);
end;

procedure TMainForm.FormResize(Sender: TObject);
var
  ye, mo, day: word;
begin
  DecodeDate(Now, ye, mo, day);
end;

procedure TMainForm.FormShow(Sender: TObject);
var
  ye, mo, day: word;
begin
  DecodeDate(Now, ye, mo, day);
end;

end.

 编译后的效果：

 

标签：MDI,end,TMenuItem,Form,object,Caption,lazarus,Font,Sender
From： https://www.cnblogs.com/qiufeng2014/p/17661390.html

相关文章

  • django(Ajax、自定义分页器、form组件)
    一、Ajax1概述异步提交局部刷新例子：github注册动态获取用户名实时的跟后端确认并实时展示到前端（局部刷新）朝后端发送请求的方式1.浏览器地址栏直接输入url回车GET请求2.a标签href属性GET请求3.form表单GET......
  • wml input标记的format属性
    1、wml  input标记的format属性A从A到Z的任何大写字母，没有数字或其他字符。a从a到z的任何小写字母，没有数字和其他字符。N任何0到9的数字。X从A到Z从0到9的任何字符。x从a到z从0到9的任何字符。M任何字符，输入默认从大写开始。m任何字符，输入默认从小写开始。*f（星号）意味着......
  • 聊聊HuggingFace Transformer
    概述参见：聊聊HuggingFace项目组件一个完整的transformer模型主要包含三部分：Config、Tokenizer、Model。Config用于配置模型的名称、最终输出的样式、隐藏层宽度和深度、激活函数的类别等。示例：{"architectures":["BertForMaskedLM"],"attention_probs_dropo......
  • This TensorFlow binary is optimized to use available CPU instructions in perform
    ThisTensorFlowbinaryisoptimizedtouseavailableCPUinstructionsinperformance-criticaloperations.Toenablethefollowinginstructions:AVX2FMA,inotheroperations,rebuildTensorFlowwiththeappropriatecompilerflags.   这是TensorFlow库在安......
  • GPT之路(四) 神经网络架构Transformer工作原理
     原文：WhatAreTransformerModelsandHowDoTheyWork?Transformer模型是机器学习中最令人兴奋的新发展之一。它们在论文AttentionisAllYouNeed中被介绍。Transformer可以用于写故事、文章、诗歌，回答问题，翻译语言，与人类聊天，甚至可以通过对人类来说很难的考试！但是它们到底......
  • Winform微信扫码支付
    微信扫码支付引用的是第三方的：Senparc.Weixin引用：usingSenparc.Weixin.MP.TenPayLibV3;首先，在Form_Load里面调用生成支付二维码的方法：///<summary>///Form_Load事件///</summary>///<paramname="sender"></param>///<......
  • ASP.NET-WebForm项目搭建
    目录零、开发环境一、创建工程二、发布项目三、拖拽式-调整页面零、开发环境vs2022chromeIIS服务器一、创建工程1、新建项目：2、选择web应用程序、3、设置项目存放的路径4、选择webForm的模板5、创建一个名为webs的文件夹，用于存放aspx页面：6、创建一个......
  • 【题解】CF1413C Perform Easily（双指针）
    【题解】CF1413CPerformEasily写篇题解水水经验~顺便增加一下RP~比较套路和简单的一道绿题。题目链接PerformEasily-洛谷|计算机科学教育新生态(luogu.com.cn)题意概述给你一个长度为\(6\)的\(a\)数组，和一个长度为\(n\)的\(b\)数组，要求将\(b\)数组内的每......
  • c# WinForm--微信Native支付
    c#WinForm--微信Native支付 一、了解Native支付流程我用的是模式二，模式二的流程如下二、如何将Demo用在我的WinForm里面打开Demo工程，复制里面的lib、third文件夹到我的工程下，添加引用，引用的内容就是third文件夹里的。还有Demo里面的business文件夹，里面的代码可以参考（复......
  • swin transformer
    摘要核心1.本文提出一种可以适用于多种任务的backbone->swintransformer2.Transformer迁移到CV中有两点挑战->物体尺度不一，图像分辨率大3.为了解决尺度不一的问题，SwinTransformer使用了分层的结构(Pyramid)4.为了能够在高分辨率上运行，SwinTransformer限制了attention的计算范围......

赞助商

阅读排行

网站主页关于我们联系我们网站地图

本网站内容转载自其他媒体，侵权联系[admin##ips99.com]。

Copyright © 2020-2023 IPS99 版权所有 IPS99