unit Udraw;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
  private
    procedure dessinecurseur;
  end;
 
  Tcurseur = record
     drawing : boolean; // en cours de déplacement
     rr  : trect;            // rectangle position courante
     rro : trect;           // rectangle ancienne position
     RECsprite : Trect;  // le rectangle correspondant a BMPSprite
  end;
 
var
  Form1: TForm1;
  H, W : integer;            // hauteur et largeur de la paintbox
  BmpFond : Tbitmap;     // bitmap de fond
  BmpMemoire : Tbitmap; // bitmap memoire pour preparation dessin a afficher
  BMPsprite : Tbitmap;    // le bitmap que je veux deplacer avec la souris
                                  // et qui comporte dans son milieu de la couleur noire
                                  // que je voudrais rendre transparente
  cc : Tcurseur;             // pour la gestion du bitmap BMPSprite
 
implementation
{$R *.DFM}
 
//------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
  H := paintbox1.height;
  W := paintbox1.width;
  cc.drawing := false;
  cc.rr := rect(50, 50, 150, 150); // definition d'un premier emplacement
                                             // pour le nouveau rectangle
  cc.rro := cc.rr;                       // position courante du spprite devient
                                             // l'ancienne position
 
  BmpFond := Tbitmap.create;     // bitmap de fond
  BmpFond.width  := W;
  BmpFond.height := H;
  BmpFond.LoadFromFile('fond.bmp');  // fond.bmp = 500x333 16 millions couleurs
 
  BmpMemoire := tbitmap.create;
  BmpMemoire.assign(BmpFond);      // copie de BmpFond sur BmpMemoire
 
  BMPsprite := Tbitmap.Create;
  BMPsprite.LoadFromFile('bitmap.bmp'); // chargement de l'image du sprite
  BMPsprite.PixelFormat := pf32bit;
   
  // c'est là que je determine la transparence mais cela ne marche pas.
  // je voudrais que tout le noir de mon sprite devienne transparent
  // j'ai fabriqué ce sprite avec image éditeur de delphi :
  // bitmap.bmp = 100x100 256 couleurs
 
  BMPsprite.Transparent := true;
  BMPsprite.TransparentColor := rgb(0,0,0); // couleur noire
 
  cc.RECsprite.Left := 0;
  cc.RECsprite.Top := 0;
  cc.RECsprite.Right := BMPsprite.Width;
  cc.RECsprite.Bottom := BMPsprite.Height;
 
  dessinecurseur;  // affichage du premier sprite à la position de départ
end;
//------------------------------------------------------------
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
form1.paintbox1.Canvas.Draw(0,0,BmpMemoire);
end;
//------------------------------------------------------------
Procedure Tform1.dessinecurseur;
var
  Runion: Trect;
begin
  BmpMemoire.canvas.copyrect(cc.rro, BmpFond.canvas,cc.rro);
  BmpMemoire.Canvas.CopyRect(cc.rr,BMPsprite.canvas,cc.RECsprite);
  Unionrect(Runion, cc.rro, cc.rr);
  form1.paintbox1.canvas.copyrect(Runion, BmpMemoire.canvas, Runion);
  cc.rro := cc.rr;
end;
//------------------------------------------------------------
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Var
  p : tpoint;
begin
  p.x := X;  p.y := Y;
  if ptinrect(cc.rr, p) then
  begin
    cc.drawing := true;
    cc.rr := rect(x, y, x+100, y+100);   //100 = largeur et hauteur de BMPSprite
  end;
  dessinecurseur;
end;
//------------------------------------------------------------
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  IF cc.drawing then
  begin
     cc.rr := rect(x, y, x+100, y+100);
     dessinecurseur;
  end;
end;
//------------------------------------------------------------
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IF cc.drawing then
  begin
    cc.rr := rect(x, y, x+100, y+100);
    dessinecurseur;
    cc.drawing := false;
  end;
end;
//------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
  BmpFond.free;
  BmpMemoire.free;
  BMPSprite.Free;
end;
 
end.