Einzelnen Beitrag anzeigen

Pfoto

Registriert seit: 26. Aug 2005
Ort: Daun
541 Beiträge
 
Turbo Delphi für Win32
 
#4

Re: TTrckbar und Aktion auf rechte Maustaste - wie?

  Alt 7. Sep 2008, 12:06
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
Jürgen Höfs
  Mit Zitat antworten Zitat