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.