Déplace dessin en 3d

Soyez le premier à donner votre avis sur cette source.

Vue 11 575 fois - Téléchargée 840 fois

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?

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

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
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!!!
Voilà le zip les progs'!!!!

Allez bone prog'!!!!!

Gogogogogogogogooooooooo
MakeExE
Messages postés
4
Date d'inscription
jeudi 31 janvier 2002
Statut
Membre
Dernière intervention
31 janvier 2002
-
http://perso.wanadoo.fr/bardou/michel/delphi.htm#tutorials

C'est du celebre Jean-Yves Quéinec

(Site de Michel Bardou EXCELLENT )
nirvanew
Messages postés
9
Date d'inscription
mardi 22 juillet 2003
Statut
Membre
Dernière intervention
23 juillet 2003
-
eske on peut faire un copier coller pour le mettre dans un script rep plize

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.