How could I fade in/out a TImage?

Question

I have a simple TForm named Form1; Image1 which is a TImage loaded with a PNGImage and a Button1 TButton to test things. It was implemented sucessfully a method to AlphaBlend Image1's picture. Code follows:

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;

If I simple calls this on the Button1 onClick the Image is blended. My goal anyway is to Fade In/Out Image1; or in other words, go to Opacity 0 to 255 and inverse way. What I could see is that the SetPNGOpacity up there stop working inside a Loop. I naturaly tried set the application busy with the following code:

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;

I was just expecting to wait some seconds with a inactive window and then Image1 should desappear completelly. What did not happen. So I tried it with a simple thread to Fade Out, descripted here:

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;

And call it like this:

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

Again, nothing happens. So I need you guys again. Someone have an idea about it? Am I doing something wrong? Does anyone know some useful reading; or even a helpful piece of code? Note: I really wish it would be using TImage or even a TBitmap which I could "extract/store" in a TImage.

Thanks in advance.

Answer 1

There are three main problems for why your approach is not working (I haven't looked at the threaded part).

1. You don't give a chance for the application to process the messages that would reflect the change in the image. This is mentioned in the now deleted answer. For testing purposes, you can insert an Application.ProcessMessages call in each iteration. Ultimately, you would like to use a timer for animation purposes. Depending on your needs it may need to be something with a higher resolution than the TTimer.

2. You are not rendering from the same image every time. This is mentioned in the comments as not keeping an original image to render from. Right after the first iteration your image has been changed, and when you grab the image out of it to use as the source consecutively, it doesn't look anything like the previous source.

3. You are not blending on the same target every time. The first time round you render the image on a blank-black bitmap. With each iteration, the target you're blending on to changes to something else.

The below is not my recommendation but what would be modified for your approach to see it work. The foremost important thing IMO you should do is that, render it wherever you like but keep your original image unmodified, not in a TImage but in a TPngImage of its own 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

At the risk of sounding like a broken record, you are going about this the wrong way. A TImage is useful for a static image – it's the wrong thing to use to show anything dynamic. What you need to do is:

1. Load your image into a TBitmap or TPNGImage or some such TGraphic descendent.
2. Put a TPaintBox onto your form.
3. Run a timer that ticks at the desired refresh rate.
4. From the timer call Invalidate or perhaps Refresh on the paint box.
5. Add an OnPaint handler for the paint box that paints your dynamic image.

The code looks like this:

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;

This results in a reasonable result, but there is flicker. This can be eliminated by setting the form's DoubleBuffered property to True, but I'd prefer a better solution to that.

This approach to solving the flicker is to make the paint box a windowed control. The VCL TPaintBox is a non-windowed control and so paints on its parent's window. This does tend to lead to flicker. So, here's a version with a simple paint box control derived from TCustomControl. This variant sets everything up at run time because I've not bother registering the paint box control as a design time control, although it's perfectly simple to do so.

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.

This is a GUI program contained in a single file, which is obviously not the way to write production code. I just do it like this here to make it possible for you to paste the code into a .dpr file verbatim and so prove to yourself that this approach works.