Function Text Animation

Version imprimable

Code:

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;

vin'diousss! 8O

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:

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.

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

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

12/12/2009, 10h58
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 ;)
12/12/2009, 12h08
Montor

Citation:

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

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

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

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

et dans un thread:

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

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

13/12/2009, 17h07
Andnotor

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:

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

effectivement c'est pas optimisé, le coup du

Code:

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:

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.

14/12/2009, 09h36
Andnotor

En effet, désolé :oops:

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

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:

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:

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:

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;

14/12/2009, 22h04
kheiropc

Je vous remercie pour vos corrections même si mes érreurs étaient catastrophique
15/12/2009, 11h48
ouiouioui

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

ton code est astucieux, pourquoi tu crée le thread en pause et le resume :??
15/12/2009, 18h08
Andnotor

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

ps: Les transtypages sont aussi inutiles !
16/12/2009, 14h49
Montor

Citation:

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

Citation:

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
16/12/2009, 16h45
Andnotor

Citation:

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.

Citation:

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...
16/12/2009, 18h19
Montor

Citation:

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 8-)
16/12/2009, 20h24
Andnotor

... appelé depuis ThreadProc qui n'est pas exécutée :aie:.
21/12/2009, 20h03
Montor

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

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

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

26/12/2009, 17h56
Droïde Système7

Super :ccool:

Mais le

Code:

Application.ProcessMessages;

Est-il utile ? :oops: