Discussion :

[jack554]

Bonjour,

Je ne sais pas trop si le titre de ce sujet est clair ... Je sais faire défiler un texte dans un label, caractère par caractère avec un timer ... mais pixel par pixel ? Possible ?

Merci par avance de vos idées et suggestions.
Jack.

[ShaiLeTroll]

Pixel par Pixel, utilise une TPaintBox\TImage
Il suffit de dessiner le texte dans un TBitmap, une seule fois, puis via DrawTo tu dessines dans la TPaintBox\TImage en décalant l'offset, si tu veux un texte rotatif, il suffit de faire un deuxième dessin décaler de la largeur du texte + espacement

[jack554]

Merci ShaiLeTroll, malheureusement mon texte est variable, comme par exemple l'heure ...

[ShaiLeTroll]

Cela ne change pas grand chose !
Suffit de changer le texte régulièrement

C'est baclé mais tu peux tout mettre dans le TScroller et en faire un vrai composant

Code dfm :

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
 
object BtnScrollingText: TButton
  Left = 16
  Top = 176
  Width = 75
  Height = 25
  Caption = 'Scrolling Text'
  TabOrder = 0
  OnClick = BtnScrollingTextClick
end
object PaintBoxScrollingText: TPaintBox
  Left = 112
  Top = 176
  Width = 297
  Height = 105
  OnPaint = PaintBoxScrollingTextPaint
end
object TrackBarScrollingText: TTrackBar
  Left = 16
  Top = 287
  Width = 150
  Height = 26
  Max = 1000
  Min = 1
  PageSize = 20
  Frequency = 100
  Position = 1000
  TabOrder = 1
  ThumbLength = 15
  OnChange = TrackBarScrollingTextChange
end

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
 
type
  TScroller = class(TObject)
  private
    FCache: TBitmap;
    FPosition: Integer;
    FMax: Integer;
    FText: string;
    procedure SetText(const Value: string);
    procedure SetPosition(const Value: Integer);
    procedure SetMax(const Value: Integer);
  public
    procedure DrawTo(ACanvas: TCanvas);
    property Text: string read FText write SetText;
    property Position: Integer read FPosition write SetPosition;
    property Max: Integer read FMax write SetMax;
  end;
 
{ TScroller }
 
procedure TScroller.DrawTo(ACanvas: TCanvas);
begin
  if not Assigned(FCache) then
  begin
    FCache := TBitmap.Create();
    FCache.Canvas.Font := ACanvas.Font;
    FCache.Width := FCache.Canvas.TextExtent(FText + ' ').Width;
    FCache.Height := FCache.Canvas.TextExtent(FText + ' ').Height;
    FCache.Canvas.TextOut(0, 0, FText + ' ');
  end;
  ACanvas.Draw(Position - System.Math.Max(FCache.Width, FMax), 0, FCache);
  ACanvas.Draw(Position, 0, FCache);
end;
 
procedure TScroller.SetMax(const Value: Integer);
begin
  FMax := Value;
  if Assigned(FCache) and (FPosition > System.Math.Max(FCache.Width, FMax)) then
    FPosition := 0;
end;
 
procedure TScroller.SetPosition(const Value: Integer);
begin
  FPosition := Value;
  if Assigned(FCache) and (FPosition > System.Math.Max(FCache.Width, FMax)) then
    FPosition := 0;
end;
 
