un composant perso

**jakouz** · 25/03/2011, 15h00

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

**Gilbert Geyer** · 25/03/2011, 15h26

Salut,

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

En voiçi un qui clignote :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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+.

**ShaiLeTroll** · 25/03/2011, 15h55

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 !

**EMC51** · 25/03/2011, 22h55

Ca existait dans une ancienne version de JVCL :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Gilbert Geyer** · 26/03/2011, 11h54

Bonjour,

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.

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+.

**Gilbert Geyer** · 26/03/2011, 13h01

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+.

**jakouz** · 27/03/2011, 13h52

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...

**macumba** · 28/03/2011, 14h22

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.

**ShaiLeTroll** · 28/03/2011, 15h50

Tu as l'oeil macumba !

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 !

**jakouz** · 01/04/2011, 14h44

Bravo macumba

!!! 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é)

un composant perso

Composants VCL Delphi

Discussions similaires

Partager

Partager