{$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;
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.
JulioDelphi
Messages postés2226Date d'inscriptiondimanche 5 octobre 2003StatutMembreDernière intervention18 novembre 201014 30 oct. 2007 à 23:17
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.
31 oct. 2007 à 00:24
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.
30 oct. 2007 à 23:17
Allez voir dans ma fiche, je n'ai pas le lien sous la main.