Ratón arriba, ratón abajo, ratón arriba...

[ecfisa]

Hola tiammat.

Hay problemas con los eventos OnMouseWheel del TScrollBox, y lamentablemente el conocido código: (1)

Código Delphi [-]
procedure TForm1.MouseWheel(var Msg: tagMSG; var Handled: Boolean);
var
  i: SmallInt;
begin
  if Msg.message = WM_MOUSEWHEEL then
  begin
    Msg.message := WM_KEYDOWN;
    Msg.lParam := 0;
    i := HiWord(Msg.wParam);
    if i > 0 then
      Msg.wParam := VK_UP
    else
      Msg.wParam := VK_DOWN;
    Handled := false;
  end;
end;

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

Que funciona para otros componentes, no lo hace con TScrollBox...

Una solución también conocida es:

Código Delphi [-]
procedure TForm1.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  ScrollBox1.Perform(WM_VSCROLL,0,0);
end;

procedure TForm1.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  ScrollBox1.Perform(WM_VSCROLL,1,0);
end;

Una idea que se me ocurrió para usar el código (1) de forma que contemple a TScrollBox es:

Código Delphi [-]
...
type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    FControl: TWinControl;
    procedure AppEventsIdle(Sender: TObject; var Done: Boolean);
    procedure MouseWheel(var Msg: tagMSG; var Handled: Boolean);
  public
  end;
....
implementation

procedure TForm1.AppEventsIdle(Sender: TObject; var Done: Boolean);
var
  ctrl : TWinControl;
begin
  ctrl := FindVCLWindow(Mouse.CursorPos);
  if ctrl <> nil then
    FControl:= ctrl;
end;

procedure TForm1.MouseWheel(var Msg: tagMSG; var Handled: Boolean);
var
 i: SmallInt;
begin
  if Msg.message = WM_MOUSEWHEEL then
  begin
    Msg.message := WM_KEYDOWN;
    Msg.lParam := 0;
    i := HiWord(Msg.wParam);
    if GetWindowLong(FControl.Handle, GWL_STYLE) and WS_VSCROLL <> 0 then
    begin
      if FControl is TScrollBox then
      begin
        with TScrollBox(FControl).VertScrollBar do
          if i > 0 then
            Position := Position - Increment
          else
            Position := Position + Increment;
      end
      else
      begin
        if i > 0 then
          Msg.wParam := VK_UP
        else
          Msg.wParam := VK_DOWN;
      end;
    end;
  end;
  Handled := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnIdle:= AppEventsIdle;
  Application.OnMessage:= MouseWheel;
end;
...

Aparentemente funciona bién, pero no la he probado lo suficiente como para asegurar que lo hace en todos los casos.

Estoy pensando si no me estoy complicando y exista una solución más sencilla...

Un saludo.