How can I go to / from TImage?

Question

How can I go to / from TImage?

I have a simple one TForm

named Form1; Image1, which is TImage

loaded with PNGImage and Button1 TButton

for validation. It has been successfully implemented using the AlphaBlend Image1 method. The 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 just call this on Button1 the onClick

image is blended. Anyway, my goal is Fade In / Out Image1; or in other words, go to Opacity from 0 to 255 and vice versa. I saw that SetPNGOpacity

there stops working inside Loop. I naturally put 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 just waited a few seconds with the window inactive and then Image1 should disappear completely. What didn't happen. So I tried it with a simple thread for Fade Out described 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. Therefore, I need you again. Anyone have an idea? Am I doing something wrong? Does anyone know of some helpful reading; or even a helpful piece of code? Note. I would really like it to be used TImage

or even TBitmap

that I could "extract / store" in TImage

.

Thanks in advance.

+1

delphi delphi-xe3

Guill Feb 14 14 at 22:08

source to share

2 answers

There are three main issues why your approach doesn't work (I didn't look at the threaded part).

You have no way for the application to process messages that reflect the image change. This is mentioned in a deleted answer. For testing purposes, you can insert a call Application.ProcessMessages

at each iteration. Ultimately, you would like to use a timer for animation. More than that may be required depending on your needs TTimer

.
You will not display the same image every time. This is mentioned in the comments as it doesn't save the original image for rendering. Right after the first iteration, your image was resized, and when you extract the image from it to use it as a source consistently, it doesn't look like the previous source.
You don't mix the same goal every time. The first time you render the image on a black and white bitmap. With each iteration, the target you're laughing at changes to something else.

Below is not my recommendation, but what would change for your approach to see how it works. The main thing you need to do IMO is to make it anywhere, anywhere, but keep the original image intact, not in TImage

, but in TPngImage

its own fi.

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;

+5

Sertac Akyuz 15 Feb At 2:01 am

source to share

David Heffernan · Accepted Answer · 2014-02-15T12:02:17+0000

At the risk of sounding like a broken record, you are going wrong. A TImage

is useful for a static image - it is not the right thing to show anything dynamic. What you need to do:

Upload an image to TBitmap

or TPNGImage

or some of them TGraphic

.
Place a TPaintBox

on your form.
Start a timer that marks the desired refresh rate.
From calling a timer, Invalidate

or perhaps Refresh

in a drawing field.
Add a handler OnPaint

for the paint field that displays 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 produces a reasonable result, but there is flicker. This can be fixed by setting the property to a DoubleBuffered

value True

, but I would prefer a better solution to this.

This approach to solving flicker is to make the paint a box with a windowed control. The VCL TPaintBox

is not a windowed control and is therefore painted in its parent window. This tends to result in flickering. So here is the simple box control version derived from TCustomControl

. This option sets everything at runtime because I didn't bother registering the paint control as a design-time control, although it is quite easy to do.

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.

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

How can I go to / from TImage?

More articles: