Déplace dessin en 3d

0/5 (5 avis)

Vue 12 709 fois - Téléchargée 990 fois

Télécharger le projet
Commenter

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

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?
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
nirvanew Messages postés 9 Date d'inscription mardi 22 juillet 2003 Statut Membre Dernière intervention 23 juillet 2003
20 sept. 2003 à 19:36
eske on peut faire un copier coller pour le mettre dans un script rep plize
MakeExE Messages postés 4 Date d'inscription jeudi 31 janvier 2002 Statut Membre Dernière intervention 31 janvier 2002
31 janv. 2002 à 06:39
http://perso.wanadoo.fr/bardou/michel/delphi.htm#tutorials

C'est du celebre Jean-Yves Quéinec

(Site de Michel Bardou EXCELLENT )
jia2812
30 juil. 2001 à 14:47
Voilà le zip les progs'!!!!

Allez bone prog'!!!!!

Gogogogogogogogooooooooo
jia2812
24 juil. 2001 à 14:24
Trop gros mon zip alors normal k'il part pô!!! 8-(

Euh, à ki je dois l'envoyer pr ke le webmestre le mette manuellement?

!!!HELP!!!
jia2812
24 juil. 2001 à 12:28
Euh, désolé les prog'! Mais bon comme il est midi dans ma boîte, alors la connection rame trop souvent dès 11H...

Je tenterais tt à l'heure vers 14H ou 15H... Merci de votre compréhension & de votre patience!.... ;-P

Allez bonne prog'!!!!!

Gogogogogogooooooo
S'inscrire maintenant

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.

Du même auteur (jia2812)