Function Text Animation

**kheiropc** · 11/12/2009, 15h09

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
procedure anim(str : string ; memo1: TMemo);
var
i:Integer;
x:String;
begin
  For i:= 1 to length(str) do
    begin
    Form1.Memo1.Text := (Form1.Memo1.Text +str [i]+'_');
    x := Form1.Memo1.Text;
    Application.ProcessMessages;
    Sleep(100);
    Form1.Memo1.Text:=copy(Form1.Memo1.Text,1,length(Form1.Memo1.Text)-1);
    end;
Form1.Memo1.Text:=  Form1.Memo1.Text + #13#10;
end;

**Dr.Who** · 12/12/2009, 00h36

vin'diousss!

bon alors, heu ... comment dire ... quel grand moment de solitude...

que dire ... c'est ... bien ... c'est trés bien ...

c'est exactement le code, qui montre et démontre tout ce qu'il ne faut pas faire.

bon ... il fonctionne, ça ok ... mais niveau code ... houlalala.

déjà, tu passe un argument ... qui n'est pas nomé correctement (memo1), et qui n'est jamais utilisé dans la methode.
On evitera, pour ce genre de methode d'utiliser un type qui créera une dépendance notable.
Ici, on devrait pouvoir utiliser n'importe quel objet comportant un TStrings, c'est donc ce type que l'on utilisera.

ensuite, tu appel Form1 ... ce qui est trés peux recommendé dans ce cas.
ta methode devient totalement dépendante de cette variable globale.
C'est l'une des erreur les plus courrante dans le developpement en Delphi, souvent on vois la variable FormN utilisée dans la classe TFormN.
Ce n'est pas bon, on utilisera Self à l'intérieur de la classe TFormN et on passera un parametre de type TForm pour une methode externe.

ensuite, la variable X, mal nommée également, on préféra toujours un identifiant qui rappel la finalité ou le type d'une variable.
ici, tout développeurs pensera X = coordonnée quelconque axe X.
une variable de type string s'appelera naturellement S ou par exemple OutStr, InStr, TmpStr ... S, St, Str, Sr, Sn.
Le S est aux chaines ce que P est aux pointeurs.
le C est aux caractères ce que T est aux types.
d'ailleur, parlons de la présence de "X" dans la fonction, X n'est jamais utilisé.
assigné oui, utilisée non. donc elle ne sert à rien.

sinon, dans l'ensemble, la methode appliquée est bonne.
juste des erreur d'ecriture, des dépendances superflues et un manque total de souplesse et de réutilisabilité.

pour finir, quand tu présente une fonction, accompagne la d'explication, de commentaires et d'un exemple.
les gens accorderons toujours plus de crédit à du code détaillé, bien présenté, largement commenté et comportant une démonstration.
tu ne gagnera rien a poster un code trop vite et baclé.

voici une correction :

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
 
{ AnimatedWrite
 
  Ecrit un texte dans un TStrings avec une animation de type
  machine à écrire.
 
  Paramètres :
    aStr     [i] string, texte à écrire dans l'objet textuel.
    aStrings [i] TStrings, destination (Memo.Lines, ListBox.Items etc).
    aIndex   [i] LongInt, index de la ligne ou commencer à ecrire
                 le texte, si -1 on ajoute une ligne a la fin (add) et
                 on ecrit à partir de cette dernière.
    aSpeed   [i] LongWord, vitesse d'écriture du texte, en millisecondes
                 (80 par défaut).
    aStopPtr [i] PBoolean, pointeur sur un booléen qui permet d'arrêter
                 l'animation (true), peut être nil (pas de control
                 d'arrêt), false par défaut.
                 Si aStopPtr est définit et qu'elle mets fin à
                 l'animation, aStr sera assigné completement à la chaine
                 de destination.
 
  Utilisation :
    AnimatedWrite('Hello world !', Memo1.Lines);
    AnimatedWrite('Hello world !', Memo1.Lines, 3, 160);
    AnimatedWrite('Hello world !', Memo1.Lines, -1, 80, @StopAnim);
 
}
procedure AnimatedWrite(aStr: string; aStrings: TStrings; const aIndex: LongInt=-1; const aSpeed: LongWord=80; aStopPtr: PBoolean=nil);
var
  N, IDX : LongInt;
  S : String;
