从delphi转到lazarus,发现lazarus不支持MDI窗体,我们可以用PageContorl实现,不过发现使用ATTabs component更简单方便。
关键在ATTabs添加:
demo及ATTabs控件下载:
https://pan.baidu.com/s/1fsuFGkocnrmX8m6PRT8g0A?pwd=e8wu 提取码: e8wu
直接上代码:
form:
关键在ATTabs添加:
procedure ATTabs1TabClick(Sender: TObject); procedure ATTabs1TabClose(Sender: TObject; ATabIndex: integer;
https://pan.baidu.com/s/1fsuFGkocnrmX8m6PRT8g0A?pwd=e8wu 提取码: e8wu
直接上代码:
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; ATTabs1.ColorBg:=self.Color; ATTabs1.ColorTabActive:=clMoneyGreen; ATTabs1.ColorTabOver:=$0080FFFF; ATTabs1.ColorTabPassive:=self.Color; ATTabs1.ColorCloseX:=clWindowText; ATTabs1.ColorFont:=clWindowText; ATTabs1.ColorFontActive:=clWindowText; ATTabs1.ColorFontHot:=clWindowText; 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.
在其他form的onClose添加:
procedure TSetSysFrm.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin mainform.ATTabs1.DeleteTab(mainform.ATTabs1.TabIndex,False,false);//这句不是用tabclose关闭时不要执行 end;
编译后的效果: