Question

我有一个名为Form1的简单TForm; Image1是TImage加载了PNGImage和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;换句话说，转到Opacity 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

为什么你的方法不起作用有三个主要问题（我没有看过线程部分）。

您没有机会让应用程序处理反映图像更改的消息。现在删除的答案中提到了这一点。出于测试目的，您可以在每次迭代中插入Application.ProcessMessages调用。最终，您希望使用计时器进行动画制作。根据您的需要，它可能需要具有比TTimer更高分辨率的东西。
您不是每次都使用相同的图像进行渲染。注释中提到的是不保留要渲染的原始图像。在第一次迭代之后，您的图像已经被更改，当您从中获取图像以连续用作源时，它看起来与先前的源不同。
每次都没有在同一目标上混合。第一次将图像渲染到空白 - 黑色位图上。每次迭代时，您要混合的目标都会更改为其他内容。

以下内容不是我的建议，但会为您的方法进行修改以使其发挥作用。你应该做的最重要的事情是，在任何你喜欢的地方渲染它，但保持原始图像不被修改，而不是在TImage但在TPngImage的f.i中。

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;

Answer 2

冒着听起来像破纪录的风险，你会以错误的方式解决这个问题。 TImage对于静态图像非常有用 - 用于显示动态的内容是错误的。你需要做的是：

将您的图片加载到TBitmap或TPNGImage或某些此类TGraphic后代。
将TPaintBox放入您的表单。
运行一个以所需刷新率滴答的计时器。
来自绘图框上的计时器调用Invalidate或Refresh。
为绘制动态图像的绘图框添加OnPaint处理程序。

代码如下所示：

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FBitmap: TBitmap;
    FOpacity: Integer;
  end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Png: TPngImage;
begin
  Png := TPngImage.Create;
  Try
    Png.LoadFromFile('C:\desktop\YoshiMarioParty9.png');
    FBitmap := TBitmap.Create;
    FBitmap.Assign(Png);
  Finally
    Png.Free;
  End;

  BorderIcons := [biSystemMenu, biMinimize];
  BorderStyle := bsSingle;
  PaintBox1.Align := alClient;
  ClientWidth := FBitmap.Width;
  ClientHeight := FBitmap.Height;

  Timer1.Interval := 1000 div 25; // 25Hz refresh rate
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Timer1.Enabled := False;
  FBitmap.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  inc(FOpacity, 5);
  PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Brush.Color := clWhite;
  PaintBox1.Canvas.Brush.Style := bsSolid;
  PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);
  PaintBox1.Canvas.Draw(0, 0, FBitmap, FOpacity);
end;

这导致合理的结果，但有闪烁。这可以通过将表单的DoubleBuffered属性设置为True来消除，但我更倾向于使用更好的解决方案。

这种解决闪烁的方法是使油漆盒成为窗口控制。 VCL TPaintBox是一个非窗口控件，因此在其父窗口上绘制。这确实会导致闪烁。所以，这是一个带有从TCustomControl派生的简单绘制框控件的版本。这个变种在运行时设置了所有内容，因为我没有将绘制框控件注册为设计时间控件，尽管这样做非常简单。

program PaintBoxDemo;

uses
  Classes, Graphics, Controls, Forms, ExtCtrls, Diagnostics, pngimage;

type
  TWindowedPaintBox = class(TCustomControl)
  private
    FOnPaint: TNotifyEvent;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property Canvas;
  published
    property Align;
    property Anchors;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Touch;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnGesture;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property OnStartDock;
    property OnStartDrag;
  end;

constructor TWindowedPaintBox.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csReplicatable];
  Width := 105;
  Height := 105;
end;

procedure TWindowedPaintBox.Paint;
begin
  Canvas.Font := Font;
  Canvas.Brush.Color := Color;
  if csDesigning in ComponentState then
  begin
    Canvas.Pen.Style := psDash;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(0, 0, Width, Height);
  end;
  if Assigned(FOnPaint) then
    FOnPaint(Self);
end;

var
  Form: TForm;
  PaintBox: TWindowedPaintBox;
  Timer: TTimer;
  Bitmap: TBitmap;
  Stopwatch: TStopwatch;

type
  TEventHandlers = class
    class procedure TimerHandler(Sender: TObject);
    class procedure PaintHandler(Sender: TObject);
  end;

class procedure TEventHandlers.TimerHandler(Sender: TObject);
begin
  PaintBox.Invalidate;
end;

class procedure TEventHandlers.PaintHandler(Sender: TObject);
var
  t: Double;
  Opacity: Integer;
begin
  t := Stopwatch.ElapsedMilliseconds;
  Opacity := Trunc(128.0*(1.0+Sin(t/300.0)));
  PaintBox.Canvas.Brush.Color := clWhite;
  PaintBox.Canvas.Brush.Style := bsSolid;
  PaintBox.Canvas.FillRect(PaintBox.ClientRect);
  PaintBox.Canvas.Draw(0, 0, Bitmap, Opacity);
end;

procedure BuildForm;
var
  Png: TPngImage;
begin
  Png := TPngImage.Create;
  Try
    Png.LoadFromFile('C:\desktop\YoshiMarioParty9.png');
    Bitmap := TBitmap.Create;
    Bitmap.Assign(Png);
  Finally
    Png.Free;
  End;

  PaintBox := TWindowedPaintBox.Create(nil);
  PaintBox.Parent := Form;
  PaintBox.Align := alClient;
  PaintBox.DoubleBuffered := True;
  PaintBox.OnPaint := TEventHandlers.PaintHandler;

  Timer := TTimer.Create(nil);
  Timer.Interval := 1000 div 25; // 25Hz refresh rate
  Timer.Enabled := True;
  Timer.OnTimer := TEventHandlers.TimerHandler;

  Form.Caption := 'PaintBox Demo';
  Form.BorderIcons := [biSystemMenu, biMinimize];
  Form.BorderStyle := bsSingle;
  Form.ClientWidth := Bitmap.Width;
  Form.ClientHeight := Bitmap.Height;
  Form.Position := poScreenCenter;

  Stopwatch := TStopwatch.StartNew;
end;

procedure TidyUp;
begin
  Timer.Free;
  PaintBox.Free;
  Bitmap.Free;
end;

begin
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm, Form);
  BuildForm;
  Application.Run;
  TidyUp;
end.

这是一个包含在单个文件中的GUI程序，显然不是编写生产代码的方法。我这样做就是为了让你可以将代码逐字地粘贴到.dpr文件中，并证明这种方法有效。

我怎么能淡入/淡出TImage？

2 个答案: