Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2011.10.02;
Скачать: [xml.tar.bz2];

Вниз

Создание кнопок и меню в рантайм   Найти похожие ветки 

 
Exterr   (2011-06-10 21:23) [0]

В программе в рантайме создаются SpedButton"ы и PopupMenu. Пункты меню тоже строятся динамически. Надо сделать что-бы по Л.клику выпадало меню. Только как связать каждую кнопку и соответствующее ему меню не соображу. Подскажете пожалуйста.


procedure CreateHDDBtn;
var
 Drv: Char;
 DrvType: Integer;
 DiskBtn : TsSpeedButton;
 DiskMenu : TPopupMenu;
 DiskItem : TMenuItem;
 i : Char;
begin
 for i := "A" to "Z" do begin
   DrvType := GetDriveType(PChar(i + ":\"));
   if DrvType = DRIVE_FIXED then begin
     DiskBtn := TsSpeedButton.Create(DiskPanel);
     DiskMenu := TPopupMenu.Create(DiskBtn);
     DiskItem := TMenuItem.Create(DiskMenu);
     DiskItem.Caption := RC_EmptyItem;
     DiskMenu.Items.Add(DiskItem);

     with DiskBtn do begin
       Parent := DiskPanel;
       Top := 0;
       Left := DiskPanel.Tag * 24;
       Caption := i ;
       hint := i + ":\";
       Height := 24;
       Width := 24;
       Visible := true;
     end;
     DiskPanel.Tag := DiskPanel.Tag + 1;
   end;
 end;
end;


 
Loginov Dmitry ©   (2011-06-10 21:43) [1]

У SpeedButton (равно как и у любого визуального компонента) есть прекрасное свойство "PopupMenu". Этому свойству вполне логично присваивать созданный DiskMenu. При нажатии на кнопке ЛКМ для отображения меню на экране достаточно вызвать метод MyButton.PopupMenu.Popup()


 
Exterr   (2011-06-10 21:56) [2]

Так и сделал только конструкция выглядит ужасно, думал может есть способ попроще.

       DiskBtn.PopupMenu := DiskMenu;
       DiskBtn.OnClick := DiskSpeedBtnClick;


 
procedure DiskSpeedBtnClick(Sender: TObject);
begin
 DynBuild((sender as TsSpeedButton).PopupMenu.Items, (sender as TsSpeedButton).Hint);

 sSkinManager1.SkinableMenus.HookPopupMenu((sender as TsSpeedButton).PopupMenu, True);

 (sender as TsSpeedButton).PopupMenu.Popup
 ( DiskPanel.Left + ((sender as TsSpeedButton).Left),
 (sender as TsSpeedButton).Top + (sender as TsSpeedButton).Height);
end;


Спасибо!


 
Юрий Зотов ©   (2011-06-10 22:50) [3]

> Exterr   (10.06.11 21:56) [2]
> конструкция выглядит ужасно, думал может есть способ попроще

В код не вникал, а конструкцию упростить можно:

procedure DiskSpeedBtnClick(Sender: TObject);
var
 sb: TsSpeedButton;
begin
 sb := sender as TsSpeedButton;
 DynBuild(sb.PopupMenu.Items, sb.Hint);
 sSkinManager1.SkinableMenus.HookPopupMenu(sb.PopupMenu, True);
 sb.PopupMenu.Popup(DiskPanel.Left + sb.Left, sb.Top + sb.Height);
end;


 
Exterr   (2011-06-11 07:12) [4]

Спасибо, так более читаемо будет.


 
Юрий Зотов ©   (2011-06-11 09:31) [5]


> Exterr   (11.06.11 07:12) [4]

И работать будет чуть-чуть быстрее - ведь при каждом AS выполняется проверка типа, а на нее тратится время.


 
sniknik ©   (2011-06-11 10:37) [6]

procedure DiskSpeedBtnClick(Sender: TObject);
begin
 with sender as TsSpeedButton do begin
   DynBuild(PopupMenu.Items, Hint);
   sSkinManager1.SkinableMenus.HookPopupMenu(PopupMenu, True);
   PopupMenu.Popup(DiskPanel.Left + Left, Top + Height);
 end"
end;



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2011.10.02;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.003 c
2-1307690430
@!!ex
2011-06-10 11:20
2011.10.02
Кнопки и PageControl игнорируются Font.Charset


15-1307548488
Rouse_
2011-06-08 19:54
2011.10.02
Может и боян, но все-же хочется поделиться ссылочкой :)


15-1307430272
RGV
2011-06-07 11:04
2011.10.02
Актуальность Delphi.


15-1307587555
Дмитрий С
2011-06-09 06:45
2011.10.02
Как запретить всяким quicktime, vlc, acrobat-ам регистрироваться


2-1307976499
Push
2011-06-13 18:48
2011.10.02
ПРоверака логина и пароля





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский