delphi - 我如何淡入/淡出 TImage？

Question

我有一个名为 Form1 的简单 TForm； Image1 是一个加载了 PNGImage 的 TImage 和一个用于测试的 Button1 TButton 。成功实现了AlphaBlend Image1图片的方法。代码如下:

procedure SetPNGOpacity(Image : TImage; Alpha: Byte);
var
    Bmp: TBitmap;
    BlendFn: TBlendFunction;
    PNG: TPNGImage;
begin
    Png := TPngImage.Create;
    Png.Assign(TPNGImage(Image.Picture.Graphic));
    Bmp := TBitmap.Create;
    Bmp.Assign(Png);
    Image.Picture.Bitmap.PixelFormat := pf32bit;
    Image.Picture.Bitmap.AlphaFormat := afPremultiplied;
    Image.Picture.Bitmap.Canvas.Brush.Color := clBlack;
    Image.Picture.Bitmap.SetSize(Png.Width, Png.Height);
    BlendFn.BlendOp := AC_SRC_OVER;
    BlendFn.BlendFlags := 0;
    BlendFn.SourceConstantAlpha := Alpha;
    BlendFn.AlphaFormat := AC_SRC_ALPHA;
    winapi.windows.AlphaBlend(
        Image.Picture.Bitmap.Canvas.Handle,
        0, 0, Image.Picture.Bitmap.Width,
        Image.Picture.Bitmap.Height,
        Bmp.Canvas.Handle,
        0, 0, Bmp.Width,
        Bmp.Height,
        BlendFn
    );
    Bmp.FreeImage;
    Bmp.Free;
    Png.Free;
end;

如果我简单地在 Button1 onClick 上调用它，图像就会混合。无论如何，我的目标是淡入/淡出 Image1；或者换句话说，转到不透明度 0 到 255 并以相反的方式。我看到的是上面的 SetPNGOpacity 停止在循环内工作。我自然地尝试使用以下代码让应用程序忙碌:

procedure TForm1.Button1Click(Sender: TObject);
var 
    I : integer;
begin
    I := 255;
    while I > 0 do
    begin
        I := I - 1;
        sleep(125);
        SetPNGOpacity(Image2, I);
   //     MessageBeep(0);
    end;
end;

我只是希望在非事件窗口中等待几秒钟，然后 Image1 应该完全消失。什么没有发生。所以我尝试使用一个简单的淡出线程，如下所述:

TBar = class(TThread)
private
    I : integer;
public
    procedure execute; override;
    procedure Test;
    constructor Create;
end;

implementation

constructor TBar.Create;
begin
    inherited Create(false);
    I := 255;
end;

procedure TBar.execute;
begin
    while I > 0 do
    begin
        I := I - 1;
        sleep(250);
        synchronize(Test);
     //   MessageBeep(0);
    end;
end;

procedure TBar.Test;
begin
    SetPNGOpacity(Form1.Image2, I);
end;

并这样调用它:

procedure TForm1.Button1Click(Sender: TObject);
var 
    Foo : TBar;
begin
    Foo := TBar.Create;
end;

同样，什么也没有发生。所以我再次需要你们。有人对此有什么想法吗？难道我做错了什么？有谁知道一些有用的读物​​吗？或者甚至是一段有用的代码？注意:我真的希望它能使用 TImage 甚至是 TBitmap，我可以在 TImage 中“提取/存储”它。

提前致谢。

Answer 1

您的方法不起作用的原因有三个主要问题(我没有查看线程部分)。

1. 您不给应用程序处理反射(reflect)图像更改的消息的机会。现在删除的答案中提到了这一点。出于测试目的，您可以在每次迭代中插入 Application.ProcessMessages 调用。最终，您希望使用计时器来实现动画目的。根据您的需求，它可能需要比 TTimer 具有更高的分辨率。

2. 您并非每次都从同一个图像进行渲染。评论中提到这一点，因为不保留原始图像进行渲染。在第一次迭代之后，您的图像已更改，当您从中抓取图像以连续用作源时，它看起来与之前的源完全不同。

3. 您并非每次都针对同一个目标进行混合。第一次，您在空白黑色位图上渲染图像。在每次迭代中，您要混合的目标都会更改为其他内容。

以下不是我的建议，而是为了让您的方法发挥作用而需要修改的内容。在我看来，你应该做的最重要的事情是，在任何你喜欢的地方渲染它，但保持原始图像不被修改，不是在 TImage 中，而是在它自己的 TPngImage 中。

procedure SetPNGOpacity(Master: TBitmap; Image : TImage; Alpha: Byte);
begin
    Image.Picture.Bitmap.PixelFormat := pf32bit;
    Image.Picture.Bitmap.AlphaFormat := afPremultiplied;
    Image.Picture.Bitmap.Canvas.Brush.Color := clBlack;
    Image.Picture.Bitmap.SetSize(Master.Width, Master.Height);
    Image.Picture.Bitmap.Canvas.FillRect(Rect(0, 0, Master.Width, Master.Height));
    Image.Picture.Bitmap.Canvas.Draw(0, 0, Master, Alpha); // thanks to TLama for telling that Canvas.Draw has an optional opacity parameter in later Delphi versions
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    Bmp: TBitmap;
    I : integer;
begin
    Bmp := TBitmap.Create;
    Bmp.Assign(TPNGImage(Image2.Picture.Graphic));
    I := 255;
    while I > 0 do
    begin
        I := I - 1;
        SetPNGOpacity(Bmp, Image2, I);
        Application.ProcessMessages;
        Sleep(10);
   //     MessageBeep(0);
    end;
    Bmp.Free;
end;