Mousewheel и TDblookUpCombobox

Чешков Антон

что то ни как не получаеться поймать событие "поворота колесика мыши" на компоненте ((все перепробывал, каким образом это можно сделать , наверное существует какойтообщий способ для любого компонента???
10 ответов

Чешков Антон

Из справки TWinControl.WndProc(правда для Builder'a но в Delphi также <можно справку посмотреть>)This example shows how to use the WndProc method and the WindowProc property to subclass a custom control’s window procedure. This example subclasses the window procedure of a TListBox descendant to respond to a user-defined message called WM_STYLEMESSAGE. The subclassed window procedure can be turned on or off by pressing a radio button.
void __fastcall TMyListBoxDescendant::SubClassWndProc(Messages::TMessage &Message)
<i>{
 if (Message.Msg == WM_STYLEMESSAGE)
 Style = (TListBoxStyle)Message.WParam;
 else
 WndProc(Message);
}</i>
void __fastcall TMyListBoxDescendant::ToggleSubClass(bool On)
<i>{
 if (On)
 WindowProc = SubClassWndProc;
 else
 WindowProc = WndProc;
}</i>
void __fastcall TForm1::SubClassRadioGroup1Click(TObject *Sender)
<i>{
 MyListBoxDescendant1->ToggleSubClass(SubClassRadioGroup1->ItemIndex == 0);}</i>
А в данном случае нужно перехватитьWM_MOUSEWHEELfwKeys = LOWORD(wParam); // key flagszDelta = (short) HIWORD(wParam); // wheel rotationxPos = (short) LOWORD(lParam); // horizontal position of pointeryPos = (short) HIWORD(lParam); // vertical position of pointer


Чешков Антон

что то я не погимаю ((( пишу так ...
.......

<b>type</b> myc = <b>class</b> (TDBLookupComboboxEh)
 <b>public</b>
 	<b>procedure</b> wndproc1(<b>var</b> Message: TMessage);
 <b>end</b>;

<b>type</b>
 Tfm_order_correct = <b>class</b>(TForm)
 DBLookupComboboxEh1: myc;
 .......
<b>end</b>;


<b>procedure</b> myc.wndproc1(<b>var</b> Message: TMessage);
<b>begin</b>
 <b>if</b> Message.Msg = WM_MOUSEWHEEL <b>then</b>
 	Exit;
 
 WndProc(message);
<b>end</b>;

<b>procedure</b> Tfm_order_correct .onShow(....);
<b>begin</b>
 DBLookupComboboxEh1.WindowProc:=winproc1;
<b>end</b>;
что то не робит , я явно делаю что то не так (


Чешков Антон

а зачем
<b>type</b> myc = <b>class</b> (TDBLookupComboboxEh)
 <b>public</b>
 	<b>procedure</b> wndproc1(<b>var</b> Message: TMessage);
 <b>end</b>;
может проще так
<b>type</b>
 Tfm_order_correct = <b>class</b>(TForm)
 DBLookupComboboxEh1: myc;
 <b>public</b>
 	<b>procedure</b> wndproc1(<b>var</b> Message: TMessage);
 .......
<b>end</b>;


<b>procedure</b> Tfm_order_correct .wndproc1(<b>var</b> Message: TMessage);
<b>begin</b>
 <b>if</b> Message.Msg = WM_MOUSEWHEEL <b>then</b>
 	Exit;
 
 WndProc(message);
<b>end</b>;

<b>procedure</b> Tfm_order_correct .onShow(....);
<b>begin</b>
 DBLookupComboboxEh1.WindowProc:=winproc1;
<b>end</b>;


Чешков Антон

Вернее
<b>type</b>
 Tfm_order_correct = <b>class</b>(TForm)
 DBLookupComboboxEh1: DBLookupComboboxEh;
 <b>public</b>
 	<b>procedure</b> wndproc1(<b>var</b> Message: TMessage);
 .......
<b>end</b>;


Чешков Антон

так тоже писал , у меня при открытии окна просто форма подвисла, а именно этот контрол (


Чешков Антон

получаеться вызываеться WndProc самой формы


Чешков Антон

Можно попробовать так
<b>type</b>
 Tfm_order_correct = <b>class</b>(TForm)
 DBLookupComboboxEh1: DBLookupComboboxEh;

 <b>procedure</b> WMMouseWheel(<b>var</b> Message: TWMMouseWheel); message WM_MOUSEWHEEL;
 .......
<b>end</b>;

<b>procedure</b> Tfm_order_correct.WMMouseWheel(<b>var</b> Message: TWMMouseWheel);
<b>begin</b>
<i>{ проверяем где крутим и если надо то реагируем}</i>
 Message.XPos ...
 Message.YPos ...
<b>end</b>


Чешков Антон

Когда фокус в контролн, форма почему то не обрабатывает скролл , не знаю что такое (( видно не судьба................


Чешков Антон

А если нужен только скроллто в потомке TDBLookupCombobox надо определить
<b>procedure</b> WMVScroll(<b>var</b> Message: TWMVScroll); message WM_VSCROLL;
текст того что сейчас там есть:
<b>procedure</b> TDBLookupListBox.WMVScroll(<b>var</b> Message: TWMVScroll);
<b>begin</b>
 SearchText := '';
 <b>if</b> ListLink.DataSet = <b>nil</b> <b>then</b>
 Exit;
 <b>with</b> Message, ListLink.DataSet <b>do</b>
 <b>case</b> ScrollCode <b>of</b>
 SB_LINEUP: MoveBy(-FRecordIndex - <b>1</b>);
 SB_LINEDOWN: MoveBy(FRecordCount - FRecordIndex);
 SB_PAGEUP: MoveBy(-FRecordIndex - FRecordCount + <b>1</b>);
 SB_PAGEDOWN: MoveBy(FRecordCount - FRecordIndex + FRecordCount - <b>2</b>);
 SB_THUMBPOSITION:
 <b>begin</b>
 <b>case</b> Pos <b>of</b>
 <b>0</b>: First;
 <b>1</b>: MoveBy(-FRecordIndex - FRecordCount + <b>1</b>);
 <b>2</b>: Exit;
 <b>3</b>: MoveBy(FRecordCount - FRecordIndex + FRecordCount - <b>2</b>);
 <b>4</b>: Last;
 <b>end</b>;
 <b>end</b>;
 SB_BOTTOM: Last;
 SB_TOP: First;
 <b>end</b>;
<b>end</b>;


Чешков Антон

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