procedure TScroller.SetText(const Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    FreeAndNil(FCache);
  end;
end;
 
var
  Scroller: TScroller = nil;
 
 
procedure TZooVCLControlExperimentForm.BtnScrollingTextClick(Sender: TObject);
begin
  if not Assigned(Scroller) then
  begin
    Scroller := TScroller.Create();
    Scroller.Text := FormatDateTime('dddd d mmmm yyyy, hh:nn:ss', Now());
    Scroller.Max := PaintBoxScrollingText.Width;
  end;
 
  PaintBoxScrollingText.Canvas.Font := BtnScrollingText.Font;
  TimerScrollingText.Enabled := not TimerScrollingText.Enabled;
end;
 
procedure TZooVCLControlExperimentForm.PaintBoxScrollingTextPaint(Sender: TObject);
begin
  if Assigned(Scroller) then
    Scroller.DrawTo(PaintBoxScrollingText.Canvas);
end;
 
procedure TZooVCLControlExperimentForm.TimerScrollingTextTimer(Sender: TObject);
begin
  if Assigned(Scroller) then
  begin
    Scroller.Text := FormatDateTime('dddd d mmmm yyyy, hh:nn:ss', Now());
    Scroller.Position := Scroller.Position + 1;
  end;
 
  PaintBoxScrollingText.Invalidate();
end;
 
procedure TZooVCLControlExperimentForm.TrackBarScrollingTextChange(Sender: TObject);
begin
  TimerScrollingText.Enabled := not TimerScrollingText.Enabled;
  TimerScrollingText.Interval := TrackBarScrollingText.Position;
  TimerScrollingText.Enabled := not TimerScrollingText.Enabled;
end;

[jack554]

Oh là là, désolé ShaiLeTroll, tu vas rire (ou pas !), mais c'est compliqué pour moi, pauvre développeur niveau 1 que je suis
Je ne sais pas où mettre tout ce code ...
J'ai juste créé une form1 avec les trois composants BtnScrollingText (le bouton), PaintBoxScrollingText (la TPaintBox) et TrackBarScrollingText (le TrackBar), puis collé le code en dessous dans la partie implementation de Unit1 comme ci-dessous, mais j'ai (évidemment) une erreur sur la propriété Width de FCache ...

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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls;
 
type
  TForm1 = class(TForm)
    TrackBarScrollingText: TTrackBar;
    BtnScrollingText: TButton;
    PaintBoxScrollingText: TPaintBox;
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
 
  TScroller = class(TObject)
  private
    FCache: TBitmap;
    FPosition: Integer;
    FMax: Integer;
    FText: string;
    procedure SetText(const Value: string);
    procedure SetPosition(const Value: Integer);
    procedure SetMax(const Value: Integer);
  public
    procedure DrawTo(ACanvas: TCanvas);
    property Text: string read FText write SetText;
    property Position: Integer read FPosition write SetPosition;
    property Max: Integer read FMax write SetMax;
  end;
 
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TScroller.DrawTo(ACanvas: TCanvas);
begin
  if not Assigned(FCache) then
  begin
    FCache := TBitmap.Create();
    FCache.Canvas.Font := ACanvas.Font;
    FCache.Width := FCache.Canvas.TextExtent(FText + ' ').Width;
    FCache.Height := FCache.Canvas.TextExtent(FText + ' ').Height;
    FCache.Canvas.TextOut(0, 0, FText + ' ');
  end;
  ACanvas.Draw(Position - System.Math.Max(FCache.Width, FMax), 0, FCache);
  ACanvas.Draw(Position, 0, FCache);
end;
 
procedure TScroller.SetMax(const Value: Integer);
begin
  FMax := Value;
  if Assigned(FCache) and (FPosition > System.Math.Max(FCache.Width, FMax)) then
    FPosition := 0;
end;
 
procedure TScroller.SetPosition(const Value: Integer);
begin
  FPosition := Value;
  if Assigned(FCache) and (FPosition > System.Math.Max(FCache.Width, FMax)) then
    FPosition := 0;
end;
 
procedure TScroller.SetText(const Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    FreeAndNil(FCache);
  end;
end;
 
var
  Scroller: TScroller = nil;
 
procedure TZooVCLControlExperimentForm.BtnScrollingTextClick(Sender: TObject);
begin
  if not Assigned(Scroller) then
  begin
    Scroller := TScroller.Create();
    Scroller.Text := FormatDateTime('dddd d mmmm yyyy, hh:nn:ss', Now());
    Scroller.Max := PaintBoxScrollingText.Width;
  end;
 
  PaintBoxScrollingText.Canvas.Font := BtnScrollingText.Font;
  TimerScrollingText.Enabled := not TimerScrollingText.Enabled;
end;
 
procedure TZooVCLControlExperimentForm.PaintBoxScrollingTextPaint(Sender: TObject);
begin
  if Assigned(Scroller) then
    Scroller.DrawTo(PaintBoxScrollingText.Canvas);
end;
 
procedure TZooVCLControlExperimentForm.TimerScrollingTextTimer(Sender: TObject);
begin
  if Assigned(Scroller) then
  begin
    Scroller.Text := FormatDateTime('dddd d mmmm yyyy, hh:nn:ss', Now());
    Scroller.Position := Scroller.Position + 1;
  end;
 
  PaintBoxScrollingText.Invalidate();
end;
 
procedure TZooVCLControlExperimentForm.TrackBarScrollingTextChange(Sender: TObject);
begin
  TimerScrollingText.Enabled := not TimerScrollingText.Enabled;
  TimerScrollingText.Interval := TrackBarScrollingText.Position;
  TimerScrollingText.Enabled := not TimerScrollingText.Enabled;
end;
 
 
end.

[ShaiLeTroll]

Tient j'ai oublié le Timer

Code :

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

1
2
3
4
5
6
object TimerScrollingText: TTimer
  Enabled = False
  OnTimer = TimerScrollingTextTimer
  Left = 52
  Top = 240
end

Tu sais que tu peux aussi copier le texte dfm et le coller directement sur la fiche ?

Après, une erreur, c'est flou, précise un peu !

Déjà il semble évident que ta fiche s'appelle TForm1 alors qu'il faut renommer TZooVCLControlExperimentForm en TForm1, si cela ne l'est pas pour toi, ne mets pas la charrue avant les bœufs, je te conseille de compulser Guide Pascal et Delphi avant de vouloir aller plus loin

[Gilbert Geyer]

Bonjour,

Peut-être que le simple bidouillage suivant pourrait faire l'affaire :

Avec un premier Timer où l'on actualise l'heure :

Code :

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

1
2
3
4
5
procedure TForm1.Timer1Timer(Sender: TObject); // Timer1.interval = 1000
begin
  LabelDefile.Caption:=' Heure :'+TimeToStr(now);
  LabelDefile.upDate;
end;

... et un deuxième Timer où l'on fait défiler l'heure avec un Timer2.interval égal à une fraction de Timer1.interval :

Code :

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

1
2
3
4
5
6
procedure TForm1.Timer2Timer(Sender: TObject);  // Timer2.interval = 200
const Saut = 1;
begin
  LabelDefile.Caption := Copy(labelDefile.Caption, Saut + 1, Length(labelDefile.Caption) - Saut)
    + Copy(labelDefile.Caption, 1, Saut);
end;

Le problème avec les trucs qui défilent c'est que ça fatigue les yeux.

A+.