View Issue Details

IDProjectCategoryView StatusLast Update
0036582LazarusLCLpublic2020-01-23 20:50
ReporterKostas MichalopoulosAssigned ToOndrej Pokorny 
PrioritynormalSeverityminorReproducibilityalways
Status assignedResolutionopen 
Product Version2.1 (SVN)Product Build 
Target VersionFixed in Version 
Summary0036582: MDI support for Windows (patch and demo included)
DescriptionThe attached patch implements MDI support for the Win32 widgetset. It implements pretty much everything i could figure out supported by Delphi 2 (the only Delphi i have) in terms of behavior and API. Also attached is a "MDI doodle" demo that uses all of the implemented APIs and can be compiled in both Lazarus and Delphi 2 (mind the .res file, D2 doesn't like it, so you'll have to delete it to compile it).

I have tested it in Windows 2000, Windows XP and Windows 10 and seems to work and behave the same way as in Delphi 2.
Tagsdelphi compatibility, MDI, patch, win32, windows
Fixed in Revision
LazTarget
WidgetsetWin32/Win64
Attached Files
  • win32mdisupport-svn62555.diff (29,074 bytes)
    Index: lcl/forms.pp
    ===================================================================
    --- lcl/forms.pp	(revision 62555)
    +++ lcl/forms.pp	(working copy)
    @@ -768,6 +768,8 @@
         procedure Previous;
         { mdi related routine}
         procedure Tile;
    +    { mdi related routine}
    +    procedure ArrangeIcons;
         { mdi related property}
         property ClientHandle;
     
    Index: lcl/include/customform.inc
    ===================================================================
    --- lcl/include/customform.inc	(revision 62555)
    +++ lcl/include/customform.inc	(working copy)
    @@ -101,7 +101,10 @@
       GlobalNameSpace.BeginWrite;
       Screen.FSaveFocusedList.Remove(Self);
       RemoveFixupReferences(Self, '');
    -  if FormStyle <> fsMDIChild then Hide;
    +  if FormStyle <> fsMDIChild then
    +    Hide
    +  else if Assigned(Menu) and Assigned(Application.MainForm) and Assigned(Application.MainForm.Menu) then
    +    Application.MainForm.Menu.Unmerge(Menu);
       DoDestroy;
       // don't call the inherited method because it calls Destroying which is already called
     end;
    @@ -659,9 +662,11 @@
     
       inherited WMSize(Message);
     
    -  FDelayedWMSize := True;
    -  Inc(FDelayedEventCtr);
    -  Application.QueueAsyncCall(@DelayedEvent, 0);
    +  if not (csDestroying in ComponentState) then begin
    +    FDelayedWMSize := True;
    +    Inc(FDelayedEventCtr);
    +    Application.QueueAsyncCall(@DelayedEvent, 0);
    +  end;
     end;
     
     procedure TCustomForm.WMMove(var Message: TLMMove);
    @@ -668,9 +673,11 @@
     begin
       inherited WMMove(Message);
     
    -  FDelayedWMMove := True;
    -  Inc(FDelayedEventCtr);
    -  Application.QueueAsyncCall(@DelayedEvent, 0);
    +  if not (csDestroying in ComponentState) then begin
    +    FDelayedWMMove := True;
    +    Inc(FDelayedEventCtr);
    +    Application.QueueAsyncCall(@DelayedEvent, 0);
    +  end;
     end;
     
     procedure TCustomForm.DelayedEvent(Data: PtrInt);
    @@ -796,6 +803,12 @@
     
     procedure TCustomForm.CMActivate(var Message: TLMessage);
     begin
    +  if (FormStyle=fsMDIChild) and
    +     Assigned(Menu) and
    +     Assigned(Application.MainForm) and
    +     (Application.MainForm.FormStyle=fsMDIForm) and
    +     Assigned(Application.MainForm.Menu) then
    +    Application.MainForm.Menu.Merge(Menu);
       Activate;
     end;
     
    @@ -802,6 +815,12 @@
     procedure TCustomForm.CMDeactivate(var Message: TLMessage);
     begin
       Deactivate;
    +  if (FormStyle=fsMDIChild) and
    +     Assigned(Menu) and
    +     Assigned(Application.MainForm) and
    +     (Application.MainForm.FormStyle=fsMDIForm) and
    +     Assigned(Application.MainForm.Menu) then
    +    Application.MainForm.Menu.Unmerge(Menu);
     end;
     
     procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType;
    @@ -1378,7 +1397,7 @@
     
             if FormStyle = fsMDIFORM then
             begin
    -          // ToDo
    +          Exit;
             end
             else
             begin
    @@ -2214,12 +2233,15 @@
         Result:=true;
       end;
     
    +var
    +  I: Integer;
     begin
       if FormStyle = fsMDIForm then
       begin
         // Query children forms whether we can close
         if not Check(Self) then exit(False);
    -    // TODO: mdi logic
    +    for I := 0 to MDIChildCount - 1 do
    +      if not MDIChildren[I].CloseQuery then Exit(False);
       end;
       Result := True;
       if Assigned(FOnCloseQuery) then
    @@ -3206,6 +3228,22 @@
         TWSCustomFormClass(WidgetSetClass).Tile(Self);
     end;
     
    +{------------------------------------------------------------------------------
    +  Method: TForm.ArrangeIcons
    +  Params:  None
    +  Returns: Nothing
    +
    +  Arranges the minimized MDI icons in an MDI form.
    +  ArrangeIcons works only if the form FormStyle = fsMDIForm.
    + ------------------------------------------------------------------------------}
    +procedure TForm.ArrangeIcons;
    +begin
    +  if (FormStyle <> fsMDIForm) then
    +    Exit;
    +  if HandleAllocated and not (csDesigning in ComponentState) then
    +    TWSCustomFormClass(WidgetSetClass).ArrangeIcons(Self);
    +end;
    +
     //==============================================================================
     
     { TFormPropertyStorage }
    Index: lcl/include/mainmenu.inc
    ===================================================================
    --- lcl/include/mainmenu.inc	(revision 62555)
    +++ lcl/include/mainmenu.inc	(working copy)
    @@ -50,6 +50,46 @@
       inherited MenuChanged(Sender, Source, Rebuild);
     end;
     
    +procedure TMainMenu.Merge(Menu: TMainMenu);
    +var
    +  EquivalentItem, ClonedItem: TMenuItem;
    +  I, J, InsertIndex: Integer;
    +begin
    +  for I := 0 to Menu.Items.Count - 1 do begin
    +    InsertIndex := -1;
    +    for J := 0 to Items.Count - 1 do
    +      if Items[J].GroupIndex=Menu.Items[I].GroupIndex then begin
    +        if InsertIndex=-1 then InsertIndex := J;
    +        Items[J].Visible := False;
    +      end;
    +    if InsertIndex=-1 then
    +      for J := 0 to Items.Count - 1 do
    +        if Items[J].GroupIndex > Menu.Items[I].GroupIndex then begin
    +          InsertIndex := J;
    +          Break;
    +        end;
    +    ClonedItem := TMenuItem.Create(Menu);
    +    MenuItem_Copy(Menu.Items[I], ClonedItem);
    +    if InsertIndex=-1 then
    +      Items.Add(ClonedItem)
    +    else
    +      Items.Insert(InsertIndex, ClonedItem);
    +  end;
    +end;
    +
    +procedure TMainMenu.Unmerge(Menu: TMainMenu);
    +var
    +  I, J: Integer;
    +begin
    +  for I := 0 to Menu.Items.Count - 1 do
    +    for J := 0 to Items.Count - 1 do
    +      if Items[J].GroupIndex=Menu.Items[I].GroupIndex then
    +        Items[J].Visible := True;
    +  for I := Items.Count - 1 downto 0 do
    +    if Items[I].Owner=Menu then
    +      Items.Delete(I);
    +end;
    +
     {------------------------------------------------------------------------------
       Method: TMainMenu.Create
       Params:  AOwner: the owner of the class
    Index: lcl/interfaces/win32/win32callback.inc
    ===================================================================
    --- lcl/interfaces/win32/win32callback.inc	(revision 62555)
    +++ lcl/interfaces/win32/win32callback.inc	(working copy)
    @@ -72,6 +72,7 @@
       depthLen: integer;
     {$endif}
       setComboWindow: boolean;
    +  WindowInfo: PWin32WindowInfo;
     begin
     {$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
       depthLen := Length(MessageStackDepth);
    @@ -78,10 +79,31 @@
       if depthLen > 0 then
         MessageStackDepth[depthLen] := '#';
     {$endif}
    -  PrevWndProc := GetWin32WindowInfo(Window)^.DefWndProc;
    +  WindowInfo := GetWin32WindowInfo(Window);
    +  PrevWndProc := WindowInfo^.DefWndProc;
       if (PrevWndProc = nil) or (PrevWndProc = @WindowProc) // <- prevent recursion
       then begin
    -    Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam)
    +    if WindowInfo^.WinControl is TCustomForm then begin
    +      case TCustomForm(WindowInfo^.WinControl).FormStyle of
    +        fsMDIForm:
    +          if Msg <> WM_COMMAND then
    +            Result := Windows.DefFrameProcW(Window, Win32WidgetSet.MDIClientHandle, Msg, WParam, LParam)
    +          else if (LoWord(WParam)=SC_CLOSE) or
    +                  (LoWord(WParam)=SC_MAXIMIZE) or
    +                  (LoWord(WParam)=SC_MINIMIZE) or
    +                  (LoWord(WParam)=SC_RESTORE) or
    +                  (LoWord(WParam)=SC_NEXTWINDOW) or
    +                  (LoWord(WParam)=SC_PREVWINDOW) then
    +            Result := Windows.DefFrameProcW(Window, Win32WidgetSet.MDIClientHandle, Msg, WParam, LParam)
    +          else
    +            Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam);
    +        fsMDIChild:
    +          Result := Windows.DefMDIChildProcW(Window, Msg, WParam, LParam);
    +        else
    +          Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam);
    +      end;
    +    end else
    +      Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam);
       end
       else begin
         // combobox child edit weirdness: combobox handling WM_SIZE will compare text
    @@ -1942,6 +1964,7 @@
       R: TRect;
       ACtl: TWinControl;
       LMouseEvent: TTRACKMOUSEEVENT;
    +  MaximizedActiveChild: WINBOOL;
     {$IF NOT DECLARED(WM_DPICHANGED)} // WM_DPICHANGED was added in FPC 3.1.1
     const
       WM_DPICHANGED = $02E0;
    @@ -2028,6 +2051,13 @@
           if HIWORD(lParam) = 0 then //if not system menu
           begin
             TargetObject := GetPopMenuItemObject;
    +        // Check if the menu was the maximized icon menu for an MDI child window and ignore it in that case
    +        if (LoWord(LParam)=0) and (lWinControl=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then begin
    +          MaximizedActiveChild := False;
    +          if SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, Windows.WPARAM(@MaximizedActiveChild)) <> 0 then begin
    +            if MaximizedActiveChild then TargetObject := nil;
    +          end;
    +        end;
             if TargetObject is TMenuItem then
             begin
               LMessage.Msg := LM_ACTIVATE;
    @@ -2040,6 +2070,13 @@
         WM_MENUSELECT:
         begin
           TargetObject := GetMenuItemObject((HIWORD(Integer(WParam)) and MF_POPUP) <> 0);
    +      // Check if the menu was the maximized icon menu for an MDI child window and ignore it in that case
    +      if (LoWord(WParam)=0) and (lWinControl=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then begin
    +        MaximizedActiveChild := False;
    +        if SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, Windows.WPARAM(@MaximizedActiveChild)) <> 0 then begin
    +          if MaximizedActiveChild then TargetObject := nil;
    +        end;
    +      end;
           if TargetObject is TMenuItem then
             TMenuItem(TargetObject).IntfDoSelect
           else
    @@ -2419,6 +2456,12 @@
           SetLMessageAndParams(Msg, True);
       end;  // case Msg of
     
    +  // Update MDI form client bounds
    +  if WinProcess and (Msg=WM_SIZE) and (Window=Application.MainFormHandle) and (Application.MainForm.FormStyle=fsMDIForm) then begin
    +    Win32WidgetSet.UpdateMDIClientBounds;
    +    WinProcess := False;
    +  end;
    +
       if WinProcess then
       begin
         PLMsg^.Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
    Index: lcl/interfaces/win32/win32int.pp
    ===================================================================
    --- lcl/interfaces/win32/win32int.pp	(revision 62555)
    +++ lcl/interfaces/win32/win32int.pp	(working copy)
    @@ -129,6 +129,7 @@
         FMetrics: TNonClientMetrics;
         FMetricsFailed: Boolean;
         FDefaultFont: HFONT;
    +    FMDIClientHandle: HWND;
     
         FWaitHandleCount: dword;
         FWaitHandles: array of HANDLE;
    @@ -150,6 +151,7 @@
         function WinRegister: Boolean;
     
         procedure CreateAppHandle;
    +    function GetMDIClientHandle: HWND;
       protected
         function CreateThemeServices: TThemeServices; override;
         function GetAppHandle: THandle; override;
    @@ -201,6 +203,11 @@
         procedure HandleWakeMainThread(Sender: TObject);
         property DefaultFont: HFONT read FDefaultFont;
     
    +    // MDI client handle (if any)
    +    property MDIClientHandle: HWND read GetMDIClientHandle;
    +
    +    procedure UpdateMDIClientBounds;
    +
         {$I win32winapih.inc}
         {$I win32lclintfh.inc}
     
    Index: lcl/interfaces/win32/win32object.inc
    ===================================================================
    --- lcl/interfaces/win32/win32object.inc	(revision 62555)
    +++ lcl/interfaces/win32/win32object.inc	(working copy)
    @@ -403,8 +403,17 @@
               PostQuitMessage(AMessage.wParam);
               break;
             end;
    -        TranslateMessage(@AMessage);
    -        DispatchMessageW(@AMessage);
    +        // Handle MDI form accelerators
    +        if Assigned(Application) and
    +           Assigned(Application.MainForm) and
    +           (Application.MainForm.FormStyle=fsMDIForm) and
    +           TranslateMDISysAccel(Win32WidgetSet.MDIClientHandle, @AMessage) then begin
    +          // handled by TranslateMDISysAccel
    +          write;
    +        end else begin
    +          TranslateMessage(@AMessage);
    +          DispatchMessageW(@AMessage);
    +        end;
           end;
         end else
         if retVal = WAIT_TIMEOUT then
    @@ -634,6 +643,31 @@
         Windows.PostMessage(FAppHandle, WM_NULL, 0, 0);
     end;
     
    +procedure TWin32WidgetSet.UpdateMDIClientBounds;
    +
    +  function CalculateClientArea: TRect;
    +  var
    +    I: Integer;
    +  begin
    +    Windows.GetClientRect(Application.MainFormHandle, Result);
    +    for I := 0 to Application.MainForm.ControlCount - 1 do
    +      if Application.MainForm.Controls[I].Visible then
    +        case Application.MainForm.Controls[I].Align of
    +          alLeft: Inc(Result.Left, Application.MainForm.Controls[I].Width);
    +          alTop: Inc(Result.Top, Application.MainForm.Controls[I].Height);
    +          alRight: Dec(Result.Right, Application.MainForm.Controls[I].Width);
    +          alBottom: Dec(Result.Bottom, Application.MainForm.Controls[I].Height);
    +        end;
    +  end;
    +
    +var
    +  R: TRect;
    +begin
    +  if not (Assigned(Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm)) then Exit;
    +  R := CalculateClientArea;
    +  MoveWindow(Win32WidgetSet.MDIClientHandle, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, True);
    +end;
    +
     { Private methods (in no significant order) }
     
     {------------------------------------------------------------------------------
    @@ -696,6 +730,26 @@
       Windows.DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
     end;
     
    +function TWin32WidgetSet.GetMDIClientHandle: HWND;
    +const
    +  MDIClientW: array[0..9] of WideChar = ('M', 'D', 'I', 'C', 'L', 'I', 'E', 'N', 'T', #0);
    +var
    +  CCS: TCLIENTCREATESTRUCT;
    +begin
    +  if (FMDIClientHandle=0) and
    +     Assigned(Application) and
    +     Assigned(Application.MainForm) and
    +     (Application.MainForm.FormStyle=fsMDIForm) then begin
    +    CCS.hWindowMenu := 0;
    +    CCS.idFirstChild := 0;
    +    FMDIClientHandle := CreateWindowW(@MDIClientW, nil,
    +      WS_CHILD or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or WS_VSCROLL or WS_HSCROLL,
    +      0, 0, 0, 0, Application.MainForm.Handle, 0, HInstance, @CCS);
    +    ShowWindow(FMDIClientHandle, SW_SHOW);
    +  end;
    +  Result := FMDIClientHandle;
    +end;
    +
     function TWin32WidgetSet.CreateThemeServices: TThemeServices;
     begin
       Result := TWin32ThemeServices.Create;
    Index: lcl/interfaces/win32/win32winapi.inc
    ===================================================================
    --- lcl/interfaces/win32/win32winapi.inc	(revision 62555)
    +++ lcl/interfaces/win32/win32winapi.inc	(working copy)
    @@ -2458,8 +2458,14 @@
           SetWidthHeightFromRect(R);
         end;
       end
    -  else
    -    SetWidthHeightFromRect(WP.rcNormalPosition);
    +  else begin
    +    // rcNormalPosition is not valid for MDI children se we use GetWindowRect instead
    +    if (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_MDICHILD) <> 0 then begin
    +      Windows.GetWindowRect(Handle, R);
    +      SetWidthHeightFromRect(R);
    +    end else
    +      SetWidthHeightFromRect(WP.rcNormalPosition);
    +  end;
     
       WindowInfo := GetWin32WindowInfo(Handle);
     
    @@ -3285,7 +3291,12 @@
      ------------------------------------------------------------------------------}
     function TWin32WidgetSet.SetForegroundWindow(HWnd: HWND): boolean;
     begin
    -  Result := Windows.SetForegroundWindow(HWnd);
    +  // MDI children need to use WM_MDIACTIVATE to bring themselves into the foreground
    +  if (GetWindowLong(HWnd, GWL_EXSTYLE) and WS_EX_MDICHILD) <> 0 then begin
    +    SendMessage(GetParent(HWnd), WM_MDIACTIVATE, HWnd, 0);
    +    Result := True;
    +  end else
    +    Result := Windows.SetForegroundWindow(HWnd);
     end;
     
     function TWin32WidgetSet.SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean;
    Index: lcl/interfaces/win32/win32wscontrols.pp
    ===================================================================
    --- lcl/interfaces/win32/win32wscontrols.pp	(revision 62555)
    +++ lcl/interfaces/win32/win32wscontrols.pp	(working copy)
    @@ -468,6 +468,10 @@
           Windows.SetWindowPos(Handle, 0, IntfLeft, IntfTop, IntfWidth, IntfHeight, SWP_NOZORDER or SWP_NOACTIVATE);
       end;
       LCLControlSizeNeedsUpdate(AWinControl, True);
    +  // If this control is a child of an MDI form, then we need to update the MDI client bounds in
    +  // case this control has affected the client area
    +  if Assigned(Application.MainForm) and (AWinControl.Parent=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then
    +    Win32WidgetSet.UpdateMDIClientBounds;
     end;
     
     class procedure TWin32WSWinControl.SetColor(const AWinControl: TWinControl);
    @@ -545,7 +549,12 @@
       {$ifdef RedirectDestroyMessages}
       SetWindowLong(Handle, GWL_WNDPROC, PtrInt(@DestroyWindowProc));
       {$endif}
    -  DestroyWindow(Handle);
    +  // Instead of calling DestroyWindow directly, we need to call WM_MDIDESTROY for MDI children
    +  if Assigned(Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) and
    +    (AWinControl is TCustomForm) and (TCustomForm(AWinControl).FormStyle=fsMDIChild) then
    +    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIDESTROY, Handle, 0)
    +  else
    +    DestroyWindow(Handle);
     end;
     
     class procedure TWin32WSWinControl.Invalidate(const AWinControl: TWinControl);
    @@ -571,7 +580,11 @@
       VisibilityToFlag: array[Boolean] of UINT = (SWP_HIDEWINDOW, SWP_SHOWWINDOW);
     begin
       Windows.SetWindowPos(AWinControl.Handle, 0, 0, 0, 0, 0,
    -    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible])
    +    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible]);
    +  // If this control is a child of an MDI form, then we need to update the MDI client bounds in
    +  // case altering this control's visibility has affected the client area
    +  if Assigned(Application.MainForm) and (AWinControl.Parent=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then
    +    Win32WidgetSet.UpdateMDIClientBounds;
     end;
     
     class procedure TWin32WSWinControl.ScrollBy(const AWinControl: TWinControl;
    Index: lcl/interfaces/win32/win32wsforms.pp
    ===================================================================
    --- lcl/interfaces/win32/win32wsforms.pp	(revision 62555)
    +++ lcl/interfaces/win32/win32wsforms.pp	(working copy)
    @@ -83,6 +83,16 @@
            const APopupParent: TCustomForm); override;
         class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
         class procedure ShowHide(const AWinControl: TWinControl); override;
    +    {mdi support}
    +    class function ActiveMDIChild(const AForm: TCustomForm): TCustomForm; override;
    +    class function Cascade(const AForm: TCustomForm): Boolean; override;
    +    class function GetClientHandle(const AForm: TCustomForm): HWND; override;
    +    class function GetMDIChildren(const AForm: TCustomForm; AIndex: Integer): TCustomForm; override;
    +    class function Next(const AForm: TCustomForm): Boolean; override;
    +    class function Previous(const AForm: TCustomForm): Boolean; override;
    +    class function Tile(const AForm: TCustomForm): Boolean; override;
    +    class function ArrangeIcons(const AForm: TCustomForm): Boolean; override;
    +    class function MDIChildCount(const AForm: TCustomForm): Integer; override;
       end;
     
       { TWin32WSForm }
    @@ -394,6 +404,7 @@
       lForm: TCustomForm absolute AWinControl;
       Bounds: TRect;
       SystemMenu: HMenu;
    +  MaximizeForm: Boolean = False;
     begin
       // general initialization of Params
       PrepareCreateWindow(AWinControl, AParams, Params);
    @@ -425,6 +436,20 @@
             end;
           end;
         end;
    +    if (not (csDesigning in lForm.ComponentState)) and
    +       (lForm.FormStyle=fsMDIChild) and
    +       (lForm <> Application.MainForm) and
    +       Assigned(Application.MainForm) and
    +       (Application.MainForm.FormStyle=fsMDIForm) then begin
    +      Parent := Win32WidgetSet.MDIClientHandle;
    +      if Parent <> 0 then begin
    +        Flags := Flags or WS_CHILD;
    +        FlagsEx := FlagsEx or WS_EX_MDICHILD;
    +        // If there is already a maximized MDI child, we'll need to maximize the new one too
    +        if Assigned(Application.MainForm) and Assigned(Application.MainForm.ActiveMDIChild) then
    +          MaximizeForm := Application.MainForm.ActiveMDIChild.WindowState=wsMaximized;
    +      end;
    +    end;
         CalcFormWindowFlags(lForm, Flags, FlagsEx);
         pClassName := @ClsName[0];
         WindowTitle := StrCaption;
    @@ -461,6 +486,21 @@
       // create window
       FinishCreateWindow(AWinControl, Params, False);
     
    +  if (not (csDesigning in lForm.ComponentState)) and
    +     (lForm.FormStyle=fsMDIChild) and
    +     (lForm <> Application.MainForm) and
    +     Assigned(Application.MainForm) and
    +     (Application.MainForm.FormStyle=fsMDIForm) then begin
    +    // Force a resize event to align children
    +    GetWindowRect(Params.Window, Bounds);
    +    lForm.BoundsRect := Bounds;
    +    // New MDI forms are always activated
    +    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIACTIVATE, Params.Window, 0);
    +    // Maximize the form if there was already a maximized MDI child
    +    if MaximizeForm then
    +      lForm.WindowState := wsMaximized;
    +  end;
    +
       Result := Params.Window;
     
       // remove system menu items for bsDialog
    @@ -733,6 +773,116 @@
         Windows.ShowWindow(AWinControl.Handle, SW_HIDE);
     end;
     
    +class function TWin32WSCustomForm.ActiveMDIChild(const AForm: TCustomForm): TCustomForm;
    +var
    +  ActiveChildHWND: HWND;
    +  PInfo: PWin32WindowInfo;
    +begin
    +  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
    +    ActiveChildHWND := SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, 0);
    +    if ActiveChildHWND=0 then Exit(nil);
    +    PInfo := GetWin32WindowInfo(ActiveChildHWND);
    +    if not (PInfo^.WinControl is TCustomForm) then Exit(nil);
    +    Result := TCustomForm(PInfo^.WinControl);
    +  end else
    +    Result := nil;
    +end;
    +
    +class function TWin32WSCustomForm.Cascade(const AForm: TCustomForm): Boolean;
    +begin
    +  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
    +    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDICASCADE, 0, 0);
    +    Result := True;
    +  end else
    +    Result := False;
    +end;
    +
    +class function TWin32WSCustomForm.GetClientHandle(const AForm: TCustomForm): HWND;
    +begin
    +  if AForm.FormStyle=fsMDIForm then
    +    Result := Win32WidgetSet.MDIClientHandle
    +  else
    +    Result := 0;
    +end;
    +
    +class function TWin32WSCustomForm.GetMDIChildren(const AForm: TCustomForm;
    +  AIndex: Integer): TCustomForm;
    +var
    +  ChildHWND: HWND;
    +  PInfo: PWin32WindowInfo;
    +  Index: Integer;
    +begin
    +  Index := 0;
    +  Result := nil;
    +  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
    +    ChildHWND := GetWindow(Win32WidgetSet.MDIClientHandle, GW_CHILD);
    +    while ChildHWND <> 0 do begin
    +      if (GetWindowLong(ChildHWND, GWL_EXSTYLE) and WS_EX_MDICHILD) <> 0 then begin
    +        PInfo := GetWin32WindowInfo(ChildHWND);
    +        if PInfo^.WinControl is TCustomForm then begin
    +          if Index=AIndex then Exit(TCustomForm(PInfo^.WinControl));
    +          Inc(Index);
    +        end;
    +      end;
    +      ChildHWND := GetWindow(ChildHWND, GW_HWNDNEXT);
    +    end;
    +  end;
    +end;
    +
    +class function TWin32WSCustomForm.Next(const AForm: TCustomForm): Boolean;
    +begin
    +  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
    +    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDINEXT, 0, 1);
    +    Result := True;
    +  end else
    +    Result := False;
    +end;
    +
    +class function TWin32WSCustomForm.Previous(const AForm: TCustomForm): Boolean;
    +begin
    +  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
    +    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDINEXT, 0, 0);
    +    Result := True;
    +  end else
    +    Result := False;
    +end;
    +
    +class function TWin32WSCustomForm.Tile(const AForm: TCustomForm): Boolean;
    +begin
    +  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
    +    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDITILE, MDITILE_HORIZONTAL, 0);
    +    Result := True;
    +  end else
    +    Result := False;
    +end;
    +
    +class function TWin32WSCustomForm.ArrangeIcons(const AForm: TCustomForm): Boolean;
    +begin
    +  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
    +    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIICONARRANGE, 0, 0);
    +    Result := True;
    +  end else
    +    Result := False;
    +end;
    +
    +class function TWin32WSCustomForm.MDIChildCount(const AForm: TCustomForm): Integer;
    +var
    +  ChildHWND: HWND;
    +  PInfo: PWin32WindowInfo;
    +begin
    +  Result := 0;
    +  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
    +    ChildHWND := GetWindow(Win32WidgetSet.MDIClientHandle, GW_CHILD);
    +    while ChildHWND <> 0 do begin
    +      if (GetWindowLong(ChildHWND, GWL_EXSTYLE) and WS_EX_MDICHILD) <> 0 then begin
    +        PInfo := GetWin32WindowInfo(ChildHWND);
    +        if PInfo^.WinControl is TCustomForm then Inc(Result);
    +      end;
    +      ChildHWND := GetWindow(ChildHWND, GW_HWNDNEXT);
    +    end;
    +  end;
    +end;
    +
     class procedure TWin32WSCustomForm.ShowModal(const ACustomForm: TCustomForm);
     var
       Parent: HWND;
    Index: lcl/interfaces/win32/win32wsmenus.pp
    ===================================================================
    --- lcl/interfaces/win32/win32wsmenus.pp	(revision 62555)
    +++ lcl/interfaces/win32/win32wsmenus.pp	(working copy)
    @@ -609,14 +609,15 @@
       MenuState: TThemedMenu;
       Metrics: TVistaBarMenuMetrics;
       Details, Tmp: TThemedElementDetails;
    -  BGRect, BGClip, WndRect, TextRect, ImageRect: TRect;
    +  BGRect, BGClip, WndRect, TextRect, ImageRect, ItemRect: TRect;
       IconSize: TPoint;
       TextFlags: DWord;
       AFont, OldFont: HFONT;
       IsRightToLeft: Boolean;
       Info: tagMENUBARINFO;
    -  AWnd: HWND;
    +  AWnd, ActiveChild: HWND;
       CalculatedSize: TSIZE;
    +  MaximizedActiveChild: WINBOOL;
     begin
       if (ItemState and ODS_SELECTED) <> 0 then
         MenuState := tmBarItemPushed
    @@ -654,6 +655,24 @@
         OffsetRect(Info.rcBar, -WndRect.Left, -WndRect.Top);
         Tmp := ThemeServices.GetElementDetails(BarState[(ItemState and ODS_INACTIVE) = 0]);
         ThemeDrawElement(AHDC, Tmp, Info.rcBar, nil);
    +    // if there is any maximized MDI child, the call above erased its icon... so we'll
    +    // need to redraw the icon again
    +    if (AMenuItem.GetParentMenu.Parent=Application.MainForm) and
    +       (Application.MainForm.FormStyle=fsMDIForm) then begin
    +      MaximizedActiveChild := False;
    +      ActiveChild := HWND(SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, Windows.WPARAM(@MaximizedActiveChild)));
    +      if ActiveChild <> 0 then begin
    +        if MaximizedActiveChild then begin
    +          if GetMenuItemRect(AWnd, Info.hMenu, 0, @ItemRect) then begin
    +            OffsetRect(ItemRect, -WndRect.Left, -WndRect.Top);
    +            DrawIconEx(AHDC, ItemRect.Left + (ItemRect.Width - 16) div 2, ItemRect.Top + (ItemRect.Height - 16) div 2,
    +              GetClassLong(ActiveChild, GCL_HICONSM),
    +              16, 16, 0, 0,
    +              DI_NORMAL);
    +          end;
    +        end;
    +      end;
    +    end;
       end;
     
       BGRect := ARect;
    @@ -1418,6 +1437,7 @@
       ParentOfParent: HMenu;
       CallMenuRes: Boolean;
       WideBuffer: widestring;
    +  ItemIndex: Integer;
     begin
       ParentMenuHandle := AMenuItem.Parent.Handle;
       FillChar(MenuInfo, SizeOf(MenuInfo), 0);
    @@ -1486,7 +1506,16 @@
         if AMenuItem.Default then
           fState := fState or MFS_DEFAULT;
       end;
    -  CallMenuRes := InsertMenuItemW(ParentMenuHandle, AMenuItem.Parent.VisibleIndexOf(AMenuItem), True, @MenuInfo);
    +  ItemIndex := AMenuItem.Parent.VisibleIndexOf(AMenuItem);
    +  // MDI forms with a maximized MDI child insert a menu at the first index for
    +  // the MDI child's window menu, so we need to take that into account
    +  if Assigned(Application.MainForm) and
    +     (Application.MainForm.Menu=AMenuItem.Parent.Menu) and
    +     (Application.MainForm.FormStyle=fsMDIForm) and
    +     Assigned(Application.MainForm.ActiveMDIChild) and
    +     (Application.MainForm.ActiveMDIChild.WindowState=wsMaximized) then
    +    Inc(ItemIndex);
    +  CallMenuRes := InsertMenuItemW(ParentMenuHandle, ItemIndex, True, @MenuInfo);
       if not CallMenuRes then
         DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]);
       TriggerFormUpdate(AMenuItem);
    Index: lcl/menus.pp
    ===================================================================
    --- lcl/menus.pp	(revision 62555)
    +++ lcl/menus.pp	(working copy)
    @@ -396,6 +396,8 @@
         procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
       public
         constructor Create(AOwner: TComponent); override;
    +    procedure Merge(Menu: TMainMenu);
    +    procedure Unmerge(Menu: TMainMenu);
         property Height: Integer read GetHeight;
         property WindowHandle: HWND read FWindowHandle write SetWindowHandle;
       published
    Index: lcl/widgetset/wsforms.pp
    ===================================================================
    --- lcl/widgetset/wsforms.pp	(revision 62555)
    +++ lcl/widgetset/wsforms.pp	(working copy)
    @@ -101,6 +101,7 @@
         class function Next(const AForm: TCustomForm): Boolean; virtual;
         class function Previous(const AForm: TCustomForm): Boolean; virtual;
         class function Tile(const AForm: TCustomForm): Boolean; virtual;
    +    class function ArrangeIcons(const AForm: TCustomForm): Boolean; virtual;
         class function MDIChildCount(const AForm: TCustomForm): Integer; virtual;
       end;
       TWSCustomFormClass = class of TWSCustomForm;
    @@ -254,6 +255,11 @@
       Result := False;
     end;
     
    +class function TWSCustomForm.ArrangeIcons(const AForm: TCustomForm): Boolean;
    +begin
    +  Result := False;
    +end;
    +
     class function TWSCustomForm.Tile(const AForm: TCustomForm): Boolean;
     begin
       Result := False;
    
  • mdidoodle.zip (72,121 bytes)

