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

You don't show the more interesting code: the one which paint the bitmaps. Please edit your question. Note that the issue is likely that you don't correctly handle transparency for the background in the bitmaps. And also please note that if you want to draw circles, don't use a bitmap! Simply use TCanvas methods to draw the circle (Ellipse). Select the brush you need for a plain color or a texture. — fpiette, Feb 13 '21 at 12:20
The tags you used are way to much broad. I suggest you use only Delphi-7. — fpiette, Feb 13 '21 at 12:22
Hello François Piette, I put the full code .. and I did not understand the tags! — sherlock, Feb 13 '21 at 14:29
The tags are used to filter questions by readers (like me) to narrow subject of interest. It should reflect the issue you have. For example, your issue is not an animation issue, it is a Delphi canvas painting issue. IMO the only interesting tag here is Delphi-7. — fpiette, Feb 13 '21 at 18:06
Regarding the overall design, you might find some inspiration here: https://stackoverflow.com/a/7224075/282848. For instance, there's no need for a paint box. — Andreas Rejbrand, Feb 13 '21 at 19:18
@Piette : I misspoke. I understood for the tags, but it's for the indentation of my code in my question. my In delphi 7, it is perfectly indented but I did not understand how to paste it. please tell me if it's " ", or ' ', or , or the 8 spaces to encapsulate it.. sorry i'm lost.. — sherlock, Feb 13 '21 at 21:18
@Andreas Rejbrand : Thank you for the link. Yes, if I use methods like: Canvas.Ellipse (0, 0, 100, 100) directly in the canvas of the Tform I would of course not have the problems of superimposing the discs. But, I want to have beautiful images with beautiful colors.. But what is most disturbing is that if I treat the code in loading frame by frame and assigning all corresponding coordinates (x1, y1, x2, y2 etc.) the problem of overlapping bitmaps disappears !! and there I do not understand .. — sherlock, Feb 13 '21 at 21:56
Try the following: use an "offscreen bitmap" to draw the background and the spheres. Use `BitBlt()` to transfer the "offscreen bitmap" to the screen in one go. — Tom Brunberg, Feb 14 '21 at 06:41
Adding to Tom's comment: If you draw the composite bitmap to screen in the OnPaint of the form and keep track of the "dirty" rectangles, you only need to call InvalidateRect for the dirty rectangles to update the screen more efficiently. — Renate Schaaf, Feb 14 '21 at 11:24

Renate Schaaf · Accepted Answer · 2021-02-16T08:07:08.450

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;

score 0 · Answer 2 · edited Feb 16 '21 at 21:50

0

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);    }

edited Feb 16 '21 at 21:50

John Conde

217,595
99
455
496

answered Feb 16 '21 at 13:27

sherlock

13
5

Wrong. Without these lines RUnion is uninitialized and could be anything. Also, plain logic tells you that the rects where the spheres used to be need to be part of the update-rect. Don't use "experimental programming". – Renate Schaaf Feb 17 '21 at 06:53

how to move two bitmap-image on a canvas

2 Answers2