Déplace dessin en 3d
Description
Zoli code ma foi! Attention, je n'en suis point l'auteur! Si jamais vous connaissez cette source & son auteur dites-le moi pour ke j'le mette en en-tête, j'ai cherché ds ma mémoire, puiif!... KE dalle!.. 8-(
Euh, je pense qu'en le testant vous saurez comment se servir du timer & surtout du trackbar... en tout cas il m'a bien servi ce code...
P'tite précision: je possède Delphi Standard version 4, walla!
Mais assez dur... NIveau 2?
Source / Exemple :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Timer1: TTimer;
TrackBar1: TTrackBar;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormDblClick(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
Var
fin : boolean; // terminaison du programme
BmpFond : Tbitmap; // BitMap pour stocker l'image original du fond
BmpManoeuvre: TBitmap; // BitMap zone de travail invisible (hidden)
BmpImage : TBitmap; // BitMap de l'image à déplacer
W, H : integer; // dimensions de l'image
RNew1 : TRect; // Rectangle nouvelle position de l'image animée.
ROld1 : TRect; // Rectangle ancienne position de l'image annimée
X1, Y1 : integer; // positions de l'image pour affichage
xx1, yy1, vx1, vy1: single; // positions et vitesses de l'image pour calculs
RNew2 : TRect; // Rectangle nouvelle position de l'image animée.
ROld2 : TRect; // Rectangle ancienne position de l'image annimée
X2, Y2 : integer; // positions de l'image pour affichage
xx2, yy2, vx2, vy2: single; // positions et vitesses de l'image pour calculs
procedure TForm1.FormCreate(Sender: TObject);
begin
Fin := false;
BmpFond := TBitmap.Create;
BmpManoeuvre := TBitmap.Create;
BmpImage := TBitmap.Create;
BmpFond.LoadFromFile('quadrill.bmp');
BmpFond.Width := PaintBox1.Width;
BmpFond.Height:= PaintBox1.Height;
BmpManoeuvre.Assign(BmpFond);
BmpImage.LoadFromFile('Earth.bmp');
W := Bmpimage.width;
H := Bmpimage.height;
BmpImage.Transparent := True;
BmpImage.TransParentColor := Bmpimage.canvas.pixels[1,1];
// initialisation paramètres animation image
xx1 := 1; yy1 := 1; // position pour calcul
x1 := trunc(xx1); y1 := trunc(yy1); // position pour affichage
vx1 := 1.5 ; vy1 := 0.5; // vitesses
RNew1 := bounds(x1, y1, W, H); // bounds -> rectangle plus pratique que rect
Rold1 := Rnew1;
xx2 := 100; yy2 := 100; // position pour calcul
x2 := trunc(xx2); y2 := trunc(yy2); // position pour affichage
vx2 := 1 ; vy2 := 0; // vitesses
RNew2 := bounds(x2, y2, W, H); // bounds -> rectangle plus pratique que rect
Rold1 := Rnew1;
Timer1.interval := 1; // vitesse maxi (insuffisante !)
Timer1.enabled := true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Fin := true; // protège la boucle animation de la destruction des bitmaps
BmpFond.free;
BmpManoeuvre.free;
BmpImage.Free;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintBox1.Canvas.Draw(0,0,BmpManoeuvre);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
n : integer;
Runion : Trect;
begin
{ Astuce : on répète plusieurs fois l'animation dans la séquence timer
en effet, le timer ne donne pas la main toutes les millisecondes
comme on l'a demandé, mais environ toutes les 50 ms. }
for n := 1 to trackbar1.position do
begin
IF fin then exit; { protection si destruction des bitmaps en cours }
{ 1 - effacements dans Bmpmanoeuvre de tous les dessins à leur ancienne
position, à partir du bitmap Bmpfond }
BmpManoeuvre.Canvas.CopyRect(ROld1,bmpFond.canvas,ROld1);
BmpManoeuvre.Canvas.CopyRect(ROld2,bmpFond.canvas,ROld2);
{ 2 - calcul des nouvelles positions et affichage caché dans Bmpmanoeuvre
Note : plusieurs images peuvent se superposer sans clignotement }
// rebonds . Earth.bmp a 32 pixels de trop à droite et à gauche
if (x1 < -32) or (x1 > Bmpfond.width - W+32) then vx1 := -vx1;
if (y1 < 0) or (y1 > Bmpfond.height - H) then vy1 := -vy1;
xx1 := xx1+vx1 ; yy1 := yy1+vy1; // calcul position
x1 := trunc(xx1); y1 := trunc(yy1);
RNew1 := bounds(x1, y1, W, H); // rectangle nouvelle position
BmpManoeuvre.Canvas.Draw(x1, y1 ,BmpImage);
if x2 > Bmpfond.width - 32 then // réapparition
begin x2 := - W + 32; xx2 := x2; end;
xx2 := xx2+vx2 ; yy2 := yy2+vy2; // calcul position
x2 := trunc(xx2); y2 := trunc(yy2);
RNew2 := bounds(x2, y2, W, H); // rectangle nouvelle position
BmpManoeuvre.Canvas.Draw(x2, y2 ,BmpImage);
{ 3 - affichage sur le canvas de la paintbox de la zone modifiée, c'est-
à-dire l'union des rectangles, ancienne et nouvelle position }
UnionRect(RUnion, ROld1, RNew1);
PaintBox1.Canvas.CopyRect(RUnion, BmpManoeuvre.Canvas,RUnion);
Rold1 := Rnew1; // mise à jour rectangle
UnionRect(RUnion, ROld2, RNew2);
PaintBox1.Canvas.CopyRect(RUnion, BmpManoeuvre.Canvas,RUnion);
Rold2 := Rnew2; // mise à jour rectangle
end;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Edit1.text := inttostr(trackbar1.position);
IF trackbar1.position = 1 then
label2.visible := true else label2.visible := false;
end;
procedure TForm1.FormDblClick(Sender: TObject);
begin
Close;
end;
end.
Conclusion :
Euh, je pense qu'en le testant vous saurez comment se servir du timer & surtout du trackbar... en tout cas il m'a bien servi ce code...
P'tite précision: je possède Delphi Standard version 4, walla!
Mais assez dur... NIveau 2?
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.