Activities

Kostas Michalopoulos

2020-01-14 21:07

reporter  

win32mdisupport-svn62555.diff (29,074 bytes)
Index: lcl/forms.pp
===================================================================
--- lcl/forms.pp	(revision 62555)
+++ lcl/forms.pp	(working copy)
@@ -768,6 +768,8 @@
     procedure Previous;
     { mdi related routine}
     procedure Tile;
+    { mdi related routine}
+    procedure ArrangeIcons;
     { mdi related property}
     property ClientHandle;
 
Index: lcl/include/customform.inc
===================================================================
--- lcl/include/customform.inc	(revision 62555)
+++ lcl/include/customform.inc	(working copy)
@@ -101,7 +101,10 @@
   GlobalNameSpace.BeginWrite;
   Screen.FSaveFocusedList.Remove(Self);
   RemoveFixupReferences(Self, '');
-  if FormStyle <> fsMDIChild then Hide;
+  if FormStyle <> fsMDIChild then
+    Hide
+  else if Assigned(Menu) and Assigned(Application.MainForm) and Assigned(Application.MainForm.Menu) then
+    Application.MainForm.Menu.Unmerge(Menu);
   DoDestroy;
   // don't call the inherited method because it calls Destroying which is already called
 end;
@@ -659,9 +662,11 @@
 
   inherited WMSize(Message);
 
-  FDelayedWMSize := True;
-  Inc(FDelayedEventCtr);
-  Application.QueueAsyncCall(@DelayedEvent, 0);
+  if not (csDestroying in ComponentState) then begin
+    FDelayedWMSize := True;
+    Inc(FDelayedEventCtr);
+    Application.QueueAsyncCall(@DelayedEvent, 0);
+  end;
 end;
 
 procedure TCustomForm.WMMove(var Message: TLMMove);
@@ -668,9 +673,11 @@
 begin
   inherited WMMove(Message);
 
-  FDelayedWMMove := True;
-  Inc(FDelayedEventCtr);
-  Application.QueueAsyncCall(@DelayedEvent, 0);
+  if not (csDestroying in ComponentState) then begin
+    FDelayedWMMove := True;
+    Inc(FDelayedEventCtr);
+    Application.QueueAsyncCall(@DelayedEvent, 0);
+  end;
 end;
 
 procedure TCustomForm.DelayedEvent(Data: PtrInt);
@@ -796,6 +803,12 @@
 
 procedure TCustomForm.CMActivate(var Message: TLMessage);
 begin
+  if (FormStyle=fsMDIChild) and
+     Assigned(Menu) and
+     Assigned(Application.MainForm) and
+     (Application.MainForm.FormStyle=fsMDIForm) and
+     Assigned(Application.MainForm.Menu) then
+    Application.MainForm.Menu.Merge(Menu);
   Activate;
 end;
 