begin
  if aIndex = -1 then
    // si aIndex est égal à -1 on ajoute une ligne et
    // on la choisi comme ligne ou il faut écrire
    Idx := aStrings.Add('')
  else
    // sinon, on se référe à l'index passé en paramètre
    Idx := aIndex;
 
  for N := 1 to length(aStr) do
  begin
    // copie d'une partie de la chaine
    S := Copy(aStr, 1, N);
 
    // on assigne la chaine coupée avec un curseur _ ou | par exemple
    aStrings[idx] := S + '_';
 
    // on evite les freeze du au sleep ... ^_^
    // ça empeche les surprises avec le mister freeze dans le sleep ... hahaha
    Application.ProcessMessages;
    // hum hum ... on attend un peu ...
    Sleep(aSpeed);
 
    // on assigne la chaine coupée sans le curseur ... houuu!
    aStrings[idx] := S;
 
    // on gère la sortie si necessaire
    if aStopPtr <> nil then
      if aStopPtr^ then
      begin
        // quand on stop, on affiche la chaine complète
        aStrings[idx] := aStr;
        // et on sort
        exit;
      end;
  end;
end;

voila et bon code.

**Andnotor** · 12/12/2009, 10h06

Une autre variante en utilisant les fonctions de sélection pour éviter ces copies de chaîne.

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
procedure anim(const aStr :string; const aMemo: TMemo);
var
  i :Integer;
 
begin
  with aMemo do
  begin
    //Ajoute "_" en fin de mémo
    SelStart := MaxInt;
    SelText  := '_';
 
    //Positionne le curseur avant "_"
    SelStart := SelStart -1;
 
    //Ajoute les caractères
    For i:= 1 to length(aStr) do
    begin
      SelText := aStr[i];
      Sleep(100);
    end;
 
    //Sélectionne "_" et le remplace par #13#10
    SelLength := 1;
    SelText   := #13#10;
  end;
end;

**ouiouioui** · 12/12/2009, 10h58

J'ai une question, je ne sais pas si c'est bien l'endroit, mais threader cette fonction ne serait-il pas mieux a cause du sleep?
Moi je thread dès qu'il y a sleep alors j'en profite pour demander au pro leur avis

**Montor** · 12/12/2009, 12h08

Envoyé par ouiouioui

J'ai une question, je ne sais pas si c'est bien l'endroit, mais threader cette fonction ne serait-il pas mieux a cause du sleep?
Moi je thread dès qu'il y a sleep alors j'en profite pour demander au pro leur avis

j'ai cru squatter contribuer ... nous les débutants tant pis pour les pro

**Montor** · 12/12/2009, 13h52

voici une nouvelle version Andnotor améliorée...

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
procedure anim(const aStr :string; const aMemo: TMemo);
var
  i :Integer;
begin
  with aMemo do
  begin
    //Ajoute "_" en fin de mémo
    SelStart := MaxInt;
    SelText  := '|';
 
    //Positionne le curseur avant "_"
    SelStart := SelStart -1;
 
    //Ajoute les caractères
    For i:= 1 to length(aStr) do
    begin
      SelText := aStr[i];
      if ((i mod (Random(8)+3) ) = 0 ) or not (aStr[i] in['A'..'Z','a'..'z']) then
        Sleep(300)
      else
        Sleep(70);
    end;
 
    //Sélectionne "_" et le remplace par #13#10
    SelLength := 1;
    SelText   := #13#10;
  end;
end;

ex:"taper avec deux doigts"

Code :

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

1
2
3
4
5
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  anim('Un bon programmeur ce lui qui programme bien !.', memo1)
end;

**ouiouioui** · 13/12/2009, 14h25

et dans un thread:

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
Unit Anim;
 
Interface
 
Uses
  Classes, StdCtrls, SysUtils;
 
Type
  ThreadAnim = Class(TThread)
  Private
    Txt, TxtToWite: String;
    pMemo:          ^TMemo;
    Procedure SynchroTxt;
    Procedure SynchroFinnish;
    Procedure SynchroPrepare;
  Protected
    Procedure Execute; Override;
  Public
    Constructor Create(aTxt: String; apMemo: pointer);
  End;
 
Implementation
 
Constructor ThreadAnim.Create(aTxt: String; apMemo: pointer);
Begin
  Inherited Create(False);
  FreeOnTerminate := True;
  Txt             := aTxt;
  pMemo           := apMemo;
End;
 
Procedure ThreadAnim.Execute;
Var
  I: Integer;
Begin
  Synchronize(SynchroPrepare);
  //Ajoute les caractères
  For I := 1 To Length(Txt) Do
  Begin
    If Terminated Then
      Exit;
    TxtToWite := Txt[I];
    Synchronize(SynchroTxt);
    If ((I Mod (Random(8) + 3)) = 0) Or Not (Txt[I] In ['A'..'Z', 'a'..'z']) Then
      Sleep(200)
    Else
      Sleep(50);
  End;
  Synchronize(SynchroFinnish);
End;
 
Procedure ThreadAnim.SynchroPrepare;
Begin
  With pMemo^ Do
  Begin
    //Ajoute "_" en fin de mémo
    SelStart := MaxInt;
    SelText  := '_';
 
    //Positionne le curseur avant "_"
    SelStart := SelStart - 1;
  End;
End;
 
