Bouton avec compte à rebours

Soyez le premier à donner votre avis sur cette source.

Vue 4 570 fois - Téléchargée 537 fois

Description

Salut à tous

Suite à un message de "MUSTAPH_A" qui demandait un peu d'aide voici une petite création rapide.

Un simple Composant de type TButton avec compte à rebours qui devrait l'aider.
Par contre je n'ai pas fait de commentaire (je l'envoie brut de fonderie), mais j'accepte toutes critiques qui permettrai d'agrémenter l'objet.

Source / Exemple :


unit CD_Button;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TCD_Button = class(TButton)
   private
    _Caption : integer;
    tmr : TTimer;
    Go : Boolean;
    Interv : Integer;

    Procedure Set_Caption(Value : integer);
    Procedure _CountDown(Sender : TObject);
    Procedure Set_Go(Value : boolean);
    Procedure Set_Interv(Value : Integer);
   published
    Property Action;
    Property Anchors;
    Property BiDiMode;
    Property Caption;
    Property Constraints;
    Property CountDown : boolean read Go write Set_Go default False;
    Property Cursor;
    property Default;
    Property DragCursor;
    Property DragKind;
    Property DragMode;
    Property Enabled;
    Property Font;
    Property Height;
    Property HelpContext;
    Property HelpKeyWord;
    Property HelpType;
    Property Hint;
    Property Interval : integer read Interv Write Set_Interv Default 1000;
    Property Left;
    Property ModalResult;
    Property Name;
    Property ParentBiDiMode;
    Property ParentFont;
    Property ParentShowHint;
    Property PopUpMenu;
    Property ShowHint;
    Property TabOrder;
    Property TabStop;
    Property Tag;
    Property Top;
    Property Value : Integer read _Caption Write Set_Caption default 100;
    Property Visible;
    Property Width;
    property OnClick;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
   public
    Constructor create(aowner : TComponent); override;
    Destructor destroy; override;
   end;

{procedure Register;}

implementation

Constructor TCD_Button.Create(AOwner : TComponent);
begin
 inherited Create(AOwner);
 Tmr := TTimer.Create(nil);
 Tmr.Enabled := False;
 Tmr.Interval := 1000;
 Tmr.OnTimer := _CountDown;
 Go := False;
 Interv := 1000;
 Caption := '100';
 Value := 100;
 repaint;
end;

Destructor TCD_Button.destroy;
begin
 Tmr.Destroy;
 Inherited Destroy;
end;

Procedure TCD_Button.Set_Interv(Value : Integer);
Begin
 Tmr.Interval := Value;
 Interv := Value;
end;

Procedure TCD_Button.Set_Go(Value : Boolean);
Begin
 Tmr.Enabled := Value;
 Go := Value;
end;

Procedure TCD_Button._CountDown(Sender : TObject);
begin
 Dec(_Caption);
 Caption := IntTostr(_Caption);
 Update;
end;

Procedure TCD_Button.Set_Caption(Value : Integer);
Begin
 _Caption := Value;
 Caption := IntTostr(_Caption);
 Update;
end;
{
procedure Register;
begin
 RegisterComponents('Perso', [TCD_Button]);
end;
}
end.

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

JulioDelphi
Messages postés
2349
Date d'inscription
dimanche 5 octobre 2003
Statut
Modérateur
Dernière intervention
18 novembre 2010
12 -
J'ai créée un composant qui n'est PAS un bouton mais qui s'adapte a un TButton, TSpeedButton, TBitBtn. en modifiant le code, on peut le faire fonctionner avec tous les boutons qu'on veux.
Allez voir dans ma fiche, je n'ai pas le lien sous la main.
f0xi
Messages postés
4200
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
2 janvier 2019
26 -
unit CD_Button;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

{.$DEFINE REGCOMPONENT}

type
TCDButton = class(TButton)
private
fCounter : cardinal;
fTimer : TTimer;
fOnCounterEnd: TNotifyEvent;
Procedure SetCounter(value: cardinal);
Procedure SetTimerState(value: boolean);
function GetTimerState: boolean;
Procedure SetInterval(value: cardinal);
function GetInterval: cardinal;
protected
procedure CounterEnd; virtual;
procedure DoCountDown(Sender: TObject); virtual;
published
property Active : boolean read GetTimerState write SetTimerState default False;
property Interval: cardinal read GetInterval Write SetInterval default 1000;
property Counter : cardinal read fCounter Write SetCounter default 100;
property OnCounterEnd: TNotifyEvent read fOnCounterEnd write fOnCounterEnd;
public
Constructor create(aowner : TComponent); override;
Destructor destroy; override;
end;

{$IFDEF REGCOMPONENT}
procedure Register;
{$ENDIF}

implementation

{$IFDEF REGCOMPONENT}
procedure Register;
begin
RegisterComponents('Exemples', [TCDButton]);
end;
{$ENDIF}

Constructor TCDButton.Create(AOwner : TComponent);
begin
inherited Create(AOwner);

fTimer := TTimer.Create(self);
with fTimer do
begin
Enabled := False;
Interval := 1000;
OnTimer := DoCountDown;
end;

SetCounter(100);
end;

Destructor TCDButton.destroy;
begin
fTimer.Enabled := false;
fTimer.Free;
Inherited Destroy;
end;

Procedure TCDButton.SetInterval(value: cardinal);
Begin
if fTimer.Interval <> Value then
fTimer.Interval := Value;
end;

Procedure TCDButton.SetTimerState(value: Boolean);
Begin
if fTimer.Enabled <> Value then
fTimer.Enabled := Value;
end;

Procedure TCDButton.DoCountDown(Sender: TObject);
begin
fCounter := fCounter - 1;
Caption := IntTostr(fCounter);
if fCounter = 0 then
begin
fTimer.Enabled := false;
CounterEnd;
end;
Update;
end;

Procedure TCDButton.SetCounter(Value: cardinal);
Begin
if fCounter <> Value then
begin
fCounter := Value;
Caption := IntTostr(fCounter);
Update;
end;
end;

procedure TCDButton.CounterEnd;
begin
if Assigned(fOnCounterEnd) then
fOnCounterEnd(Self);
end;

function TCDButton.GetInterval: cardinal;
begin
result := fTimer.Interval;
end;

function TCDButton.GetTimerState: boolean;
begin
result := fTimer.Enabled;
end;

end.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, CD_Button;

Type
TForm1 = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
public
procedure DoCDButtonClick(sender : TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DoCDButtonClick(sender : TObject);
begin
with (sender as TCDButton) do
Active := not Active;
end;

var
CDBtnList : array of TCDButton;
LastIndex : integer = -1;

procedure TForm1.FormDestroy(Sender: TObject);
var N : integer;
begin
for N := LastIndex downto 0 do
CDBtnList[N].Free;
SetLength(CDBtnList, 0);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
LastIndex := LastIndex + 1;
SetLength(CDBtnList, LastIndex+1);
CDBtnList[LastIndex] := TCDButton.create(Self);
with CDBtnList[LastIndex] do
begin
Parent := self;
Left := X;
Top := Y;
OnClick := DoCDButtonClick;
Counter := random(50)+50;
end;
end;

end.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.