http://www.borland.co.jp/qanda/delphi/d0009472.html
で紹介されているTMenuBarコンポーネントですが、
動的なサブメニューの追加（ファイル履歴など）が
やりやすいようにOnInitMenuイベントを追加してみました。

マウスのクリック、ホットキー、Alt状態からのエンターキー
のどれからでも呼び出されるように
WndProc, TrackMenuをoverrideしています。


unit MenuBar;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
Dialogs,
  ToolWin, ComCtrls, Menus;

type
  TMenuBar = class(TToolBar)
  private
    FMenu: TMainMenu;
    FOnInitMenu: TNotifyEvent;
    procedure SetMenu(const Value: TMainMenu);
  protected
    procedure DoInitMenu; dynamic;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); 
override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    function TrackMenu(Button: TToolButton): boolean; override;
  published
    property EdgeBorders default []; // 見た目悪いので修正
    property Menu: TMainMenu read FMenu write SetMenu;
    property OnInitMenu: TNotifyEvent read FOnInitMenu write 
FOnInitMenu;
  end;


implementation

{ TMenuBar }

constructor TMenuBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Flat := True;
  ShowCaptions := True;
  EdgeBorders := [];
  ControlStyle := [csCaptureMouse, csClickEvents,
    csDoubleClicks, csMenuEvents, csSetCaption];
end;


procedure TMenuBar.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;

procedure TMenuBar.SetMenu(const Value: TMainMenu);
var
  i: Integer;
  Button: TToolButton;
begin
  if FMenu = Value then exit;
  if Assigned(FMenu) then
    for i := ButtonCount - 1 downto 0 do
      Buttons[i].Free;
  FMenu := Value;
  if not Assigned(FMenu) then exit;
  for i := ButtonCount to FMenu.Items.Count - 1 do
  begin
    Button := TToolButton.Create(Self);
    try
      Button.AutoSize := True;
      Button.Grouped := True;
      Button.Parent := Self;
      Buttons[i].MenuItem := FMenu.Items[i];
    except
      Button.Free;
      raise;
    end;
  end;
  { Copy attributes from each menu item }
  for i := 0 to FMenu.Items.Count - 1 do
    Buttons[i].MenuItem := FMenu.Items[i];
end;

procedure TMenuBar.DoInitMenu;
begin
  if Assigned(FOnInitMenu) then
    FOnInitMenu(Self);
end;

function TMenuBar.TrackMenu(Button: TToolButton): boolean;
begin
  DoInitMenu;
  Result := inherited TrackMenu(Button);
end;

procedure TMenuBar.WndProc(var Message: TMessage);
var
  Control: TControl;
  CapControl: TControl;

  function IsToolButtonMouseMsg(var Message: TWMMouse): Boolean;
  begin
    if GetCapture = Handle then
    begin
      CapControl := GetCaptureControl;
      if (CapControl <> nil) and (CapControl.Parent <> Self) then
        CapControl := nil;
    end
    else
      CapControl := nil;
    Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
    Result := (Control <> nil) and (Control is TToolButton) and
      not Control.Dragging;
  end;
begin
  if not (csDesigning in ComponentState) and 
         (Message.Msg = WM_LBUTTONDOWN) and
         IsToolButtonMouseMsg(TWMMouse(Message)) then
    DoInitMenu;
  inherited;
end;

end.


                    2002/03/23(Sat) 11:19PM  tach(YIU01245)
 


- FDELPHI  MES(16):玉石混淆みんなで作るSample蔵【見本蓄積】 02/04/10 -

Original document by tach            氏 ID:(YIU01245)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。