Immer im Control unter dem Mauszeiger scrollen

[stahli]

Genial, so klappt es wunderbar!
Allerdings eher realisiert durch Versuch+Irrtum als durch ein komplexes Verständnis der Zusammenhänge

Ich habe mal die zwei VCL-Wheel-Handler angesehen und eine passende Lösung zusammengestrickt.
Falls jemand noch etwas optimieren kann, immer her damit...

Delphi-Quellcode:

// Die VCL-Wheel-Handler:

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);
  end;
end;

procedure TCustomForm.MouseWheelHandler(var Message: TMessage);
begin
  with Message do
  begin
    if FFocusedControl <> nil then
      Result := FFocusedControl.Perform(CM_MOUSEWHEEL, WParam, LParam)
    else
      inherited MouseWheelHandler(Message);
  end;
end;

Hier die Formularunit. Projekt+Exe nochmal im Anhang.

Delphi-Quellcode:

unit fScrollTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel10: TPanel;
    Panel11: TPanel;
    Panel12: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    ScrollBox2: TScrollBox;
    Panel2: TPanel;
    Panel13: TPanel;
    Panel14: TPanel;
    Panel15: TPanel;
    Panel16: TPanel;
    Panel17: TPanel;
    Panel18: TPanel;
    Panel19: TPanel;
    Panel20: TPanel;
    Panel21: TPanel;
    Panel22: TPanel;
    Edit3: TEdit;
    Button2: TButton;
    ScrollBox3: TScrollBox;
    Panel23: TPanel;
    Panel24: TPanel;
    Panel25: TPanel;
    Panel26: TPanel;
    Panel27: TPanel;
    Panel28: TPanel;
    Panel29: TPanel;
    Panel30: TPanel;
    Panel31: TPanel;
    Panel32: TPanel;
    Panel33: TPanel;
    Edit4: TEdit;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
  private
    procedure MessageEvent(var Msg: TMsg; var Handled: Boolean);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.MessageEvent(var Msg: TMsg; var Handled: Boolean);
Var
  H: HWND;
  C: TControl;
  WC: TWinControl;
  I: Integer;

  function GetParentScrollBox(WC: TWinControl): TWinControl;
  begin
    Result := WC;
    if (not(WC is TScrollBox)) and (WC.Parent <> nil) then
      Result := GetParentScrollBox(WC.Parent);
  end;

begin
  if ((Msg.Message = WM_MOUSEWHEEL) or (Msg.Message = WM_MOUSEHWHEEL)) and
    (Msg.wParam and MK_CONTROL = 0) then
  begin
    H := WindowFromPoint(Msg.Pt);
    C := FindControl(H);
    if C is TWinControl then
    begin
      WC := GetParentScrollBox(C as TWinControl);
      if WC <> nil then
      begin
        for I := 0 to Mouse.WheelScrollLines do
          WC.Perform(CM_MOUSEWHEEL, Msg.wParam, Msg.lParam); // Msg.Message funktioniert nicht
        H := 0;
      end;
    end;
    if (H = 0) or ((Msg.HWND <> H) and (GetWindowThreadProcessId(H, nil) <>
      GetCurrentThreadId)) then
    begin
      Msg.HWND := 0;
      Msg.Message := WM_NULL;
      Handled := True;
    end
    else
      Msg.HWND := H;
  end;
end;

procedure TForm1.ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  (Sender as TScrollBox).VertScrollBar.Position := (Sender as TScrollBox)
    .VertScrollBar.Position + Mouse.WheelScrollLines;
end;

procedure TForm1.ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  (Sender as TScrollBox).VertScrollBar.Position := (Sender as TScrollBox)
    .VertScrollBar.Position - Mouse.WheelScrollLines;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := MessageEvent;
end;

end.

EDIT: In der Schleife

Delphi-Quellcode:

for I := 1 to Mouse.WheelScrollLines do
  WC.Perform(CM_MOUSEWHEEL, Msg.wParam, Msg.lParam); // Msg.Message funktioniert nicht

muss man ab 1 zählen.

PS: TScrollBox sollte einen AutoWheel-Modus erhalten.