paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 01:29:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

Revert r62685 #e1838e46a0: LCL: implement MDI for win32. Issue #36582, based on patch by Kostas Michalopoulos

Browse Source 
git-svn-id: trunk@62739 -
This commit is contained in:
ondrej 2020-03-11 05:48:36 +00:00
parent cef1d45559
commit 29018d9a1a
14 changed files with 106 additions and 727 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
docs/xml/lcl/menus.xml
View File

@ -2490,15 +2490,6 @@ tbLeftButton - only left button is used to activate a menu item
<short> <short>
<var>Alignment</var> - determines the position of popup menu relative to the popup coordinate</short> <var>Alignment</var> - determines the position of popup menu relative to the popup coordinate</short>
</element> </element>
<element name="TMenuItem.GetMergedParentMenu">
<short><var>GetMergedParentMenu</var> - returns the parent menu to which this menu item belongs with taking the merged menu into account</short>
</element>
<element name="TMenuItem.MergedItems">
<short>Returns the visible and invisible child items with taking the merged menu into account</short>
</element>
<element name="TMenuItem.MergedParent">
<short>Returns the parent menu item and with taking the merged menu into account</short>
</element>
</module> </module>
<!-- Menus --> <!-- Menus -->
</package> </package>

2
lcl/forms.pp
View File

@ -769,8 +769,6 @@ type
procedure Previous; procedure Previous;
{ mdi related routine} { mdi related routine}
procedure Tile; procedure Tile;
{ mdi related routine}
procedure ArrangeIcons;
{ mdi related property} { mdi related property}
property ClientHandle; property ClientHandle;

61
lcl/include/customform.inc
View File

@ -101,11 +101,7 @@ begin
GlobalNameSpace.BeginWrite; GlobalNameSpace.BeginWrite;
Screen.FSaveFocusedList.Remove(Self); Screen.FSaveFocusedList.Remove(Self);
RemoveFixupReferences(Self, ''); RemoveFixupReferences(Self, '');
if FormStyle <> fsMDIChild then if FormStyle <> fsMDIChild then Hide;
Hide
else
if Assigned(Menu) and Assigned(Application.MainForm) and Assigned(Application.MainForm.Menu) then
Application.MainForm.Menu.Unmerge(Menu);
DoDestroy; DoDestroy;
// don't call the inherited method because it calls Destroying which is already called // don't call the inherited method because it calls Destroying which is already called
end; end;
@ -663,24 +659,18 @@ begin
inherited WMSize(Message); inherited WMSize(Message);
if not (csDestroying in ComponentState) then FDelayedWMSize := True;
begin Inc(FDelayedEventCtr);
FDelayedWMSize := True; Application.QueueAsyncCall(@DelayedEvent, 0);
Inc(FDelayedEventCtr);
Application.QueueAsyncCall(@DelayedEvent, 0);
end;
end; end;
procedure TCustomForm.WMMove(var Message: TLMMove); procedure TCustomForm.WMMove(var Message: TLMMove);
begin begin
inherited WMMove(Message); inherited WMMove(Message);
if not (csDestroying in ComponentState) then FDelayedWMMove := True;
begin Inc(FDelayedEventCtr);
FDelayedWMMove := True; Application.QueueAsyncCall(@DelayedEvent, 0);
Inc(FDelayedEventCtr);
Application.QueueAsyncCall(@DelayedEvent, 0);
end;
end; end;
procedure TCustomForm.DelayedEvent(Data: PtrInt); procedure TCustomForm.DelayedEvent(Data: PtrInt);
@ -806,26 +796,12 @@ end;
procedure TCustomForm.CMActivate(var Message: TLMessage); procedure TCustomForm.CMActivate(var Message: TLMessage);
begin 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; Activate;
end; end;
procedure TCustomForm.CMDeactivate(var Message: TLMessage); procedure TCustomForm.CMDeactivate(var Message: TLMessage);
begin begin
Deactivate; 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; end;
procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType; procedure TCustomForm.AddHandler(HandlerType: TFormHandlerType;
@ -1402,7 +1378,7 @@ begin
if FormStyle = fsMDIFORM then if FormStyle = fsMDIFORM then
begin begin
Exit; // ToDo
end end
else else
begin begin
@ -2238,15 +2214,12 @@ function TCustomForm.CloseQuery: boolean;
Result:=true; Result:=true;
end; end;
var
I: Integer;
begin begin
if FormStyle = fsMDIForm then if FormStyle = fsMDIForm then
begin begin
// Query children forms whether we can close // Query children forms whether we can close
if not Check(Self) then exit(False); if not Check(Self) then exit(False);
for I := 0 to MDIChildCount - 1 do // TODO: mdi logic
if not MDIChildren[I].CloseQuery then Exit(False);
end; end;
Result := True; Result := True;
if Assigned(FOnCloseQuery) then if Assigned(FOnCloseQuery) then
@ -3240,22 +3213,6 @@ begin
TWSCustomFormClass(WidgetSetClass).Tile(Self); TWSCustomFormClass(WidgetSetClass).Tile(Self);
end; 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 } { TFormPropertyStorage }

14
lcl/include/mainmenu.inc
View File

@ -50,20 +50,6 @@ begin
inherited MenuChanged(Sender, Source, Rebuild); inherited MenuChanged(Sender, Source, Rebuild);
end; end;
procedure TMainMenu.Merge(Menu: TMainMenu);
begin
if Assigned(Menu) then
Items.MergeWith(Menu.Items)
else
Items.MergeWith(nil);
end;
procedure TMainMenu.Unmerge(Menu: TMainMenu);
begin
if Assigned(Menu) and (Items.Merged = Menu.Items) then
Items.MergeWith(nil);
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Method: TMainMenu.Create Method: TMainMenu.Create
Params: AOwner: the owner of the class Params: AOwner: the owner of the class

156
lcl/include/menuitem.inc
View File

@ -136,11 +136,11 @@ begin
FHandle := TWSMenuItemClass(WidgetSetClass).CreateHandle(Self); FHandle := TWSMenuItemClass(WidgetSetClass).CreateHandle(Self);
CheckChildrenHandles; CheckChildrenHandles;
if MergedParent <> nil then if Parent <> nil then
begin begin
MergedParent.HandleNeeded; Parent.HandleNeeded;
//DebugLn('TMenuItem.CreateHandle Attaching ... ',Name,':',ClassName); //DebugLn('TMenuItem.CreateHandle Attaching ... ',Name,':',ClassName);
if MergedParent.HandleAllocated then if Parent.HandleAllocated then
TWSMenuItemClass(WidgetSetClass).AttachMenu(Self); TWSMenuItemClass(WidgetSetClass).AttachMenu(Self);
if HandleAllocated then if HandleAllocated then
@ -172,7 +172,6 @@ begin
FItems.Delete(Index); FItems.Delete(Index);
Cur.FParent := nil; Cur.FParent := nil;
Cur.FOnChange := nil; Cur.FOnChange := nil;
InvalidateMergedItems;
MenuChanged(Count = 0); MenuChanged(Count = 0);
end; end;
@ -202,8 +201,6 @@ begin
Dec(i); Dec(i);
end; end;
end; end;
if Assigned(FMerged) then
MergeWith(nil);
FreeAndNil(FItems); FreeAndNil(FItems);
FreeAndNil(FActionLink); FreeAndNil(FActionLink);
FreeAndNil(FImageChangeLink); FreeAndNil(FImageChangeLink);
@ -213,7 +210,6 @@ begin
FParent.FItems.Remove(Self); FParent.FItems.Remove(Self);
if FCommand <> 0 then TWSMenuItemClass(WidgetSetClass).CloseCommand(FCommand); if FCommand <> 0 then TWSMenuItemClass(WidgetSetClass).CloseCommand(FCommand);
//debugln('TMenuItem.Destroy B ',dbgsName(Self)); //debugln('TMenuItem.Destroy B ',dbgsName(Self));
FreeAndNil(FMergedItems);
inherited Destroy; inherited Destroy;
end; end;
@ -347,41 +343,28 @@ procedure TMenuItem.CheckChildrenHandles;
function GetMenu(Item: TMenuItem): TMenu; function GetMenu(Item: TMenuItem): TMenu;
begin begin
Result := nil;
repeat repeat
if Assigned(Item.FMergedWith) then Result := Item.Menu;
begin Item := Item.Parent;
if Assigned(Item.FMergedWith.Menu) then until (Result <> nil) or (Item = nil);
Result := Item.FMergedWith.Menu;
Item := Item.FMergedWith;
end else
begin
if Assigned(Item.Menu) then
Result := Item.Menu;
Item := Item.Parent;
end;
until (Item = nil);
end; end;
var var
i: Integer; i: Integer;
AMenu: TMenu; AMenu: TMenu;
AMergedItems: TMergedMenuItems;
begin begin
if FItems = nil then if FItems <> nil then
Exit;
AMenu := GetMenu(Self);
AMergedItems := MergedItems;
for i := 0 to AMergedItems.InvisibleCount-1 do
if AMergedItems.InvisibleItems[i].HandleAllocated then
AMergedItems.InvisibleItems[i].DestroyHandle;
for i := 0 to AMergedItems.VisibleCount-1 do
begin begin
if AMergedItems.VisibleItems[i].HandleAllocated and (GetMenu(AMergedItems.VisibleItems[i]) <> AMenu) then AMenu := GetMenu(Self);
AMergedItems.VisibleItems[i].DestroyHandle; for i := 0 to Count - 1 do
AMergedItems.VisibleItems[i].HandleNeeded; begin
if Items[i].Visible then
begin
if Items[i].HandleAllocated and (GetMenu(Items[i]) <> AMenu) then
Items[i].DestroyHandle;
Items[i].HandleNeeded;
end;
end;
end; end;
end; end;
@ -390,11 +373,6 @@ begin
Application.Hint := GetLongHint(Hint); Application.Hint := GetLongHint(Hint);
end; end;
procedure TMenuItem.InvalidateMergedItems;
begin
FreeAndNil(FMergedItems);
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: TMenuItem.GetChildren Function: TMenuItem.GetChildren
Params: Proc - proc to be called for each child Params: Proc - proc to be called for each child
@ -556,30 +534,6 @@ begin
if FParent <> nil then Result := FParent.IndexOf(Self); if FParent <> nil then Result := FParent.IndexOf(Self);
end; end;
function TMenuItem.GetMergedItems: TMergedMenuItems;
begin
if not Assigned(FMergedItems) then
FMergedItems := TMergedMenuItems.Create(Self);
Result := FMergedItems;
end;
function TMenuItem.GetMergedParent: TMenuItem;
begin
Result := Parent;
if Assigned(Result) and Assigned(Result.MergedWith) then
Result := Result.MergedWith;
end;
function TMenuItem.GetMergedParentMenu: TMenu;
var
Item: TMenuItem;
begin
Item := Self;
while Item.MergedParent <> nil do
Item := Item.MergedParent;
Result := Item.FMenu;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
Function: TMenuItem.GetParent Function: TMenuItem.GetParent
Params: none Params: none
@ -807,12 +761,13 @@ begin
//DebugLn('TMenuItem.DestroyHandle ',dbgsName(Self),' ',dbgs(Self)); //DebugLn('TMenuItem.DestroyHandle ',dbgsName(Self),' ',dbgs(Self));
if Assigned(FItems) then if Assigned(FItems) then
begin begin
for i := FItems.Count - 1 downto 0 do i := FItems.Count - 1;
while i >= 0 do
begin
TMenuItem(FItems[i]).DestroyHandle; TMenuItem(FItems[i]).DestroyHandle;
dec(i);
end;
end; end;
if Assigned(FMerged) then
for i := FMerged.Count - 1 downto 0 do
FMerged[i].DestroyHandle;
TWSMenuItemClass(WidgetSetClass).DestroyHandle(Self); TWSMenuItemClass(WidgetSetClass).DestroyHandle(Self);
FHandle := 0; FHandle := 0;
end; end;
@ -899,7 +854,6 @@ begin
Item.FOnChange := @SubItemChanged; Item.FOnChange := @SubItemChanged;
FItems.Insert(Index, Item); FItems.Insert(Index, Item);
InvalidateMergedItems;
if HandleAllocated and Item.Visible then if HandleAllocated and Item.Visible then
Item.HandleNeeded; Item.HandleNeeded;
MenuChanged(FItems.Count = 1); MenuChanged(FItems.Count = 1);
@ -938,19 +892,36 @@ end;
Returns the index of the menuitem of all visible menuitems Returns the index of the menuitem of all visible menuitems
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TMenuItem.VisibleIndexOf(Item: TMenuItem): Integer; function TMenuItem.VisibleIndexOf(Item: TMenuItem): Integer;
procedure RaiseVisibleInconsistency;
begin
raise Exception.Create('TMenuItem.VisibleIndexOf '+dbgsName(Item)+' is visible, but not in parents list');
end;
var var
i: Integer; i: Integer;
CurMenuItem: TMenuItem; CurMenuItem: TMenuItem;
IsMerged: Boolean;
AMergedItems: TMergedMenuItems;
begin begin
if not Item.Visible then if (FItems = nil) or (Item=nil) or (not Item.Visible) then
Exit(-1); Result := -1
AMergedItems := GetMergedItems; else
for I := 0 to AMergedItems.VisibleCount-1 do begin
if AMergedItems.VisibleItems[I]=Item then Result := 0;
Exit(I); i := 0;
Result := -1; while (i<FItems.Count) do
begin
CurMenuItem := TMenuItem(FItems[i]);
if CurMenuItem.Visible then
begin
if CurMenuItem=Item then Exit;
Inc(Result);
end;
Inc(i);
end;
Result := -1;
if Item.Visible then
RaiseVisibleInconsistency;
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -999,11 +970,8 @@ end;
function TMenuItem.IsInMenuBar: boolean; function TMenuItem.IsInMenuBar: boolean;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TMenuItem.IsInMenuBar: boolean; function TMenuItem.IsInMenuBar: boolean;
var
AMergedParent: TMenuItem;
begin begin
AMergedParent := MergedParent; Result := (FParent <> nil) and (FParent.FMenu <> nil) and (FParent.FMenu is TMainMenu);
Result := (AMergedParent <> nil) and (AMergedParent.FMenu <> nil) and (AMergedParent.FMenu is TMainMenu);
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -1097,30 +1065,6 @@ begin
Result:=Parent.VisibleIndexOf(Self); Result:=Parent.VisibleIndexOf(Self);
end; end;
procedure TMenuItem.MergeWith(const aMenu: TMenuItem);
var
i: Integer;
begin
if (Assigned(aMenu) and (csDestroying in aMenu.ComponentState))
or (FMerged=aMenu) then
Exit;
if Assigned(FMerged) then
begin
for i := 0 to FMerged.Count-1 do
FMerged[i].DestroyHandle;
FMerged.FMergedWith := nil;
end;
FMerged := aMenu;
if Assigned(FMerged) then
begin
FMerged.FMergedWith := Self;
FMerged.FreeNotification(Self);
end;
InvalidateMergedItems;
CheckChildrenHandles;
end;
procedure TMenuItem.WriteDebugReport(const Prefix: string); procedure TMenuItem.WriteDebugReport(const Prefix: string);
var var
Flags: String; Flags: String;
@ -1512,8 +1456,6 @@ begin
end; end;
FVisible := AValue; FVisible := AValue;
end; end;
if MergedParent<>nil then
MergedParent.InvalidateMergedItems;
end; end;
procedure TMenuItem.UpdateImage(forced: Boolean); procedure TMenuItem.UpdateImage(forced: Boolean);

59
lcl/interfaces/win32/win32callback.inc
View File

@ -72,43 +72,16 @@ var
depthLen: integer; depthLen: integer;
{$endif} {$endif}
setComboWindow: boolean; setComboWindow: boolean;
WindowInfo: PWin32WindowInfo;
begin begin
{$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)} {$if defined(MSG_DEBUG) or defined(DBG_SendPaintMessage)}
depthLen := Length(MessageStackDepth); depthLen := Length(MessageStackDepth);
if depthLen > 0 then if depthLen > 0 then
MessageStackDepth[depthLen] := '#'; MessageStackDepth[depthLen] := '#';
{$endif} {$endif}
WindowInfo := GetWin32WindowInfo(Window); PrevWndProc := GetWin32WindowInfo(Window)^.DefWndProc;
PrevWndProc := WindowInfo^.DefWndProc;
if (PrevWndProc = nil) or (PrevWndProc = @WindowProc) // <- prevent recursion if (PrevWndProc = nil) or (PrevWndProc = @WindowProc) // <- prevent recursion
then begin then begin
if WindowInfo^.WinControl is TCustomForm then Result := Windows.DefWindowProcW(Window, Msg, WParam, LParam)
begin
case TCustomForm(WindowInfo^.WinControl).FormStyle of
fsMDIForm:
begin
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);
end;
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 end
else begin else begin
// combobox child edit weirdness: combobox handling WM_SIZE will compare text // combobox child edit weirdness: combobox handling WM_SIZE will compare text
@ -1969,7 +1942,6 @@ var
R: TRect; R: TRect;
ACtl: TWinControl; ACtl: TWinControl;
LMouseEvent: TTRACKMOUSEEVENT; LMouseEvent: TTRACKMOUSEEVENT;
MaximizedActiveChild: WINBOOL;
{$IF NOT DECLARED(WM_DPICHANGED)} // WM_DPICHANGED was added in FPC 3.1.1 {$IF NOT DECLARED(WM_DPICHANGED)} // WM_DPICHANGED was added in FPC 3.1.1
const const
WM_DPICHANGED = $02E0; WM_DPICHANGED = $02E0;
@ -2056,16 +2028,6 @@ begin
if HIWORD(lParam) = 0 then //if not system menu if HIWORD(lParam) = 0 then //if not system menu
begin begin
TargetObject := GetPopMenuItemObject; 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 if TargetObject is TMenuItem then
begin begin
LMessage.Msg := LM_ACTIVATE; LMessage.Msg := LM_ACTIVATE;
@ -2078,16 +2040,6 @@ begin
WM_MENUSELECT: WM_MENUSELECT:
begin begin
TargetObject := GetMenuItemObject((HIWORD(Integer(WParam)) and MF_POPUP) <> 0); 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 if TargetObject is TMenuItem then
TMenuItem(TargetObject).IntfDoSelect TMenuItem(TargetObject).IntfDoSelect
else else
@ -2467,13 +2419,6 @@ begin
SetLMessageAndParams(Msg, True); SetLMessageAndParams(Msg, True);
end; // case Msg of 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 if WinProcess then
begin begin
PLMsg^.Result := CallDefaultWindowProc(Window, Msg, WParam, LParam); PLMsg^.Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);

7
lcl/interfaces/win32/win32int.pp
View File

@ -129,7 +129,6 @@ type
FMetrics: TNonClientMetrics; FMetrics: TNonClientMetrics;
FMetricsFailed: Boolean; FMetricsFailed: Boolean;
FDefaultFont: HFONT; FDefaultFont: HFONT;
FMDIClientHandle: HWND;
FWaitHandleCount: dword; FWaitHandleCount: dword;
FWaitHandles: array of HANDLE; FWaitHandles: array of HANDLE;
@ -151,7 +150,6 @@ type
function WinRegister: Boolean; function WinRegister: Boolean;
procedure CreateAppHandle; procedure CreateAppHandle;
function GetMDIClientHandle: HWND;
protected protected
function CreateThemeServices: TThemeServices; override; function CreateThemeServices: TThemeServices; override;
function GetAppHandle: THandle; override; function GetAppHandle: THandle; override;
@ -203,11 +201,6 @@ type
procedure HandleWakeMainThread(Sender: TObject); procedure HandleWakeMainThread(Sender: TObject);
property DefaultFont: HFONT read FDefaultFont; property DefaultFont: HFONT read FDefaultFont;
// MDI client handle (if any)
property MDIClientHandle: HWND read GetMDIClientHandle;
procedure UpdateMDIClientBounds;
{$I win32winapih.inc} {$I win32winapih.inc}
{$I win32lclintfh.inc} {$I win32lclintfh.inc}

58
lcl/interfaces/win32/win32object.inc
View File

@ -403,17 +403,8 @@ begin
PostQuitMessage(AMessage.wParam); PostQuitMessage(AMessage.wParam);
break; break;
end; end;
// Handle MDI form accelerators TranslateMessage(@AMessage);
if Assigned(Application) and DispatchMessageW(@AMessage);
Assigned(Application.MainForm) and
(Application.MainForm.FormStyle=fsMDIForm) and
TranslateMDISysAccel(Win32WidgetSet.MDIClientHandle, @AMessage)
then begin
// handled by TranslateMDISysAccel
end else begin
TranslateMessage(@AMessage);
DispatchMessageW(@AMessage);
end;
end; end;
end else end else
if retVal = WAIT_TIMEOUT then if retVal = WAIT_TIMEOUT then
@ -644,31 +635,6 @@ begin
Windows.PostMessage(FAppHandle, WM_NULL, 0, 0); Windows.PostMessage(FAppHandle, WM_NULL, 0, 0);
end; 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) } { Private methods (in no significant order) }
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -731,26 +697,6 @@ begin
Windows.DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND); Windows.DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
end; 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; function TWin32WidgetSet.CreateThemeServices: TThemeServices;
begin begin
Result := TWin32ThemeServices.Create; Result := TWin32ThemeServices.Create;

19
lcl/interfaces/win32/win32winapi.inc
View File

@ -2457,15 +2457,9 @@ begin
Result := Boolean(Windows.GetWindowRect(Handle, @R)); Result := Boolean(Windows.GetWindowRect(Handle, @R));
SetWidthHeightFromRect(R); SetWidthHeightFromRect(R);
end; end;
end else end
begin else
// rcNormalPosition is not valid for MDI children se we use GetWindowRect instead SetWidthHeightFromRect(WP.rcNormalPosition);
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); WindowInfo := GetWin32WindowInfo(Handle);
@ -3291,12 +3285,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
function TWin32WidgetSet.SetForegroundWindow(HWnd: HWND): boolean; function TWin32WidgetSet.SetForegroundWindow(HWnd: HWND): boolean;
begin begin
// MDI children need to use WM_MDIACTIVATE to bring themselves into the foreground Result := Windows.SetForegroundWindow(HWnd);
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; end;
function TWin32WidgetSet.SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean; function TWin32WidgetSet.SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean;

17
lcl/interfaces/win32/win32wscontrols.pp
View File

@ -468,10 +468,6 @@ begin
Windows.SetWindowPos(Handle, 0, IntfLeft, IntfTop, IntfWidth, IntfHeight, SWP_NOZORDER or SWP_NOACTIVATE); Windows.SetWindowPos(Handle, 0, IntfLeft, IntfTop, IntfWidth, IntfHeight, SWP_NOZORDER or SWP_NOACTIVATE);
end; end;
LCLControlSizeNeedsUpdate(AWinControl, True); 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; end;
class procedure TWin32WSWinControl.SetColor(const AWinControl: TWinControl); class procedure TWin32WSWinControl.SetColor(const AWinControl: TWinControl);
@ -549,12 +545,7 @@ begin
{$ifdef RedirectDestroyMessages} {$ifdef RedirectDestroyMessages}
SetWindowLong(Handle, GWL_WNDPROC, PtrInt(@DestroyWindowProc)); SetWindowLong(Handle, GWL_WNDPROC, PtrInt(@DestroyWindowProc));
{$endif} {$endif}
// Instead of calling DestroyWindow directly, we need to call WM_MDIDESTROY for MDI children DestroyWindow(Handle);
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; end;
class procedure TWin32WSWinControl.Invalidate(const AWinControl: TWinControl); class procedure TWin32WSWinControl.Invalidate(const AWinControl: TWinControl);
@ -580,11 +571,7 @@ const
VisibilityToFlag: array[Boolean] of UINT = (SWP_HIDEWINDOW, SWP_SHOWWINDOW); VisibilityToFlag: array[Boolean] of UINT = (SWP_HIDEWINDOW, SWP_SHOWWINDOW);
begin begin
Windows.SetWindowPos(AWinControl.Handle, 0, 0, 0, 0, 0, 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; end;
class procedure TWin32WSWinControl.ScrollBy(const AWinControl: TWinControl; class procedure TWin32WSWinControl.ScrollBy(const AWinControl: TWinControl;

167
lcl/interfaces/win32/win32wsforms.pp
View File

@ -83,16 +83,6 @@ type
const APopupParent: TCustomForm); override; const APopupParent: TCustomForm); override;
class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override; class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
class procedure ShowHide(const AWinControl: TWinControl); 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; end;
{ TWin32WSForm } { TWin32WSForm }
@ -404,7 +394,6 @@ var
lForm: TCustomForm absolute AWinControl; lForm: TCustomForm absolute AWinControl;
Bounds: TRect; Bounds: TRect;
SystemMenu: HMenu; SystemMenu: HMenu;
MaximizeForm: Boolean = False;
begin begin
// general initialization of Params // general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params); PrepareCreateWindow(AWinControl, AParams, Params);
@ -436,22 +425,6 @@ begin
end; end;
end; 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); CalcFormWindowFlags(lForm, Flags, FlagsEx);
pClassName := @ClsName[0]; pClassName := @ClsName[0];
WindowTitle := StrCaption; WindowTitle := StrCaption;
@ -488,22 +461,6 @@ begin
// create window // create window
FinishCreateWindow(AWinControl, Params, False); 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; Result := Params.Window;
// remove system menu items for bsDialog // remove system menu items for bsDialog
@ -776,130 +733,6 @@ begin
Windows.ShowWindow(AWinControl.Handle, SW_HIDE); Windows.ShowWindow(AWinControl.Handle, SW_HIDE);
end; 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); class procedure TWin32WSCustomForm.ShowModal(const ACustomForm: TCustomForm);
var var
Parent: HWND; Parent: HWND;

118
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -184,7 +184,6 @@ var
FirstMenuItem: TMenuItem; FirstMenuItem: TMenuItem;
SiblingMenuItem: TMenuItem; SiblingMenuItem: TMenuItem;
i: integer; i: integer;
AMergedItems: TMergedMenuItems;
begin begin
Result := MakeLResult(0, MNC_IGNORE); Result := MakeLResult(0, MNC_IGNORE);
MenuItemIndex := -1; MenuItemIndex := -1;
@ -194,15 +193,13 @@ begin
FirstMenuItem := TMenuItem(ItemInfo.dwItemData); FirstMenuItem := TMenuItem(ItemInfo.dwItemData);
if FirstMenuItem = nil then exit; if FirstMenuItem = nil then exit;
AMergedItems := FirstMenuItem.MergedParent.MergedItems; i := 0;
for i := 0 to AMergedItems.VisibleCount-1 do while (i < FirstMenuItem.Parent.Count) and (MenuItemIndex < 0) do
begin begin
SiblingMenuItem := AMergedItems.VisibleItems[i]; SiblingMenuItem := FirstMenuItem.Parent.Items[i];
if IsAccel(ACharCode, SiblingMenuItem.Caption) then if IsAccel(ACharCode, SiblingMenuItem.Caption) then
begin MenuItemIndex := SiblingMenuItem.MenuVisibleIndex;
MenuItemIndex := i; inc(i);
break;
end;
end; end;
if MenuItemIndex > -1 then if MenuItemIndex > -1 then
Result := MakeLResult(MenuItemIndex, MNC_EXECUTE); Result := MakeLResult(MenuItemIndex, MNC_EXECUTE);
@ -600,24 +597,26 @@ const
function IsLast: Boolean; function IsLast: Boolean;
var var
AMergedItems: TMergedMenuItems; Index, i: Integer;
begin begin
AMergedItems := AMenuItem.MergedParent.MergedItems; Index := AMenuItem.Parent.IndexOf(AMenuItem);
Result := (AMergedItems.VisibleCount>0) and (AMergedItems.VisibleItems[AMergedItems.VisibleCount-1]=AMenuItem); for i := Index + 1 to AMenuItem.Parent.Count - 1 do
if AMenuItem.Parent.Items[i].Visible then
Exit(False);
Result := True;
end; end;
var var
MenuState: TThemedMenu; MenuState: TThemedMenu;
Metrics: TVistaBarMenuMetrics; Metrics: TVistaBarMenuMetrics;
Details, Tmp: TThemedElementDetails; Details, Tmp: TThemedElementDetails;
BGRect, BGClip, WndRect, TextRect, ImageRect, ItemRect: TRect; BGRect, BGClip, WndRect, TextRect, ImageRect: TRect;
IconSize: TPoint; IconSize: TPoint;
TextFlags: DWord; TextFlags: DWord;
AFont, OldFont: HFONT; AFont, OldFont: HFONT;
IsRightToLeft: Boolean; IsRightToLeft: Boolean;
Info: tagMENUBARINFO; Info: tagMENUBARINFO;
AWnd, ActiveChild: HWND; AWnd: HWND;
CalculatedSize: TSIZE; CalculatedSize: TSIZE;
MaximizedActiveChild: WINBOOL;
begin begin
if (ItemState and ODS_SELECTED) <> 0 then if (ItemState and ODS_SELECTED) <> 0 then
MenuState := tmBarItemPushed MenuState := tmBarItemPushed
@ -635,8 +634,8 @@ begin
// draw backgound // draw backgound
// This is a hackish way to draw. Seems windows itself draws this in WM_PAINT or another paint handler? // This is a hackish way to draw. Seems windows itself draws this in WM_PAINT or another paint handler?
AWnd := TCustomForm(AMenuItem.GetMergedParentMenu.Parent).Handle; AWnd := TCustomForm(AMenuItem.GetParentMenu.Parent).Handle;
if (AMenuItem.MergedParent.VisibleIndexOf(AMenuItem) = 0) then if (AMenuItem.Parent.VisibleIndexOf(AMenuItem) = 0) then
begin begin
/// if we are painting the first item then request full repaint to draw the bg correctly /// if we are painting the first item then request full repaint to draw the bg correctly
if (GetProp(AWnd, 'LCL_MENUREDRAW') = 0) then if (GetProp(AWnd, 'LCL_MENUREDRAW') = 0) then
@ -655,28 +654,6 @@ begin
OffsetRect(Info.rcBar, -WndRect.Left, -WndRect.Top); OffsetRect(Info.rcBar, -WndRect.Left, -WndRect.Top);
Tmp := ThemeServices.GetElementDetails(BarState[(ItemState and ODS_INACTIVE) = 0]); Tmp := ThemeServices.GetElementDetails(BarState[(ItemState and ODS_INACTIVE) = 0]);
ThemeDrawElement(AHDC, Tmp, Info.rcBar, nil); 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.GetMergedParentMenu.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; end;
BGRect := ARect; BGRect := ARect;
@ -1327,7 +1304,7 @@ procedure TriggerFormUpdate(const AMenuItem: TMenuItem);
var var
lMenu: TMenu; lMenu: TMenu;
begin begin
lMenu := AMenuItem.GetMergedParentMenu; lMenu := AMenuItem.GetParentMenu;
if (lMenu<>nil) and (lMenu.Parent<>nil) if (lMenu<>nil) and (lMenu.Parent<>nil)
and (lMenu.Parent is TCustomForm) and (lMenu.Parent is TCustomForm)
and TCustomForm(lMenu.Parent).HandleAllocated and TCustomForm(lMenu.Parent).HandleAllocated
@ -1342,12 +1319,12 @@ begin
FillChar(MenuInfo, SizeOf(MenuInfo), 0); FillChar(MenuInfo, SizeOf(MenuInfo), 0);
MenuInfo.cbSize := sizeof(TMenuItemInfo); MenuInfo.cbSize := sizeof(TMenuItemInfo);
MenuInfo.fMask := MIIM_FTYPE; // don't retrieve caption (MIIM_STRING not included) MenuInfo.fMask := MIIM_FTYPE; // don't retrieve caption (MIIM_STRING not included)
GetMenuItemInfoW(AMenuItem.MergedParent.Handle, AMenuItem.Command, False, @MenuInfo); GetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
if Value then if Value then
MenuInfo.fType := MenuInfo.fType or Flag MenuInfo.fType := MenuInfo.fType or Flag
else else
MenuInfo.fType := MenuInfo.fType and (not Flag); MenuInfo.fType := MenuInfo.fType and (not Flag);
Result := SetMenuItemInfoW(AMenuItem.MergedParent.Handle, AMenuItem.Command, False, @MenuInfo); Result := SetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
TriggerFormUpdate(AMenuItem); TriggerFormUpdate(AMenuItem);
end; end;
@ -1380,7 +1357,7 @@ var
MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
WideBuffer: widestring; WideBuffer: widestring;
begin begin
if (AMenuItem.MergedParent = nil) or not AMenuItem.MergedParent.HandleAllocated then if (AMenuItem.Parent = nil) or not AMenuItem.Parent.HandleAllocated then
Exit; Exit;
FillChar(MenuInfo, SizeOf(MenuInfo), 0); FillChar(MenuInfo, SizeOf(MenuInfo), 0);
@ -1389,7 +1366,7 @@ begin
cbSize := sizeof(TMenuItemInfo); cbSize := sizeof(TMenuItemInfo);
fMask := MIIM_FTYPE or MIIM_STATE; // don't retrieve current caption fMask := MIIM_FTYPE or MIIM_STATE; // don't retrieve current caption
end; end;
GetMenuItemInfoW(AMenuItem.MergedParent.Handle, AMenuItem.Command, False, @MenuInfo); GetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
with MenuInfo do with MenuInfo do
begin begin
// change enabled too since we can change from '-' to normal caption and vice versa // change enabled too since we can change from '-' to normal caption and vice versa
@ -1414,7 +1391,7 @@ begin
fState := MFS_DISABLED; fState := MFS_DISABLED;
end; end;
end; end;
SetMenuItemInfoW(AMenuItem.MergedParent.Handle, AMenuItem.Command, False, @MenuInfo); SetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
// MIIM_BITMAP is needed to request new measure item call // MIIM_BITMAP is needed to request new measure item call
with MenuInfo do with MenuInfo do
@ -1422,7 +1399,7 @@ begin
fMask := MIIM_BITMAP; fMask := MIIM_BITMAP;
dwTypeData := nil; dwTypeData := nil;
end; end;
SetMenuItemInfoW(AMenuItem.MergedParent.Handle, AMenuItem.Command, False, @MenuInfo); SetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
// set owner drawn // set owner drawn
with MenuInfo do with MenuInfo do
@ -1430,7 +1407,7 @@ begin
fMask := MIIM_FTYPE; // don't set caption fMask := MIIM_FTYPE; // don't set caption
fType := (fType or MFT_OWNERDRAW) and not (MIIM_STRING or MFT_SEPARATOR); fType := (fType or MFT_OWNERDRAW) and not (MIIM_STRING or MFT_SEPARATOR);
end; end;
SetMenuItemInfoW(AMenuItem.MergedParent.Handle, AMenuItem.Command, False, @MenuInfo); SetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
TriggerFormUpdate(AMenuItem); TriggerFormUpdate(AMenuItem);
end; end;
@ -1441,21 +1418,18 @@ var
ParentOfParent: HMenu; ParentOfParent: HMenu;
CallMenuRes: Boolean; CallMenuRes: Boolean;
WideBuffer: widestring; WideBuffer: widestring;
ItemIndex: Integer;
begin begin
if AMenuItem.MergedParent=nil then ParentMenuHandle := AMenuItem.Parent.Handle;
Exit;
ParentMenuHandle := AMenuItem.MergedParent.Handle;
FillChar(MenuInfo, SizeOf(MenuInfo), 0); FillChar(MenuInfo, SizeOf(MenuInfo), 0);
MenuInfo.cbSize := sizeof(TMenuItemInfo); MenuInfo.cbSize := sizeof(TMenuItemInfo);
// Following part fixes the case when an item is added in runtime // Following part fixes the case when an item is added in runtime
// but the parent item has not defined the submenu flag (hSubmenu=0) // but the parent item has not defined the submenu flag (hSubmenu=0)
if AMenuItem.MergedParent.MergedParent <> nil then if AMenuItem.Parent.Parent <> nil then
begin begin
ParentOfParent := AMenuItem.MergedParent.MergedParent.Handle; ParentOfParent := AMenuItem.Parent.Parent.Handle;
MenuInfo.fMask := MIIM_SUBMENU; MenuInfo.fMask := MIIM_SUBMENU;
CallMenuRes := GetMenuItemInfoW(ParentOfParent, AMenuItem.MergedParent.Command, False, @MenuInfo); CallMenuRes := GetMenuItemInfoW(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo);
if CallMenuRes then if CallMenuRes then
begin begin
// the parent menu item is not defined with submenu flag // the parent menu item is not defined with submenu flag
@ -1463,29 +1437,13 @@ begin
if MenuInfo.hSubmenu = 0 then if MenuInfo.hSubmenu = 0 then
begin begin
MenuInfo.hSubmenu := ParentMenuHandle; MenuInfo.hSubmenu := ParentMenuHandle;
CallMenuRes := SetMenuItemInfoW(ParentOfParent, AMenuItem.MergedParent.Command, False, @MenuInfo); CallMenuRes := SetMenuItemInfoW(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo);
if not CallMenuRes then if not CallMenuRes then
DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]); DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]);
end; end;
end; end;
end; end;
ItemIndex := AMenuItem.MergedParent.VisibleIndexOf(AMenuItem);
if ItemIndex<0 then
begin
DebugLn(['Invisible menu item: ', AMenuItem.Name, ' (', AMenuItem.Caption, ')']);
Exit;
end;
// 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.MergedParent.Menu) and
(Application.MainForm.FormStyle=fsMDIForm) and
Assigned(Application.MainForm.ActiveMDIChild) and
(Application.MainForm.ActiveMDIChild.WindowState=wsMaximized)
then
Inc(ItemIndex);
with MenuInfo do with MenuInfo do
begin begin
if AMenuItem.Enabled then if AMenuItem.Enabled then
@ -1528,7 +1486,7 @@ begin
if AMenuItem.Default then if AMenuItem.Default then
fState := fState or MFS_DEFAULT; fState := fState or MFS_DEFAULT;
end; end;
CallMenuRes := InsertMenuItemW(ParentMenuHandle, ItemIndex, True, @MenuInfo); CallMenuRes := InsertMenuItemW(ParentMenuHandle, AMenuItem.Parent.VisibleIndexOf(AMenuItem), True, @MenuInfo);
if not CallMenuRes then if not CallMenuRes then
DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]); DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]);
TriggerFormUpdate(AMenuItem); TriggerFormUpdate(AMenuItem);
@ -1545,27 +1503,27 @@ var
MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type
CallMenuRes: Boolean; CallMenuRes: Boolean;
begin begin
if Assigned(AMenuItem.MergedParent) then if Assigned(AMenuItem.Parent) then
begin begin
ParentHandle := AMenuItem.MergedParent.Handle; ParentHandle := AMenuItem.Parent.Handle;
RemoveMenu(ParentHandle, AMenuItem.Command, MF_BYCOMMAND); RemoveMenu(ParentHandle, AMenuItem.Command, MF_BYCOMMAND);
// convert submenu to a simple menu item if needed // convert submenu to a simple menu item if needed
if (GetMenuItemCount(ParentHandle) = 0) and Assigned(AMenuItem.MergedParent.MergedParent) and if (GetMenuItemCount(ParentHandle) = 0) and Assigned(AMenuItem.Parent.Parent) and
AMenuItem.MergedParent.MergedParent.HandleAllocated then AMenuItem.Parent.Parent.HandleAllocated then
begin begin
ParentOfParentHandle := AMenuItem.MergedParent.MergedParent.Handle; ParentOfParentHandle := AMenuItem.Parent.Parent.Handle;
FillChar(MenuInfo, SizeOf(MenuInfo), 0); FillChar(MenuInfo, SizeOf(MenuInfo), 0);
with MenuInfo do with MenuInfo do
begin begin
cbSize := sizeof(TMenuItemInfo); cbSize := sizeof(TMenuItemInfo);
fMask := MIIM_SUBMENU; fMask := MIIM_SUBMENU;
end; end;
GetMenuItemInfoW(ParentOfParentHandle, AMenuItem.MergedParent.Command, False, @MenuInfo); GetMenuItemInfoW(ParentOfParentHandle, AMenuItem.Parent.Command, False, @MenuInfo);
// the parent menu item is defined with submenu flag then reset it // the parent menu item is defined with submenu flag then reset it
if MenuInfo.hSubmenu <> 0 then if MenuInfo.hSubmenu <> 0 then
begin begin
MenuInfo.hSubmenu := 0; MenuInfo.hSubmenu := 0;
CallMenuRes := SetMenuItemInfoW(ParentOfParentHandle, AMenuItem.MergedParent.Command, False, @MenuInfo); CallMenuRes := SetMenuItemInfoW(ParentOfParentHandle, AMenuItem.Parent.Command, False, @MenuInfo);
if not CallMenuRes then if not CallMenuRes then
DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]); DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]);
// Set menu item info destroys/corrupts our internal popup menu for the // Set menu item info destroys/corrupts our internal popup menu for the
@ -1573,7 +1531,7 @@ begin
if not IsMenu(ParentHandle) then if not IsMenu(ParentHandle) then
begin begin
ParentHandle := CreatePopupMenu; ParentHandle := CreatePopupMenu;
AMenuItem.MergedParent.Handle := ParentHandle; AMenuItem.Parent.Handle := ParentHandle;
end; end;
end; end;
end; end;
@ -1603,7 +1561,7 @@ var
EnableFlag: DWord; EnableFlag: DWord;
begin begin
EnableFlag := MF_BYCOMMAND or EnabledToStateFlag[Enabled]; EnableFlag := MF_BYCOMMAND or EnabledToStateFlag[Enabled];
Result := Boolean(Windows.EnableMenuItem(AMenuItem.MergedParent.Handle, AMenuItem.Command, EnableFlag)); Result := Boolean(Windows.EnableMenuItem(AMenuItem.Parent.Handle, AMenuItem.Command, EnableFlag));
TriggerFormUpdate(AMenuItem); TriggerFormUpdate(AMenuItem);
end; end;

140
lcl/menus.pp
View File

@ -117,24 +117,6 @@ type
TMenuMeasureItemEvent = procedure(Sender: TObject; ACanvas: TCanvas; TMenuMeasureItemEvent = procedure(Sender: TObject; ACanvas: TCanvas;
var AWidth, AHeight: Integer) of object; var AWidth, AHeight: Integer) of object;
TMergedMenuItems = class
private
fList: array[Boolean] of TList; // visible
function GetInvisibleCount: Integer;
function GetInvisibleItem(Index: Integer): TMenuItem;
function GetVisibleCount: Integer;
function GetVisibleItem(Index: Integer): TMenuItem;
public
constructor Create(const aParent: TMenuItem);
destructor Destroy; override;
class function DefaultSort(aItem1, aItem2, aParentItem: Pointer): Integer; static;
property VisibleCount: Integer read GetVisibleCount;
property VisibleItems[Index: Integer]: TMenuItem read GetVisibleItem;
property InvisibleCount: Integer read GetInvisibleCount;
property InvisibleItems[Index: Integer]: TMenuItem read GetInvisibleItem;
end;
TMenuItem = class(TLCLComponent) TMenuItem = class(TLCLComponent)
private private
FActionLink: TMenuActionLink; FActionLink: TMenuActionLink;
@ -153,9 +135,6 @@ type
FOnDrawItem: TMenuDrawItemEvent; FOnDrawItem: TMenuDrawItemEvent;
FOnMeasureItem: TMenuMeasureItemEvent; FOnMeasureItem: TMenuMeasureItemEvent;
FParent: TMenuItem; FParent: TMenuItem;
FMerged: TMenuItem;
FMergedWith: TMenuItem;
FMergedItems: TMergedMenuItems;
FMenuItemHandlers: array[TMenuItemHandlerType] of TMethodList; FMenuItemHandlers: array[TMenuItemHandlerType] of TMethodList;
FSubMenuImages: TCustomImageList; FSubMenuImages: TCustomImageList;
FSubMenuImagesWidth: Integer; FSubMenuImagesWidth: Integer;
@ -177,8 +156,6 @@ type
function GetCount: Integer; function GetCount: Integer;
function GetItem(Index: Integer): TMenuItem; function GetItem(Index: Integer): TMenuItem;
function GetMenuIndex: Integer; function GetMenuIndex: Integer;
function GetMergedItems: TMergedMenuItems;
function GetMergedParent: TMenuItem;
function GetParent: TMenuItem; function GetParent: TMenuItem;
function IsBitmapStored: boolean; function IsBitmapStored: boolean;
function IsCaptionStored: boolean; function IsCaptionStored: boolean;
@ -189,7 +166,6 @@ type
function IsImageIndexStored: Boolean; function IsImageIndexStored: Boolean;
function IsShortCutStored: boolean; function IsShortCutStored: boolean;
function IsVisibleStored: boolean; function IsVisibleStored: boolean;
procedure MergeWith(const aMenu: TMenuItem);
procedure SetAutoCheck(const AValue: boolean); procedure SetAutoCheck(const AValue: boolean);
procedure SetCaption(const AValue: TTranslateString); procedure SetCaption(const AValue: TTranslateString);
procedure SetChecked(AValue: Boolean); procedure SetChecked(AValue: Boolean);
@ -250,7 +226,6 @@ type
function GetImageList: TCustomImageList; function GetImageList: TCustomImageList;
function GetParentComponent: TComponent; override; function GetParentComponent: TComponent; override;
function GetParentMenu: TMenu; virtual; function GetParentMenu: TMenu; virtual;
function GetMergedParentMenu: TMenu; virtual;
function GetIsRightToLeft:Boolean; virtual; function GetIsRightToLeft:Boolean; virtual;
function HandleAllocated : Boolean; function HandleAllocated : Boolean;
function HasIcon: boolean; virtual; function HasIcon: boolean; virtual;
@ -259,7 +234,6 @@ type
procedure IntfDoSelect; virtual; procedure IntfDoSelect; virtual;
function IndexOf(Item: TMenuItem): Integer; function IndexOf(Item: TMenuItem): Integer;
function IndexOfCaption(const ACaption: string): Integer; virtual; function IndexOfCaption(const ACaption: string): Integer; virtual;
procedure InvalidateMergedItems;
function VisibleIndexOf(Item: TMenuItem): Integer; function VisibleIndexOf(Item: TMenuItem): Integer;
procedure Add(Item: TMenuItem); procedure Add(Item: TMenuItem);
procedure Add(const AItems: array of TMenuItem); procedure Add(const AItems: array of TMenuItem);
@ -287,17 +261,13 @@ type
const AMethod: TMethod; AsFirst: boolean = false); const AMethod: TMethod; AsFirst: boolean = false);
procedure RemoveHandler(HandlerType: TMenuItemHandlerType; procedure RemoveHandler(HandlerType: TMenuItemHandlerType;
const AMethod: TMethod); const AMethod: TMethod);
property Merged: TMenuItem read FMerged;
property MergedWith: TMenuItem read FMergedWith;
public public
property Count: Integer read GetCount; property Count: Integer read GetCount;
property Handle: HMenu read GetHandle write FHandle; property Handle: HMenu read GetHandle write FHandle;
property Items[Index: Integer]: TMenuItem read GetItem; default; property Items[Index: Integer]: TMenuItem read GetItem; default;
property MergedItems: TMergedMenuItems read GetMergedItems;
property MenuIndex: Integer read GetMenuIndex write SetMenuIndex; property MenuIndex: Integer read GetMenuIndex write SetMenuIndex;
property Menu: TMenu read FMenu; property Menu: TMenu read FMenu;
property Parent: TMenuItem read GetParent; property Parent: TMenuItem read GetParent;
property MergedParent: TMenuItem read GetMergedParent;
property Command: Word read FCommand; property Command: Word read FCommand;
function MenuVisibleIndex: integer; function MenuVisibleIndex: integer;
procedure WriteDebugReport(const Prefix: string); procedure WriteDebugReport(const Prefix: string);
@ -426,8 +396,6 @@ type
procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override; procedure MenuChanged(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
procedure Merge(Menu: TMainMenu);
procedure Unmerge(Menu: TMainMenu);
property Height: Integer read GetHeight; property Height: Integer read GetHeight;
property WindowHandle: HWND read FWindowHandle write SetWindowHandle; property WindowHandle: HWND read FWindowHandle write SetWindowHandle;
published published
@ -681,114 +649,6 @@ begin
RegisterNoIcon([TMenuItem]); RegisterNoIcon([TMenuItem]);
end; end;
{ TMergedMenuItems }
constructor TMergedMenuItems.Create(const aParent: TMenuItem);
procedure SearchVis(const aGroupIndex: Integer; out outIndex: Integer; out outReplace: Boolean);
var
AItem: TMenuItem;
I: Integer;
begin
outReplace := False;
for I := 0 to VisibleCount-1 do
begin
AItem := VisibleItems[I];
if AItem.GroupIndex=aGroupIndex then
begin
outIndex := I;
outReplace := True;
Exit;
end else
if AItem.GroupIndex>aGroupIndex then
begin
outIndex := I;
Exit;
end;
end;
outIndex := -1;
end;
var
B, AReplace: Boolean;
I, AItemIndex: Integer;
AItem: TMenuItem;
begin
inherited Create;
for B := Low(fList) to High(fList) do
fList[B] := TList.Create;
for I := 0 to aParent.Count-1 do
fList[aParent.Items[I].Visible].Add(aParent.Items[I]);
if Assigned(aParent.FMerged) then
begin
for I := 0 to aParent.FMerged.Count-1 do
begin
AItem := aParent.FMerged.Items[I];
if AItem.Visible then
begin
SearchVis(AItem.GroupIndex, AItemIndex, AReplace);
if AItemIndex>=0 then
begin
if AReplace then
begin
fList[False].Add(VisibleItems[AItemIndex]); // copy to invisible list
fList[True].Items[AItemIndex] := AItem // replace
end else
fList[True].Insert(AItemIndex, AItem); // insert
end else
fList[True].Add(AItem); // add
end else
fList[False].Add(AItem); // add to invisible
end;
end;
end;
class function TMergedMenuItems.DefaultSort(aItem1, aItem2,
aParentItem: Pointer): Integer;
var
Item1: TMenuItem absolute aItem1;
Item2: TMenuItem absolute aItem2;
begin
Result := Item1.GroupIndex-Item2.GroupIndex;
if Result=0 then
begin
if Pointer(Item1.Parent)=aParentItem then
Result := 1
else
Result := -1;
end;
end;
destructor TMergedMenuItems.Destroy;
var
B: Boolean;
begin
for B := Low(fList) to High(fList) do
fList[B].Destroy;
inherited Destroy;
end;
function TMergedMenuItems.GetInvisibleCount: Integer;
begin
Result := fList[False].Count;
end;
function TMergedMenuItems.GetInvisibleItem(Index: Integer): TMenuItem;
begin
Result := TMenuItem(fList[False].Items[Index]);
end;
function TMergedMenuItems.GetVisibleCount: Integer;
begin
Result := fList[True].Count;
end;
function TMergedMenuItems.GetVisibleItem(Index: Integer): TMenuItem;
begin
Result := TMenuItem(fList[True].Items[Index]);
end;
{$I menu.inc} {$I menu.inc}
{$I menuitem.inc} {$I menuitem.inc}
{$I mainmenu.inc} {$I mainmenu.inc}

6
lcl/widgetset/wsforms.pp
View File

@ -101,7 +101,6 @@ type
class function Next(const AForm: TCustomForm): Boolean; virtual; class function Next(const AForm: TCustomForm): Boolean; virtual;
class function Previous(const AForm: TCustomForm): Boolean; virtual; class function Previous(const AForm: TCustomForm): Boolean; virtual;
class function Tile(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; class function MDIChildCount(const AForm: TCustomForm): Integer; virtual;
end; end;
TWSCustomFormClass = class of TWSCustomForm; TWSCustomFormClass = class of TWSCustomForm;
@ -255,11 +254,6 @@ begin
Result := False; Result := False;
end; end;
class function TWSCustomForm.ArrangeIcons(const AForm: TCustomForm): Boolean;
begin
Result := False;
end;
class function TWSCustomForm.Tile(const AForm: TCustomForm): Boolean; class function TWSCustomForm.Tile(const AForm: TCustomForm): Boolean;
begin begin
Result := False; Result := False;