button mit wiederolfunktion

[Noob]

Hallo, habe folgendes Problem...
also ich bin delphi Anfänger (am Namen zu lesen^^) also, ich Habs gerade geschafft, meine erste Komponente nach Tutorial und selberbastelei in delphi Xe3 starter wenigstens in
die Komponentenleiste zum ziehen aufs formular zu bringen. aber der Wiederholbutton Funktioniert nicht so wie er soll sondern nur wie ein normaler Button von dem er abstammt.
Es soll ein Button sein, der die gewünschte Aktion beim "gedrückt halten" mit timer wiederholen soll.
Kann mir jemand sagen was hier falsch läuft ?

hier mal der Code :

unit Wiederholbutton;


interface

uses
System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, extctrls;

type
TWiederholbutton = class(TButton)

private
FInitRepeatPause : Cardinal;
FRepeatPause : Cardinal;
FAllowRepeat : Boolean;


{ Private-Deklarationen }
protected
FRepeatTimer: TTimer;
{ Protected-Deklarationen }
public
procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
procedure TimerExpired(Sender: TObject);
procedure MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
{ Public-Deklarationen }
published
Property InitRepeatPause : Cardinal read FInitRepeatPause write FInitRepeatPause;
Property RepeatPause : Cardinal read FRepeatPause write FRepeatPause;
Property AllowRepeat : Boolean read FAllowRepeat write FAllowRepeat;
{ Published-Deklarationen }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Standard', [TWiederholbutton]);
end;



procedure TWiederholbutton.TimerExpired(Sender: TObject);
begin
FRepeatTimer.Interval := FRepeatPause;
Click;
end;

procedure TWiederholbutton.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
If FAllowRepeat = False then Exit;
if
FRepeatTimer = nil
then
FRepeatTimer := TTimer.Create(Self);

FRepeatTimer.OnTimer := TimerExpired;
FRepeatTimer.Interval := fInitRepeatPause;
FRepeatTimer.Enabled := True;
end;


procedure TWiederholbutton.MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
If FAllowRepeat = False then Exit;
if FRepeatTimer <> nil
then FRepeatTimer.Enabled := false;
end;



end

[Bummi]

Mouseup und Down wäre als Methoden zu implementieren und zuzuweisen, allerdings könnte dann jeder Deine Zuweisung wieder abhängen. Besser ist es direkt die Mousemessages zu verarbeiten.

Delphi-Quellcode:

unit Wiederholbutton;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, extctrls,Messages;

type
  TWiederholbutton = class(TButton)

  private
    FAllowRepeat: Boolean;
    procedure SetRepeatPause(const Value: Cardinal);
    function GetRepeatPause: Cardinal;
    procedure SetAllowRepeat(const Value: Boolean);
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMLButtonDown(var Message: TWMRButtonUp); message WM_LBUTTONDown;

    { Private-Deklarationen }
  protected
    FRepeatTimer: TTimer;
     procedure Click;override;
    { Protected-Deklarationen }
  public
    procedure TimerExpired(Sender: TObject);
    Constructor Create(Aowner: TComponent); Override;
    Destructor Destroy; Override;
    { Public-Deklarationen }
  published
    Property RepeatPause: Cardinal read GetRepeatPause write SetRepeatPause;
    Property AllowRepeat: Boolean read FAllowRepeat write SetAllowRepeat;
    { Published-Deklarationen }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TWiederholbutton]);
end;

procedure TWiederholbutton.TimerExpired(Sender: TObject);
begin
  Click;
end;


procedure TWiederholbutton.WMLButtonDown(var Message: TWMRButtonUp);
begin
  inherited;
  If FAllowRepeat then
    begin
      Click;
      FRepeatTimer.OnTimer := TimerExpired;
      FRepeatTimer.Enabled := True;
    end;

end;

procedure TWiederholbutton.WMLButtonUp(var Message: TWMLButtonUp);
begin
   inherited;
   FRepeatTimer.Enabled := False;
end;

constructor TWiederholbutton.Create(Aowner: TComponent);
begin
  inherited;
  FRepeatTimer := TTimer.Create(Self);
  FRepeatTimer.Interval := 100;
  FRepeatTimer.Enabled := false;
end;

destructor TWiederholbutton.Destroy;
begin
  FRepeatTimer.Free;
  inherited;
end;

function TWiederholbutton.GetRepeatPause: Cardinal;
begin
  Result := FRepeatTimer.Interval;
end;


// Um Click nach loslassen des Buttons zu vermeiden
procedure TWiederholbutton.Click;
begin
  if (not FAllowRepeat) or FRepeatTimer.Enabled then
    inherited Click;

end;

procedure TWiederholbutton.SetAllowRepeat(const Value: Boolean);
begin
  FAllowRepeat := Value;
  FRepeatTimer.Enabled := false;
end;

procedure TWiederholbutton.SetRepeatPause(const Value: Cardinal);
begin
    FRepeatTimer.Interval := Value;
end;


end.

Minitest:

Delphi-Quellcode:

uses Wiederholbutton;

procedure TForm4.MyClick(Sender: TObject);
begin
   ListBox1.Items.Add(DateTimeToStr(now));
end;

procedure TForm4.Button1Click(Sender: TObject);

begin
    With TWiederholbutton.create(self) do
      begin
        Parent := Self;
        OnClick := MyClick;
        AllowRepeat := true;
      end;
end;

[Noob]

Cooool, vielen dank Bummi, das funktioniert erstmal super, wie genau werd ich mir die tage mal zu Gemüte führen, Meine erste lauffähige Komponente :) (dank Copy/ Paste) :-D

[Noob]

Seit Tagen rumgedümpelt. das erste Erolgserlebnis seit ich Komponenten machen wollte^^ also echt dickes danke vom Noob, (verstehen werd ich das alles eh nur nach und nach):-D

[Bummi]

nuja ... soviel zu verstehen gibt es da ja nicht