@@ -802,6 +815,12 @@
 procedure TCustomForm.CMDeactivate(var Message: TLMessage);
 begin
   Deactivate;
+  if (FormStyle=fsMDIChild) and
+     Assigned(Menu) and
+     Assigned(Application.MainForm) and
+     (Application.MainForm.FormStyle=fsMDIForm) and
+     Assigned(Application.MainForm.Menu) then
+    Application.MainForm.Menu.Unmerge(Menu);
 end;
 
 procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType;
@@ -1378,7 +1397,7 @@
 
         if FormStyle = fsMDIFORM then
         begin
-          // ToDo
+          Exit;
         end
         else
         begin
@@ -2214,12 +2233,15 @@
     Result:=true;
   end;
 
+var
+  I: Integer;
 begin
   if FormStyle = fsMDIForm then
   begin
     // Query children forms whether we can close
     if not Check(Self) then exit(False);
-    // TODO: mdi logic
+    for I := 0 to MDIChildCount - 1 do
+      if not MDIChildren[I].CloseQuery then Exit(False);
   end;
   Result := True;
   if Assigned(FOnCloseQuery) then
@@ -3206,6 +3228,22 @@
     TWSCustomFormClass(WidgetSetClass).Tile(Self);
 end;
 
+{------------------------------------------------------------------------------
+  Method: TForm.ArrangeIcons
+  Params:  None
+  Returns: Nothing
+
+  Arranges the minimized MDI icons in an MDI form.
+  ArrangeIcons works only if the form FormStyle = fsMDIForm.
+ ------------------------------------------------------------------------------}
+procedure TForm.ArrangeIcons;
+begin
+  if (FormStyle <> fsMDIForm) then
+    Exit;
+  if HandleAllocated and not (csDesigning in ComponentState) then
+    TWSCustomFormClass(WidgetSetClass).ArrangeIcons(Self);
+end;
+
 //==============================================================================
 
 { TFormPropertyStorage }
