メニュー項目を移動するには？ (ID:39681)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

1)  サブメニューへ移動するとメニューが消える
2)  サブメニューを持ってる項目に移動すると消える時と消えないときがある

unit Unit1;

interface

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

type

TPopupList = class(Menus.TPopupList)
  public
    procedure WndProc(var Message: TMessage); override;
  end;

TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    N221: TMenuItem;
    N34451: TMenuItem;
    N54351: TMenuItem;
    Memo1: TMemo;
    N61: TMenuItem;
    N111: TMenuItem;
    N121: TMenuItem;
    N131: TMenuItem;
    N211: TMenuItem;
    N222: TMenuItem;
    N231: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
  private
    { Private 宣言 }
  protected
  public
    { Public 宣言 }
  end;

const
    WH_MOUSE_LL = 14;

var
  Form1: TForm1;
  PopupList2 : TPopupList;
  SelectMenuID,DragSelectMenuID,DropSelectMenuID: Integer;
  isPopup : Boolean;
  isMouseDown: Boolean;
  isDragDrop : Boolean;

SelectPopupMenu: TPopupMenu;
  DragMenuItem,DropMenuItem: TMenuItem;

implementation

{$R *.DFM}

var
  MouseHookHandle : HHOOK;

procedure TPopupList.WndProc(var Message: TMessage);
begin
    inherited;

case Message.Msg of

WM_ENTERMENULOOP://$0211;
      begin
        SelectMenuID := -1;
        DragSelectMenuID := -2;
        IsPopup := True;
        isMouseDown := False;
        isDragDrop := False;
        DropMenuItem := nil;
        DragMenuItem := nil;
      end;

WM_MENUSELECT: //$11F
      begin
        SelectMenuID := Message.WParamLo;
      end;

WM_EXITMENULOOP://$0212;
      begin
        isPopup := False;
      end;

end;

procedure GetMenuItemRect(Value: TComponent; Index: Integer; var Result: TMenuItem);
var
    Rect: TRect;
    P: TPoint;
begin

P := Point(0, 0);
    GetCursorPos(P);

if Value is TPopupMenu then
    begin
      Windows.GetMenuItemRect(0, TPopupMenu(Value).Handle, Index, Rect);
      if (PtInRect(Rect, P)) then
      begin
        Result := TPopupMenu(Value).Items[Index]
      end;
    end;

if Value is TMenuItem then
    begin
      Windows.GetMenuItemRect(0 , TMenuItem(Value).Parent.Handle , Index, Rect);
      if (PtInRect(Rect, P)) then
      begin
        Result := TMenuItem(Value).Parent.Items[Index];
      end;
    end;

end;

procedure GetMenuItem(Value: TComponent; Index: Integer; var Result: TMenuItem);
var
    I,J: Integer;
begin

if Value is TPopupMenu then
    begin
      for I:=0 to TPopupMenu(Value).Items.Count -1 do
      begin
        if Assigned(Result) = False then
        begin
          GetMenuItemRect (Value,I,Result);
          for J:=0 to TPopupMenu(Value).Items[I].Count - 1 do
          begin
            GetMenuItem(TPopupMenu(Value).Items[I].Items[J],J,Result);
          end;
        end;
      end;
    end;

if Value is TMenuItem then
    begin
      if Assigned(Result) = False then
      begin
        GetMenuItemRect (Value,Index,Result);
        for I:=0 to TMenuItem(Value).Count -1 do
        begin
          GetMenuItem(TMenuItem(Value).Items[I],I,Result);
        end;
      end;
    end;

end;

function MouseHook(nCode: Integer; WParam: wParam; LParam: lParam): Integer; stdcall;

function _GetMenuItem: TMenuItem;
    begin
      Result := nil;
      if Assigned(SelectPopupMenu) = True then
      begin
        GetMenuItem(SelectPopupMenu,0,Result);
      end;
    end;

procedure ButtonDown;
    begin
      DragSelectMenuID := SelectMenuID;
      isMouseDown := True;
      isDragDrop := False;
      DragMenuItem := _GetMenuItem;
    end;

procedure ButtonUp;
    var
        MI: TMenuItem;
        isParent: Boolean;
    begin
      Windows.SetCursor(Screen.Cursors[crDefault]);
      if isDragDrop = True then
      begin
        DropSelectMenuID := SelectMenuID;

if DragSelectMenuID <> DropSelectMenuID then
        begin
          DropMenuItem := _GetMenuItem;
          if (Assigned(DragMenuItem) = True) and (Assigned(DropMenuItem) = True) then
          begin
            if DragMenuItem.Parent = DropMenuItem.Parent then
            begin
              if DropMenuItem.MenuIndex <> DragMenuItem.MenuIndex then
              begin
                DragMenuItem.MenuIndex := DropMenuItem.MenuIndex;
              end
            end
            else
            begin
              isParent := False;
              MI := DropMenuItem;
              while MI <> SelectPopupMenu.Items do
              begin
                if DragMenuItem = MI then isParent := True;
                MI := MI.Parent;
              end;
              if isParent = False then
              begin
                DragMenuItem.Parent.Delete(DragMenuItem.MenuIndex);
                DropMenuItem.Parent.Insert(DropMenuItem.MenuIndex,DragMenuItem);
              end
              else
              begin
                //子や孫にはコピーできない
              end;
            end;
          end;
          Result := 1;
        end;

end;
      isMouseDown := False;
    end;

begin

Result := 0;

if IsPopup = True then
  begin
    if nCode = HC_ACTION then
    begin
      case WParam of
        WM_LBUTTONDOWN:
        begin
         if (GetSystemMetrics(SM_SWAPBUTTON) = 0) then ButtonDown;
        end;
        WM_RBUTTONDOWN:
        begin
         if (GetSystemMetrics(SM_SWAPBUTTON) <> 0) then ButtonDown;
        end;
        WM_MOUSEMOVE:
        begin
          if isMouseDown = True then
          begin
            SetCursor(Screen.Cursors[crDrag]);
            isDragDrop := True;
          end;
        end;
        WM_LBUTTONUP:
        begin
          if (GetSystemMetrics(SM_SWAPBUTTON) = 0) then ButtonUp;
          if isDragDrop = True then Result := 1;
        end;
        WM_RBUTTONUP:
        begin
          if (GetSystemMetrics(SM_SWAPBUTTON) <> 0) then ButtonUp;
          if isDragDrop = True then Result := 1;
        end;
      end;
    end;
  end;

if Result = 0 then
  begin
    Result := CallNextHookEx(MouseHookHandle, nCode, wParam, lParam);
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
    I: Integer;
begin
    PopupList2 := TPopupList(PopupList);
    PopupList  := TPopupList.Create;
    for I:=0 to PopupList2.Count -1 do
    begin
      PopupList.Add(TPopupMenu(PopupList2.Get(I)));
    end;
    MouseHookHandle := SetWindowsHookEx(WH_MOUSE_LL,@MouseHook,hInstance,0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    PopupList.Free;
    PopupList := TPopupList(PopupList2);
    UnhookWindowsHookEx(MouseHookHandle);
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
    SelectPopupMenu := PopupMenu1;
end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る