Перехват сообщений от мыши в меню -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [3.149.255.162]

Модераторы: jack128, Rouse_, Krid

Перехват сообщений от мыши в меню

Krid

Сообщ. #1 , 23.01.05, 14:50

Moderator

Профиль · PM

Рейтинг (т): 237

Цитата s-mike @ 23.01.05, 11:40

я так понимаю ты хочешь сделать, чтобы как в меню Пуск по нажатию правой кнопки мыши выводилось контекстное меню

Вот как это можно сделать:
cm_frm.pas

unit cm_frm;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, StdCtrls;

type

TForm1 = class(TForm)

PopupMenu1: TPopupMenu;

Color1: TMenuItem;

Font1: TMenuItem;

fddfd1: TMenuItem;

MainMenu1: TMainMenu;

File1: TMenuItem;

Open1: TMenuItem;

N1: TMenuItem;

Edit1: TMenuItem;

Copy1: TMenuItem;

Past1: TMenuItem;

Close1: TMenuItem;

Info1: TMenuItem;

Button1: TButton;

AddPopup1: TMenuItem;

Settings1: TMenuItem;

Run1: TMenuItem;

Description1: TMenuItem;

procedure Info1Click(Sender: TObject);

procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormCreate(Sender: TObject);

private

fCurItemIndex:Integer;

fCurItemHandle:HMENU;

procedure WMRMenuButtonUp(var M: TMessage); message WM_MENURBUTTONUP;

public

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.WMRMenuButtonUp(var M: TMessage);

var

pt:TPoint;

ncmd:DWORD;

begin

fCurItemIndex:=M.WParam;

fCurItemHandle:=M.LParam;

if fCurItemHandle=GetSystemMenu(Handle,false) then exit;

if (fCurItemHandle=MainMenu1.Items[0].Handle) and (fCurItemIndex=1) then exit;

GetCursorPos(pt);

ncmd:=DWORD(TrackPopupMenu(PopupMenu1.Handle,TPM_LEFTALIGN or TPM_RIGHTBUTTON or TPM_RETURNCMD or TPM_RECURSE,

pt.X,pt.Y,0,Handle,nil));

PostMessage(Handle, WM_NULL, 0, 0);

if ncmd = Info1.Command then Info1Click(Info1);

end;

procedure TForm1.Info1Click(Sender: TObject);

var

n:integer;

begin

if fCurItemHandle=MainMenu1.Items[0].Handle then n:=0 else

if fCurItemHandle=MainMenu1.Items[1].Handle then n:=1 else

if fCurItemHandle=MainMenu1.Items[2].Handle then n:=2;

ShowMessage('ContextMenu for '+MainMenu1.Items[n].Caption+'|'+MainMenu1.Items[n].Items[fCurItemIndex].Caption)

end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

pt:TPoint;

begin

if Button=mbRight then

begin

GetCursorPos(pt);

TrackPopupMenu(MainMenu1.Items[2].Handle,TPM_LEFTALIGN or TPM_LEFTBUTTON,

pt.X,pt.Y,0,Handle,nil)

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

RemoveMenu(MainMenu1.Handle,2,MF_BYPOSITION)

end;

end.

cm_frm.dfm

object Form1: TForm1

Left = 318

Top = 121

Width = 657

Height = 312

Caption = 'Form1'

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

Menu = MainMenu1

OldCreateOrder = False

OnCreate = FormCreate

PixelsPerInch = 96

TextHeight = 13

object Button1: TButton

Left = 248

Top = 104

Width = 75

Height = 25

Caption = 'Button1'

TabOrder = 0

OnMouseUp = Button1MouseUp

end

object PopupMenu1: TPopupMenu

Left = 416

Top = 88

object Color1: TMenuItem

Caption = '&Color'

end

object Font1: TMenuItem

Caption = '&Font'

end

object fddfd1: TMenuItem

Caption = '-'

end

object Info1: TMenuItem

Caption = '&Info'

OnClick = Info1Click

end

object MainMenu1: TMainMenu

Left = 408

Top = 24

object File1: TMenuItem

Caption = 'File'

object Open1: TMenuItem

Caption = '&Open'

end

object N1: TMenuItem

Caption = '-'

end

object Close1: TMenuItem

Caption = '&Close'

end

object Edit1: TMenuItem

Caption = 'Edit'

object Copy1: TMenuItem

Caption = '&Copy'

end

object Past1: TMenuItem

Caption = '&Past'

end

object AddPopup1: TMenuItem

Caption = 'AddPopup'

object Settings1: TMenuItem

Caption = '&Settings'

end

object Run1: TMenuItem

Caption = '&Run'

end

object Description1: TMenuItem

Caption = '&Description'

end

Контекстное меню по правой кнопке появляется для MenuItem'ов и у MainMenu и у PopupMenu компонента (в данном случае кнопки).
PopupMenu для кнопки является частью MainMenu (у самого MainMenu этого меню не видно).

Это сообщение было перенесено сюда или объединено из темы "Перехват сообщений от мыши в TPopupMenu"

0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0205 ] [ 16 queries used ] [ Generated: 27.04.24, 07:05 GMT ]