淡出TImage

淡出TImage

关注
发信
关注(28)粉丝(399)

如何淡入/淡出TImage?

本文介绍了如何淡入/淡出TImage?的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我有一个名为Form1的简单 TForm ；Image1是一个 TImage ，其中加载了PNGImage和一个Button1 TButton 来进行测试.它成功地实现了一种对AlphaBlend Image1的图片的方法.代码如下:

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;

如果我简单地在Button1 onClick 上调用它，图像将被融合.无论如何，我的目标是淡入/淡出Image1.或者换句话说，转到不透明度0"到"255"并以相反的方式进行.我可以看到的是，在那里的 SetPNGOpacity 停止在循环内工作.我自然尝试使用以下代码将应用程序设置为忙:

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;

我只是希望在窗口不活动的情况下等待几秒钟，然后Image1应该完全消失.什么都没发生.因此，我使用了一个简单的线程来进行淡入淡出，如下所示:

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;

并这样称呼它:

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

同样，什么也没发生.所以我再次需要你们.有人对此有想法吗?难道我做错了什么?有人知道一些有用的读物​​吗?甚至是有用的代码?注意:我真的希望它会使用 TImage 甚至是 TBitmap ，我可以将它们提取/存储"到 TImage 中.

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.

提前谢谢.

推荐答案

冒着听起来像是唱片破损的风险，因此您将以错误的方式进行操作. TImage 对于静态图像很有用，用它来显示动态图像是错误的.您需要做的是:

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. 将图像加载到 TBitmap 或 TPNGImage 或某些类似的 TGraphic 后代中.
  2. 在表单上放置一个 TPaintBox .
  3. 运行一个计时器，以所需的刷新频率进行计时.
  4. 从计时器中调用 Invalidate 或在油漆盒上调用 Refresh .
  5. 为绘制动态图像的绘画框添加 OnPaint 处理程序.
  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.

代码如下:

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 来消除这种情况，但是我希望有一个更好的解决方案.

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.

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

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.

这是一个包含在单个文件中的GUI程序，显然，这不是编写生产代码的方法.我只是在这里这样做，使您可以将代码逐字粘贴到.dpr文件中，并向自己证明这种方法有效.

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.

这篇关于如何淡入/淡出TImage?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！

07-31 14:42
Powered by LMLPHP ©2024 淡出TImage 0.040482