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

[TiammatMX]

Buena tarde, compañerit@s del foro. Acá con un par de dudas, de las cuales una vez resueltas me permitirán avanzar en mi proyecto. Les cuento.

Tengo un TScrollBox, trabajando en Delphi 6 (Windows XP y MSSQLServer 2008 R2) y requiero poder controlarlo con la rueda del mouse de la computadora. Hacia arriba y hacia abajo, me refiero.

También, si pudiesen incluir el "cómo hacerlo" para un TDbGrid, sería altamente fabuloso.

De antemano, muchas gracias.

[*Caro*]

Hola tiammat, puedes utilizar el evento OnMouseWeel de tu ScrollBox:

Código Delphi [-]
procedure TForm1.ScrollBox1MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
 ScrollBox1.VertScrollBar.Position:=ScrollBox1.VertScrollBar.Position-(WheelDelta div 30);
end;

Para el dbGrid, revisa esta página.

Y recuerda preguntas diferentes, deben estar en hilos diferentes.

Saluditos

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

[[Al González]]

Nada más decir que me da mucho gusto verlo por aquí don Felipe, además de en su blog.

[ecfisa]

Hola Felipe.

En otra prueba me dí cuenta que el código anterior dejaba fuera al TForm por ejemplo.

De este modo queda contemplado:

Código Delphi [-]
procedure TForm1.MouseWheel(var Msg: tagMSG; var Handled: Boolean);
var
  i: SmallInt;
  FControl: TWinControl;
begin
  FControl:= FindVCLWindow(Mouse.CursorPos);
  if Msg.message = WM_MOUSEWHEEL then
  begin
    if (GetWindowLong(FControl.Handle, GWL_STYLE) and WS_VSCROLL <> 0) then //  Scroll vertical presente ?
    begin
      Msg.message := WM_KEYDOWN;
      Msg.lParam := 0;
      i:= HiWord(Msg.wParam);
      if (FControl is TScrollingWinControl) then // ScrollBoxBox, Form,...
      begin
        with TScrollingWinControl(FControl).VertScrollBar do
          if i > 0 then
            Position:= Position - Increment
          else
            Position := Position + Increment;
      end
      else if FControl.Focused then // DBGrid, StringGrid, Memo, ...
      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.OnMessage:= MouseWheel;
end;

Un saludo.

[ecfisa]

Hola de nuevo.

Para que no se te haga tán fácil a la hora de elegir , en este enlace , hay algunas formas más para lograrlo.

Un saludo.

[TiammatMX]

Empezado por ecfisa

Hola Felipe.

En otra prueba me dí cuenta que el código anterior dejaba fuera al TForm por ejemplo.

...
Un saludo.

¡¡Muchas gracias!!, ésto es lo que buscaba, precisamente...

Y Al, compadre, también es un gustazo andar por éstos lares. Aún te debo una cerveza... :P