TImage

TImage

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

delphi - 如何淡入/淡出TImage？

我有一个简单的TForm名为Form1； 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。或者换句话说，转到“不透明度” 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中。

提前致谢。

最佳答案

冒着听起来像是唱片破损的风险，您将以错误的方式进行操作。 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文件中，并向自己证明这种方法有效。

关于delphi - 如何淡入/淡出TImage？，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/21790393/

10-10 16:55
Powered by LMLPHP ©2024 TImage 0.044384