Developpez.com - Delphi
X

Choisissez d'abord la catégorieensuite la rubrique :

Nono40.developpez.com
Le petit coin du web de Nono40
SOURCES TESTS DELPHI WIN32 AUTOMATISMES DELPHI .NET QUICK-REPORT
Retour à l'accueil
74 - REALISATION D'UN EFFET TUNNEL SIMPLE

PRÉSENTATION : Réaliser une animation "effet tunnel"
ZIP : Téléchargez le zip APERÇUS :

NOTES : Cet exemple montre la mise en place d'un thread simple pour la gestion d'une animation simple.
C'est une base de départ pour la réalisation de dessins sans utiliser DirectX ni OpenGL, ce qui est suffisant pour ce type d'animation.

CODE :
//
// Sujet : Réalisation d'un effet tunnel simple
//
// Par Nono40 : http://nono40.developpez.com   http://nono40.fr.st
//              mailTo:nono40@fr.st
//
// Le 13/01/2004
//

Unit Unit1;

Interface

Uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs;

Type
  TForm1 = Class(TForm)
    Procedure FormCreate(Sender: TObject);
    Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
  Private
    { Déclarations privées }
  Public
    { Déclarations publiques }
  End;

  // Définition d'un classe personnalisée simple de thread
  TMonThread = Class(TThread)
  Private
    { Déclarations privées }
    BitMap:TBitMap;
  Protected
    Procedure Execute; override;
    Procedure MAJForm;
  End;

Var
  Form1: TForm1;
  MonThread:TMonThread;

Implementation

Uses Math;
{$R *.dfm}

Const
  // Taille du dessin en pixels
  Taille       = 600;
  // Nombre de cercles à dessiner
  NombreCercle = 100;

Procedure TMonThread.Execute;
Var
  i            :Integer;  // Indexs de travail...
  Tick         :DWord;    // Chronomatrage pour la vitesse de dessin
  IndexCouleur :Integer;  // Index dans le tableau des couleurs
  Pas          :Double;   // Pas de zoom exponentiel
  Rayon        :Double;   // Rayon du cercle en cours de dessin
  RayonInt     :Integer;
  Couleurs     : Array[1..NombreCercle]Of TColor;

Begin
  // Création du bitmap de travail avec les propriétés voulues
  BitMap:=TBitMap.Create;
  BitMap.Width  := Taille;
  BitMap.Height := Taille;
  BitMap.PixelFormat := pf32Bit;

  // Effacement du bitmap
  BitMap.Canvas.Brush.Color := clBlack;
  Bitmap.Canvas.FillRect(BitMap.Canvas.ClipRect);

  // Ne pas dessiner le contenu du cercle...
  BitMap.Canvas.Brush.Style := bsClear;

  // Préremplissage du tableau des couleurs
  For i:= 1 To NombreCercle Do Couleurs[i]:=Random($1000000);

  // Memo pour synchro sur le nombre de Tick
  Tick  := 0;

  // Couleur en cours en bas du tableau
  IndexCouleur := 1;

  // Pas de zoom pour la simulation d'avance des points
  // Le premier cercle étant de 4 point, si on peut que le dernier
  // soit de 400 point ( 100 fois plus ), pas pas multiplicateur
  // est donc la racine NombreCercle-ième de 100.
  Pas   := Power(100,1/NombreCercle);

  While Not Terminated Do
  Begin
    If (GetTickCount-Tick)>=20 Then // Une image tous les 20ms soit 50 Images/Seconde
    Begin
      // Mémorisation de l'heure de départ
      Tick:=GetTickCount;

      // On décale les couleurs d'un cran pour faire "avancer le dessin"
      Dec(IndexCouleur);
      If (IndexCouleur<=0Then IndexCouleur:=NombreCercle;

      // On commence par le cerlce du milieu
      Rayon := 4;

      For i:=1 To NombreCercle Do
      Begin
        // Chois de la couleur
        Bitmap.Canvas.Pen.Color:=Couleurs[IndexCouleur];
        // Dessin du cercle
        RayonInt := Round(Rayon);
        Bitmap.Canvas.Ellipse(Taille Div 2 - RayonInt,Taille Div 2 - RayonInt,
                              Taille Div 2 + RayonInt,Taille Div 2 + RayonInt);
        // Le cercle suivant sur "pas fois" plus grand
        Rayon:=Rayon * Pas;
        // couleur du cercle suivant
        Inc(IndexCouleur);
        If (IndexCouleur>NombreCercle) Then IndexCouleur:=1;
      End;

      // Mise à jour de la fiche
      Synchronize(MAJForm);
    End;
  End;

  BitMap.Free;
End;

Procedure TMonThread.MAJForm;
Begin
  // La mise à jour est un simple Draw sur l'image.
  Form1.Canvas.Draw(0,0,BitMap);
End;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
  // Limitations de la taille de la fiche
  ClientWidth  :=Taille;
  ClientHeight :=Taille;

  // Création de la tâche de dessin
  MonThread:=TMonThread.Create(False);
End;

Procedure TForm1.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
  // Pour pouvoir quitter l'application il faut fermer la
  // tâche de dessin.
  MonThread.Terminate;
  MonThread.WaitFor;
End;

end.

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2003 Bruno Guérangé. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Responsables bénévoles de la rubrique Delphi : Gilles Vasseur - Alcatîz -