Index: lcl/include/mainmenu.inc
===================================================================
--- lcl/include/mainmenu.inc	(revision 62555)
+++ lcl/include/mainmenu.inc	(working copy)
@@ -50,6 +50,46 @@
   inherited MenuChanged(Sender, Source, Rebuild);
 end;
 
+procedure TMainMenu.Merge(Menu: TMainMenu);
+var
+  EquivalentItem, ClonedItem: TMenuItem;
+  I, J, InsertIndex: Integer;
+begin
+  for I := 0 to Menu.Items.Count - 1 do begin
+    InsertIndex := -1;
+    for J := 0 to Items.Count - 1 do
+      if Items[J].GroupIndex=Menu.Items[I].GroupIndex then begin
+        if InsertIndex=-1 then InsertIndex := J;
+        Items[J].Visible := False;
+      end;
+    if InsertIndex=-1 then
+      for J := 0 to Items.Count - 1 do
+        if Items[J].GroupIndex > Menu.Items[I].GroupIndex then begin
+          InsertIndex := J;
+          Break;
+        end;
+    ClonedItem := TMenuItem.Create(Menu);
+    MenuItem_Copy(Menu.Items[I], ClonedItem);
+    if InsertIndex=-1 then
+      Items.Add(ClonedItem)
+    else
+      Items.Insert(InsertIndex, ClonedItem);
+  end;
+end;
+
+procedure TMainMenu.Unmerge(Menu: TMainMenu);
+var
+  I, J: Integer;
+begin
+  for I := 0 to Menu.Items.Count - 1 do
+    for J := 0 to Items.Count - 1 do
+      if Items[J].GroupIndex=Menu.Items[I].GroupIndex then
+        Items[J].Visible := True;
+  for I := Items.Count - 1 downto 0 do
+    if Items[I].Owner=Menu then
+      Items.Delete(I);
+end;
+
 {------------------------------------------------------------------------------
   Method: TMainMenu.Create
   Params:  AOwner: the owner of the class
Index: lcl/interfaces/win32/win32callback.inc
===================================================================
--- lcl/interfaces/win32/win32callback.inc	(revision 62555)
+++ lcl/interfaces/win32/win32callback.inc	(working copy)
@@ -72,6 +72,7 @@
   depthLen: integer;
 {$endif}
   setComboWindow: boolean;
+  WindowInfo: PWin32WindowInfo;
 begin
 {$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
   depthLen := Length(MessageStackDepth);
@@ -78,10 +79,31 @@
   if depthLen > 0 then
     MessageStackDepth[depthLen] := '#';
 {$endif}
-  PrevWndProc := GetWin32WindowInfo(Window)^.DefWndProc;
+  WindowInfo := GetWin32WindowInfo(Window);
+  PrevWndProc := WindowInfo^.DefWndProc;
   if (PrevWndProc = nil) or (PrevWndProc = @WindowProc) // <- prevent recursion
   then begin
-    Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam)
+    if WindowInfo^.WinControl is TCustomForm then begin
+      case TCustomForm(WindowInfo^.WinControl).FormStyle of
+        fsMDIForm:
+          if Msg <> WM_COMMAND then
+            Result := Windows.DefFrameProcW(Window, Win32WidgetSet.MDIClientHandle, Msg, WParam, LParam)
+          else if (LoWord(WParam)=SC_CLOSE) or
+                  (LoWord(WParam)=SC_MAXIMIZE) or
+                  (LoWord(WParam)=SC_MINIMIZE) or
+                  (LoWord(WParam)=SC_RESTORE) or
+                  (LoWord(WParam)=SC_NEXTWINDOW) or
+                  (LoWord(WParam)=SC_PREVWINDOW) then
+            Result := Windows.DefFrameProcW(Window, Win32WidgetSet.MDIClientHandle, Msg, WParam, LParam)
+          else
+            Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam);
+        fsMDIChild:
+          Result := Windows.DefMDIChildProcW(Window, Msg, WParam, LParam);
+        else
+          Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam);
+      end;
+    end else
+      Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam);
   end
   else begin
     // combobox child edit weirdness: combobox handling WM_SIZE will compare text
@@ -1942,6 +1964,7 @@
   R: TRect;
   ACtl: TWinControl;
   LMouseEvent: TTRACKMOUSEEVENT;
+  MaximizedActiveChild: WINBOOL;
 {$IF NOT DECLARED(WM_DPICHANGED)} // WM_DPICHANGED was added in FPC 3.1.1
 const
   WM_DPICHANGED = $02E0;
@@ -2028,6 +2051,13 @@
       if HIWORD(lParam) = 0 then //if not system menu
       begin
         TargetObject := GetPopMenuItemObject;
+        // Check if the menu was the maximized icon menu for an MDI child window and ignore it in that case
+        if (LoWord(LParam)=0) and (lWinControl=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then begin
+          MaximizedActiveChild := False;
+          if SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, Windows.WPARAM(@MaximizedActiveChild)) <> 0 then begin
+            if MaximizedActiveChild then TargetObject := nil;
+          end;
+        end;
         if TargetObject is TMenuItem then
         begin
           LMessage.Msg := LM_ACTIVATE;
@@ -2040,6 +2070,13 @@
     WM_MENUSELECT:
     begin
       TargetObject := GetMenuItemObject((HIWORD(Integer(WParam)) and MF_POPUP) <> 0);
+      // Check if the menu was the maximized icon menu for an MDI child window and ignore it in that case
+      if (LoWord(WParam)=0) and (lWinControl=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then begin
+        MaximizedActiveChild := False;
+        if SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, Windows.WPARAM(@MaximizedActiveChild)) <> 0 then begin
+          if MaximizedActiveChild then TargetObject := nil;
+        end;
+      end;
       if TargetObject is TMenuItem then
         TMenuItem(TargetObject).IntfDoSelect
       else
@@ -2419,6 +2456,12 @@
       SetLMessageAndParams(Msg, True);
   end;  // case Msg of
 
+  // Update MDI form client bounds
+  if WinProcess and (Msg=WM_SIZE) and (Window=Application.MainFormHandle) and (Application.MainForm.FormStyle=fsMDIForm) then begin
+    Win32WidgetSet.UpdateMDIClientBounds;
+    WinProcess := False;
+  end;
+
   if WinProcess then
   begin
     PLMsg^.Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
Index: lcl/interfaces/win32/win32int.pp
===================================================================
--- lcl/interfaces/win32/win32int.pp	(revision 62555)
+++ lcl/interfaces/win32/win32int.pp	(working copy)
@@ -129,6 +129,7 @@
     FMetrics: TNonClientMetrics;
     FMetricsFailed: Boolean;
     FDefaultFont: HFONT;
+    FMDIClientHandle: HWND;
 
     FWaitHandleCount: dword;
     FWaitHandles: array of HANDLE;
@@ -150,6 +151,7 @@
     function WinRegister: Boolean;
 
     procedure CreateAppHandle;
+    function GetMDIClientHandle: HWND;
   protected
     function CreateThemeServices: TThemeServices; override;
     function GetAppHandle: THandle; override;
@@ -201,6 +203,11 @@
     procedure HandleWakeMainThread(Sender: TObject);
     property DefaultFont: HFONT read FDefaultFont;
 
+    // MDI client handle (if any)
+    property MDIClientHandle: HWND read GetMDIClientHandle;
+
+    procedure UpdateMDIClientBounds;
+
     {$I win32winapih.inc}
     {$I win32lclintfh.inc}
 
Index: lcl/interfaces/win32/win32object.inc
===================================================================
--- lcl/interfaces/win32/win32object.inc	(revision 62555)
+++ lcl/interfaces/win32/win32object.inc	(working copy)
@@ -403,8 +403,17 @@
           PostQuitMessage(AMessage.wParam);
           break;
         end;
-        TranslateMessage(@AMessage);
-        DispatchMessageW(@AMessage);
+        // Handle MDI form accelerators
+        if Assigned(Application) and
+           Assigned(Application.MainForm) and
+           (Application.MainForm.FormStyle=fsMDIForm) and
+           TranslateMDISysAccel(Win32WidgetSet.MDIClientHandle, @AMessage) then begin
+          // handled by TranslateMDISysAccel
+          write;
+        end else begin
+          TranslateMessage(@AMessage);
+          DispatchMessageW(@AMessage);
+        end;
       end;
     end else
     if retVal = WAIT_TIMEOUT then
@@ -634,6 +643,31 @@
     Windows.PostMessage(FAppHandle, WM_NULL, 0, 0);
 end;
 
+procedure TWin32WidgetSet.UpdateMDIClientBounds;
+
+  function CalculateClientArea: TRect;
+  var
+    I: Integer;
+  begin
+    Windows.GetClientRect(Application.MainFormHandle, Result);
+    for I := 0 to Application.MainForm.ControlCount - 1 do
+      if Application.MainForm.Controls[I].Visible then
+        case Application.MainForm.Controls[I].Align of
+          alLeft: Inc(Result.Left, Application.MainForm.Controls[I].Width);
+          alTop: Inc(Result.Top, Application.MainForm.Controls[I].Height);
+          alRight: Dec(Result.Right, Application.MainForm.Controls[I].Width);
+          alBottom: Dec(Result.Bottom, Application.MainForm.Controls[I].Height);
+        end;
+  end;
+
+var
+  R: TRect;
+begin
+  if not (Assigned(Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm)) then Exit;
+  R := CalculateClientArea;
+  MoveWindow(Win32WidgetSet.MDIClientHandle, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, True);
+end;
+
 { Private methods (in no significant order) }
 
 {------------------------------------------------------------------------------
@@ -696,6 +730,26 @@
   Windows.DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
 end;
 
+function TWin32WidgetSet.GetMDIClientHandle: HWND;
+const
+  MDIClientW: array[0..9] of WideChar = ('M', 'D', 'I', 'C', 'L', 'I', 'E', 'N', 'T', #0);
+var
+  CCS: TCLIENTCREATESTRUCT;
+begin
+  if (FMDIClientHandle=0) and
+     Assigned(Application) and
+     Assigned(Application.MainForm) and
+     (Application.MainForm.FormStyle=fsMDIForm) then begin
+    CCS.hWindowMenu := 0;
+    CCS.idFirstChild := 0;
+    FMDIClientHandle := CreateWindowW(@MDIClientW, nil,
+      WS_CHILD or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or WS_VSCROLL or WS_HSCROLL,
+      0, 0, 0, 0, Application.MainForm.Handle, 0, HInstance, @CCS);
+    ShowWindow(FMDIClientHandle, SW_SHOW);
+  end;
+  Result := FMDIClientHandle;
+end;
+
 function TWin32WidgetSet.CreateThemeServices: TThemeServices;
 begin
   Result := TWin32ThemeServices.Create;
Index: lcl/interfaces/win32/win32winapi.inc
===================================================================
--- lcl/interfaces/win32/win32winapi.inc	(revision 62555)
+++ lcl/interfaces/win32/win32winapi.inc	(working copy)
@@ -2458,8 +2458,14 @@
       SetWidthHeightFromRect(R);
     end;
   end
-  else
-    SetWidthHeightFromRect(WP.rcNormalPosition);
+  else begin
+    // rcNormalPosition is not valid for MDI children se we use GetWindowRect instead
+    if (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_MDICHILD) <> 0 then begin
+      Windows.GetWindowRect(Handle, R);
+      SetWidthHeightFromRect(R);
+    end else
+      SetWidthHeightFromRect(WP.rcNormalPosition);
+  end;
 
   WindowInfo := GetWin32WindowInfo(Handle);
 
@@ -3285,7 +3291,12 @@
  ------------------------------------------------------------------------------}
 function TWin32WidgetSet.SetForegroundWindow(HWnd: HWND): boolean;
 begin
-  Result := Windows.SetForegroundWindow(HWnd);
+  // MDI children need to use WM_MDIACTIVATE to bring themselves into the foreground
+  if (GetWindowLong(HWnd, GWL_EXSTYLE) and WS_EX_MDICHILD) <> 0 then begin
+    SendMessage(GetParent(HWnd), WM_MDIACTIVATE, HWnd, 0);
+    Result := True;
+  end else
+    Result := Windows.SetForegroundWindow(HWnd);
 end;
 
 function TWin32WidgetSet.SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean;
Index: lcl/interfaces/win32/win32wscontrols.pp
===================================================================
--- lcl/interfaces/win32/win32wscontrols.pp	(revision 62555)
+++ lcl/interfaces/win32/win32wscontrols.pp	(working copy)
@@ -468,6 +468,10 @@
       Windows.SetWindowPos(Handle, 0, IntfLeft, IntfTop, IntfWidth, IntfHeight, SWP_NOZORDER or SWP_NOACTIVATE);
   end;
   LCLControlSizeNeedsUpdate(AWinControl, True);
+  // If this control is a child of an MDI form, then we need to update the MDI client bounds in
+  // case this control has affected the client area
+  if Assigned(Application.MainForm) and (AWinControl.Parent=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then
+    Win32WidgetSet.UpdateMDIClientBounds;
 end;
 
 class procedure TWin32WSWinControl.SetColor(const AWinControl: TWinControl);
@@ -545,7 +549,12 @@
   {$ifdef RedirectDestroyMessages}
   SetWindowLong(Handle, GWL_WNDPROC, PtrInt(@DestroyWindowProc));
   {$endif}
-  DestroyWindow(Handle);
+  // Instead of calling DestroyWindow directly, we need to call WM_MDIDESTROY for MDI children
+  if Assigned(Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) and
+    (AWinControl is TCustomForm) and (TCustomForm(AWinControl).FormStyle=fsMDIChild) then
+    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIDESTROY, Handle, 0)
+  else
+    DestroyWindow(Handle);
 end;
 
 class procedure TWin32WSWinControl.Invalidate(const AWinControl: TWinControl);
@@ -571,7 +580,11 @@
   VisibilityToFlag: array[Boolean] of UINT = (SWP_HIDEWINDOW, SWP_SHOWWINDOW);
 begin
   Windows.SetWindowPos(AWinControl.Handle, 0, 0, 0, 0, 0,
-    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible])
+    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible]);
+  // If this control is a child of an MDI form, then we need to update the MDI client bounds in
+  // case altering this control's visibility has affected the client area
+  if Assigned(Application.MainForm) and (AWinControl.Parent=Application.MainForm) and (Application.MainForm.FormStyle=fsMDIForm) then
+    Win32WidgetSet.UpdateMDIClientBounds;
 end;
 
 class procedure TWin32WSWinControl.ScrollBy(const AWinControl: TWinControl;
Index: lcl/interfaces/win32/win32wsforms.pp
===================================================================
--- lcl/interfaces/win32/win32wsforms.pp	(revision 62555)
+++ lcl/interfaces/win32/win32wsforms.pp	(working copy)
@@ -83,6 +83,16 @@
        const APopupParent: TCustomForm); override;
     class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
     class procedure ShowHide(const AWinControl: TWinControl); override;
+    {mdi support}
+    class function ActiveMDIChild(const AForm: TCustomForm): TCustomForm; override;
+    class function Cascade(const AForm: TCustomForm): Boolean; override;
+    class function GetClientHandle(const AForm: TCustomForm): HWND; override;
+    class function GetMDIChildren(const AForm: TCustomForm; AIndex: Integer): TCustomForm; override;
+    class function Next(const AForm: TCustomForm): Boolean; override;
+    class function Previous(const AForm: TCustomForm): Boolean; override;
+    class function Tile(const AForm: TCustomForm): Boolean; override;
+    class function ArrangeIcons(const AForm: TCustomForm): Boolean; override;
+    class function MDIChildCount(const AForm: TCustomForm): Integer; override;
   end;
 
   { TWin32WSForm }
@@ -394,6 +404,7 @@
   lForm: TCustomForm absolute AWinControl;
   Bounds: TRect;
   SystemMenu: HMenu;
+  MaximizeForm: Boolean = False;
 begin
   // general initialization of Params
   PrepareCreateWindow(AWinControl, AParams, Params);
@@ -425,6 +436,20 @@
         end;
       end;
     end;
+    if (not (csDesigning in lForm.ComponentState)) and
+       (lForm.FormStyle=fsMDIChild) and
+       (lForm <> Application.MainForm) and
+       Assigned(Application.MainForm) and
+       (Application.MainForm.FormStyle=fsMDIForm) then begin
+      Parent := Win32WidgetSet.MDIClientHandle;
+      if Parent <> 0 then begin
+        Flags := Flags or WS_CHILD;
+        FlagsEx := FlagsEx or WS_EX_MDICHILD;
+        // If there is already a maximized MDI child, we'll need to maximize the new one too
+        if Assigned(Application.MainForm) and Assigned(Application.MainForm.ActiveMDIChild) then
+          MaximizeForm := Application.MainForm.ActiveMDIChild.WindowState=wsMaximized;
+      end;
+    end;
     CalcFormWindowFlags(lForm, Flags, FlagsEx);
     pClassName := @ClsName[0];
     WindowTitle := StrCaption;
@@ -461,6 +486,21 @@
   // create window
   FinishCreateWindow(AWinControl, Params, False);
 
+  if (not (csDesigning in lForm.ComponentState)) and
+     (lForm.FormStyle=fsMDIChild) and
+     (lForm <> Application.MainForm) and
+     Assigned(Application.MainForm) and
+     (Application.MainForm.FormStyle=fsMDIForm) then begin
+    // Force a resize event to align children
+    GetWindowRect(Params.Window, Bounds);
+    lForm.BoundsRect := Bounds;
+    // New MDI forms are always activated
+    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIACTIVATE, Params.Window, 0);
+    // Maximize the form if there was already a maximized MDI child
+    if MaximizeForm then
+      lForm.WindowState := wsMaximized;
+  end;
+
   Result := Params.Window;
 
   // remove system menu items for bsDialog
@@ -733,6 +773,116 @@
     Windows.ShowWindow(AWinControl.Handle, SW_HIDE);
 end;
 
+class function TWin32WSCustomForm.ActiveMDIChild(const AForm: TCustomForm): TCustomForm;
+var
+  ActiveChildHWND: HWND;
+  PInfo: PWin32WindowInfo;
+begin
+  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
+    ActiveChildHWND := SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, 0);
+    if ActiveChildHWND=0 then Exit(nil);
+    PInfo := GetWin32WindowInfo(ActiveChildHWND);
+    if not (PInfo^.WinControl is TCustomForm) then Exit(nil);
+    Result := TCustomForm(PInfo^.WinControl);
+  end else
+    Result := nil;
+end;
+
+class function TWin32WSCustomForm.Cascade(const AForm: TCustomForm): Boolean;
+begin
+  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
+    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDICASCADE, 0, 0);
+    Result := True;
+  end else
+    Result := False;
+end;
+
+class function TWin32WSCustomForm.GetClientHandle(const AForm: TCustomForm): HWND;
+begin
+  if AForm.FormStyle=fsMDIForm then
+    Result := Win32WidgetSet.MDIClientHandle
+  else
+    Result := 0;
+end;
+
+class function TWin32WSCustomForm.GetMDIChildren(const AForm: TCustomForm;
+  AIndex: Integer): TCustomForm;
+var
+  ChildHWND: HWND;
+  PInfo: PWin32WindowInfo;
+  Index: Integer;
+begin
+  Index := 0;
+  Result := nil;
+  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
+    ChildHWND := GetWindow(Win32WidgetSet.MDIClientHandle, GW_CHILD);
+    while ChildHWND <> 0 do begin
+      if (GetWindowLong(ChildHWND, GWL_EXSTYLE) and WS_EX_MDICHILD) <> 0 then begin
+        PInfo := GetWin32WindowInfo(ChildHWND);
+        if PInfo^.WinControl is TCustomForm then begin
+          if Index=AIndex then Exit(TCustomForm(PInfo^.WinControl));
+          Inc(Index);
+        end;
+      end;
+      ChildHWND := GetWindow(ChildHWND, GW_HWNDNEXT);
+    end;
+  end;
+end;
+
+class function TWin32WSCustomForm.Next(const AForm: TCustomForm): Boolean;
+begin
+  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
+    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDINEXT, 0, 1);
+    Result := True;
+  end else
+    Result := False;
+end;
+
+class function TWin32WSCustomForm.Previous(const AForm: TCustomForm): Boolean;
+begin
+  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
+    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDINEXT, 0, 0);
+    Result := True;
+  end else
+    Result := False;
+end;
+
+class function TWin32WSCustomForm.Tile(const AForm: TCustomForm): Boolean;
+begin
+  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
+    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDITILE, MDITILE_HORIZONTAL, 0);
+    Result := True;
+  end else
+    Result := False;
+end;
+
+class function TWin32WSCustomForm.ArrangeIcons(const AForm: TCustomForm): Boolean;
+begin
+  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
+    SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIICONARRANGE, 0, 0);
+    Result := True;
+  end else
+    Result := False;
+end;
+
+class function TWin32WSCustomForm.MDIChildCount(const AForm: TCustomForm): Integer;
+var
+  ChildHWND: HWND;
+  PInfo: PWin32WindowInfo;
+begin
+  Result := 0;
+  if (AForm.FormStyle=fsMDIForm) and (Application.MainForm=AForm) then begin
+    ChildHWND := GetWindow(Win32WidgetSet.MDIClientHandle, GW_CHILD);
+    while ChildHWND <> 0 do begin
+      if (GetWindowLong(ChildHWND, GWL_EXSTYLE) and WS_EX_MDICHILD) <> 0 then begin
+        PInfo := GetWin32WindowInfo(ChildHWND);
+        if PInfo^.WinControl is TCustomForm then Inc(Result);
+      end;
+      ChildHWND := GetWindow(ChildHWND, GW_HWNDNEXT);
+    end;
+  end;
+end;
+
 class procedure TWin32WSCustomForm.ShowModal(const ACustomForm: TCustomForm);
 var
   Parent: HWND;
Index: lcl/interfaces/win32/win32wsmenus.pp
===================================================================
--- lcl/interfaces/win32/win32wsmenus.pp	(revision 62555)
+++ lcl/interfaces/win32/win32wsmenus.pp	(working copy)
@@ -609,14 +609,15 @@
   MenuState: TThemedMenu;
   Metrics: TVistaBarMenuMetrics;
   Details, Tmp: TThemedElementDetails;
-  BGRect, BGClip, WndRect, TextRect, ImageRect: TRect;
+  BGRect, BGClip, WndRect, TextRect, ImageRect, ItemRect: TRect;
   IconSize: TPoint;
   TextFlags: DWord;
   AFont, OldFont: HFONT;
   IsRightToLeft: Boolean;
   Info: tagMENUBARINFO;
-  AWnd: HWND;
+  AWnd, ActiveChild: HWND;
   CalculatedSize: TSIZE;
+  MaximizedActiveChild: WINBOOL;
 begin
   if (ItemState and ODS_SELECTED) <> 0 then
     MenuState := tmBarItemPushed
@@ -654,6 +655,24 @@
     OffsetRect(Info.rcBar, -WndRect.Left, -WndRect.Top);
     Tmp := ThemeServices.GetElementDetails(BarState[(ItemState and ODS_INACTIVE) = 0]);
     ThemeDrawElement(AHDC, Tmp, Info.rcBar, nil);
+    // if there is any maximized MDI child, the call above erased its icon... so we'll
+    // need to redraw the icon again
+    if (AMenuItem.GetParentMenu.Parent=Application.MainForm) and
+       (Application.MainForm.FormStyle=fsMDIForm) then begin
+      MaximizedActiveChild := False;
+      ActiveChild := HWND(SendMessage(Win32WidgetSet.MDIClientHandle, WM_MDIGETACTIVE, 0, Windows.WPARAM(@MaximizedActiveChild)));
+      if ActiveChild <> 0 then begin
+        if MaximizedActiveChild then begin
+          if GetMenuItemRect(AWnd, Info.hMenu, 0, @ItemRect) then begin
+            OffsetRect(ItemRect, -WndRect.Left, -WndRect.Top);
+            DrawIconEx(AHDC, ItemRect.Left + (ItemRect.Width - 16) div 2, ItemRect.Top + (ItemRect.Height - 16) div 2,
+              GetClassLong(ActiveChild, GCL_HICONSM),
+              16, 16, 0, 0,
+              DI_NORMAL);
+          end;
+        end;
+      end;
+    end;
   end;
 
   BGRect := ARect;
@@ -1418,6 +1437,7 @@
   ParentOfParent: HMenu;
   CallMenuRes: Boolean;
   WideBuffer: widestring;
+  ItemIndex: Integer;
 begin
   ParentMenuHandle := AMenuItem.Parent.Handle;
   FillChar(MenuInfo, SizeOf(MenuInfo), 0);
@@ -1486,7 +1506,16 @@
     if AMenuItem.Default then
       fState := fState or MFS_DEFAULT;
   end;
-  CallMenuRes := InsertMenuItemW(ParentMenuHandle, AMenuItem.Parent.VisibleIndexOf(AMenuItem), True, @MenuInfo);
+  ItemIndex := AMenuItem.Parent.VisibleIndexOf(AMenuItem);
+  // MDI forms with a maximized MDI child insert a menu at the first index for
+  // the MDI child's window menu, so we need to take that into account
+  if Assigned(Application.MainForm) and
+     (Application.MainForm.Menu=AMenuItem.Parent.Menu) and
+     (Application.MainForm.FormStyle=fsMDIForm) and
+     Assigned(Application.MainForm.ActiveMDIChild) and
+     (Application.MainForm.ActiveMDIChild.WindowState=wsMaximized) then
+    Inc(ItemIndex);
+  CallMenuRes := InsertMenuItemW(ParentMenuHandle, ItemIndex, True, @MenuInfo);
   if not CallMenuRes then
     DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]);
   TriggerFormUpdate(AMenuItem);
