button mit wiederolfunktion

[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;