un composant perso

Version imprimable

un composant perso

A titre d'exemple, je veux créer un composant personnel simple; il s'agit d'un Label qui clignote dont voici le code source :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
 
interface
 
uses StdCtrls, QExtCtrls, Classes;
 
type
TFlashLabel = class(TCustomLabel)
  private
    { Déclarations privées }
    Ftimer :TTimer;
    Ffrequence :Cardinal;
    Fflashing :Boolean;
    procedure SetFlashing(const isFlashing :Boolean);
    procedure SetFrequence(const Afrequence :Cardinal);
    procedure TmrTimer(Sender: TObject);
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
    //destructor Destroy; override;
    property Flashing :Boolean read Fflashing write SetFlashing default True;
    property Frequence :Cardinal read Ffrequence write SetFrequence default 1000;
  end;
 
implementation
 
{ TFlashLabel }
 
constructor TFlashLabel.Create(AOwner: TComponent);
begin
  inherited;
  Fflashing := True;
  Ffrequence := 1000;
  Ftimer := TTimer.Create(Self);
  Ftimer.Enabled := Fflashing;
  Ftimer.Interval := Ffrequence;
  Ftimer.OnTimer := TmrTimer;
end;
 
//destructor TFlashLabel.Destroy;
//begin
//  Ftimer.Free;
//  inherited;
//end;
 
procedure TFlashLabel.SetFlashing(const IsFlashing: Boolean);
begin
  Fflashing := IsFlashing;
  if not Fflashing then
    Visible := True;
  Ftimer.Enabled := IsFlashing;
end;
 
procedure TFlashLabel.SetFrequence(const Afrequence: Cardinal);
begin
  Ffrequence := Afrequence;
  Ftimer.Interval := Afrequence;
end;
 
procedure TFlashLabel.TmrTimer(Sender: TObject);
begin
  Visible := not Visible;
end;

pour tester ce composant j'utilise une fiche avec un bouton et une zone edit où j'instancie dynamiquement le TFlashLabel dont voici le code source :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
var
  FshLbl :TFlashLabel;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  FshLbl := TFlashLabel.Create(Self);
  FshLbl.Parent := Self;
  FshLbl.SetBounds(50, 50, 200, 20);
  FshLbl.Caption := 'COUCOU...COUCOU...COUCOU';
  FshLbl.Visible := True;
end;
 
procedure TForm1.btn1Click(Sender: TObject);
begin
  FshLbl.Flashing := not FshLbl.Flashing;
  if FshLbl.Flashing then
    TButton(Sender).Caption := 'label statique'
  else
    TButton(Sender).Caption := 'label dynamique';
  FshLbl.Frequence := StrToIntDef(medt1.Text, 1000);
end;

le problème est qu'il ne clignote pas ... et je vois pas ce que j'ai oublié dans le code. un petit coup de main SVP ?

25/03/2011, 15h26
Gilbert Geyer
Salut,

Bigre quelle usine à gaz, pas besoin d'un composant spécial.

En voiçi un qui clignote :
Code:

1 2 3 4 procedure TForm1.Timer1Timer(Sender: TObject); begin Timer1.Interval:=300; MonLabel.visible:=not MonLabel.visible; end;
Timer1.Interval:=300; est à placer dans l'inspecteur si on veut pas modifier l'intervalle de 300 ms
mais si on veut permettre à l'utilisateur de la modifier y'à-ka créer un TEdit pour lui permettre de le modifier.

A+. :D
25/03/2011, 15h55
ShaiLeTroll

J'ai du faire la même chose quand j'ai débuté !
Est-ce que rentre dans TmrTimer (un ShowMessage te le dira)
Je me rappele de violation d'accès montreuse !

Ton code semble bon, ne cumul pas trop de TTimer, j'ai modifié mon composant au final, pour qu'il s'accroche sur un singleton, un thread se chargait de calculer les délais pour chaque objet accorché et envoyait un message

@Gilbert Geyer, c'est un dev à but pédagogique, plus que fonctionnel !

Ca existait dans une ancienne version de JVCL :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
type
  TJvBlinkingLabel = class(TJvLabel)
  private
    FBlinking: Boolean;
    FShowing: Boolean;
    FTimer: TTimer;
    FDelay: Cardinal;
    FBlink: Integer;
    procedure SetBlinking(Value: Boolean);
    procedure OnBlink(Sender: TObject);
  protected
    function GetLabelText: string; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Blinking: Boolean read FBlinking write SetBlinking default True;
    property BlinkingDelay: Cardinal read FDelay write FDelay default 400;
    property BlinkingTime: Integer read FBlink write FBlink default 200;
  end;
 
implementation
 
constructor TJvBlinkingLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBlinking := True;
  FShowing := True;
  FDelay := 400;
  FBlink := 200;
  FTimer := TTimer.Create(Self);
  FTimer.OnTimer := OnBlink;
  FTimer.Interval := FDelay;
  FTimer.Enabled := FBlinking;
end;
 
destructor TJvBlinkingLabel.Destroy;
begin
  FTimer.Enabled := False;
  FTimer.Free;
  inherited Destroy;
end;
 
function TJvBlinkingLabel.GetLabelText: string;
begin
  if FShowing then
    Result := Caption
  else
    Result := '';
end;
 
procedure TJvBlinkingLabel.SetBlinking(Value: Boolean);
begin
  if Value <> FBlinking then
  begin
    FBlinking := Value;
    FTimer.Interval := BlinkingTime;
    FTimer.Enabled := Value;
    FShowing := True;
    Invalidate;
  end;
end;
 
procedure TJvBlinkingLabel.OnBlink(Sender: TObject);
begin
  FShowing := not FShowing;
  if not FShowing then
    FTimer.Interval := FDelay
  else
    FTimer.Interval := FBlink;
  Invalidate;
end;

Mais effectivement si on en a 50 en même temps ça fait beaucoup de timers et le singleton est bien vu :ccool:

26/03/2011, 11h54
Gilbert Geyer

Bonjour,

Citation:

ShaiLeTroll :
@Gilbert Geyer, c'est un dev à but pédagogique, plus que fonctionnel !

... OK, mais en matière de pédagogie j'ai un faible très prononcé pour la simplicité d'où ma réaction sans oublier qu'avec une usine à gaz qui comporte un bug on s'emm... à s'équarquiller les yeux pour le localiser.

Citation:

EMC51:
Mais effectivement si on en a 50 en même temps ça fait beaucoup de timers

... non seulement cela ferait beaucoup de timers mais en plus ils ne seraient réellement utiles que s'il étaient utilisés pour faire clignoter les 50 à des fréquences différentes : l'utilisateur en prendrai plein les yeux !

A+. :D

Re-bonjour,

Entre-temps j'ai testé le code initial de Jakouz après l'avoir adapté à Delphi 5 les seules modifs apparaissent dans le uses principal. Et le code ci-après fonctionne parfaitement sans avoir nécessité d'autres modifs :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
unit uLabelClignot;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,
  extctrls; //<- ajouté pour les TTimer''s
  // QExtCtrls <- n''existe pas sous Delphi5
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
type
TFlashLabel = class(TCustomLabel)
  private
    { Déclarations privées }
    Ftimer :TTimer;
    Ffrequence :Cardinal;
    Fflashing :Boolean;
    procedure SetFlashing(const isFlashing :Boolean);
    procedure SetFrequence(const Afrequence :Cardinal);
    procedure TmrTimer(Sender: TObject);
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
    //destructor Destroy; override;
    property Flashing :Boolean read Fflashing write SetFlashing default True;
    property Frequence :Cardinal read Ffrequence write SetFrequence default 1000;
  end;
 
{ TFlashLabel }
 
constructor TFlashLabel.Create(AOwner: TComponent);
begin
  inherited;
  Fflashing := True;
  Ffrequence := 1000;
  Ftimer := TTimer.Create(Self);
  Ftimer.Enabled := Fflashing;
  Ftimer.Interval := Ffrequence;
  Ftimer.OnTimer := TmrTimer;
end;
 
//destructor TFlashLabel.Destroy;
//begin
//  Ftimer.Free;
//  inherited;
//end;
 
procedure TFlashLabel.SetFlashing(const IsFlashing: Boolean);
begin
  Fflashing := IsFlashing;
  if not Fflashing then
    Visible := True;
  Ftimer.Enabled := IsFlashing;
end;
 
procedure TFlashLabel.SetFrequence(const Afrequence: Cardinal);
begin
  Ffrequence := Afrequence;
  Ftimer.Interval := Afrequence;
end;
 
procedure TFlashLabel.TmrTimer(Sender: TObject);
begin
  Visible := not Visible;
end;
 
var
  FshLbl :TFlashLabel;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  FshLbl := TFlashLabel.Create(Self);
  FshLbl.Parent := Self;
  FshLbl.SetBounds(50, 50, 200, 20);
  FshLbl.Caption := 'COUCOU...COUCOU...COUCOU';
  FshLbl.Visible := True;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  FshLbl.Flashing := not FshLbl.Flashing;
  if FshLbl.Flashing then
    TButton(Sender).Caption := 'label statique'
  else
    TButton(Sender).Caption := 'label dynamique';
  FshLbl.Frequence := StrToIntDef(edit1.Text, 1000);
end;
 
END.

A+. :D

27/03/2011, 13h52
jakouz

j'ai testé le code sous Delphi 5 ; ça marche moyennant qq modifs dans la clause uses. donc c'est très bizarre que ça ne fonctionne pas sous Delphi 7 ! incompréhensible...
28/03/2011, 14h22
macumba

Hello,
C'est quoi les modifs dans ta clause uses sous delphi 7?
Tu n'as pas ajouter un nouveau uses commençant par un Q..., ces uses servent pour Kilyx et non Delphi, elles ont la même utilité, mais pas pour le même environnement de compilation.
28/03/2011, 15h50
ShaiLeTroll

Tu as l'oeil macumba ! :ccool:
Effectivement le TTimer de QExtCtrls (Kylix) et ExtCtrls (VCL), ce n'est pas le même ! l'implémentation est très différente, l'une par QT et l'autre Win32

Mélanger les deux, ce n'est jamais bon !
Les constantes ne sont pas les mêmes, ils se mélangent les pinceaux !
01/04/2011, 14h44
jakouz

Bravo macumba :ccool:!!! c'est bien dans la clause Uses qui posait problème : remplacer QExtCtrls par ExtCtrls et tout est rentré dans l'ordre. Encore merci (j'aurais jamais trouvé):)