TPageControl - > Tabs per Maus durchsrollen?

[NoGAD]

Hallo,

TPageControl hat kein OnMouseWheel. Ich hatte mir das vor einem Jahr schon programmiert, nur leider den Quellcode verloren, es ging mit dem Standardcontrol.

Aber ich habe vergessen, wie ich das gemacht hatte.

Weiß jemand bitte, wie ich, wenn ich mit der Maus über den Tabs stehe, den PageIndex beim Scrollen mit dem Mausrad ändern kann?

LG Mathias

[Renate Schaaf]

Per interceptor class, die cm_MouseWheel abfängt:

Delphi-Quellcode:

  type
  TPageControl = class(Vcl.ComCtrls.TPageControl)
  private
    procedure cmMouseWheel(var Message: TCMMouseWheel); Message cm_MouseWheel;
  end;

implementation

{ TPageControl }

procedure TPageControl.cmMouseWheel(var Message: TCMMouseWheel);
var
  Dir: integer;
begin
  if Message.WheelDelta < 0 then
    Dir := 1
  else
    Dir := -1;
  if (Dir = -1) and (ActivePageIndex = 0) then
    ActivePageIndex := PageCount - 1
  else
    ActivePageIndex := (ActivePageIndex + Dir) mod PageCount;
  Message.Result:=1;
end;

[NoGAD]

Hallo liebe Renate,


vielen Dank für den Code. In meiner Erinnerung habe ich das etwas anders im Kopf, da ich explizit entscheiden konnte, ob sich denn die Maus über den Tabs befindet.

Mit deinem aktuellen Code wird das Ereignis komplett abgefangen, eine Scrollbox innerhalb des PageControls z.B. funktioniert dann nicht mehr. Daher habe ich es etwas angepasst.

Mit dem folgenden Code wird vorher noch geprüft, ob der Mauszeiger sich auf einem Tab befindet. (eigentlich auf dem TPageControl direkt)

Delphi-Quellcode:

procedure TPageControl.cmMouseWheel(var Msg: TCMMouseWheel);
var
  Dummy_Direction: Integer;
  Dummy_Window: HWND;
  Dummy_WinControl: TWinControl;
begin

  Dummy_Window := WindowFromPoint(Msg.Pos);
  if Dummy_Window <> 0 then
  begin
    Dummy_WinControl := FindControl(Dummy_Window);
    if Dummy_WinControl <> nil then
    begin
      if Dummy_WinControl is TPageControl then
      begin
        if Msg.WheelDelta < 0 then
          Dummy_Direction := 1
        else
          Dummy_Direction := -1;
        if (Dummy_Direction = -1) and (ActivePageIndex = 0) then
          ActivePageIndex := PageCount - 1
        else
          ActivePageIndex := (ActivePageIndex + Dummy_Direction) mod PageCount;
        Msg.Result := 1;
      end;
    end;
  end;
end;

Ich hoffe, das ist so in Ordung.


LG und ein schönes Wochenende!

[Renate Schaaf]

Ich würde es etwas anders lösen (war zu faul meine Var-Namen zu ändern ):

Delphi-Quellcode:

procedure TPageControl.cmMouseWheel(var Message: TCMMouseWheel);
var
  Dir: Integer;
  P: TPoint;
begin
  P:=ScreenToClient(Message.Pos);
  if IndexOfTabAt(P.X, P.Y) < 0 then
    exit;
  if Message.WheelDelta < 0 then
    Dir := 1
  else
    Dir := -1;
  if (Dir = -1) and (ActivePageIndex = 0) then
    ActivePageIndex := PageCount - 1
  else
    ActivePageIndex := (ActivePageIndex + Dir) mod PageCount;
  Message.Result := 1;
end;

Gruß, und auch Dir schönes Wochenende

Renate

[NoGAD]

Hallo Renate,

danke für diesen schönen Beitrag. Es ist sehr übersichtlich, jedoch hat meine Methode (was ich nicht erwähnt hatte) auch den Zweck, bei Bedarf zwischen bestimmten PageControls zu unterscheiden. Somit kann ich z.B. über den Namen filtern, ob das Event erlaubt werden darf.

LG