Animation pour patienter

Version imprimable

2 pièce(s) jointe(s)

Bonjour,

Je vous propose un petit bout de code amusant pour dessiner cette animation :
Pièce jointe 183660

je vous propose en petit jeu de présenter vos formules mathématiques permettant de donner d'autres effets sympa :)

voici le code placé dans un TPaintBox.OnPaint et animé par un Timer

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
 
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  t: Cardinal;
  d: Cardinal;
  i: Integer;
  r: TRect;
  x,y: Integer;
  w: Integer;
  cs, sn: Single;
  c: Integer;
begin
  t := GetTickCount;
 
  if FTicks = 0 then
  begin
    d := 0;
    FTicks := t;
  end else begin
    d := (t - FTicks) mod 4000;
  end;
 
  with PaintBox1.Canvas do
  begin
 
    Brush.Color := Self.Color;
    FillRect(PaintBox1.ClientRect);
 
    x := PaintBox1.Width div 2;
    y := PaintBox1.Height div 2;
    w := 2 * x div 3;
 
    for i := 0 to 7 do
    begin
 
      c := 255 - 64 + Round(32 * Cos(PI * i / 4));
      Brush.Color := RGB(c, c, c);
 
      SinCos(PI * ((1 + i/4) * Cos(PI * d / 4000)), cs, sn);
 
      r.Left := x + Round(w * cs) - 2;
      r.Top  := y + Round(w * sn) - 2;
      r.Right := r.Left + 4;
      r.Bottom := r.Top + 4;
      FillRect(r);
 
    end;
 
  end;
 
end;

le projet complet sous Delphi XE8 (mais il devrait fonctionner avec n'importe quelle version aux uses près)
Pièce jointe 183661

1 pièce(s) jointe(s)

le même principe appliqué à quelques TSphere sous Firemonkey avec un effet GaussianBlur en prime ;)

Pièce jointe 183747

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
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  t: TDateTime;
  d: Integer;
  i: Integer;
  w: Single;
  cs, sn: Single;
begin
  t := Now();
 
  d := MillisecondsBetween(t, FStart) mod 4000;
  t := FStart;
 
  w := 2;
 
  GaussianBlurEffect1.BlurAmount := 0.25 - Cos(PI * d/2000)/8;
  for i := 0 to 7 do
  begin
 
    SinCos(PI * ((1 + i/4) * Cos(PI * d / 4000)), cs, sn);
 
    FSpheres[i].Position.x := w * cs;
    FSpheres[i].Position.y := w * sn;
    FSpheres[i].Opacity := 0.75 - Cos(PI * i / 4)/4;
 
  end;
 
end;

06/11/2015, 19h45
FOCUS77

Plus de simplification

Bonsoir paul :P

A vrai dire je suis intéressé par votre code et j'ai essayé de l'appliquer plusieurs fois, pour une application Laz,
mais en vain.:(
si vous pouviez me définir ces variables:

Code:

GetTickCount, FTicks, cs et sn

.

et cette formule:

Code:

SinCos(PI * ((1 + i/4) * Cos(PI * d / 4000)), cs, sn);

1/SinCos=Sin(Cos())?
2/la fonction Sin() à 3 arguments comment?
3/ou sera t-elle placée (la formule)?

merci d'avance.
06/11/2015, 20h17
Roland Chastain
@FOCUS77

La procédure SinCos de l'unité Math renvoie en même temps le cosinus et le sinus du nombre passé en premier argument dans les variables cs (cosinus) et sn (sinus).

La fonction GetTickCount provient de l'unité Windows. Elle permet de mesurer le temps écoulé.

FTicks est déclaré en même temps que le type TForm1 :
Code:

1 2 3 4 5 6 7 8 type TForm1 = class(TForm) PaintBox1: TPaintBox; Timer1: TTimer; procedure PaintBox1Paint(Sender: TObject); private { Déclarations privées } FTicks: Cardinal;
06/11/2015, 20h35
Roland Chastain

1 pièce(s) jointe(s)

Il n'y a rien à changer dans le code pour construire un projet Lazarus, à part le nom des unités (comme Paul l'avait d'ailleurs signalé). ;)

Je l'ai fait à la main mais je pense que même une conversion automatique aurait fonctionné (après correction des noms d'unités).
06/11/2015, 21h31
FOCUS77

OK c'est reglé

Bonsoir Roland et merci pour ton explication :P
une fois j'ai ajouté Math et windows à use et FTicks: Cardinal; à Private et j'ai changer cs, sn: single; à cs, sn: Extended;
le programme a fonctionné automatiquement et qu'elle était grande ma joie :D
merci encore une autre fois. 8-)
07/11/2015, 11h19
Roland Chastain

Au fait, l'ordre des deux derniers paramètres de SinCos, ce serait plutôt :

Code:

SinCos(PI * ((1 + i / 4) * Cos(PI * d / 4000)), sn, cs);

Mais ça ne change rien au résultat. Vraiment très joli programme. :king:

J'aime bien aussi le résultat du programme visible dans une image GIF. Je suis en train d'essayer de faire la même chose. :)
07/11/2015, 18h10
FOCUS77

Bonsoir Roland :P
tu as raison, ce programme est très joli.
quant à moi j'utilise ces couleurs

Code:

Brush.Color :=RGB(3*c,c,2*c);

c'est encore plus joli :applo:

Bon courage pour tes travaux Roland !

Bonsoir à tous

Je vous propose un autre mouvement: :D

Code:

1
2
3
4
5
6
7
8
9
10
11
 for i := 0 to 10 do
    begin
      c := 255 - 64 + Round(32 * Cos(PI * i / 4));
      Brush.Color :=RGB(3*c,c,2*c);
      SinCos((PI*i*d/21000),sn, cs);
      r.Left := x + Round(w * sn) - 2;
      r.Top  := y + Round(w * cs) - 2;
      r.Right := r.Left + 4;
      r.Bottom := r.Top + 4;
      FillRect(r);
    end;

merci à tous

09/11/2015, 11h30
Roland Chastain

Citation:

Envoyé par FOCUS77

Je vous propose un autre mouvement: :D

Pas mal ! :ccool:

Celui là peut-être ? :koi:

Code:

1
2
3
4
5
6
7
8
9
10
11
 for i := 0 to 40 do
    begin
      if j<7 then  j:=j+1 else j:=0;
      Brush.Color :=Random(120000);
      SinCos((PI*i*d/80000),sn, cs);
      r.Left := x + Round(w * cs*0.2*j) - 2;
      r.Top  := y + Round(w *sn*0.2*j) - 2;
      r.Right := r.Left + 3;
      r.Bottom := r.Top + 3;
      FillRect(r);
    end;