Fatal编程技术网
  • delphi/
  • Delphi 如何在画布上移动两个位图图像

Delphi 如何在画布上移动两个位图图像

delphi

Delphi 如何在画布上移动两个位图图像,delphi,delphi-7,tcanvas,Delphi,Delphi 7,Tcanvas,我正在Delphi7下编写一个动画程序，其中包括在画布上移动两张光盘（我选择了一个画框），并在边缘上产生反弹效果 如果我一张一张地加载图片，那就没问题了：在这种情况下，当不时到达的两个磁盘叠加在一起时，就不会出现背景矩形，甚至也不会出现令人愉悦的透明效果 但是，如果我试图通过引入一张唱片来推广更多光盘的操作 移动正常，但在这种情况下，当光盘交叉时，背景 矩形出现在上面的图像中，破坏了一切 我甚至尝试使用以下对象编写代码： TSphere = class (TObject) 但无事可做

我正在Delphi7下编写一个动画程序，其中包括在画布上移动两张光盘（我选择了一个画框），并在边缘上产生反弹效果

如果我一张一张地加载图片，那就没问题了：在这种情况下，当不时到达的两个磁盘叠加在一起时，就不会出现背景矩形，甚至也不会出现令人愉悦的透明效果

但是，如果我试图通过引入一张唱片来推广更多光盘的操作

移动正常，但在这种情况下，当光盘交叉时，背景 矩形出现在上面的图像中，破坏了一切

我甚至尝试使用以下对象编写代码：

    TSphere = class (TObject)
但无事可做，这种现象依然存在

你知道如何消除这个显示缺陷吗

我还有一个问题，我想用纹理填充磁盘

完整代码：

    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.

单元1；
接口
使用
窗口、消息、系统、类、图形、控件、窗体、，
对话框、ExtCtrls、StdCtrls、ComCtrls；
类型
t球=记录
W、 H：整数；
vx，vy：扩展；
x、 y：整数；
xx，yy：扩展；
ROld，RNew:TRect；
Bitm:TBitmap；
结束；
类型
TForm1=类（TForm）
PaintBox1:tPaintbox1；
按钮1:t按钮；
定时器1:TTimer；
标签1:TLabel；
编辑1：TEdit；
标签2:TLabel；
TrackBar1:TTrackBar；
过程表单创建（发送方：ToObject）；
销毁程序表（发送方：TObject）；
程序FormPaint（发送方：TObject）；
程序按钮1点击（发送方：ToObject）；
程序定时器1定时器（发送方：TObject）；
程序跟踪条1变更（发送方：ToObject）；
结束；
变量
表1:TForm1；
鳍：布尔型；
BmpBkg:Tbitmap；
BmpMoving:TBitmap；
球体：T球体阵列；
常数
nb=2；
图像宽度=32；
实施
{$R*.DFM}
程序图像存储；
变量
i：整数；
开始
设置长度（球体，nb）；
对于i:=0到（nb-1）do
开始
用球体[我]做
开始
Bitm:=TBitmap.Create；
案例一
0:Bitm.loadFromFile（'Sphere1.bmp'）；
1:Bitm.loadFromFile（'Sphere2.bmp'）；
结束；
结束；
结束；
结束；
过程TForm1.FormCreate（发送方：TObject）；
变量
i：整数；
开始
双缓冲：=真；
随机化；
Fin:=假；
BmpBkg:=TBitmap.Create；
BmpMoving:=TBitmap.Create；
BmpBkg.Canvas.Brush.Color:=ClBtnFace；
BmpBkg.Canvas.FillRect（Rect（0,0，PaintBox1.height，
油漆盒（1.宽度）；
BmpBkg.宽度：=油漆箱1.宽度；
BmpBkg.高度：=油漆箱1.高度；
bmp移动分配（BmpBkg）；
图片收藏；
对于i:=0到（nb-1）do
开始
用球体[我]做
开始
W:=位宽；
H:=比特高度；
比特透明：=真；
Bitm.TransParentColor:=Bitm.canvas.pixels[1,1]；
xx:=随机（400）+1；
yy:=随机（200）+1；
x:=trunc（xx）；
y:=trunc（yy）；
vx:=随机（3）+1；
vy:=随机（4）+1；
RNew:=边界（x，y，W，H）；
ROld:=RNew；
结束；
结束；
Timer1.interval:=1；
Timer1.enabled:=真；
结束；
程序TForm1.FormDestroy（发送方：ToObject）；
变量
i：整数；
开始
Fin:=真；
BmpBkg.游离；
BmpMoving.free；
对于i:=0到（nb-1）do
球体[i].Bitm.Free；
结束；
程序TForm1.FormPaint（发送方：TObject）；
开始
PaintBox1.Canvas.Draw（0,0，bmp移动）；
结束；
程序TForm1.按钮1单击（发送方：TObject）；
开始
接近；
结束；
程序TForm1.Timer1Timer（发送方：TObject）；
变量
n、 i：整数；
符文：Trect；
开始
对于n:=1到trackbar1.do位置
开始
如果是，则退出；
对于i:=0到（nb-1）do
开始
用球体[我]做
开始
BmpMoving.Canvas.CopyRect（ROld，bmpBkg.Canvas，ROld）；
如果（x<-ImageWidth）或（x>bmpBkg.width-W+ImageWidth）
然后
vx:=-vx；
如果（y<0）或（y>bmpBkg.height-H），则
vy:=-vy；
xx:=xx+vx；
yy:=yy+vy；
x:=trunc（xx）；
y:=trunc（yy）；
RNew:=边界（x，y，W，H）；
BmpMoving.Canvas.Draw（x，y，Bitm）；
UnionRect（RUnion、ROld、RNew）；
PaintBox1.Canvas.CopyRect（RUnion、BmpMoving.Canvas、，
鲁宁）；
ROld:=RNew；
结束；
结束；
结束；
结束；
程序TForm1.TrackBar1Change（发送方：TObject）；
开始
Edit1.text:=inttostr（trackbar1.position）；
如果trackbar1.position=1，则
label2.visible:=真
其他的
label2.visible:=假；
结束；
结束。
这个项目只是另一个更重要的项目的开始

谢谢

您的代码基本正常

据我所知，您的问题是由于在新位置绘制位图之前未完全恢复背景造成的。在绘制新矩形之前，需要恢复所有球体的旧矩形。在更新到屏幕之前，还需要收集所有新的和旧的矩形的完整联合

出于兴趣，我会避免使用全局变量，并将其作为表单的字段。若你们也让PictureStorage成为一种形式的方法，那个么一切都是有效的

计时器间隔为1似乎有点过头了。我会将其设置为1000 div 120（120 FPS）

我会将doublebuffered设置为false，因为您已经在执行自己的doublebuffering。我也会移动表单的OnP 
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;

   // Collect the old rects into the update-rect

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