Index: lcl/menus.pp
===================================================================
--- lcl/menus.pp	(revision 62555)
+++ lcl/menus.pp	(working copy)
@@ -396,6 +396,8 @@
     procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
   public
     constructor Create(AOwner: TComponent); override;
+    procedure Merge(Menu: TMainMenu);
+    procedure Unmerge(Menu: TMainMenu);
     property Height: Integer read GetHeight;
     property WindowHandle: HWND read FWindowHandle write SetWindowHandle;
   published
Index: lcl/widgetset/wsforms.pp
===================================================================
--- lcl/widgetset/wsforms.pp	(revision 62555)
+++ lcl/widgetset/wsforms.pp	(working copy)
@@ -101,6 +101,7 @@
     class function Next(const AForm: TCustomForm): Boolean; virtual;
     class function Previous(const AForm: TCustomForm): Boolean; virtual;
     class function Tile(const AForm: TCustomForm): Boolean; virtual;
+    class function ArrangeIcons(const AForm: TCustomForm): Boolean; virtual;
     class function MDIChildCount(const AForm: TCustomForm): Integer; virtual;
   end;
   TWSCustomFormClass = class of TWSCustomForm;
@@ -254,6 +255,11 @@
   Result := False;
 end;
 
+class function TWSCustomForm.ArrangeIcons(const AForm: TCustomForm): Boolean;
+begin
+  Result := False;
+end;
+
 class function TWSCustomForm.Tile(const AForm: TCustomForm): Boolean;
 begin
   Result := False;
mdidoodle.zip (72,121 bytes)

Ondrej Pokorny

2020-01-21 17:34

developer   ~0120610

Last edited: 2020-01-21 17:34

View 2 revisions

I reviewed the patch - it looks good, thanks a lot.

However there is a problem: you should not merge the menu items on the LCL level (you should not place the merged items into TMainMenu.Items). It should be done on the WidgetSet level - mark the menu as merged with main form's menu and place them into the mainmenu in the WidgetSet part. So that TMainMenu.Items actually don't know about the merged items.

Can you rewrite it so?

Kostas Michalopoulos

2020-01-22 01:20

reporter   ~0120667

Are you sure this should be done at the WidgetSet level? In Delphi the TMainMenu class has Merge and Unmerge methods that handle the merging (you can also call them manually for non-MDI forms, see http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/Menus_TMainMenu_Merge.html). Also it sounds like a framework level feature instead of a low level feature as Windows itself doesn't do any merging (FWIW i did a test in VB with an MDI form and an MDI child and the child's menu completely replaces the MDI form's menu).

Having said that i did a test to see what is the state of TMainMenu after merging in Delphi 2 and it looks like the original (non-merged) menu is what you get when accessing TMainMenu.Items instead of the merged ones (so i guess TMainMenu handles merging at the background). However i still think this should be handled by TMainMenu since it doesn't sound widgetset-specific (any widgetset may need the merging functionality). If anything, this will also allow implementing the AutoMerge property (from Delphi's TMainMenu which from what i see in the online docs, still exists today) at some point later.

Ondrej Pokorny

2020-01-22 15:26

developer   ~0120673

Last edited: 2020-01-22 15:27

View 2 revisions

> so i guess TMainMenu handles merging at the background

Yes. The LCL should do the same. Delphi has the 2 variables to handle merged items:
  TMenuItem = class(TComponent)
    FMerged: TMenuItem;
    FMergedWith: TMenuItem;
it does not merge them the "hard" way you do it.

Delphi creates the merged items on the WidgetSet (WinAPI) level based on the FMerged/FMergedWith information when the menu handle is created.

Kostas Michalopoulos

2020-01-22 16:10

reporter   ~0120674

Last edited: 2020-01-22 17:52

View 3 revisions

LCL's TMainMenu descends from TMenu and seems to rely on it for most of the functionality, unlike Delphi's that descends from TComponent, so it might be a bit tricky but i guess i could create a shadow menu when something is merged. In any case i can change that, but just to be on the same page, you agree that the merging should be done in TMainMenu, right?

Delphi doesn't have the concept of a widgetset and it just uses Win32 calls directly from TMainMenu, so i think the closest equivalent would be for TMainMenu to provide the merging and the logic be available to all widgetsets instead of it being implemented on the widgetset side (which i'm not sure how it'd be done since from what i can see there isn't a TMainMenu proxy on the widgetset side).

EDIT: i looked around the LCL code and it seems i may need to implement this in the TMenu instead of TMainMenu as pretty much everything is handled there.

Ondrej Pokorny

2020-01-22 18:29

developer   ~0120676

No shadow menu is needed. The LCL-side merging should be done in TMenuItem with just filling the FMerged and FMergedWith fields of TMenuItem. TWSMenuItem (WidgetSet side) then handles the actual merging - it should not be very complicated - you just reuse the methods from TWSMenuItem.

> which i'm not sure how it'd be done since from what i can see there isn't a TMainMenu proxy on the widgetset side).
You merge the Items -> you need TWSMenuItem.

Kostas Michalopoulos

2020-01-22 22:52

reporter   ~0120680

Sorry i do not understand, why involve TMenuItem? The merging only happens for top-level menus (those in the TMainMenu) and the items are replaced (that is, if an MDI child has menus with GroupIndex 1 and the main form has menus with GroupIndex 1 too, these are not merged but the main form's menus are replaced with the MDI child's).

Also i still do not understand why this is to be handled in the widgetset. You'd still want the merging logic to work even in other widgetsets, e.g. GTK may not support MDI but it still creates these forms and you'd want the main form to use the merged menu, not have the menu scattered in two forms (and even have access to menu items that may not apply - e.g. two File menus where the one in main was to be replaced with the MDI one).

Ondrej Pokorny

2020-01-23 11:21

developer   ~0120685

> Also i still do not understand why this is to be handled in the widgetset.

Because the original LCL menu(s) should not know about the merged items. The LCL may not change properties/items/etc. of components for internal purposes. You directly change Menu.Items and the Visible property for internal features, this is not correct.

The Merge/Unmerge methods as you wrote and understand them are OK if they are to be used by the end-program and not by the LCL itself.

I'll take a look into it - it should not be that difficult to achieve. The WinAPI functionality is there and you did all the rest.

Kostas Michalopoulos

2020-01-23 20:50

reporter   ~0120690

I agree about the merged items, it is also how Delphi seems to do it (they are not visible if you access them via the properties), i just didn't knew about it when i wrote the code (i thought that you'd be able to access the merged menu afterwards).

What i do not understand is why this should be handled by the widgetset instead of LCL. Menu merging isn't something the underlying API does, it is a framework job (provided by VCL in Delphi, not the Win32 API), so it makes sense to be done by LCL and not be a widgetset-specific feature (remember that the API - in Delphi - can be used even for regular forms, not just MDI, it just happens to be needed by MDI so i had to also implement that). The same merging functionality should be usable by Gtk, Cocoa, Qt, etc.

Issue History

Date Modified Username Field Change
2020-01-14 21:07 Kostas Michalopoulos New Issue
2020-01-14 21:07 Kostas Michalopoulos File Added: win32mdisupport-svn62555.diff
2020-01-14 21:07 Kostas Michalopoulos File Added: mdidoodle.zip
2020-01-14 21:08 Kostas Michalopoulos Tag Attached: delphi compatibility
2020-01-14 21:08 Kostas Michalopoulos Tag Attached: MDI
2020-01-14 21:08 Kostas Michalopoulos Tag Attached: windows
2020-01-14 21:08 Kostas Michalopoulos Tag Attached: win32
2020-01-14 21:08 Kostas Michalopoulos Tag Attached: patch
2020-01-15 06:07 Ondrej Pokorny Assigned To => Ondrej Pokorny
2020-01-15 06:07 Ondrej Pokorny Status new => assigned
2020-01-21 17:34 Ondrej Pokorny Note Added: 0120610
2020-01-21 17:34 Ondrej Pokorny Note Edited: 0120610 View Revisions
2020-01-22 01:20 Kostas Michalopoulos Note Added: 0120667
2020-01-22 15:26 Ondrej Pokorny Note Added: 0120673
2020-01-22 15:27 Ondrej Pokorny Note Edited: 0120673 View Revisions
2020-01-22 16:10 Kostas Michalopoulos Note Added: 0120674
2020-01-22 16:13 Kostas Michalopoulos Note Edited: 0120674 View Revisions
2020-01-22 17:52 Kostas Michalopoulos Note Edited: 0120674 View Revisions
2020-01-22 18:29 Ondrej Pokorny Note Added: 0120676
2020-01-22 22:52 Kostas Michalopoulos Note Added: 0120680
2020-01-23 11:21 Ondrej Pokorny Note Added: 0120685
2020-01-23 20:50 Kostas Michalopoulos Note Added: 0120690