AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

button mit wiederolfunktion

Ein Thema von Noob · begonnen am 26. Mär 2013 · letzter Beitrag vom 26. Mär 2013
Antwort Antwort
Noob

Registriert seit: 26. Mär 2013
3 Beiträge
 
#1

button mit wiederolfunktion

  Alt 26. Mär 2013, 19:31
Delphi-Version: XE2
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

Geändert von Noob (26. Mär 2013 um 19:56 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#2

AW: button mit wiederolfunktion

  Alt 26. Mär 2013, 20:34
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;
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
Noob

Registriert seit: 26. Mär 2013
3 Beiträge
 
#3

AW: button mit wiederolfunktion

  Alt 26. Mär 2013, 21:16
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)
  Mit Zitat antworten Zitat
Noob

Registriert seit: 26. Mär 2013
3 Beiträge
 
#4

AW: button mit wiederolfunktion

  Alt 26. Mär 2013, 21:38
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)
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#5

AW: button mit wiederolfunktion

  Alt 26. Mär 2013, 21:54
nuja ... soviel zu verstehen gibt es da ja nicht
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 05:34 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