DBR Delphi-Ecke

// Durch Mausradbewegungen wird von einem WinControl zum anderen
// gesprungen (vorrangig für Buttons gedacht).

// Getestet mit D2010 unter Win7

// Einfache Variante

...  
 private  
    { Private-Deklarationen }  
  public  
    { Public-Deklarationen }  
    procedure MyMessage(var Msg: TMsg; var Handled: Boolean);  
  end;  
  
var  
  Form1: TForm1;  
  
implementation  
  
{$R *.dfm}  
  
procedure TForm1.MyMessage(var Msg: TMsg; var Handled: Boolean);  
begin  
  if Msg.Message = WM_MOUSEWHEEL then  
  begin  
    Msg.Message := WM_KEYDOWN;  
    Msg.lParam := 0;  
    if Msg.wParam > 0 then  
      Msg.wParam := VK_UP  
    else  
      Msg.wParam := VK_DOWN;  
    Handled := false;  
  end;  
end;  
  
procedure TForm1.FormCreate(Sender: TObject);  
begin  
  Application.OnMessage := MyMessage;  
end;

// Erweiterte Variante

// Wenn sich beispielsweise ein Stringgrid auf der Form befindet und es wird
// angesprungen, dann bleibt Mousewheel innerhalb des Grids gefangen.
// Deshalb die Erweiterung, bei welcher nach Durchlauf des Grids das nächste
// Control angesprungen wird.

procedure TForm1.MyMessage(var Msg: TMsg; var Handled: Boolean); 
begin 
  if (Msg.Message = WM_MOUSEWHEEL) and (activecontrol <> StringGrid1) then 
  begin 
    Msg.Message := WM_KEYDOWN; 
    Msg.lParam := 0; 
    if Msg.wParam > 0 then 
      Msg.wParam := VK_UP 
    else 
      Msg.wParam := VK_DOWN; 
    Handled := false; 
  end; 
end; 
 
procedure TForm1.StringGrid1MouseWheelDown(Sender: TObject; Shift: TShiftState; 
  MousePos: TPoint; var Handled: Boolean); 
begin 
  with TStringGrid(Sender) do 
    if succ(Row) = Rowcount then 
      SendMessage(Self.Handle, WM_NEXTDLGCTL, 0, 0); 
end; 
 
procedure TForm1.StringGrid1MouseWheelUp(Sender: TObject; Shift: TShiftState; 
  MousePos: TPoint; var Handled: Boolean); 
begin 
  with TStringGrid(Sender) do 
    if Row = FixedRows then 
      SendMessage(Self.Handle, WM_NEXTDLGCTL, 1, 0); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Application.OnMessage := MyMessage; 
end;