Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi TPageControl - > Tabs per Maus durchsrollen? (https://www.delphipraxis.net/210530-tpagecontrol-tabs-per-maus-durchsrollen.html)

NoGAD 6. Mai 2022 18:02

TPageControl - > Tabs per Maus durchsrollen?
 
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 7. Mai 2022 09:12

AW: TPageControl - > Tabs per Maus durchsrollen?
 
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 7. Mai 2022 20:21

AW: TPageControl - > Tabs per Maus durchsrollen?
 
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 7. Mai 2022 23:09

AW: TPageControl - > Tabs per Maus durchsrollen?
 
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 8. Mai 2022 01:00

AW: TPageControl - > Tabs per Maus durchsrollen?
 
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 :-)


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:08 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz