COMPOSANT : TDBPDEFAULTBUTTON

{
################################################################################
# DBPDEFAULTBUTTON                                                             #
################################################################################
#                                                                              #
# VERSION       : 1.1                                                          #
# FICHIERS      : dbpDefaultButton.pas,.dcu,.dcr,.bmp,ReadMe.htm               #
# AUTEUR        : Julio P. (Diabloporc)                                        #
# CREATION      : 13 dec 2004                                                  #
# MODIFIEE      : 14 dec 2004                                                  #
# SITE WEB      : http://diabloporc.free.fr                                    #
# MAIL          : juliobox@free.fr                                             #
# LEGAL         : Free sous Licence GNU/GPL                                    #
# INFOS         : Retrouvez moi sur www.delphifr.com : "JulioDelphi"           #
#                                                                              #
################################################################################
}
unit dbpDefaultButton;

interface

uses
  buttons, stdCtrls, SysUtils, Classes, ExtCtrls, controls, forms;

type
  TdbpDelay = 1..3600;
  TdbpDefaultButton = class(TComponent)
  private
    fDelay: TdbpDelay;
    fAbout,fCaptionSuffix, fCaption: string;
    fTButton: TButton;
    fTSpeedButton: TSpeedButton;
    fEnable, fActive: boolean;
    fTimer: TTimer;
    fTimeDelay: word;

    procedure SetAbout(v: string);
    procedure SetFButton(compo: TButton);
    procedure SetFSpeedButton(compo: TSpeedButton);
    procedure SetEnable(Value: boolean);
    procedure SetDelay(Value: TdbpDelay);
    procedure SetCaptionSuffix(value: string);
    procedure ProcOnTimer(Sender: TObject);
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent);                       override;
    Destructor  Destroy;                                          override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  published
    property About: string read fAbout write SetAbout;
    property Enabled: boolean read fEnable write SetEnable default false;
    property TButton: Tbutton read fTButton write SetFButton;
    property TButtonActive: boolean read fActive write fActive default true;
    property TSpeedButton: TSpeedbutton read fTSpeedButton write SetFSpeedButton;
    property Delay: TdbpDelay read fDelay write SetDelay default 5;
    property CaptionSuffix: string read fCaptionSuffix write SetCaptionSuffix;
  end;

procedure Register;

implementation

{$R *.dcr}

procedure TdbpDefaultButton.SetAbout(v: string);
begin
 //
end;

procedure TdbpDefaultButton.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (aComponent = fTButton) and (Operation = opRemove) then fTButton := nil;
  if (aComponent = fTSpeedButton) and (Operation = opRemove) then fTSpeedButton := nil;
end;

procedure TdbpDefaultButton.SetDelay(Value: TdbpDelay);
begin
 if (fenable) or (Value=fDelay) then exit;
 fTimeDelay := Value;
 fDelay := Value;
end;

procedure TdbpDefaultButton.SetCaptionSuffix(Value: string);
begin
 if (fEnable) or (Value=fCaptionSuffix) then exit;
 fCaptionSuffix := Value;
end;

procedure TdbpDefaultButton.SetFButton(compo: TButton);
begin
 if fenable then exit;
 if fTButton<>compo then fTButton := Compo;
 fTSpeedButton := nil;
end;

procedure TdbpDefaultButton.SetFSpeedButton(compo: TSpeedButton);
begin
 if fenable then exit;
 if fTSpeedButton<>compo then fTSpeedButton := Compo;
 fTButton := nil;
end;

procedure TdbpDefaultButton.SetEnable(Value: boolean);
begin
 if (csDesigning in ComponentState) or (fEnable=Value) or ((not Assigned(fTButton)) and (not Assigned(fTSpeedButton))) then exit;
 fEnable := Value;
 fTimer.Enabled := value;
 if (assigned(TButton)) and fActive and fEnable then TButton.SetFocus;
 if not fEnable then fTimeDelay := fDelay;
 if Assigned(fTButton) then
  begin
  if fEnable then
   begin
    fCaption := fTButton.Caption;
    fTButton.Caption := Format('%s%s%d',[fCaption,fCaptionSuffix,fTimeDelay]);
   end
  else
   begin
    fTButton.Caption := fCaption;
   end;
  end
 else
  begin
   if fEnable then
    begin
     fCaption := fTSpeedButton.Caption;
     fTSpeedButton.Caption := Format('%s%s%d',[fCaption,fCaptionSuffix,fTimeDelay]);
    end
   else
    begin
     fTSpeedButton.Caption := fCaption;
    end;
  end;
end;

constructor TdbpDefaultButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FAbout          := 'v1.0 par Julio P. (Diabloporc)';
 fDelay          := 5;
 fActive         := true;
 fEnable         := false;
 fTimeDelay      := 5;
 fTimer          := TTimer.Create(self);
 fTimer.Enabled  := false;
 fTimer.Interval := 999;
 fTimer.OnTimer  := ProcOnTimer;
 fCaption        := '';
end;

destructor TdbpDefaultButton.destroy;
begin
 inherited destroy;
 fTimer.Enabled := false;
 fTimer := nil;
end;

procedure TdbpDefaultButton.ProcOnTimer(Sender: TObject);
begin
if (csDesigning in ComponentState) then exit;
 dec(fTimeDelay);
 if assigned(fTButton) then
  begin
   fTButton.caption := format('%s%s%d',[fCaption,fCaptionSuffix,fTimeDelay]);
   sleep(1);
   if (fTimeDelay=0) then
    begin
     SetEnable(false);
     fTButton.click;
    end;
  end
 else
 if assigned(fTSpeedButton) then
  begin
   fTSpeedButton.caption := format('%s%s%d',[fCaption,fCaptionSuffix,fTimeDelay]);
   sleep(1);
   if (fTimeDelay=0) then
    begin
     SetEnable(false);
     fTSpeedButton.Click;
    end;
  end;
end;

procedure Register;
begin
  RegisterComponents('Diabloporc', [TdbpDefaultButton]);
end;

end.

Télécharger le zip

14 décembre 2004 00:28:46 :

euh rien :D

14 décembre 2004 21:17:55 :

ajout d'une propriété TbuttonActive qui permet de donner le focus au Tbutton, TBitbtn choisi au moment du Enabled := true;