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.