Procedure ThreadAnim.SynchroTxt;
Begin
  pMemo^.SelText := TxtToWite;
End;
 
Procedure ThreadAnim.SynchroFinnish;
Begin
  With pMemo^ Do
  Begin
    //Sélectionne "_" et le remplace par #13#10
    SelLength := 1;
    SelText   := #13#10;
  End;
End;
 
End.

appel:

Code :

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

1
2
3
4
Procedure TForm1.Button1Click(Sender: TObject);
Begin
  ThreadAnim.Create('Code de Andnotor modifié par Montor dans un Thread!', @Memo1);
End;

**Andnotor** · 13/12/2009, 17h07

Tu n'as pas besoin de définir un pointer pour le memo, tu peux directement définir ta variable en TMemo.
SynchroPrepare pourrait être directement appelé depuis Create et SynchroFinnish depuis Destroy

.

Quant à Synchronize(SynchroTxt), remplace le par:

Code :

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

PostMessage(pMemo.Handle, EM_REPLACESEL, 0, Longint(Txt[i]));

Ainsi tu tireras vraiment parti du thread.

ps: Je passerais aussi le mémo en ReadOnly dans le Create pour éviter que l'utilisateur déplace le curseur pendant l'écriture

.

**ouiouioui** · 13/12/2009, 17h58

effectivement c'est pas optimisé, le coup du

Code :

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

1
2
 
    PostMessage(Memo.Handle, EM_REPLACESEL, 0, Longint(Txt[I]));

j'y avais pensé sans trouvé, d'ailleurs chez moi sa ne fonctionne pas sur mon D2007

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
Unit Anim;
 
Interface
 
Uses
  Windows, Messages, Classes, StdCtrls, SysUtils;
 
Type
  ThreadAnim = Class(TThread)
  Private
    Txt, TxtToWite:  String;
    Memo: TMemo;
    Procedure SynchroTxt;
  Protected
    Procedure Execute; Override;
  Public
    Constructor Create(aTxt: String; aMemo: TMemo);
    Destructor Destroy; Override;
  End;
 
Implementation
 
Constructor ThreadAnim.Create(aTxt: String; aMemo: TMemo);
Begin
  Inherited Create(False);
  FreeOnTerminate := True;
  Txt             := aTxt;
  Memo            := aMemo;
  With Memo Do
  Begin
    //un thread ecrit déjà
    If ReadOnly Then
      Exit;
    ReadOnly := True;
    //Ajoute "_" en fin de mémo
    SelStart := MaxInt;
    SelText  := '_';
 
    //Positionne le curseur avant "_"
    SelStart := SelStart - 1;
  End;
End;
 
Procedure ThreadAnim.Execute;
Var
  I: Integer;
Begin
  //Ajoute les caractères
  For I := 1 To Length(Txt) Do
  Begin
    If Terminated Then
      Exit;
    TxtToWite := Txt[I];
    Synchronize(SynchroTxt);
    If ((I Mod (Random(8) + 3)) = 0) Or Not (Txt[I] In ['A'..'Z', 'a'..'z']) Then
      Sleep(200)
    Else
      Sleep(50);
  End;
End;
 
Destructor ThreadAnim.Destroy;
Begin
  With Memo Do
  Begin
    //Sélectionne "_" et le remplace par #13#10
    SelLength := 1;
    SelText   := #13#10;
    ReadOnly  := False;
  End;
  Inherited;
End;
 
Procedure ThreadAnim.SynchroTxt;
Begin
  Memo.SelText := TxtToWite;
End;
 
End.

**Andnotor** · 14/12/2009, 09h36

En effet, désolé

PostMessage ne peux pas avoir de pointer en paramètre !

**Montor** · 14/12/2009, 17h07

Tu peux me dire pourquoi tu as réintroduit Destrory ?
ce n'est pas bon du tout on doit appeler le destructeur manuellement du coup cette utilisation et interdite

Code :

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

 ThreadAnim.Create('Code de Andnotor modifié par Montor dans un Thread!', memo1);

ce que explique pourqui est ececuté une seul fois sur le meme control

voici ce que j'ai pu ajouté si vrai que utilisation de enbled et beaucuop mieux que ReadOnly mais elle change asspec visuel du control

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
  ThreadAnim = Class(TThread)
  Private
    Txt      :String;
    FControl :TCustomEdit;
    H        :integer;
  Protected
    Procedure Execute; Override;
  Public
    Constructor Create(const aTxt: String; ACustomEdit: TCustomEdit);
    Destructor Destroy; override;
  End;
Implementation
 
Constructor ThreadAnim.Create(const aTxt: String; ACustomEdit: TCustomEdit);
var
 int:integer;
 S:string;
