I saw in case of screen overflow if there are more sub-menu items seems like while clicking the parent menu .vcl code adds the subitems in the selected list and fires the execute for that as it's treating this mouse click for the child menu too. any solution for this or its a bug in .vcl? Display setting: scale (125%) display resolution (1920 * 1080)
.dfm file
object frmCodeTree: TfrmCodeTree
Left = 353
Top = 0
Caption = 'CodeTree'
ClientHeight = 598
ClientWidth = 1101
Color = clBtnFace
CustomTitleBar.Control = TitleBarPanel1
CustomTitleBar.Enabled = True
CustomTitleBar.Height = 58
CustomTitleBar.SystemHeight = False
CustomTitleBar.SystemColors = False
CustomTitleBar.SystemButtons = False
CustomTitleBar.BackgroundColor = clGreen
CustomTitleBar.ForegroundColor = clWhite
CustomTitleBar.InactiveBackgroundColor = clGreen
CustomTitleBar.InactiveForegroundColor = clWhite
CustomTitleBar.ButtonForegroundColor = clWhite
CustomTitleBar.ButtonBackgroundColor = clGreen
CustomTitleBar.ButtonHoverForegroundColor = clWhite
CustomTitleBar.ButtonHoverBackgroundColor = clGreen
CustomTitleBar.ButtonPressedForegroundColor = clWhite
CustomTitleBar.ButtonPressedBackgroundColor = clGreen
CustomTitleBar.ButtonInactiveForegroundColor = clWhite
CustomTitleBar.ButtonInactiveBackgroundColor = clGreen
DoubleBuffered = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
FormStyle = fsMDIForm
GlassFrame.Enabled = True
GlassFrame.Top = 58
OldCreateOrder = True
Position = poDesigned
ShowHint = True
StyleElements = [seFont, seClient]
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 15
object TitleBarPanel1: TTitleBarPanel
Left = 0
Top = 0
Width = 1101
Height = 57
CustomButtons = <>
object ScrollBox1: TScrollBox
Left = 408
Top = 3
Width = 329
Height = 41
HorzScrollBar.ButtonSize = 11
VertScrollBar.ButtonSize = 11
VertScrollBar.Position = 8
TabOrder = 0
object ActionMainMenuBar1: TActionMainMenuBar
Left = 0
Top = -8
Width = 308
Height = 50
UseSystemFont = False
ActionManager = ActionManager1
Align = alBottom
AllowHiding = True
Caption = 'ActionMainMenuBar1'
Color = clMenuBar
ColorMap.DisabledFontColor = 7171437
ColorMap.HighlightColor = clWhite
ColorMap.BtnSelectedFont = clBlack
ColorMap.UnusedColor = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
Spacing = 0
OnGetPopupClass = ActionMainMenuBar1GetPopupClass
OnPaint = ActionMainMenuBar1Paint
end
end
end
object ActionManager1: TActionManager
ActionBars = <
item
Items = <
item
Items = <
item
Action = FileOpen1
ImageIndex = 7
ShortCut = 16463
end
item
Action = FileOpenWith1
Caption = 'O&pen with...'
end
item
Action = FileSaveAs1
ImageIndex = 30
end
item
Action = FilePrintSetup1
end
item
Action = FilePageSetup1
Caption = 'Pa&ge Setup...'
end
item
Action = FileRun1
end
item
Action = FileExit1
ImageIndex = 43
end
item
Action = BrowseForFolder1
Caption = '&BrowseForFolder1'
end
item
Caption = 'ActionClientItem8'
end
item
Caption = 'A&ctionClientItem9'
end
item
Caption = 'Ac&tionClientItem10'
end
item
Caption = 'Act&ionClientItem11'
end
item
Caption = 'ActionClientItem12'
end
item
Caption = 'Actio&nClientItem13'
end
item
Caption = 'ActionC&lientItem14'
end
item
Caption = 'ActionCli&entItem15'
end
item
Caption = 'ActionClientIte&m16'
end
item
Caption = 'ActionClientItem&17'
end
item
Caption = 'ActionClientItem1&8'
end
item
Caption = 'ActionClientItem1&9'
end
item
Caption = 'ActionClientItem&20'
end
item
Caption = 'ActionClientItem21'
end
item
Caption = 'ActionClientItem22'
end
item
Caption = 'ActionClientItem2&3'
end
item
Caption = 'ActionClientItem2&4'
end
item
Caption = 'ActionClientItem2&5'
end
item
Caption = 'ActionClientItem2&6'
end
item
Caption = 'ActionClientItem2&7'
end
item
Caption = 'ActionClientItem28'
end
item
Caption = 'ActionClientItem29'
end
item
Caption = 'ActionClientItem3&0'
end
item
Caption = 'ActionClientItem31'
end
item
Caption = 'ActionClientItem32'
end
item
Caption = 'ActionClientItem33'
end
item
Caption = 'ActionClientItem34'
end
item
Caption = 'ActionClientItem35'
end
item
Caption = 'ActionClientItem36'
end
item
Caption = 'ActionClientItem37'
end
item
Caption = 'ActionClientItem38'
end
item
Caption = 'ActionClientItem39'
end
item
Caption = 'ActionClientItem40'
end
item
Caption = 'ActionClientItem41'
end
item
Caption = 'ActionClientItem42'
end
item
Caption = 'ActionClientItem43'
end
item
Caption = 'ActionClientItem44'
end
item
Caption = 'ActionClientItem45'
end
item
Caption = 'ActionClientItem46'
end
item
Caption = 'ActionClientItem47'
end
item
Caption = 'ActionClientItem48'
end
item
Caption = 'ActionClientItem49'
end
item
Caption = 'ActionClientItem50'
end
item
Caption = 'ActionClientItem51'
end
item
Caption = 'ActionClientItem52'
end
item
Caption = 'ActionClientItem53'
end
item
Caption = 'ActionClientItem54'
end
item
Caption = 'ActionClientItem55'
end
item
Caption = 'ActionClientItem56'
end
item
Caption = 'ActionClientItem57'
end
item
Caption = 'ActionClientItem58'
end
item
Caption = 'ActionClientItem59'
end
item
Caption = 'ActionClientItem60'
end
item
Caption = 'ActionClientItem61'
end
item
Caption = 'ActionClientItem62'
end
item
Caption = 'ActionClientItem63'
end
item
Caption = 'ActionClientItem64'
end
item
Caption = 'ActionClientItem65'
end
item
Caption = 'ActionClientItem66'
end
item
Caption = 'ActionClientItem67'
end
item
Caption = 'ActionClientItem68'
end
item
Caption = 'ActionClientItem69'
end
item
Caption = 'ActionClientItem70'
end>
Tag = 777
Caption = '&File'
end
item
Items = <
item
Action = EditUndo1
ImageIndex = 3
ShortCut = 16474
end
item
Action = EditDelete1
ImageIndex = 5
ShortCut = 46
end>
Caption = '&Edit'
end
item
Caption = '&View'
end
item
Items = <
item
Action = SearchFindFirst1
end>
Caption = '&Repository'
end
item
Items = <
item
Action = InternetBrowseURL1
end
item
Action = InternetDownLoadURL1
end
item
Action = InternetSendMail1
end>
Caption = '&Actions'
end
item
Items = <
item
Action = Action1
Caption = '&Options'
end>
Caption = '&Tools'
end
item
Items = <
item
Action = Action2
Caption = '&About CodeTree'
end>
Caption = '&Help'
end
item
Items = <
item
Action = SearchFindFirst1
end>
Caption = 'Re&pository'
end
item
Caption = 'V&iew'
end
item
Items = <
item
Action = FileOpen1
ImageIndex = 7
ShortCut = 16463
end
item
Action = FileOpenWith1
Caption = 'O&pen with...'
end
item
Action = FileSaveAs1
ImageIndex = 30
end
item
Action = FilePrintSetup1
end
item
Action = FilePageSetup1
Caption = 'Pa&ge Setup...'
end
item
Action = FileRun1
end
item
Action = FileExit1
ImageIndex = 43
end
item
Action = BrowseForFolder1
Caption = '&BrowseForFolder1'
end
item
Items = <
item
Action = SearchFindFirst1
end>
Caption = 'R&epository'
UsageCount = 1
end
item
Action = InternetBrowseURL1
Caption = 'Bro&wse URL'
end
item
Action = InternetDownLoadURL1
end
item
Action = InternetSendMail1
end
item
Action = Action2
Caption = 'Abou&t CodeTree'
end
item
Action = Action3
Caption = 'A&ction3'
end
item
Action = Action4
Caption = 'Act&ion4'
end
item
Action = Action5
Caption = 'Actio&n5'
end
item
Action = Action6
Caption = 'Action&6'
end
item
Action = Action7
Caption = 'Action&7'
end
item
Action = Action8
Caption = 'Action&8'
end
item
Action = Action9
Caption = 'Action&9'
end
item
Action = Action10
Caption = 'Action&10'
end
item
Action = Action11
end
item
Action = Action12
Caption = 'Action1&2'
end
item
Action = Action13
Caption = 'Action1&3'
end
item
Action = Action14
Caption = 'Action1&4'
end
item
Action = Action15
Caption = 'Action1&5'
end
item
Action = Action16
end
item
Action = Action17
end
item
Action = Action18
end
item
Action = Action19
end
item
Action = Action20
Caption = 'Action2&0'
end
item
Action = Action21
end
item
Action = Action22
end
item
Action = Action23
end
item
Action = Action24
end
item
Action = Action25
end
item
Action = Action26
end
item
Action = Action27
end
item
Action = Action28
end
item
Action = Action29
end
item
Action = Action34
end>
Caption = 'A&ctions'
end>
ActionBar = ActionMainMenuBar1
end>
Left = 600
Top = 278
StyleName = 'Platform Default'
object EditUndo1: TEditUndo
Category = 'Edit'
Caption = '&Undo'
Hint = 'Undo|Reverts the last action'
ImageIndex = 3
ShortCut = 16474
end
object EditDelete1: TEditDelete
Category = 'Edit'
Caption = '&Delete'
Hint = 'Delete|Erases the selection'
ImageIndex = 5
ShortCut = 46
end
object FileOpen1: TFileOpen
Category = 'Actions'
Caption = '&Open...'
Hint = 'Open|Opens an existing file'
ImageIndex = 7
ShortCut = 16463
end
object FileOpenWith1: TFileOpenWith
Category = 'Actions'
Caption = 'Open with...'
FileName = ''
end
object FileSaveAs1: TFileSaveAs
Category = 'Actions'
Caption = 'Save &As...'
Hint = 'Save As|Saves the active file with a new name'
ImageIndex = 30
end
object FilePrintSetup1: TFilePrintSetup
Category = 'Actions'
Caption = 'Print Set&up...'
Hint = 'Print Setup'
end
object FilePageSetup1: TFilePageSetup
Category = 'Actions'
Caption = 'Page Set&up...'
Dialog.MinMarginLeft = 0
Dialog.MinMarginTop = 0
Dialog.MinMarginRight = 0
Dialog.MinMarginBottom = 0
Dialog.MarginLeft = 1000
Dialog.MarginTop = 1000
Dialog.MarginRight = 1000
Dialog.MarginBottom = 1000
Dialog.PageWidth = 8500
Dialog.PageHeight = 11000
end
object FileRun1: TFileRun
Category = 'Actions'
Browse = False
BrowseDlg.Title = 'Run'
Caption = '&Run...'
Hint = 'Run|Runs an application'
Operation = 'open'
ShowCmd = scShowNormal
end
object FileExit1: TFileExit
Category = 'Actions'
Caption = 'E&xit'
Hint = 'Exit|Quits the application'
ImageIndex = 43
end
object BrowseForFolder1: TBrowseForFolder
Category = 'Actions'
Caption = 'BrowseForFolder1'
DialogCaption = 'BrowseForFolder1'
BrowseOptions = []
BrowseOptionsEx = []
end
object InternetBrowseURL1: TBrowseURL
Category = 'Actions'
Caption = '&Browse URL'
Hint = 'Browse URL'
end
object InternetDownLoadURL1: TDownLoadURL
Category = 'Actions'
Caption = '&Download URL'
Hint = 'Download from URL'
end
object InternetSendMail1: TSendMail
Category = 'Actions'
Caption = '&Send Mail...'
Hint = 'Send email'
end
object SearchFindFirst1: TSearchFindFirst
Category = 'Repository'
Caption = 'F&ind First'
Hint = 'Find First|Finds the first occurance of specified text'
end
object Action1: TAction
Category = 'Tools'
Caption = 'Options'
end
object Action2: TAction
Category = 'Actions'
Caption = 'About CodeTree'
end
object Action3: TAction
Category = 'Actions'
Caption = 'Action3'
end
object Action4: TAction
Category = 'Actions'
Caption = 'Action4'
end
object Action5: TAction
Category = 'Actions'
Caption = 'Action5'
end
object Action6: TAction
Category = 'Actions'
Caption = 'Action6'
end
object Action7: TAction
Category = 'Actions'
Caption = 'Action7'
end
object Action8: TAction
Category = 'Actions'
Caption = 'Action8'
end
object Action9: TAction
Category = 'Actions'
Caption = 'Action9'
end
object Action10: TAction
Category = 'Actions'
Caption = 'Action10'
end
object Action11: TAction
Category = 'Actions'
Caption = 'Action11'
end
object Action12: TAction
Category = 'Actions'
Caption = 'Action12'
end
object Action13: TAction
Category = 'Actions'
Caption = 'Action13'
end
object Action14: TAction
Category = 'Actions'
Caption = 'Action14'
end
object Action15: TAction
Category = 'Actions'
Caption = 'Action15'
end
object Action16: TAction
Category = 'Actions'
Caption = 'Action16'
end
object Action17: TAction
Category = 'Actions'
Caption = 'Action17'
end
object Action18: TAction
Category = 'Actions'
Caption = 'Action18'
end
object Action19: TAction
Category = 'Actions'
Caption = 'Action19'
end
object Action20: TAction
Category = 'Actions'
Caption = 'Action20'
end
object Action21: TAction
Category = 'Actions'
Caption = 'Action21'
end
object Action22: TAction
Category = 'Actions'
Caption = 'Action22'
end
object Action23: TAction
Category = 'Actions'
Caption = 'Action23'
end
object Action24: TAction
Category = 'Actions'
Caption = 'Action24'
end
object Action25: TAction
Category = 'Actions'
Caption = 'Action25'
end
object Action26: TAction
Category = 'Actions'
Caption = 'Action26'
end
object Action27: TAction
Category = 'Actions'
Caption = 'Action27'
end
object Action28: TAction
Category = 'Actions'
Caption = 'Action28'
end
object Action29: TAction
Category = 'Actions'
Caption = 'Action29'
end
object Action34: TAction
Category = 'Actions'
Caption = 'Action34'
end
end
end
my .pas file
unit CodeTreeForm;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
System.Actions,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ComCtrls,
Vcl.TitleBarCtrls,
Vcl.Menus,
Vcl.StdActns,
Vcl.ExtActns,
Vcl.ActnList,
Vcl.PlatformDefaultStyleActnCtrls,
Vcl.ActnMan,
Vcl.ToolWin,
Vcl.ActnCtrls,
Vcl.ActnMenus,
Vcl.Imaging.pngimage,
Vcl.ExtCtrls,
Vcl.ThemedActnCtrls, Vcl.Buttons;
type
TMyThemedPopupMenu = class(TThemedPopupMenu)
protected
procedure PositionPopup(AnOwner: TCustomActionBar; ParentItem: TCustomActionControl); override;
end;
type
TfrmCodeTree = class(TForm)
TitleBarPanel1: TTitleBarPanel;
ActionManager1: TActionManager;
EditUndo1: TEditUndo;
EditDelete1: TEditDelete;
FileOpen1: TFileOpen;
FileOpenWith1: TFileOpenWith;
FileSaveAs1: TFileSaveAs;
FilePrintSetup1: TFilePrintSetup;
FilePageSetup1: TFilePageSetup;
FileRun1: TFileRun;
FileExit1: TFileExit;
BrowseForFolder1: TBrowseForFolder;
InternetBrowseURL1: TBrowseURL;
InternetDownLoadURL1: TDownLoadURL;
InternetSendMail1: TSendMail;
SearchFindFirst1: TSearchFindFirst;
Action1: TAction;
Action2: TAction;
Action3: TAction;
Action4: TAction;
Action5: TAction;
Action6: TAction;
Action7: TAction;
Action8: TAction;
Action9: TAction;
Action10: TAction;
Action11: TAction;
Action12: TAction;
Action13: TAction;
Action14: TAction;
Action15: TAction;
Action16: TAction;
Action17: TAction;
Action18: TAction;
Action19: TAction;
Action20: TAction;
Action21: TAction;
Action22: TAction;
Action23: TAction;
Action24: TAction;
Action25: TAction;
Action26: TAction;
Action27: TAction;
Action28: TAction;
Action29: TAction;
ScrollBox1: TScrollBox;
ActionMainMenuBar1: TActionMainMenuBar;
Action34: TAction;
procedure pgcRepositoriesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure ActionMainMenuBar1Paint(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ActionMainMenuBar1GetPopupClass(Sender: TObject;
var PopupClass: TCustomPopupClass);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
public
end;
var
frmCodeTree: TfrmCodeTree;
implementation
{$R *.dfm}
procedure TfrmCodeTree.FormClose(Sender: TObject; var Action: TCloseAction);
begin
;//PostMessage(Handle, WM_CLOSE, 0, 0);
end;
procedure TfrmCodeTree.FormCreate(Sender: TObject);
//var
// ScrollBox1: TScrollBox;
begin
// The ActionMainMenuBar does not draw correctly in the title bar area. So DoubleBuffered must be enabled, and
// Transparent must be set to False
ScrollBox1.Parent := TitleBarPanel1;
ActionMainMenuBar1.Parent := ScrollBox1;
ActionMainMenuBar1.Align := altop;
ActionMainMenuBar1.DoubleBuffered := True;
ActionMainMenuBar1.Transparent := False;
ActionManager1.ActionBars[0].Items[0].Tag := 777;
end;
procedure TMyThemedPopupMenu.PositionPopup(AnOwner: TCustomActionBar; ParentItem: TCustomActionControl);
var
ParentItemPosition: TPoint;
begin
inherited;
var tag := TActionClientItem(ParentItem).Tag ;
if Assigned(AnOwner) and (AnOwner.Align = alBottom) and
(ParentItem.Caption = frmCodeTree.ActionManager1.ActionBars[0].Items[0].Caption) and
Assigned(ParentItem) and (ParentItem is TCustomMenuButton) then
begin
// ParentItemPosition := ParentItem.ClientToScreen(Point(0, 0));
//if (ParentItemPosition.Y < Top) and (0 <= Top - Height - ParentItem.Height) then
tag := TContainedAction(ParentItem).Tag ;
Left :=ParentItem.Width + Left ;
end;
end;
procedure TfrmCodeTree.ActionMainMenuBar1GetPopupClass(Sender: TObject;
var PopupClass: TCustomPopupClass);
begin
if PopupClass = TThemedPopupMenu then
PopupClass := TMyThemedPopupMenu;
end;
procedure TfrmCodeTree.ActionMainMenuBar1Paint(Sender: TObject);
begin
// Paint the background of the ActionMainMenuBar. Please note that for this app, the title bar is always the
// same color regardless of whether or not the app is active or inactive.
ActionMainMenuBar1.Canvas.Brush.Color := CustomTitleBar.BackgroundColor;
ActionMainMenuBar1.Canvas.FillRect( ActionMainMenuBar1.ClientRect );
end;
procedure TfrmCodeTree.pgcRepositoriesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
sc_DragMove = $F012;
begin
// This event handler allows the user to drag the form around when clicking on the background area of the tab control
ReleaseCapture;
Perform( wm_SysCommand, sc_DragMove, 0 );
end;
end.