Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Высота PopupMenu, Как узнать высоту PopupMenu 
:(
    Опции темы
Alex
Дата 10.10.2004, 20:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162
Цитата(Pakshin @ 9.10.2004, 19:14)
А что тут такого? 
Вот пример для обычного меню:
H:=6 + ColItems*17
В другом компоненте будет поправка на шрифт... 

Да не поправка на шрифт должна быть и в стандартном компоненте, т.к. у пользователя может стоять крупный шрифт или вообще другой шрифт для интерфейса.


--------------------
Написать можно все - главное четко представлять, что ты хочешь получить в конце. 
PM Skype   Вверх
Pakshin A. S.
Дата 11.10.2004, 18:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 5056
Регистрация: 16.2.2003

Репутация: 21
Всего: 61
А вот это не учел... stena.gif
PM   Вверх
x77
Дата 12.10.2004, 16:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1255
Регистрация: 25.3.2002

Репутация: 19
Всего: 22
а если так:

Код

var
 Form1: TForm1;
 MenuHeight: integer;

implementation

{$R *.dfm}

// вычисляем размер всех пунктов
procedure TForm1.N31MeasureItem(Sender: TObject; ACanvas: TCanvas;
 var Width, Height: Integer);
begin
 with (Sender as TMenuItem), ACanvas do begin
   Font.Size := MenuIndex * 10;
   Width := TextWidth (Caption);
   Height := TextHeight (Caption);
   if MenuIndex = 0 then
     MenuHeight := 0;
   Inc (MenuHeight, Height);
 end;
end;

// все пункты рисуем шрифтом разного размера
procedure TForm1.N31DrawItem(Sender: TObject; ACanvas: TCanvas;
 ARect: TRect; Selected: Boolean);
begin
 with (Sender as TMenuItem), ACanvas do begin
   Font.Size := MenuIndex * 10;
   TextOut (ARect.Left, ARect.Top, Caption);
 end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
var
 p: TPoint;
begin
 p.X := X;
 p.Y := Y;
 p := ClientToScreen (p);
 if Button = mbRight then
   PopupMenu1.Popup(p.X, p.Y - MenuHeight);
end;


есс-но, у поп-апа OwnerDraw = TRUE и AutoPopup = FALSE. в принципе, работает. можно наверное и ещё подогнать, если учитывать GetSystemMetrics (SM_CYEDGE, SM_CYBORDER и им подобные), но это я уже не пробовал.
Добавлено @ 16:07
кстати о GetSystemMetrics. если заведомо известно, что пункты меню рисуются стандартным шрифтом винды (пофигу, какого он там размера), то высоту менюшки можно получить как GetSystemMetrics (SM_CYMENU) * PopupMenu1.Items.Count


--------------------
Я никогда не сопротивлялся искушению, поскольку узнал: что мне
не нравится, то меня не искушает. © Джордж Бернард Шоу (Ирландия)
PM MAIL ICQ   Вверх
Girder
Дата 12.10.2004, 18:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Лентяй 2
***


Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 31
Всего: 155
Через Timer замутил... smile.gif
Код
....
var
 Form1: TForm1;
 FPM:Boolean;
 PointPM:TPoint;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var P:TPoint;
begin
FPM:=false;
getCursorPos(P);
PointPM:=P;
PopupMenu1.OnPopup:=PopupMenu1Popup;
PopupMenu1.Popup(p.X,p.Y);
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
if FPM=true then exit;
Timer1.Interval:=10;
Timer1.OnTimer:=Timer1Timer;
Timer1.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,X,Y:integer;
   R:TRect;
begin
if FPM=true then
 begin
   PopupMenu1.Popup(PointPM.X,PointPM.Y);
   Timer1.Enabled:=false;
   exit;
 end;
i:=PopupMenu1.Items.Count;
X:=0;
Y:=0;
R:=Rect(0,0,0,0);
while (i>0) do
 begin
  dec(i);
  R:=Rect(0,0,0,0);
  GetMenuItemRect(0,PopupMenu1.Handle,i,R);
  Y:=Y+(R.Bottom-R.Top);
 end;
X:=(R.Right-R.Left);
Caption:='Ширина:'+IntToStr(X)+'; Высота:'+IntToStr(Y);
FPM:=true;
EndMenu;
PointPM.X:=PointPM.X-X;
PointPM.Y:=PointPM.Y-Y;
end;
...


PS: Не зависит от стиля пункта меню, его шрифтов и картинок в меню... не учитывается только отступ

Это сообщение отредактировал(а) Girder - 12.10.2004, 22:00


--------------------
Как слышим, так и пишим.
Истина где-то там...
PM   Вверх
x77
Дата 12.10.2004, 18:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1255
Регистрация: 25.3.2002

Репутация: 19
Всего: 22
круто smile.gif

только не совсем понятно, зачем вообще здесь таймер?
Добавлено @ 18:42

у меня после всех мучений получилось так:

Код
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
var
 p: TPoint;
begin
 p.X := X;
 p.Y := Y;
 p := ClientToScreen (p);
 if Button = mbRight then
   PopupMenu1.Popup(p.X, p.Y - GetSystemMetrics (SM_CYMENU) * PopupMenu1.Items.Count);
end;


работает, если все пункты выводятся одинаковым шрифтом. а если рисовать вручную, да разными шрифтами - то и просчитывать придётся вручную, но это тоже довольно легко.


--------------------
Я никогда не сопротивлялся искушению, поскольку узнал: что мне
не нравится, то меня не искушает. © Джордж Бернард Шоу (Ирландия)
PM MAIL ICQ   Вверх
deMike
Дата 12.10.2004, 22:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


M.Shinoda
**


Профиль
Группа: Участник
Сообщений: 361
Регистрация: 12.10.2004
Где: Санкт-Петербург

Репутация: нет
Всего: 0
Цитата
Можно с ума сойти...

Согласен! А если 100 пунктов или 1000! biggrin.gif biggrin.gif biggrin.gif
PM MAIL WWW   Вверх
Girder
Дата 13.10.2004, 10:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Лентяй 2
***


Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 31
Всего: 155
Цитата(x77 @ 12.10.2004, 18:39)
только не совсем понятно, зачем вообще здесь таймер?

smile.gif Вот и я не понял причем здесь ширина... высота... текста(TextWidth, TextHeight) и еже с ними...

Можно и так...
(При этом не забыв повесить на OnPopup обработчик PopupMenu1Popup):
Код
 TGetPMRect = class(TThread)
 private
   { Private declarations }
   PMDisplacement:TPoint; //Необходимое смещение PopupMenu
   Wnd:THandle; //хэндл текущего окна
 protected
   procedure Execute; override;
 end;
...
procedure TGetPMRect.Execute;
var bMem:Pointer;
   h,h1,SysShadow,PM:THandle;
   pID,tPID,wExStyle,wStyle:Cardinal;
   f:boolean;
   i:integer;
   s:string;
   ssRect,pmRect:TRect;
   SizeWinPM,SizeWinSS:TPoint;
begin
pID:=0;
GetWindowThreadProcessId(Wnd,@pID);
try
 GetMem(bMem,256);
except
 bMem:=nil;
end;
if (bMem=nil)or(pID=0) then exit;
f:=true;
while ((Terminated=false)and f) do
 begin
  h1:=Wnd;
  repeat
   h:=GetWindow(h1,GW_OWNER);
   if h<>0 then h1:=h;
  until(h=0);
  h:=GetWindow(h1,GW_HWNDFIRST);
  while (h<>0) do
   begin
    tPID:=0;
    GetWindowThreadProcessId(h,@tpID);
    wExStyle:=GetWindowLong(h,GWL_EXSTYLE);
    wStyle:=GetWindowLong(h,GWL_STYLE);
    if (tpID=pID)and((wStyle and WS_VISIBLE)=WS_VISIBLE)and
       ((wExStyle and WS_EX_TOPMOST)=WS_EX_TOPMOST) then
     begin
      i:=GetClassName(h,bMem,255);
      s:=trim(Copy(PChar(bMem),0,i));
      if s[1]='#' then
       begin
        PM:=h; //Дискрептор PopupMenu
        SysShadow:=FindWindow('SysShadow',nil); //Дискрептор тени PopupMenu
        tPID:=0;
        GetWindowThreadProcessId(Wnd,@tpID);
        if tpID<>pID then SysShadow:=0;
        ssRect:=Rect(0,0,0,0);
        pmRect:=Rect(0,0,0,0);
        if Windows.GetWindowRect(PM,pmRect) then
         begin
          f:=false;
          SizeWinPM:=Point(pmRect.Right-pmRect.Left,pmRect.Bottom-pmRect.Top); //Размеры PopupMenu
          if (SysShadow<>0)then
           begin
            Windows.GetWindowRect(SysShadow,ssRect);
            SizeWinSS:=Point(ssRect.Right-ssRect.Left,ssRect.Bottom-ssRect.Top); //Размеры тени PopupMenu
           end;
          {Start: Изврат :) }
          Sleep(500);
          MoveWindow(PM,pmRect.Left-SizeWinPM.X,pmRect.Top,SizeWinPM.X,SizeWinPM.Y,True); //Тень перемещается АВТОМАТОМ! :)
          Sleep(500);
          MoveWindow(PM,pmRect.Left-SizeWinPM.X,pmRect.Top-SizeWinPM.Y,SizeWinPM.X,SizeWinPM.Y,True); //Тень перемещается АВТОМАТОМ! :)
          Sleep(500);
          MoveWindow(PM,pmRect.Left,pmRect.Top-SizeWinPM.Y,SizeWinPM.X,SizeWinPM.Y,True); //Тень перемещается АВТОМАТОМ! :)
          Sleep(500);
          MoveWindow(PM,pmRect.Left,pmRect.Top,SizeWinPM.X,SizeWinPM.Y,True); //Тень перемещается АВТОМАТОМ! :)
          Sleep(500);
          i:=1;
          while (i<SizeWinPM.X) do
           begin
            MoveWindow(PM,pmRect.Left-i,pmRect.Top,SizeWinPM.X,SizeWinPM.Y,True);
            MoveWindow(SysShadow,ssRect.Left+i,ssRect.Top,SizeWinSS.X,SizeWinSS.Y,True); //Тень перемещаем апосля :)
            inc(i);
            sleep(100);
           end;
          Sleep(500);
          MoveWindow(PM,pmRect.Left,pmRect.Top,SizeWinPM.X,SizeWinPM.Y,True); //Тень перемещается АВТОМАТОМ! :)
          Sleep(500);
          {End: Изврат :) }
          //Делаем заданное смещение :)
          MoveWindow(PM,pmRect.Left+PMDisplacement.X,pmRect.Top+PMDisplacement.Y,SizeWinPM.X,SizeWinPM.Y,True); //Тень перемещается АВТОМАТОМ! :)
         end;
       end;
     end;
    h:=GetWindow(h,gw_hWndNext);
   end;
 end;
FreeMem(bMem,256);
end;


procedure TForm1.PopupMenu1Popup(Sender: TObject);
var GetPMRect:TGetPMRect;
begin
GetPMRect:=TGetPMRect.Create(True);
GetPMRect.PMDisplacement:=Point(-100,-100);
GetPMRect.Wnd:=Handle;
GetPMRect.FreeOnTerminate:=true;
GetPMRect.Resume;
end;
...


Это сообщение отредактировал(а) Girder - 13.10.2004, 11:10


--------------------
Как слышим, так и пишим.
Истина где-то там...
PM   Вверх
x77
Дата 14.10.2004, 11:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1255
Регистрация: 25.3.2002

Репутация: 19
Всего: 22
речь идёт о высоте меню, или я чего не понимаю? высота одного пункта меню, нарисованного стандартным шрифтом, храниться в ресстре. умножьте её на кол-во пунктов - и получите полную высоту меню - N пикселов на бордюр. N, опять таки, храниться в ресстре.

объясните мне, ущербному, зачем все эти извраты?


--------------------
Я никогда не сопротивлялся искушению, поскольку узнал: что мне
не нравится, то меня не искушает. © Джордж Бернард Шоу (Ирландия)
PM MAIL ICQ   Вверх
Girder
Дата 14.10.2004, 11:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Лентяй 2
***


Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 31
Всего: 155
А если ручками smile.gif модифицировать свойства пункта?
Тем более сегодня высота... завтра и ширина понадобится... а тут уже и картинки и все такое...


--------------------
Как слышим, так и пишим.
Истина где-то там...
PM   Вверх
x77
Дата 14.10.2004, 12:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Участник Клуба
Сообщений: 1255
Регистрация: 25.3.2002

Репутация: 19
Всего: 22
Girder, да и бог с ним. создаём виртуальную канву, назначаем ей нужные для итема свойства, в цикле измеряем все итемы, и получаем высоту. почти то же самое я делал в OnMeasureItem - просто замерял высоту шрифта для каждого пункта, которая может быть разной. но там будет проблема - при первом запуске MenuHeight равно нулю. т.е. проще перед вызовом Popup в какой-то функии отрисовать меню на виртуальной канве и получить таким образом его высоту.



--------------------
Я никогда не сопротивлялся искушению, поскольку узнал: что мне
не нравится, то меня не искушает. © Джордж Бернард Шоу (Ирландия)
PM MAIL ICQ   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0670 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.