TActionMainMenuBar con TPopupMenu, una pequeña retribución.
 

Hace unas semanas me ví en la necesidad de desplegar un TPopupMenu asociado a un TActionMainMenuBar y en Delphi 7,
este componente no trae la posibilidad de hacerlo.
La actualización 'no oficial' del componente, al menos a mí, no me funcionó. Así que hice unas líneas de código que lo logran.
Para usarlo sólo es necesario incluir en la cláusula uses de la interface la unidad PMenuAMMB.

Espero que pueda serle de utilidad a aquellos que usan Delphi 7.

Código Delphi [-]
unit PMenuAMMB;

interface

uses Windows, Messages, Controls, Menus, ActnMenus;

type
  TActionMainMenuBar = class(ActnMenus.TActionMainMenuBar)
  private
    FRect: TRect;
    FPopupMenu: TPopupMenu;
  public
    property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
    procedure MouseEvent(var Msg: TMsg; var Handled: Boolean);
    procedure GetRect;
  end;

implementation

{ +------------------------------------------------------+
  | MouseEvent: Obtiene posición actual del mouse  y     |
  |             despliega el TPopupMenu asociado si      |
  |             la posición está dentro del área que     |
  |             ocupa el ActionMainMenu.                 |
  +------------------------------------------------------+ }
procedure TActionMainMenuBar.MouseEvent(var Msg: TMsg; var Handled: Boolean);
var
  Pt: TPoint;
begin
  if Msg.message = WM_RBUTTONDOWN then // Botón derecho presionado ?
  begin
    Pt:= Mouse.CursorPos; // Obtener posición actual del mouse    
    if (Pt.X >= FRect.Left)and(Pt.Y >= FRect.Top)and // Está sobre el área ?
       (Pt.X <=FRect.Right)and(Pt.Y <= FRect.Bottom) then
      FPopupMenu.Popup(Pt.X, Pt.Y);                  // Desplegar PopupMenu
  end;
end;

{ +------------------------------------------------------+
  | GetRect: Obtiene las coordenadas de las esquinas     |
  |          superior izquierda e inferior derecha del   |
  | ActionMainMenu.                                      |
  | Las almacena en la variable privada FRect.           |
  +------------------------------------------------------+ }
procedure TActionMainMenuBar.GetRect;
var
  P: TPoint;
begin
  P:= ClientOrigin; // Coordenadas esquina superior izqierda
  FRect.Left:= P.X; // Coordenada horizontal esquina sup. izquierda
  FRect.Top:=  P.Y; // Coordenada vertical esquina sup. izquierda
  FRect.Right:= P.X + Width;   // Coordenada horizontal esquina inf. derecha
  FRect.Bottom:= P.Y + Height; // Coordenada vertical esquina inf. derecha
end;

Modo de uso:

Código Delphi [-]
Unit1;

interface

uses Windows,...,PMenuAMMB;

type
 TForm1 = class(TForm)
   ActionMainMenuBar1: TActionMainMenuBar;
   PopupMenu1: TPopupMenu; 
   ...
   procedure FormShow(Sender: TObject); 
 end;

implementation
 ...

procedure TForm1.FormShow(Sender: TObject);
begin
  ActionMainMenuBar1.PopupMenu:= PopupMenu1;
  Application.OnMessage:= ActionMainMenuBar1.MouseEvent;
  ActionMainMenuBar1.GetRect;
end;
...

Saludos. :)

¿Retribución/Contribución? ¿Desliz? ;)

Gracias por el código ecfisa.
Si te apetece puedes subirlo al FTP. Será una buena forma de no perderlo.

Hola Neftali.

No es un desliz, es precisamente eso: retribuir, compensar, gratificar mínimamente todo lo que me ha dado el Club. ;)

¿ No pensarías que esperaba una retribucion ???? jajaja :D:D:D

Te agradecería si me orientas un poco como subirlo al FTP.

Saludos. :)

Siguiendo el consejo y gracias a la ayuda de Casimiro el código ya está en el [ FTP ].

Saludos. :)

No, ya me imaginaba que no... ;):D:D:D:D:D

Más bien había pensado en lo otro... en un desliz. ;)
Gracias por el aporte.

Has instalado el TPopupActionBar incluido en dicha actualización???

Hola Delfino.

Si hablamos de la misma actualización, si. Después de muchas pruebas no pude hacer que funcione .
De todos modos ya no sigo buscando ya que el problema se solucionó con pocas líneas y sin componentes de terceros.
Igualmente agradezco muchísimo tu interés.

Saludos. :)

Lo he instalado varias veces sin ningún problema siguiendo las instrucciones. De todos modos a partir de Delphi2007 esta incluido en la paleta de componentes con todos los bugs corregidos..

Si Delfino, escuché que venía en las nuevas versiones y mejorado pero por ahora me están faltando $$$ para saltar a otra. :(
Tal vez el año entrante...

En realidad no lo utilizo por cuestión de estética si no por que necesitaba que en una aplicación corrieran varios TMainMenu y la solución fue
poner en cada MDIChild un TActionMainMenu si no; hubiera seguido con el TMainMenu...

Nuevamente muchas gracias por tu interés.

Un saludo. :)