…вызов popup-меню связан с координатами экрана. Координаты, получаемые в вашем обрабочике события, вероятно относятся к объекту, который создал это сообщение. Для преобразования координат вам необходимо воспользоваться функцией ClientToScreen.
Вот пример вызова контекстного меню, вызываемого при щелчке правой кнопкой мыши на узле TTreeView. Этот пример не в точности отвечает на ваш вопрос, но у меня нет желания расчитывать wParams прямо сейчас. Я думаю вы можете воспользоваться предложенной мною идеей и развить ее в нужном направлении.
procedureTfrmExplorer.TreeViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var P : TPoint;
begin
if Button<>mbRight then exit;
TreeMenu.AutoPopup := False;
if TreeView.GetNodeAt(X,Y)<>NIL then begin
TreeView.Selected := TreeView.GetNodeAt(X,Y);
P.X := X;
P.Y:=Y;
P := TreeView.ClientToScreen(P);
TreeMenu.Popup(P.X,P.Y);
end;
end;
Delphi 2
type TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem; /**** Элемент для Menu Bar ****/
Open1: TMenuItem; /**** Элемент для Menu File ****/
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{private declarations}
public
{public declarations}
Icn, Txt, MnuItm: TBitmap;
end;
procedure TForm2.FormCreate(Sender: TObject);
var
R: TRect;
HIcn: HIcon;
Ic: TIcon;
Index: Word;
FileName: PChar;
begin
/** Получаем иконку определенного приложения **/
Ic:=TIcon.Create;
Ic.Handle:=ExtractAssociatedIcon(Hinstance, /* задаем путь и имя файла */, Index);
/** Создаем для текста изображение **/
Txt:=TBitmap.Create;
with Txt do begin
Width:=Canvas.TextWidth(' Тест');
Height:=Canvas.TextHeight(' Тест');
Canvas.TextOut(0, 0, ' Тест');
end;
/** Копируем иконку в bitmap для изменения его размера. Вы не можете менять размер иконки **/
Icn:=TBitmap.Create;
with Icn do begin
Width:=32;
Height:=32;
Brush.Color:=clBtnFace;
Canvas.Draw(0, 0, Ic);
end;
/** Создаем окончательное изображение, куда мы помещаем иконку и текст **/
MnuItm:=TBitmap.Create;
with MnuItm do begin
Width:=Txt.Width+18;
Height:=18;
with Canvas do begin
Brush.Color:=clBtnFace;
Pen.Color:=clBtnFace;
Brush.Style:=bsSolid;
Rectangle(0, 0, Width, Height);
CopyMode:=cmSrcAnd;
StretchDraw(Rect(0, 0, 16, 16), Icn);
CopyMode:=cmSrcAnd;
Draw(16, 8-(Txt.Height div 2), Txt);
end;
end;
end;
procedure TForm2.FormShow(Sender: TObject);
var
ItemInfo: TMenuItemInfo;
hBmp1 : THandle;
begin
HBmp1:=MnuItm.Handle;
with ItemInfo do begin
cbSize := SizeOf(ItemInfo);
fMask := MIIM_TYPE;
fType := MFT_BITMAP;
dwTypeData := PChar(MakeLong(hBmp1, 0));
end;
/** Заменяем MenuItem Open1 законченным изображением **/
SetMenuItemInfo(GetSubMenu(MainMenu1.Handle, File1.MenuIndex), Open1.MenuIndex, true, ItemInfo);
end;
В меню существуют некоторые проблемы масштабированием и палитрой иконки. Я также ищу лучшее решение, но это все, что я вам могу сейчас дать.