Immer im Control unter dem Mauszeiger scrollen

[wolfgang_SV]

danke für den Tipp.
aber das kenn ich schon und hab es bei mir auch schon implementiert.
Doch das ist nicht das Problem...

[stahli]

Gibt es auch eine Lösung für (mehrere) Scrollboxen?
Ich will also nicht prüfen müssen, ob Handle = ScrollBox1.Handle oder ScrollBox2.Handle ist o.ä.
Anbei mal ein XE-Testprojekt.
Ich dachte, so sollte es funktionieren!? Ob man mit SendMessage o.ä. weiter kommt?


EDIT: Anhang entfernt (später neu)

[himitsu]

eigenlich sollte es egal sein, ob eine oder mehrere Scrollboxen,

aber wenn der Mauszeiger nicht über der Scrollbox, sondern auf etwas Anderem liegt und dieses das Scrollereignis an die Scrollbox weiterreicht, dann geht's natürlich nicht.

In diesem Fall müßte myn irgendwie prüfen, oder das Control (H) Scrollereignisse verarbeiten kann/tut und wenn nicht, dann den Parent prüfen und sich so bis zur ScrollBox vorarbeiten.

[stahli]

So dachte ich das ja.
Die ScrollBox finde ich auch. Sie erhält aber das Scrollereignis nicht (auch mit Perform nicht)!?
Ich bin mit den Messages nicht so vertraut und kann nicht erkennen, wo es da klemmt:

Delphi-Quellcode:

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

  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
//        WC.Perform(Msg.Message, Msg.wParam, Msg.lParam);
//        H := 0;
        H := WC.Handle;
      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;

[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.