允许在同一个应用程序上使用多个 MDI 父表单

Question

我正在尝试遵循 Vcl.Forms.pas 的 this answer, changing this part 中的建议：

procedure TCustomForm.CreateWindowHandle(const Params: TCreateParams);
var
  CreateStruct: TMDICreateStruct;
  NewParams: TCreateParams;
begin
  if (FormStyle = fsMDIChild) and not (csDesigning in ComponentState) then
  begin
    {if (Application.MainForm = nil) or
      (Application.MainForm.ClientHandle = 0) then
      raise EInvalidOperation.Create(SNoMDIForm);}
    with CreateStruct do
    begin
      szClass := Params.WinClassName;
      szTitle := Params.Caption;
      hOwner := THandle(HInstance);
      X := Params.X;
      Y := Params.Y;
      cX := Params.Width;
      cY := Params.Height;
      style := Params.Style;
      lParam := THandle(Params.Param);
    end;
    WindowHandle := SendStructMessage(Application.MainForm.ClientHandle,
      WM_MDICREATE, 0, CreateStruct);
    Include(FFormState, fsCreatedMDIChild);
  end
  else

  //...

但仍然出现错误说 "no MDI Form is active"

这个建议还需要做些什么才能奏效？提前致谢。

表格测试代码：

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2 := TForm2.Create(Self); // MDIForm
  Form2.Show;
  Form3 := TForm3.Create(Form2); // MDIChild
  Form3.Show;
end;

Answer 1

在上述评论（主要是@Remy Lebeau）的帮助下，此代码可以正常工作。我希望这可以帮助前面的人:-)。

// MainForm
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2 := TForm2.Create(Application);
  Form2.Show;
end;

// MDIForm
type
  TForm2 = class(TForm)
    MainMenu1: TMainMenu;
    O1: TMenuItem;
    procedure O1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses
  Unit3;

{$R *.dfm}

procedure TForm2.O1Click(Sender: TObject);
begin
  Form3 := TForm3.Create(Self);
  Form3.Show;
end;

// MDIChild
type
  TForm3 = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DestroyWindowHandle; override;
  protected
    FMDIClientHandle: HWND;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

uses
  Unit1;

{$R *.dfm}

procedure TForm3.CreateWindowHandle(const Params: TCreateParams);
var
  CreateStruct: TMDICreateStruct;

  function GetMDIClientHandle: HWND;
  begin
    Result := 0;
    if (Owner is TForm) then
      Result := TForm(Owner).ClientHandle;
    if (Result = 0) and (Application.MainForm <> nil) then
      Result := Application.MainForm.ClientHandle;
    if Result = 0 then
      raise EInvalidOperation.Create('No Parent MDI Form');
  end;

begin
  if (FormStyle = fsMDIChild) and not (csDesigning in ComponentState) then
  begin
    FMDIClientHandle := GetMDIClientHandle;
    with CreateStruct do
    begin
      szClass := Params.WinClassName;
      szTitle := Params.Caption;
      hOwner := HInstance;
      X := Params.X;
      Y := Params.Y;
      cX := Params.Width;
      cY := Params.Height;
      style := Params.Style;
      lParam := Longint(Params.Param);
    end;
    WindowHandle := SendMessage(FMDIClientHandle, WM_MDICREATE, 0, LongInt(@CreateStruct));
    Include(FFormState, fsCreatedMDIChild);
  end
  else
  begin
    FMDIClientHandle := 0;
    inherited CreateWindowHandle(Params);
    Exclude(FFormState, fsCreatedMDIChild);
  end;
end;

procedure TForm3.DestroyWindowHandle;
begin
  if fsCreatedMDIChild in FFormState then
    SendMessage(FMDIClientHandle, WM_MDIDESTROY, Handle, 0)
  else
    inherited DestroyWindowHandle;
  FMDIClientHandle := 0;
end;

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := CaFree;
end;

允许在同一个应用程序上使用多个 MDI 父表单

Allow multiple MDI Parent Forms on same Application

delphi

vcl

mdi

mdichild

delphi-10.3-rio