Begin
  Inherited Create(True);
  FreeOnTerminate := True;
  if not Assigned(ACustomEdit) then Exit;
  FControl := ACustomEdit;
  Txt      := aTxt;
  With TEdit(FControl) Do
  Begin
    If ReadOnly Then
      Exit;
    ReadOnly := True;
    SelStart := maxint;
    SelText  := '_';
    SelStart := SelStart - 1;
    H        := Handle;
  End;
  Resume;
End;
 
Procedure ThreadAnim.Execute;
Var
  I,intStart: Integer;
Begin
  //Ajoute les caractères
  SendMessage(H, EM_GETSEL, Longint(@intStart), 0);
  dec(intStart);
  For I := 1 To Length(Txt) Do
  Begin
    If Terminated Then
     Exit;
    intStart:= intStart+1;
    SendMessage(H, EM_SETSEL,intStart,intStart);
    SendMessage(H, EM_REPLACESEL, 0, Longint(string(Txt[I])));
    If ((I Mod (Random(8) + 3)) = 0) Or Not (Txt[I] In ['A'..'Z', 'a'..'z']) Then
      Sleep(200)
    Else
      Sleep(50);
  End;
End;
 
Destructor ThreadAnim.Destroy;
Begin
  With TEdit(FControl) Do
  Begin
    SelLength := 1;
    SelText   := #13#10;
    ReadOnly  := False;
  End;
    inherited;
End;

Ex:

Code :

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

1
2
3
4
5
procedure TForm1.Button1Click(Sender: TObject);
begin
  ThreadAnim.Create('La petite fille qui s''adonnait a la natation en 1200'
                    +' est une nageuse moyenne moyenâgeuse !.', memo1);
end;

**kheiropc** · 14/12/2009, 22h04

Je vous remercie pour vos corrections même si mes érreurs étaient catastrophique

**ouiouioui** · 15/12/2009, 11h48

@ Montor j'ai corrigé l'erreur pour destroy

ton code est astucieux, pourquoi tu crée le thread en pause et le resume

?

**Andnotor** · 15/12/2009, 18h08

Il le crée en pause parce que si aCustomEdit n'est pas assigné, tous se plante

.
Mais c'est pas bon, parce que dans ce cas, le thread n'est jamais détruit

ps: Les transtypages sont aussi inutiles !

**Montor** · 16/12/2009, 14h49

Il le crée en pause parce que si aCustomEdit n'est pas assigné, tous se plante .
Mais c'est pas bon, parce que dans ce cas, le thread n'est jamais détruit

je ne pense pas que ceci est vrai

ps: Les transtypages sont aussi inutiles !

CustomEdit
pour être compatible avec TEdit TMemo TRichedit ...
par contre les properties sur CustomEdit sont protégées c est pourquoi le transtypage

**Andnotor** · 16/12/2009, 16h45

Envoyé par Montor

je ne pense pas que ceci est vrai

Il te suffit de mettre un point d'arrêt dans ton destructeur pour constater que tu n'y passes pas

.
La tâche n'est pas démarrée, ThreadProc n'est jamais appelé et par conséquent le TThread n'est jamais détruit.

Si tu remplaçais Exit par Raise, la création serait abortée.

Envoyé par Montor

CustomEdit
pour être compatible avec TEdit TMemo TRichedit ...
par contre les properties sur CustomEdit sont protégées c est pourquoi le transtypage

Elles sont public sous D2007...

**Montor** · 16/12/2009, 18h19

Il te suffit de mettre un point d'arrêt dans ton destructeur pour constater que tu n'y passes pas .
La tâche n'est pas démarrée, ThreadProc n'est jamais appelé et par conséquent le TThread n'est jamais détruit.

il y a la fonction Enthread

**Andnotor** · 16/12/2009, 20h24

... appelé depuis ThreadProc qui n'est pas exécutée

.

**Montor** · 21/12/2009, 20h03

en réalité je utilise Endthread avec beginthead ... mais si il arrive une exception dans le constructeur le destructeur est appelé automatiquement

**Montor** · 26/12/2009, 12h15

Tu as bien raison j'ai changé le constructeur par un procedure de classe

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
class procedure ThreadAnim.Animate(const aTxt: string;ACustomEdit: TCustomEdit);
var
 int:integer;
 S:string;
begin
    if Assigned(ACustomEdit) and  not TEdit(ACustomEdit).ReadOnly then
    begin
      with Inherited Create(true)do
      begin
          FreeOnTerminate := True;
          FControl := ACustomEdit;
          Txt      := aTxt;
          Application.ProcessMessages;
          With TEdit(FControl) Do
          Begin
                ReadOnly := True;
                SelStart := maxint;
                SelText  := '_';
                SelStart := SelStart - 1;
                H        := Handle;
          End;
          Resume;
      end;
    end
    else
      raise Exception.Create('Aie aie aie');
end;

Function Text Animation

Contribuez Delphi

Discussions similaires

Partager

Partager