VPF::Правя кнопка и edit - Форум программистов

mosha

Дата 9.2.2006, 13:15 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

Репутация: нет
Всего: нет

Как сделать так, чтобы при нажатии правой кнопки на edit выпадало меню?

_hunter

Дата 9.2.2006, 13:34 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 15
Всего: 98

положи на форму PopupMenu и заполни им соответствующее свойство Edit' а

--------------------

Tempora mutantur, et nos mutamur in illis...

mosha

Дата 9.2.2006, 13:44 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

Репутация: нет
Всего: нет

И еще надо, чтоб вводить данные в edit можно было только с этого выпадающего меню. Т.е. чтоб с клавы нельзя было. И курсор чтоб ставить нельзя было.

Это сообщение отредактировал(а) mosha - 9.2.2006, 13:46

Romikgy

Дата 9.2.2006, 13:55 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7325
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

Мож тогда комбобокс юзать?

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

mosha

Дата 9.2.2006, 14:00 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

Репутация: нет
Всего: нет

Нет. Там менюшка разветвленная.

Romikgy

Дата 9.2.2006, 16:23 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7325
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

Хорошо , юзай эдит, но поставь ему свойство не редактируемый, и вызывай попап
Добавлено @ 16:26
Допустим ReadOnly:=true;

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

mosha

Дата 9.2.2006, 16:30 (ссылка)

(нет голосов)

Загрузка ...

Новичок

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

Репутация: нет
Всего: нет

Я поставил. А еще надо чтоб туда не ставился курсор. я поставил enabled:=false. Но тогда не выподает меню.

Romikgy

Дата 9.2.2006, 16:45 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7325
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

Свойство TabStop:=false; и чтоб долго не мучатся

Код


procedure TForm1.Edit1Enter(Sender: TObject);
begin
BitBtn1.SetFocus
end;

Вместо битбтн любой видимый компонент

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Snowy

Дата 9.2.2006, 17:12 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Цитата(Romikgy @ 9.2.2006, 16:45

)

Вместо битбтн любой видимый компонент

Или, как альтернатива:

Код

ActiveControl := nil;

- так пусть же фокус не достанется никому! smile

Romikgy

Дата 9.2.2006, 17:42 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7325
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

Цитата(Snowy @ 9.2.2006, 16:12

)

так пусть же фокус не достанется никому

Уф

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

bems

Дата 9.2.2006, 21:30 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 31
Всего: 88

Вот нашкрябал левой задней и выношу на всеобщее обозрение. Может кто-то из спецов исправит чтобы корректно выгружалось.

Код


unit ComboWithMenu;

interface
uses windows,messages,SysUtils,classes,controls,StdCtrls,Menus;
type
 TComboWithMenu=class;
 TTextChengeEvent=procedure (sender:TComboWithMenu;const OldText:string;var NewText:string;AItem:TMenuItem) of object;
 TComboWithMenu=class(TComboBox)
                private
                 FDDMenu:TPopupMenu;
                 FOnTxtChng:TTextChengeEvent;
                 AllowChangeItemIndex:boolean;
                 procedure CNCommand(var message: TWMCommand);message CN_COMMAND;
                 procedure CBSetCurSel(var message:TMessage);message CB_SETCURSEL;
                protected
                 procedure SetStyle(Value: TComboBoxStyle);override;
                 procedure SetItemIndex(AIndex:integer);
                public
                 constructor Create(AOwner:TComponent);override;
                 procedure ItemSelected(AItem:TMenuItem);
                published
                 property DropDownMenu:TPopupMenu read FDDMenu write FDDMenu;
                 property OnTextChange:TTextChengeEvent read FOnTxtChng write FOnTxtChng;
                end;

procedure Register;

implementation
var OldProc:pointer;

procedure Register;
begin
RegisterComponents('Bems controls',[TComboWithMenu]);
end;

procedure UnsubclassPopupList;
begin
SetWindowLong(PopupList.window,GWL_WNDPROC,integer(OldProc));
OldProc:=nil;
end;

function InterceptPopupMessages(wnd:HWND;msg:DWORD;wparam:WPARAM;lparam:LPARAM):LRESULT;stdcall;

 function SafeIs(ref:TObject;cls:TClass):boolean;
 begin
 try
  result:=(ref<>nil) and (ref is cls)
 except
  result:=false
 end;
 end;

var i:integer;item:TMenuItem;menu:TMenu;puMenu:TPopupMenu;RealProc:pointer;
begin
case msg of
 WM_COMMAND:begin
            for i:=0 to PopupList.count-1 do
                begin
                menu:=TMenu(PopupList.items[i]);
                item:=menu.FindItem(wparam,fkCommand);
                if (item<>nil) and SafeIs(menu,TPopupMenu)
                   then begin
                        puMenu:=menu as TPopupMenu;
                        if SafeIs(puMenu.PopupComponent,TComboWithMenu)
                           then (puMenu.PopupComponent as TComboWithMenu).ItemSelected(item);
                        end;
                end;
            end;
 WM_DESTROY:UnsubclassPopupList;
end;
if OldProc<>nil then result:=CallWindowProc(OldProc,wnd,msg,wparam,lparam)
                else begin
                     RealProc:=pointer(GetWindowLong(PopupList.window,GWL_WNDPROC));
                     result:=CallWindowProc(RealProc,wnd,msg,wparam,lparam)
                     end;
end;

procedure SubclassPopupList;
begin
OldProc:=pointer(SetWindowLong(PopupList.window,GWL_WNDPROC,integer(@InterceptPopupMessages)));
end;

constructor TComboWithMenu.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
AllowChangeItemIndex:=false;
style:=csDropDownList;
end;

procedure TComboWithMenu.ItemSelected(AItem:TMenuItem);
var NewText,OldText:string;i:integer;
begin
NewText:=AItem.Caption;
i:=pos('&',NewText);
if i>0 then Delete(NewText,i,1);
if ItemIndex>=0 then OldText:=items[0]
                else OldText:='';
items.Clear;
if assigned(OnTextChange) then OnTextChange(self,OldText,NewText,AItem);
items.Add(NewText);
SetItemIndex(0);
end;

procedure TComboWithMenu.SetItemIndex(AIndex:integer);
begin
AllowChangeItemIndex:=true;
try
 ItemIndex:=AIndex
finally
 AllowChangeItemIndex:=false;
end;
end;

procedure TComboWithMenu.CBSetCurSel(var message:TMessage);
begin
if AllowChangeItemIndex then inherited
end;

procedure TComboWithMenu.SetStyle(Value: TComboBoxStyle);
begin
if value<>csDropDownList then raise Exception.Create('Стили кроме csDropDownList не поддерживаются')
                         else inherited;
end;

procedure TComboWithMenu.CNCommand(var Message: TWMCommand);
var pt:TPoint;
begin
if message.NotifyCode=CBN_DROPDOWN
   then if assigned(FDDMenu) then begin
                                  if OldProc=nil then SubclassPopupList;
                                  pt.x:=0;
                                  pt.y:=height;
                                  pt:=ClientToScreen(pt);
                                  FDDMenu.PopupComponent:=self;
                                  FDDMenu.Popup(pt.x,pt.y);
                                  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
                                  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
                                  end
                             else begin
                                  mouse_event(MOUSEEVENTF_LEFTDOWN,0,0,0,0);
                                  mouse_event(MOUSEEVENTF_LEFTUP,0,0,0,0);
                                  end
   else inherited;
end;

end.

Не стесняйтесь делиться впечатлениями smile

--------------------

Обижено школьников: 8

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »