Демо проекты и решения - Передача событий колеса мыши в контрол, над которым находится мышиный курсор.
Как известно в VCL до определенного момента события колеса мыши передавались в контрол, который имел фокус ввода. Из-за этого интерфейс программ написанных на VCL отличался от классических программ под Windows.
Начиная с Delphi XE 10.1 разработчики VCL изменили алгоритм таким образом, что событие колеса посылается в контрол над которым находится мышь.
Теперь колесо мыши работает одинаково как для стандартных Windows контролов так и для контролов написанных в чистом виде на VCL.
У вас также есть возможность реализовать аналогичный алгоритм для Delphi версии раньше чем XE 10.1.
Для этого необходимо внести минимальные изменения в исходники классов TCustomForm и TControl.
- Скопируйте файлы Vcl.Forms.pas и Vcl.Controls.pas в папку с вашим проектом.
- В файл Vcl.Forms.pas измените код метода TCustomForm.MouseWheelHandler следующем образом
Code:
procedure TCustomForm.MouseWheelHandler(var Message: TMessage);
begin
inherited MouseWheelHandler(Message);
// with Message do
// begin
// if FFocusedControl <> nil then
// Result := FFocusedControl.Perform(CM_MOUSEWHEEL, WParam, LParam)
// else
// inherited MouseWheelHandler(Message);
// end;
end;
- В файл Vcl.Controls.pas измените код метода TControl.MouseWheelHandler следующем образом
Code:
procedure TControl.MouseWheelHandler(var Message: TMessage);
var
Form: TCustomForm;
Capture: TControl;
begin
Form := GetParentForm(Self);
Capture := GetCaptureControl;
if Assigned(Capture) and (Capture <> Form) and (Capture <> Self) and (Capture.Parent = nil) then
Capture.WndProc(Message);
if Message.Result = 0 then
begin
// if (Form <> nil) and (Form <> Self) then
// Form.MouseWheelHandler(Message)
// else
// Message.Result := Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
if (Form <> nil) and (Form <> Self) then
Form.MouseWheelHandler(Message);
if Message.Result = 0 then
Message.Result := Perform(CM_MOUSEWHEEL, Message.WParam, Message.LParam);
end;
end;
-- Перекомпилируйте весь проект, запустите и проверьте результат.