how to move two bitmap-image on a canvas

Question

I am writing an animation program under Delphi 7 consisting of moving two discs on a canvas (I choose a PaintBox) with a bounce effect on the edges.

it's woks fine if I load the pictures one by one: In this case, when the two disks that arrive from time to time are superimposed, no background rectangle appears with even a rather pleasant transparency effect.

But if I try to generalize the operation with many more discs by introducing for example a Record.

The movements are ok BUT in this case, when the discs cross, a background rectangle appears in the upper image which spoils everything!

I even tried to write the code with an Object with :

    TSphere = class (TObject) 

but nothing to do, the phenomenon remains ..

Do you have any idea how to remove this display defect?

and i have another question, i would like to fill the disks with textures.

the full code :

    unit Unit1;

    interface

    uses
     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
    Dialogs, ExtCtrls, StdCtrls, ComCtrls;


    type
    TSphere = record
    W, H: integer;
    vx, vy: Extended;
    x, y: integer;
    xx, yy: extended;
    ROld, RNew: TRect;
    Bitm: TBitmap;
    end;

    type
    TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Timer1: TTimer;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    TrackBar1: TTrackBar;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    end;

    var
    Form1: TForm1;

    fin: boolean;
    BmpBkg: Tbitmap;
    BmpMoving: TBitmap;

    Spheres: array of TSphere;

    const
    nb = 2;
    ImageWidth = 32;

    implementation

    {$R *.DFM}

    procedure PictureStorage;
    var
    i: integer;
    begin
    SetLength(Spheres, nb);
    for i := 0 to (nb - 1) do
    begin
      with Spheres[i] do
       begin
        Bitm := TBitmap.Create;
         case i of
           0: Bitm.loadFromFile('Sphere1.bmp');
           1: Bitm.loadFromFile('Sphere2.bmp');
         end;
       end;
     end;
     end;

    procedure TForm1.FormCreate(Sender: TObject);
    var
    i: integer;
    begin
    DoubleBuffered := true;
    randomize;
    Fin := false;

    BmpBkg := TBitmap.Create;
    BmpMoving := TBitmap.Create;

    BmpBkg .Canvas.Brush.Color := ClBtnFace;
    BmpBkg .Canvas.FillRect(Rect(0, 0, PaintBox1.height, 
    PaintBox1.width));
    BmpBkg .Width := PaintBox1.Width;
    BmpBkg .Height := PaintBox1.Height;
    BmpMoving .Assign(BmpBkg );

    PictureStorage;

      for i := 0 to (nb - 1) do
      begin
      with Spheres[i] do
        begin
        W := Bitm.Width;
        H := Bitm.Height;
        Bitm.Transparent := True;
        Bitm.TransParentColor := Bitm.canvas.pixels[1, 1];

        xx := random(400) + 1;
        yy := random(200) + 1;
         x := trunc(xx);
         y := trunc(yy);
         vx := random(3) + 1;
         vy := random(4) + 1;
         RNew := bounds(x, y, W, H);
         ROld := RNew;
        end;
       end;

       Timer1.interval := 1;
       Timer1.enabled := true;
       end;

       procedure TForm1.FormDestroy(Sender: TObject);
       var
       i: integer;
        begin
        Fin := true;
        BmpBkg.free;
        BmpMoving.free;

         for i := 0 to (nb - 1) do
          Spheres[i].Bitm.Free;
         end;

      procedure TForm1.FormPaint(Sender: TObject);
      begin
        PaintBox1.Canvas.Draw(0, 0, BmpMoving);
      end;

      procedure TForm1.Button1Click(Sender: TObject);
       begin
         close;
       end;

      procedure TForm1.Timer1Timer(Sender: TObject);
        var
        n, i: integer;
       Runion: Trect;
         begin
          for n := 1 to trackbar1.position do
           begin
               if fin then exit;
            for i := 0 to (nb - 1) do
            begin
             with Spheres[i] do
              begin
                BmpMoving.Canvas.CopyRect(ROld, bmpBkg.canvas, ROld);

              if (x < -ImageWidth) or (x > bmpBkg.width - W + ImageWidth) 
                then
               vx := -vx;
                if (y < 0) or (y > bmpBkg.height - H) then
                vy := -vy;
                xx := xx + vx;
                yy := yy + vy;
                 x := trunc(xx);
                 y := trunc(yy);
                RNew := bounds(x, y, W, H);
                BmpMoving.Canvas.Draw(x, y, Bitm);

                UnionRect(RUnion, ROld, RNew);
                PaintBox1.Canvas.CopyRect(RUnion, BmpMoving.Canvas, 
                RUnion);
                ROld := RNew;
                end;
               end;
              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;

        end.

this program is just the start of another more important

thanks

Answer 1

Your code is almost OK.

As far as I can see your problem is caused by not completely restoring the background before you draw the bitmaps at their new locations. You need to restore the old rects of all spheres before you draw the new ones. Also you need to collect the complete union of all new and old rects before you update to screen.

As a matter of taste, I would avoid the global variables and make them fields of the form. If you also make PictureStorage a method of the form, everything works.

The timer interval of 1 seems a bit of an overkill. I would set it to 1000 div 120 (120 FPS).

I would set doublebuffered to false, as you are already doing your own doublebuffering. Also I would move the form's OnPaint to the paintbox's OnPaint, but that doesn't seem to work for you.

Here is the replacement of the OnTimer event which should work (I checked an analogue with Delphi 2006, I don't have Delphi7 installed anymore and I don't know what the n means).

procedure TForm1.Timer1Timer(Sender: TObject);
var
  n, i: integer;
  Runion: TRect;
begin
  //I don't know what the n-loop is for, in my test I left it out
  for n := 1 to TrackBar1.position do
  begin
    //prevent reentry?
    if fin then
      exit;
    // Restore the background completely
    for i := 0 to (nb - 1) do
      with Spheres[i] do
      begin
        BmpMoving.Canvas.CopyRect(ROld, BmpBkg.Canvas, ROld);
        // Collect the old rects into the update-rect
        if i = 0 then
          Runion := ROld
        else
          UnionRect(Runion, Runion, ROld);
      end;
    for i := 0 to (nb - 1) do
      with Spheres[i] do
      begin
        if (x < -ImageWidth) or (x > BmpBkg.width - W + ImageWidth) then
          vx := -vx;
        if (y < 0) or (y > BmpBkg.height - H) then
          vy := -vy;
        xx := xx + vx;
        yy := yy + vy;
        x := trunc(xx);
        y := trunc(yy);
        RNew := bounds(x, y, W, H);
        BmpMoving.Canvas.Draw(x, y, Bitm);
        // Add RNew to RUnion
        UnionRect(Runion, Runion, RNew);
        // No painting yet, update the screen as few times as possible
        ROld := RNew;
      end;
    //Now update the screen
    //This is the reliable way for sherlock to update the screen:
    OffsetRect(RUnion, Paintbox1.left, Paintbox1.top); 
    //RUnion in form's coordinates
    InvalidateRect(Handle, @RUnion, false);
    //The following works for me just as well:
    (**************
    PaintBox1.Canvas.CopyRect(Runion, BmpMoving.Canvas, Runion);
    ***************)
  end;
end;

Answer 2

This code can be commented out. Tt does not affect the program :

   // Collect the old rects into the update-rect

       {      if i = 0 then
      Runion := ROld
       else
      UnionRect(Runion, Runion, ROld);    }