Я использую несколько элементов управления прокруткой: TTreeViews, TListViews, DevExpress cxGrids и cxTreeLists и т.д. Когда колесико мыши вращается, управление с фокусом получает вход, независимо от того, какой контроль над курсором мыши завершен.
Как вы управляете вводом колесика мыши в любое управление курсором мыши? В этом отношении Delphi IDE работает очень хорошо.
Попробуйте переопределить метод формы MouseWheelHandler
вроде этого (я не тестировал это полностью):
procedure TMyForm.MouseWheelHandler(var Message: TMessage);
var
Control: TControl;
begin
Control := ControlAtPos(ScreenToClient(SmallPointToPoint(TWMMouseWheel(Message).Pos)), False, True, True);
if Assigned(Control) and (Control <> ActiveControl) then
begin
Message.Result := Control.Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
Control.DefaultHandler(Message);
end
else
inherited MouseWheelHandler(Message);
end;
Действие с колесом мыши приводит к сообщению WM_MOUSEWHEEL
:
Отправлено в окно фокуса, когда колесико мыши повернуто. Функция DefWindowProc передает сообщение родительскому окну. Не должно быть внутренней пересылки сообщения, так как DefWindowProc распространяет его на родительскую цепочку, пока не найдет окно, которое его обрабатывает.
WM_MOUSEWHEEL
в очередь сообщений о потоках окон переднего плана.Application.ProcessMessage
). Это сообщение имеет тип TMsg
, у которого есть член hwnd
, обозначающий дескриптор окна, для которого указано сообщение.Application.OnMessage
запускается.
Handled
True
останавливает дальнейшую обработку сообщения (за исключением следующих шагов).Application.IsPreProcessMessage
.
PreProcessMessage
, который по умолчанию ничего не делает. Отсутствие контроля в VCL превзошло этот метод.Application.IsHintMsg
.
IsHintMsg
. Предотвращение сообщения от дальнейшей обработки невозможно.DispatchMessage
.TWinControl.WndProc
сфокусированного окна получает сообщение. Это сообщение имеет тип TMessage
, которому не хватает окна (потому что это экземпляр, вызываемый этим методом).TWinControl.IsControlMouseMsg
, чтобы проверить, должно ли сообщение мыши быть перенаправлено на один из его дочерних элементов управления, отличных от окон.
WndProc
, см. шаг 10. ( 2) Это никогда не произойдет, потому что WM_MOUSEWHEEL
содержит свою позицию мыши в координатах экрана, а IsControlMouseMsg
предполагает положение мыши в клиентских координатах (XE2).)TControl.WndProc
получает сообщение.
CM_MOUSEWHEEL
и отправляется на TControl.MouseWheelHandler
, см. шаг 13.TControl.WMMouseWheel
получает сообщение.WM_MOUSEWHEEL
w indow m Essage (значимый для системы и часто для VCL тоже) преобразуется в CM_MOUSEWHEEL
c ontrol m essage (значимый только для VCL), который обеспечивает удобную информацию VCL ShiftState
вместо данные системных клавиш.MouseWheelHandler
.
TCustomForm
, тогда вызывается метод TCustomForm.MouseWheelHandler
.
CM_MOUSEWHEEL
отправляется на сфокусированное управление, см. шаг 14.TControl.MouseWheelHandler
.
Capture
получен с помощью GetCaptureControl
, который проверяет наличие Parent <> nil
(XE2).)MouseWheelHandler
, см. шаг 13.1.CM_MOUSEWHEEL
отправляется в элемент управления, см. шаг 14.TControl.CMMouseWheel
получает сообщение.
TControl.DoMouseWheel
.
OnMouseWheel
запущено.TControl.DoMouseWheelDown
или TControl.DoMouseWheelUp
в зависимости от направления прокрутки.OnMouseWheelDown
или OnMouseWheelUp
.CM_MOUSEWHEEL
отправляется в родительский элемент управления, см. шаг 14. (Я считаю, что это противоречит рекомендациям MSDN в приведенной выше цитате, но это, несомненно, является продуманным решением разработчиков. Возможно, потому что это начало этой самой цепи.)Почти на каждом этапе этой цепочки обработки сообщение можно игнорировать, ничего не делая, изменяя путем изменения параметров сообщения, обрабатывая его действием и отменя, установив Handled := True
или установив Message.Result
в ненулевое значение.
Только когда какой-либо элемент управления имеет фокус, это сообщение принимается приложением. Но даже когда Screen.ActiveCustomForm.ActiveControl
принудительно настроено на nil
, VCL обеспечивает сфокусированное управление с TCustomForm.SetWindowFocus
, которое по умолчанию относится к ранее активной форме. (С Windows.SetFocus(0)
, действительно, сообщение никогда не отправляется.)
Из-за ошибки в IsControlMouseMsg
2)TControl
может получать только сообщение WM_MOUSEWHEEL
, если оно захватило мышь. Это можно сделать вручную, установив Control.MouseCapture := True
, но вы должны проявлять особую осторожность в том, чтобы освободить этот захват оперативно, иначе он будет иметь нежелательные побочные эффекты, такие как необходимость ненужный дополнительный щелчок, чтобы что-то сделать. Кроме того, захват мыши обычно происходит только между нажатием мыши и событием мыши, но это ограничение необязательно необходимо применять. Но даже когда сообщение достигает элемента управления, оно отправляется его методу MouseWheelHandler
, который просто отправляет его обратно либо в форму, либо в активный элемент управления. Таким образом, не-оконные элементы управления VCL никогда не могут действовать по сообщению по умолчанию. Я считаю, что это еще одна ошибка, иначе зачем все манипуляции с колесами были реализованы в TControl
? Компонент-писатели, возможно, внедрили свой собственный метод MouseWheelHandler
для этой цели, и независимо от того, что решение приходит к этому вопросу, необходимо позаботиться о том, чтобы не нарушить эту существующую настройку.
Встроенные элементы управления, которые способны прокручивать колесо, например TMemo
, TListBox
, TDateTimePicker
, TComboBox
, TTreeView
, TListView
и т.д., прокручиваются самой системой. Отправка CM_MOUSEWHEEL
в такой элемент управления по умолчанию не влияет. Эти подклассифицированные элементы управления прокручиваются в результате сообщения WM_MOUSEWHEEL
, отправленного с помощью связанной с подкладом процедуры окна API с помощью CallWindowProc
, который VCL позаботится о TWinControl.DefaultHandler
. Как ни странно, эта процедура не проверяет Message.Result
перед вызовом CallWindowProc
, и после отправки сообщения прокрутка не может быть предотвращена. Сообщение возвращается с набором Result
, зависящим от того, может ли управление нормально прокручивать или управлять типом элемента управления. (Например, a TMemo
возвращает <> 0
, а TEdit
возвращает 0
.) Независимо от того, действительно ли он прокручивается, не влияет на результат сообщения.
Элементы управления VCL полагаются на обработку по умолчанию, реализованную в TControl
и TWinControl
, как описано выше. Они воздействуют на события колеса в DoMouseWheel
, DoMouseWheelDown
или DoMouseWheelUp
. Насколько мне известно, никакой контроль в VCL не превзошел MouseWheelHandler
, чтобы обрабатывать события колес.
При взгляде на разные приложения, похоже, нет соответствия, по которому поведение прокрутки колес является стандартом. Например: MS Word прокручивает страницу, которая зависает, MS Excel прокручивает рабочую книгу, которая сфокусирована, Windows Eplorer прокручивает сфокусированную панель, веб-сайты реализуют поведение прокрутки по-разному, Evernote прокручивает окно, которое зависает, и т.д.... и Delphi собственная среда IDE вершина всего, прокручивая сфокусированное окно , а также зависающее окно, за исключением того, что при зависании редактора кода, тогда редактор кода крадет фокус при прокрутке (XE2).
К счастью Microsoft предлагает как минимум рекомендации для пользователей для настольных приложений на базе Windows:
- Сделать колесико мыши влияющим на элемент управления, панель или окно, в котором в данный момент находится указатель.. Это позволяет избежать непреднамеренных результатов.
- Сделать колесико мыши эффектом без щелчка или с фокусом ввода. Наведение достаточно.
- Сделать колесико мыши влияющим на объект с наиболее конкретной областью. Например, если указатель находится над элементом управления прокручиваемым списком в прокручиваемой панели в прокручиваемом окне, колесико мыши влияет на list box.
- Не меняйте фокус ввода при использовании колеса мыши.
Таким образом, требование к запросу только для прокрутки зависающего элемента управления имеет достаточные основания, но разработчики Delphi не упростили его реализацию.
Предпочтительным решением является один без подклассов окон или нескольких реализаций для разных форм или элементов управления.
Чтобы предотвратить прокрутку сфокусированного элемента управления, управление может не получать сообщение CM_MOUSEWHEEL
. Следовательно, MouseWheelHandler
любого элемента управления не может быть вызван. Поэтому WM_MOUSEWHEEL
не может быть отправлен на какой-либо элемент управления. Таким образом, единственное место, оставшееся для вмешательства, - это TApplication.OnMessage
. Кроме того, сообщение не может выйти из него, поэтому вся обработка должна выполняться в этом обработчике событий, и когда вся обработка колес VCL по умолчанию отключена, все возможные условия должны быть приняты во внимание.
Пусть начнется просто. Окно с включенным окном, которое в настоящее время зависает, получает WindowFromPoint
.
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
var
Window: HWND;
begin
if Msg.message = WM_MOUSEWHEEL then
begin
Window := WindowFromPoint(Msg.pt);
if Window <> 0 then
begin
Handled := True;
end;
end;
end;
С FindControl
мы получаем ссылку на элемент управления VCL. Если результатом является nil
, тогда зависающее окно не относится к приложению, или это окно, не известное VCL (например, упавшее TDateTimePicker
). В этом случае сообщение нужно переслать обратно в API, и его результат нам неинтересен.
WinControl: TWinControl;
WndProc: NativeInt;
WinControl := FindControl(Window);
if WinControl = nil then
begin
WndProc := GetWindowLongPtr(Window, GWL_WNDPROC);
CallWindowProc(Pointer(WndProc), Window, Msg.message, Msg.wParam,
Msg.lParam);
end
else
begin
end;
Когда окно является элементом управления VCL, несколько обработчиков сообщений должны считаться вызывающими в определенном порядке. Когда в позиции мыши есть включенное не оконное управление (типа TControl
или потомка), оно должно сначала получить сообщение CM_MOUSEWHEEL
, потому что этот элемент управления определенно является элементом управления переднего плана. Сообщение должно быть построено из сообщения WM_MOUSEWHEEL
и переведено в его эквивалент VCL. Во-вторых, сообщение WM_MOUSEWHEEL
должно быть отправлено на элемент управления DefaultHandler
, чтобы разрешить обработку для собственных элементов управления. И наконец, снова сообщение CM_MOUSEWHEEL
должно быть отправлено в элемент управления, когда предыдущий обработчик не позаботился о сообщении. Эти последние два этапа не могут иметь место в обратном порядке, например, заметка в окне прокрутки также должна прокручиваться.
Point: TPoint;
Message: TMessage;
Point := WinControl.ScreenToClient(Msg.pt);
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
TCMMouseWheel(Message).ShiftState :=
KeysToShiftState(TWMMouseWheel(Message).Keys);
Message.Result := WinControl.ControlAtPos(Point, False).Perform(
CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if Message.Result = 0 then
begin
Message.Msg := Msg.message;
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
WinControl.DefaultHandler(Message);
end;
if Message.Result = 0 then
begin
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
TCMMouseWheel(Message).ShiftState :=
KeysToShiftState(TWMMouseWheel(Message).Keys);
Message.Result := WinControl.Perform(CM_MOUSEWHEEL, Message.WParam,
Message.LParam);
end;
Когда окно захватило мышь, все сообщения колеса должны быть отправлены на него. Окно, полученное с помощью GetCapture
, будет являться окном текущего процесса, но оно не должно быть элементом управления VCL. Например. во время операции перетаскивания создается временное окно (см. TDragObject.DragHandle
), который получает сообщения мыши. Все сообщения? Noooo, WM_MOUSEWHEEL
не отправляется в окно захвата, поэтому мы должны перенаправить его. Кроме того, когда окно захвата не обрабатывает сообщение, должна выполняться вся другая предварительно обработанная обработка. Это функция, отсутствующая в VCL: при повороте во время операции перетаскивания Form.OnMouseWheel
действительно вызывается, но сфокусированный или зависающий элемент управления не получает сообщение. Это означает, например, что текст нельзя перетащить в содержимое заметки в месте, которое находится за пределами видимой части заметки.
Window := GetCapture;
if Window <> 0 then
begin
Message.Result := GetCaptureControl.Perform(CM_MOUSEWHEEL, Message.WParam,
Message.LParam);
if Message.Result = 0 then
Message.Result := SendMessage(Window, Msg.message, Msg.wParam,
Msg.lParam);
end;
Это по существу выполняет эту работу, и это послужило основой для представленной ниже единицы. Чтобы заставить его работать, просто добавьте имя единицы в одно из предложений о применении в вашем проекте. Он имеет следующие дополнительные возможности:
MouseWheelHandler
.TApplicationEvents
перед всеми остальными.OnMessage
ко всем остальным TApplicationEvents
объектам.unit ScrollAnywhere;
interface
uses
System.Classes, System.Types, System.Contnrs, Winapi.Windows, Winapi.Messages,
Vcl.Controls, Vcl.Forms, Vcl.AppEvnts;
type
TWheelMsgSettings = record
MainFormPreview: Boolean;
ActiveFormPreview: Boolean;
ActiveControlPreview: Boolean;
VclHandlingAfterHandled: Boolean;
VclHandlingAfterUnhandled: Boolean;
CancelApplicationEvents: Boolean;
procedure RegisterMouseWheelHandler(ControlClass: TControlClass);
end;
TMouseHelper = class helper for TMouse
public
class var WheelMsgSettings: TWheelMsgSettings;
end;
procedure Activate;
implementation
type
TWheelInterceptor = class(TCustomApplicationEvents)
private
procedure ApplicationMessage(var Msg: tagMSG; var Handled: Boolean);
public
constructor Create(AOwner: TComponent); override;
end;
var
WheelInterceptor: TWheelInterceptor;
ControlClassList: TClassList;
procedure TWheelInterceptor.ApplicationMessage(var Msg: tagMSG;
var Handled: Boolean);
var
Window: HWND;
WinControl: TWinControl;
WndProc: NativeInt;
Message: TMessage;
OwningProcess: DWORD;
procedure WinWParamNeeded;
begin
Message.WParam := Msg.wParam;
end;
procedure VclWParamNeeded;
begin
TCMMouseWheel(Message).ShiftState :=
KeysToShiftState(TWMMouseWheel(Message).Keys);
end;
procedure ProcessControl(AControl: TControl;
CallRegisteredMouseWheelHandler: Boolean);
begin
if (Message.Result = 0) and CallRegisteredMouseWheelHandler and
(AControl <> nil) and
(ControlClassList.IndexOf(AControl.ClassType) <> -1) then
begin
AControl.MouseWheelHandler(Message);
end;
if Message.Result = 0 then
Message.Result := AControl.Perform(CM_MOUSEWHEEL, Message.WParam,
Message.LParam);
end;
begin
if Msg.message <> WM_MOUSEWHEEL then
Exit;
with Mouse.WheelMsgSettings do
begin
Message.Msg := Msg.message;
Message.WParam := Msg.wParam;
Message.LParam := Msg.lParam;
Message.Result := LRESULT(Handled);
// Allow controls for which preview is set to handle the message
VclWParamNeeded;
if MainFormPreview then
ProcessControl(Application.MainForm, False);
if ActiveFormPreview then
ProcessControl(Screen.ActiveCustomForm, False);
if ActiveControlPreview then
ProcessControl(Screen.ActiveControl, False);
// Allow capturing control to handle the message
Window := GetCapture;
if (Window <> 0) and (Message.Result = 0) then
begin
ProcessControl(GetCaptureControl, True);
if Message.Result = 0 then
Message.Result := SendMessage(Window, Msg.message, Msg.wParam,
Msg.lParam);
end;
// Allow hovered control to handle the message
Window := WindowFromPoint(Msg.pt);
if (Window <> 0) and (Message.Result = 0) then
begin
WinControl := FindControl(Window);
if WinControl = nil then
begin
// Window is a non-VCL window (e.g. a dropped down TDateTimePicker), or
// the window doesn't belong to this process
WndProc := GetWindowLongPtr(Window, GWL_WNDPROC);
Message.Result := CallWindowProc(Pointer(WndProc), Window,
Msg.message, Msg.wParam, Msg.lParam);
end
else
begin
// Window is a VCL control
// Allow non-windowed child controls to handle the message
ProcessControl(WinControl.ControlAtPos(
WinControl.ScreenToClient(Msg.pt), False), True);
// Allow native controls to handle the message
if Message.Result = 0 then
begin
WinWParamNeeded;
WinControl.DefaultHandler(Message);
end;
// Allow windowed VCL controls to handle the message
if not ((MainFormPreview and (WinControl = Application.MainForm)) or
(ActiveFormPreview and (WinControl = Screen.ActiveCustomForm)) or
(ActiveControlPreview and (WinControl = Screen.ActiveControl))) then
begin
VclWParamNeeded;
ProcessControl(WinControl, True);
end;
end;
end;
// Bypass default VCL wheel handling?
Handled := ((Message.Result <> 0) and not VclHandlingAfterHandled) or
((Message.Result = 0) and not VclHandlingAfterUnhandled);
// Modify message destination for current process
if (not Handled) and (Window <> 0) and
(GetWindowThreadProcessID(Window, OwningProcess) <> 0) and
(OwningProcess = GetCurrentProcessId) then
begin
Msg.hwnd := Window;
end;
if CancelApplicationEvents then
CancelDispatch;
end;
end;
constructor TWheelInterceptor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnMessage := ApplicationMessage;
end;
procedure Activate;
begin
WheelInterceptor.Activate;
end;
{ TWheelMsgSettings }
procedure TWheelMsgSettings.RegisterMouseWheelHandler(
ControlClass: TControlClass);
begin
ControlClassList.Add(ControlClass);
end;
initialization
ControlClassList := TClassList.Create;
WheelInterceptor := TWheelInterceptor.Create(Application);
finalization
ControlClassList.Free;
end.
Отказ от ответственности:
Этот код намеренно не прокручивает ничего, он только готовит маршрутизацию сообщений для событий VCL OnMouseWheel*
, чтобы получить надлежащую возможность уволить. Этот код не проверяется на сторонних элементах управления. Когда VclHandlingAfterHandled
или VclHandlingAfterUnhandled
установлено True
, события мыши могут быть запущены дважды. В этом посте я сделал несколько утверждений, и я счел, что в VCL есть три ошибки, но все это основано на изучении документации и тестирования. Проведите тестирование этого устройства и прокомментируйте результаты и ошибки. Прошу прощения за этот довольно длинный ответ; У меня просто нет блога.
1) Именование нахально взято из Одиссея ключей
2) См. мой Отчет об ошибке Quality Central # 135258
3) См. мой Отчет об ошибках в Quality Central # 135305
classes.StdWndProc
0 в classes.StdWndProc
, прежде чем вызывать целевую оконную процедуру.
Отмените событие TApplication.OnMessage(или создайте TApplicationEvents) и перенаправить сообщение WM_MOUSEWHEEL в обработчик события:
procedure TMyForm.AppEventsMessage(var Msg: tagMSG;
var Handled: Boolean);
var
Pt: TPoint;
C: TWinControl;
begin
if Msg.message = WM_MOUSEWHEEL then begin
Pt.X := SmallInt(Msg.lParam);
Pt.Y := SmallInt(Msg.lParam shr 16);
C := FindVCLWindow(Pt);
if C = nil then
Handled := True
else if C.Handle <> Msg.hwnd then begin
Handled := True;
SendMessage(C.Handle, WM_MOUSEWHEEL, Msg.wParam, Msg.lParam);
end;
end;
end;
Здесь хорошо работает, хотя вы можете добавить некоторую защиту, чтобы он от рекурсии, если произойдет что-то неожиданное.
Это решение, которое я использовал:
Добавьте amMouseWheel
в раздел uses раздела реализации единицы формы после блока forms
:
unit MyUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
// Fix and util for mouse wheel
amMouseWheel;
...
Сохраните следующий код amMouseWheel.pas
:
unit amMouseWheel;
// -----------------------------------------------------------------------------
// The original author is Anders Melander, [email protected], http://melander.dk
// Copyright 2008 Anders Melander
// -----------------------------------------------------------------------------
// License:
// Creative Commons Attribution-Share Alike 3.0 Unported
// http://creativecommons.org/licenses/by-sa/3.0/
// -----------------------------------------------------------------------------
interface
uses
Forms,
Messages,
Classes,
Controls,
Windows;
//------------------------------------------------------------------------------
//
// TForm work around for mouse wheel messages
//
//------------------------------------------------------------------------------
// The purpose of this class is to enable mouse wheel messages on controls
// that doesn't have the focus.
//
// To scroll with the mouse just hover the mouse over the target control and
// scroll the mouse wheel.
//------------------------------------------------------------------------------
type
TForm = class(Forms.TForm)
public
procedure MouseWheelHandler(var Msg: TMessage); override;
end;
//------------------------------------------------------------------------------
//
// Generic control work around for mouse wheel messages
//
//------------------------------------------------------------------------------
// Call this function from a control (e.g. a TFrame) DoMouseWheel method like
// this:
//
// function TMyFrame.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
// MousePos: TPoint): Boolean;
// begin
// Result := ControlDoMouseWheel(Self, Shift, WheelDelta, MousePos) or inherited;
// end;
//
//------------------------------------------------------------------------------
function ControlDoMouseWheel(Control: TControl; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint): Boolean;
implementation
uses
Types;
procedure TForm.MouseWheelHandler(var Msg: TMessage);
var
Target: TControl;
begin
// Find the control under the mouse
Target := FindDragTarget(SmallPointToPoint(TCMMouseWheel(Msg).Pos), False);
while (Target <> nil) do
begin
// If the target control is the focused control then we abort as the focused
// control is the originator of the call to this method.
if (Target = Self) or ((Target is TWinControl) and (TWinControl(Target).Focused)) then
begin
Target := nil;
break;
end;
// Let the target control process the scroll. If the control doesn't handle
// the scroll then...
Msg.Result := Target.Perform(CM_MOUSEWHEEL, Msg.WParam, Msg.LParam);
if (Msg.Result <> 0) then
break;
// ...let the target parent give it a go instead.
Target := Target.Parent;
end;
// Fall back to the default processing if none of the controls under the mouse
// could handle the scroll.
if (Target = nil) then
inherited;
end;
type
TControlCracker = class(TControl);
function ControlDoMouseWheel(Control: TControl; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint): Boolean;
var
Target: TControl;
begin
(*
** The purpose of this method is to enable mouse wheel messages on controls
** that doesn't have the focus.
**
** To scroll with the mouse just hover the mouse over the target control and
** scroll the mouse wheel.
*)
Result := False;
// Find the control under the mouse
Target := FindDragTarget(MousePos, False);
while (not Result) and (Target <> nil) do
begin
// If the target control is the focused control then we abort as the focused
// control is the originator of the call to this method.
if (Target = Control) or ((Target is TWinControl) and (TWinControl(Target).Focused)) then
break;
// Let the target control process the scroll. If the control doesn't handle
// the scroll then...
Result := TControlCracker(Target).DoMouseWheel(Shift, WheelDelta, MousePos);
// ...let the target parent give it a go instead.
Target := Target.Parent;
end;
end;
end.
Вы можете найти эту статью полезной: отправить сообщение прокрутки вниз в список с помощью мыши, но в списке нет фокуса [1], он написан на С#, но преобразование в Delphi не должно быть слишком большой проблемой. Он использует крючки для достижения желаемого эффекта.
Чтобы узнать, какой компонент находится в данный момент, вы можете использовать функцию FindVCLWindow, пример которой можно найти в этой статье: Получить Управление под мышью в приложении Delphi [2].
[1] http://social.msdn.microsoft.com/forums/en-US/winforms/thread/ec1fbfa2-137e-49f6-b444-b634e4f44f21/
[2] http://delphi.about.com/od/delphitips2008/qt/find-vcl-window.htm
Только для использования с элементами управления DevExpress
Он работает на XE3. Он не тестировался в других версиях.
procedure TMainForm.DoApplicationMessage(var AMsg: TMsg; var AHandled: Boolean);
var
LControl: TWinControl;
LMessage: TMessage;
begin
if AMsg.message <> WM_MOUSEWHEEL then
Exit;
LControl := FindVCLWindow(AMsg.pt);
if not Assigned(LControl) then
Exit;
LMessage.WParam := AMsg.wParam;
// see TControl.WMMouseWheel
TCMMouseWheel(LMessage).ShiftState := KeysToShiftState(TWMMouseWheel(LMessage).Keys);
LControl.Perform(CM_MOUSEWHEEL, LMessage.WParam, AMsg.lParam);
AHandled := True;
end;
если вы не используете элементы управления DevExpress, затем выполните → SendMessage
SendMessage(LControl.Handle, AMsg.message, AMsg.WParam, AMsg.lParam);
У меня была такая же проблема, и я решил немного взломать ее, но она работает.
Я не хотел общаться с сообщениями и решил просто вызвать метод DoMouseWheel для управления, который мне нужен. Hack заключается в том, что метод DoMouseWheel защищен и поэтому недоступен из файла формы модуля, поэтому я определил свой класс в модуле формы:
TControlHack = class(TControl)
end; //just to call DoMouseWheel
Затем я написал обработчик событий TForm1.onMouseWheel:
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var i: Integer;
c: TControlHack;
begin
for i:=0 to ComponentCount-1 do
if Components[i] is TControl then begin
c:=TControlHack(Components[i]);
if PtInRect(c.ClientRect,c.ScreenToClient(MousePos)) then
begin
Handled:=c.DoMouseWheel(shift,WheelDelta,MousePos);
if Handled then break;
end;
end;
end;
Как вы видите, он ищет все элементы управления в форме, а не только ближайшие дети, и оказывается, чтобы искать от родителей к детям. Было бы лучше (но больше кода) сделать рекурсивный поиск у детей, но код выше работает просто отлично.
Чтобы только один элемент управления реагировал на событие мыши, всегда нужно установить Handled: = true, когда он будет реализован. Если, например, у вас есть панель ввода внутри панели, панель сначала выполнит DoMouseWheel, и если она не обрабатывает событие, будет выполняться listbox.DoMouseWheel. Если контроль над курсором мыши не обрабатывается DoMouseWheel, то сфокусированный элемент управления будет выглядеть довольно адекватно.
В событии OnMouseEnter для каждого прокручиваемого элемента управления добавьте соответствующий вызов SetFocus
Итак, для ListBox1:
procedure TForm1.ListBox1MouseEnter(Sender: TObject);
begin
ListBox1.SetFocus;
end;
Достигает ли это желаемого эффекта?