From 763779959f903c74a933e7e528ed9d8396a197de Mon Sep 17 00:00:00 2001 From: paul Date: Mon, 24 Sep 2007 06:03:19 +0000 Subject: [PATCH] Qt: menu rework (also fixed issue with destroying menu items - they had not destroyed their handles) git-svn-id: trunk@12153 - --- lcl/interfaces/qt/qtint.pp | 1 + lcl/interfaces/qt/qtobject.inc | 24 ++++- lcl/interfaces/qt/qtwidgets.pas | 73 ++++++--------- lcl/interfaces/qt/qtwsforms.pp | 6 -- lcl/interfaces/qt/qtwsmenus.pp | 160 ++++++++++++++------------------ lcl/widgetset/wsmenus.pp | 17 +++- 6 files changed, 140 insertions(+), 141 deletions(-) diff --git a/lcl/interfaces/qt/qtint.pp b/lcl/interfaces/qt/qtint.pp index fa4ea6c98c..c19c98c922 100644 --- a/lcl/interfaces/qt/qtint.pp +++ b/lcl/interfaces/qt/qtint.pp @@ -86,6 +86,7 @@ type procedure AppRestore; override; procedure AppBringToFront; override; procedure AppSetTitle(const ATitle: string); override; + procedure AttachMenuToWindow(AMenuObject: TComponent); override; public constructor Create; destructor Destroy; override; diff --git a/lcl/interfaces/qt/qtobject.inc b/lcl/interfaces/qt/qtobject.inc index 771cf7ad8c..f3a2bc5ed6 100644 --- a/lcl/interfaces/qt/qtobject.inc +++ b/lcl/interfaces/qt/qtobject.inc @@ -193,11 +193,31 @@ begin // TODO end; +procedure TQtWidgetSet.AttachMenuToWindow(AMenuObject: TComponent); +var + AWidget, AMenuWidget: TQtWidget; + QtMainWindow: TQtMainWindow absolute AWidget; + QtMenuBar: TQtMenuBar absolute AMenuWidget; + R, R1: TRect; +begin + AMenuWidget := TQtWidget((AMenuObject as TMenu).Handle); + if AMenuWidget is TQtMenuBar then + begin + AWidget := TQtWidget(TWinControl(AMenuObject.Owner).Handle); + if AWidget is TQtMainWindow then + begin + R := AWidget.LCLObject.ClientRect; + R1 := QtMainWindow.MenuBar.getGeometry; + R1.Right := R.Right; + QtMenuBar.setGeometry(R1); + QtMainWindow.setMenuBar(QMenuBarH(QtMenuBar.Widget)); + end; + end; +end; + function TQtWidgetSet.CreateThemeServices: TThemeServices; begin - // TODO: uncomment if you want to test TQtThemeServices Result := TQtThemeServices.Create; - //Result := inherited CreateThemeServices; end; function TQtWidgetSet.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; diff --git a/lcl/interfaces/qt/qtwidgets.pas b/lcl/interfaces/qt/qtwidgets.pas index d31c5bed02..ef243c24a9 100644 --- a/lcl/interfaces/qt/qtwidgets.pas +++ b/lcl/interfaces/qt/qtwidgets.pas @@ -806,11 +806,11 @@ type private FIcon: QIconH; FActionHook: QAction_hookH; + FMenuItem: TMenuItem; + protected + function CreateWidget(const APrams: TCreateParams): QWidgetH; override; public - MenuItem: TMenuItem; - public - constructor Create(const AParent: QWidgetH); overload; - constructor Create(const AHandle: QMenuH); overload; + constructor Create(const AMenuItem: TMenuItem); overload; destructor Destroy; override; public procedure AttachEvents; override; @@ -822,8 +822,7 @@ type public procedure PopUp(pos: PQtPoint; at: QActionH = nil); function actionHandle: QActionH; - function addMenu(title: PWideString): TQtMenu; - function addSeparator: TQtMenu; + function addMenu(AMenu: QMenuH): QActionH; function getVisible: Boolean; override; function getText: WideString; override; procedure setChecked(p1: Boolean); @@ -846,8 +845,7 @@ type public constructor Create(const AParent: QWidgetH); overload; public - function addMenu(title: PWideString): TQtMenu; - function addSeparator: TQtMenu; + function addMenu(AMenu: QMenuH): QActionH; function getGeometry: TRect; override; end; @@ -1079,10 +1077,13 @@ begin SetGeometry; // set focus policy - if LCLObject.TabStop then - setFocusPolicy(QtClickFocus) - else - setFocusPolicy(QtNoFocus); + if LCLObject <> nil then + begin + if LCLObject.TabStop then + setFocusPolicy(QtClickFocus) + else + setFocusPolicy(QtNoFocus); + end; // Set mouse move messages policy QWidget_setMouseTracking(Widget, True); @@ -2792,7 +2793,8 @@ end; procedure TQtWidget.SetGeometry; begin - setGeometry(LCLObject.BoundsRect); + if LCLObject <> nil then + setGeometry(LCLObject.BoundsRect); end; { TQtAbstractButton } @@ -5848,18 +5850,18 @@ end; { TQtMenu } -constructor TQtMenu.Create(const AParent: QWidgetH); +function TQtMenu.CreateWidget(const APrams: TCreateParams): QWidgetH; begin - Create; - Widget := QMenu_Create(AParent); FIcon := nil; + Result := QMenu_create(); end; -constructor TQtMenu.Create(const AHandle: QMenuH); +constructor TQtMenu.Create(const AMenuItem: TMenuItem); +var + AParams: TCreateParams; begin - Create; - Widget := AHandle; - FIcon := nil; + FMenuItem := AMenuItem; + inherited Create(nil, AParams); end; destructor TQtMenu.Destroy; @@ -5908,15 +5910,10 @@ begin Result := QMenu_menuAction(QMenuH(Widget)); end; -function TQtMenu.addMenu(title: PWideString): TQtMenu; +function TQtMenu.addMenu(AMenu: QMenuH): QActionH; begin - Result := TQtMenu.Create(QMenu_addMenu(QMenuH(Widget), title)); -end; - -function TQtMenu.addSeparator: TQtMenu; -begin - Result := TQtMenu.Create(QMenu_addMenu(QMenuH(Widget), PWideString(nil))); - Result.setSeparator(True); + setHasSubmenu(True); + Result := QMenu_addMenu(QMenuH(Widget), AMenu); end; function TQtMenu.getVisible: Boolean; @@ -6013,8 +6010,8 @@ end; ------------------------------------------------------------------------------} procedure TQtMenu.SlotTriggered(checked: Boolean); cdecl; begin - if Assigned(MenuItem) and Assigned(MenuItem.OnClick) then - MenuItem.OnClick(Self.MenuItem); + if Assigned(FMenuItem) and Assigned(FMenuItem.OnClick) then + FMenuItem.OnClick(FMenuItem); end; function TQtMenu.EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; @@ -6039,26 +6036,14 @@ begin setVisible(FVisible); end; -function TQtMenuBar.addMenu(title: PWideString): TQtMenu; +function TQtMenuBar.addMenu(AMenu: QMenuH): QActionH; begin if not FVisible then begin FVisible := True; setVisible(FVisible); end; - - Result := TQtMenu.Create(QMenuBar_addMenu(QMenuBarH(Widget), title)); -end; - -function TQtMenuBar.addSeparator: TQtMenu; -begin - if not FVisible then - begin - FVisible := True; - setVisible(FVisible); - end; - Result := TQtMenu.Create(QMenuBar_addMenu(QMenuBarH(Widget), PWideString(nil))); - Result.setSeparator(True); + Result := QMenuBar_addMenu(QMenuBarH(Widget), AMenu); end; function TQtMenuBar.getGeometry: TRect; diff --git a/lcl/interfaces/qt/qtwsforms.pp b/lcl/interfaces/qt/qtwsforms.pp index d9c94e5f6d..1a66030676 100644 --- a/lcl/interfaces/qt/qtwsforms.pp +++ b/lcl/interfaces/qt/qtwsforms.pp @@ -191,12 +191,6 @@ begin QMdiArea_addSubWindow(TQtMainWindow(Application.MainForm.Handle).MDIAreaHandle, QtMainWindow.Widget, QtWindow); {$endif} - R := AWinControl.ClientRect; - R1 := QtMainWindow.MenuBar.getGeometry; - R1.Right := R.Right; - QtMainWindow.MenuBar.setGeometry(R1); - QtMainWindow.setMenuBar(QMenuBarH(QtMainWindow.MenuBar.Widget)); - // Return the handle Result := THandle(QtMainWindow); end; diff --git a/lcl/interfaces/qt/qtwsmenus.pp b/lcl/interfaces/qt/qtwsmenus.pp index 96db2b6812..de77d76ca7 100644 --- a/lcl/interfaces/qt/qtwsmenus.pp +++ b/lcl/interfaces/qt/qtwsmenus.pp @@ -46,9 +46,10 @@ type TQtWSMenuItem = class(TWSMenuItem) private protected + class function CreateMenuFromMenuItem(const AMenuItem: TMenuItem): TQtMenu; public class procedure AttachMenu(const AMenuItem: TMenuItem); override; - class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override; + class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override; class procedure DestroyHandle(const AMenuItem: TMenuItem); override; class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override; class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); override; @@ -97,10 +98,35 @@ implementation Returns: Nothing ------------------------------------------------------------------------------} class procedure TQtWSMenuItem.AttachMenu(const AMenuItem: TMenuItem); +var + Widget: TQtWidget; begin - // set proper position + if not WSCheckMenuItem(AMenuItem, 'AttachMenu') or (AMenuItem.Parent = nil) then + Exit; + + Widget := TQtWidget(AMenuItem.Parent.Handle); + if Widget is TQtMenuBar then + TQtMenuBar(Widget).addMenu(QMenuH(TQtMenu(AMenuItem.Handle).Widget)) + else + if Widget is TQtMenu then + TQtMenu(Widget).addMenu(QMenuH(TQtMenu(AMenuItem.Handle).Widget)); end; +class function TQtWSMenuItem.CreateMenuFromMenuItem(const AMenuItem: TMenuItem): TQtMenu; +begin + Result := TQtMenu.Create(AMenuItem); + Result.setSeparator(AMenuItem.IsLine); + Result.setHasSubmenu(AMenuItem.Count > 0); + if not AMenuItem.IsLine then + begin + Result.setText(GetUtf8String(AMenuItem.Caption)); + Result.setEnabled(AMenuItem.Enabled); + Result.setChecked(AMenuItem.Checked); + Result.setShortcut(AMenuItem.ShortCut); + if AMenuItem.HasIcon then + Result.setImage(TQtImage(AMenuItem.Bitmap.Handle)); + end; +end; {------------------------------------------------------------------------------ Function: TQtWSMenuItem.CreateHandle Params: None @@ -110,9 +136,7 @@ end; ------------------------------------------------------------------------------} class function TQtWSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU; var - ParentMenu, Menu: TQtMenu; - MenuBar: TQtMenuBar; - Text: WideString; + Menu: TQtMenu; begin {$ifdef VerboseQt} WriteLn('trace:> [TQtWSMenuItem.CreateHandle] Caption: ', AMenuItem.Caption, @@ -142,86 +166,19 @@ begin because TMainMenu uses the special Handle QMenuBar while TPopUpMenu can be treat like if this menu item was a subitem of another item ------------------------------------------------------------------------------} - else if ((not AMenuItem.Parent.HasParent) and (AMenuItem.GetParentMenu is TMainMenu)) then + else + if ((not AMenuItem.Parent.HasParent) and (AMenuItem.GetParentMenu is TMainMenu)) then begin - MenuBar := TQtMenuBar(AMenuItem.GetParentMenu.Handle); - - {$ifdef VerboseQt} - Write(' Parent: ', dbghex(PtrInt(MenuBar)), ' The Parent is a TMainMenu'); - {$endif} - - { IsLine indicates that the menu item is a separator } - if AMenuItem.IsLine then - begin - Menu := MenuBar.addSeparator; - - Menu.setHasSubmenu(False); - - Result := HMENU(Menu); - end - else - begin - Text := GetUtf8String(AMenuItem.Caption); - - Menu := MenuBar.addMenu(@Text); - - Menu.MenuItem := AMenuItem; - - Menu.setShortcut(AMenuItem.ShortCut); - - if AMenuItem.HasIcon then - Menu.setImage(TQtImage(AMenuItem.Bitmap.Handle)); - - Menu.setHasSubmenu(AMenuItem.Count > 0); - - Result := HMENU(Menu); - end; + Menu := CreateMenuFromMenuItem(AMenuItem); + Result := HMENU(Menu); end {------------------------------------------------------------------------------ If the parent has a parent, then that itemīs Handle is necessarely a TQtMenu ------------------------------------------------------------------------------} else begin - ParentMenu := TQtMenu(AMenuItem.Parent.Handle); - - ParentMenu.setHasSubmenu(True); - - {$ifdef VerboseQt} - Write(' Parent: ', dbghex(PtrInt(ParentMenu)), - ' The Parent is a TPopUpMenu or a TMenuItem'); - {$endif} - - { IsLine indicates that the menu item is a separator } - if AMenuItem.IsLine then - begin - Menu := ParentMenu.addSeparator; - - Menu.setHasSubmenu(False); - - Result := HMENU(Menu); - end - { Count indicates the number of subitems this item has } - else - begin - Text := GetUtf8String(AMenuItem.Caption); - - Menu := ParentMenu.addMenu(@Text); - - Menu.MenuItem := AMenuItem; - - Menu.setEnabled(AMenuItem.Enabled); - - Menu.setChecked(AMenuItem.Checked); - - Menu.setShortcut(AMenuItem.ShortCut); - - if AMenuItem.HasIcon then - Menu.setImage(TQtImage(AMenuItem.Bitmap.Handle)); - - Menu.setHasSubmenu(AMenuItem.Count > 0); - - Result := HMENU(Menu); - end; + Menu := CreateMenuFromMenuItem(AMenuItem); + Result := HMENU(Menu); end; if Menu <> nil then @@ -261,6 +218,13 @@ class procedure TQtWSMenuItem.SetCaption(const AMenuItem: TMenuItem; const ACapt var Widget: TQtWidget; begin + {$ifdef VerboseQt} + WriteLn('[TQtWSMenuItem.SetCaption] Caption: ' + AMenuItem.Caption + ' NewCaption: ', ACaption); + {$endif} + + if not WSCheckMenuItem(AMenuItem, 'SetEnable') then + Exit; + Widget := TQtWidget(AMenuItem.Handle); if Widget is TQtMenu then TQtMenu(Widget).setText(GetUtf8String(ACaption)); @@ -275,6 +239,13 @@ class procedure TQtWSMenuItem.SetShortCut(const AMenuItem: TMenuItem; const OldS var Widget: TQtWidget; begin + {$ifdef VerboseQt} + WriteLn('[TQtWSMenuItem.SetCaption] SetShortCut: ' + AMenuItem.Caption); + {$endif} + + if not WSCheckMenuItem(AMenuItem, 'SetEnable') then + Exit; + Widget := TQtWidget(AMenuItem.Handle); if Widget is TQtMenu then TQtMenu(Widget).setShortcut(NewShortCut); @@ -287,7 +258,12 @@ end; ------------------------------------------------------------------------------} class procedure TQtWSMenuItem.SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); begin - { Here the menu item has a QMenuH handle } + {$ifdef VerboseQt} + WriteLn('[TQtWSMenuItem.SetVisible] SetShortCut: ' + AMenuItem.Caption + ' Visible: ', Visible); + {$endif} + if not WSCheckMenuItem(AMenuItem, 'SetEnable') then + Exit; + TQtMenu(AMenuItem.Handle).setVisible(Visible); end; @@ -298,7 +274,13 @@ end; ------------------------------------------------------------------------------} class function TQtWSMenuItem.SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; begin + Result := False; + + if not WSCheckMenuItem(AMenuItem, 'SetEnable') then + Exit; + TQtMenu(AMenuItem.Handle).setChecked(Checked); + Result := True; end; @@ -309,7 +291,13 @@ end; ------------------------------------------------------------------------------} class function TQtWSMenuItem.SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; begin + Result := False; + + if not WSCheckMenuItem(AMenuItem, 'SetEnable') then + Exit; + TQtMenu(AMenuItem.Handle).setEnabled(Enabled); + Result := True; end; @@ -320,7 +308,7 @@ end; ------------------------------------------------------------------------------} class function TQtWSMenuItem.SetRadioItem(const AMenuItem: TMenuItem; const RadioItem: boolean): boolean; begin - Result := True; + Result := SetCheck(AMenuItem, AMenuItem.Checked); end; {------------------------------------------------------------------------------ @@ -330,6 +318,8 @@ end; ------------------------------------------------------------------------------} class function TQtWSMenuItem.SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; begin + if not WSCheckMenuItem(AMenuItem, 'SetEnable') then + Exit; Result := True; end; @@ -359,7 +349,6 @@ class function TQtWSMenu.CreateHandle(const AMenu: TMenu): HMENU; var MenuBar: TQtMenuBar; Menu: TQtMenu; - Parent: QWidgetH; begin { If the menu is a main menu, there is no need to create a handle for it. Itīs already created on the window } @@ -371,13 +360,8 @@ begin end else if (AMenu is TPopUpMenu) then begin - if (AMenu.Owner <> nil) and (AMenu.Owner is TWinControl) then - Parent := TQtWidget(TWinControl(AMenu.Owner).Handle).Widget - else - Parent := nil; - - Menu := TQtMenu.Create(Parent); - Menu.MenuItem := AMenu.Items; + Menu := TQtMenu.Create(AMenu.Items); + //Menu.setParent(Parent); Menu.AttachEvents; Result := HMENU(Menu); diff --git a/lcl/widgetset/wsmenus.pp b/lcl/widgetset/wsmenus.pp index 3d9dbe78b1..21847efa0f 100644 --- a/lcl/widgetset/wsmenus.pp +++ b/lcl/widgetset/wsmenus.pp @@ -46,7 +46,7 @@ uses //////////////////////////////////////////////////// Menus, Graphics, //////////////////////////////////////////////////// - WSLCLClasses, LCLType; + WSLCLClasses, LCLType, LCLProc; type { TWSMenuItem } @@ -86,6 +86,8 @@ type end; TWSPopupMenuClass = class of TWSPopupMenu; +function WSCheckMenuItem(const AMenuItem: TMenuItem; + const AProcName: String): Boolean; implementation @@ -164,6 +166,19 @@ class procedure TWSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, Y: int begin end; +function WSCheckMenuItem(const AMenuItem: TMenuItem; + const AProcName: String): Boolean; + + procedure Warn; + begin + DebugLn('[WARNING] %s called without handle for %s(%s)', [AProcName, AMenuItem.Name, AMenuItem.ClassName]); + end; +begin + Result := AMenuItem.HandleAllocated; + if Result then Exit; + Warn; +end; + initialization ////////////////////////////////////////////////////