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 TTrckbar und Aktion auf rechte Maustaste - wie? (https://www.delphipraxis.net/120220-ttrckbar-und-aktion-auf-rechte-maustaste-wie.html)

Anthauri 7. Sep 2008 09:24


TTrckbar und Aktion auf rechte Maustaste - wie?
 
Hallo,
ich habe in meiner Anwendung mehrere Trackbars.
Nun möchte ich, dass beim drücken der rechten Maustaste auf der jeweiligen Trackbar eine Aktion ausgelöst wird (kein Popupmenu).

Ein (OnMouse, Mous Up oder so) Event gibt es bei der Trackbar aber anscheinend nicht.
Wie kann ich das dennoch realisieren?

Pfoto 7. Sep 2008 10:32

Re: TTrckbar und Aktion auf rechte Maustaste - wie?
 
Hallo,

du könntest eine Control von TTrackbar ableiten und das
Mouse-Event abfangen.

Ich habe die folgenden Codes aus der Unit Controls:

Delphi-Quellcode:
{ private }
procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;

{ published }
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;


{ Implementierung }
procedure TControl.WMRButtonDown(var Message: TWMRButtonDown);
begin
  inherited;
  DoMouseDown(Message, mbRight, []);
end;
Dann könntest im MouseDown-Event dir echte Maustaste abfangen, ich glaube so:
Delphi-Quellcode:
 If (mbRight = Button) then ...

Gruß
Jürgen

Anthauri 7. Sep 2008 11:10

Re: TTrckbar und Aktion auf rechte Maustaste - wie?
 
Vielen Dank für die Schnelle Antwort !
Allerdings habe ich bisher eigentlich immer nur die vorhandenen Events benutzt.

Leider habe ich keine Ahnung wie ich eine Control ableite und wo ich was dafür wo angeben muß.
(In der Suche konnte ich hierzu auf Anhib auch nichts passendes finden)

Pfoto 7. Sep 2008 12:06

Re: TTrckbar und Aktion auf rechte Maustaste - wie?
 
Hallo nochmal,

ich habe das versucht mal umzusetzen, doch leider funzt es nicht,
das Mouse-Down-Event wird im Inspektor angezeigt, aber nicht ausgelöst.

Vielleicht können die anderen mal drauf schauen, was ich falsch gemacht habe
(das Event OnChanged habe ich gleich mit dazugekommen):


Delphi-Quellcode:
unit dabTrackBar;

interface

uses
  SysUtils, Classes, Controls, ComCtrls, Messages, Forms,
  CommCtrl, StdCtrls;

type
  TdabTrackBar = class(TTrackBar)
  private
    { Private-Deklarationen }
    fOnChanged : TNotifyEvent;
    FOnMouseDown: TMouseEvent;
    FControlState: TControlState;
    FControlStyle: TControlStyle;
    procedure DoMouseDown(var Message: TWMMouse; Button: TMouseButton;
      Shift: TShiftState);
    procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;

  protected
    { Protected-Deklarationen }
  public
    { Public-Deklarationen }
    constructor Create(AOwner: TComponent); override;
    property ControlState: TControlState read FControlState write FControlState;
    property ControlStyle: TControlStyle read FControlStyle write FControlStyle;
  published
    { Published-Deklarationen }
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('dab', [TdabTrackBar]);
end;


procedure TdabTrackBar.CNHScroll(var Message: TWMHScroll);
begin
   inherited;
   if assigned(fOnChanged) and
      (Message.ScrollCode in [TB_THUMBPOSITION, TB_LINEUP, TB_LINEDOWN, TB_PAGEUP, TB_PAGEDOWN] )
   then
       fOnChanged(self);
end;

constructor TdabTrackBar.Create(AOwner: TComponent);
begin
  inherited;
  FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
end;

procedure TdabTrackBar.DoMouseDown(var Message: TWMMouse; Button: TMouseButton;
  Shift: TShiftState);
begin
  if not (csNoStdEvents in ControlStyle) then
    with Message do
      if (Width > 32768) or (Height > 32768) then
        with CalcCursorPos do
          MouseDown(Button, KeysToShiftState(Keys) + Shift, X, Y)
      else
        MouseDown(Button, KeysToShiftState(Keys) + Shift, Message.XPos, Message.YPos);
end;

procedure TdabTrackBar.WMLButtonDown(var Message: TWMLButtonDown);
begin
  SendCancelMode(Self);
  inherited;
  if csCaptureMouse in ControlStyle then MouseCapture := True;
  if csClickEvents in ControlStyle then Include(FControlState, csClicked);
  DoMouseDown(Message, mbLeft, []);
end;

procedure TdabTrackBar.WMMButtonDown(var Message: TWMMButtonDown);
begin
  inherited;
  DoMouseDown(Message, mbMiddle, []);
end;


procedure TdabTrackBar.WMRButtonDown(var Message: TWMRButtonDown);
begin
  inherited;
  DoMouseDown(Message, mbRight, []);
end;

end.
Gruß
Jürgen


Alle Zeitangaben in WEZ +1. Es ist jetzt 18:58 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