Image Delphi中类似Web2.0的假动画工具提示 初步解释

在我的delphi应用程序中，有一些关键领域需要强调。我认为标准的工具提示无法解决这个问题，而且对话框太烦人了，没有什么帮助

Web2.0工具提示（如）的干扰性更小，更适合我的具体需要

我试图解决这个问题 最初，我自定义设计了一个工具提示图像，将其与标签一起放在DevExpress的TdxImage组件（基本上是一个支持透明PNG的TImage）中，并将其用作自定义工具提示，但

我的问题是如何像在普通/web工具提示中那样设置动画？我尝试了AnimateWindow（）。它起作用了，但是文本根本没有出现（没有绘制文本，只显示图像）

需要注意的是，图像是一个透明的PNG，我愿意使用除AnimateWindowProc（）之外的任何解决方案，只要它不重，并且给我一个平滑的动画

---

伙计们，有什么好主意吗？

我有一个片段，与您真正要搜索的内容相去甚远，但我推荐使用这种技术。任何被称为EXGDIxxx的东西都来自（免费），只是重命名和改编

unit Unit_Outline;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   ExtCtrls,EXGDIPAPI,EXGDIPOBJ, StdCtrls;

type
  TForm2 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormDblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
   FDown:Boolean;
   FStartx,FstartY ,FendX,FEndY:Integer;
  public
    { Public-Deklarationen }

  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
 Function ColorToTGPColor (c : Tcolor; trans : Byte = 255):TGPColor;
Type
 TBarry=Array[0..3] of Byte;
Var
 Barry:TBarry;
 R:Byte;
begin
  move(C,Barry,4);
  R:=Barry[2];
  Barry[2]:=Barry[0];
  Barry[0]:=R;
  Barry[3]:=trans;
  move(Barry,Result,4);
end;

procedure TForm2.FormDblClick(Sender: TObject);
begin
  Close;
end;

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   FStartx := X;
   FstartY := Y;
   FDown := true;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssleft in shift then
    begin
     FEndx := X;
     FEndY := Y;
     Paint;
    end;
end;

procedure TForm2.FormPaint(Sender: TObject);
const
   C_Alpha=0;
var
   DestPoint, srcPoint:TPoint;
   winSize:TSize;
   DC         : HDC;
   blendfunc  : BLENDFUNCTION;
   Owner : HWnd;
   curWinStyle:Integer;
   exStyle:Dword;
   BackImage:TBitMap;
   Graphics :  TGPGraphics;
   Brush:TGPSolidBrush;
   FontFamily : TGPFontFamily;
   fmt:TGPStringFormat;
   aFont : TGPFont;
   Pen:TGPPen;
   xx,yy:Integer;
   path : TGPGraphicsPath;
begin

  DC := GetDC(0);
  BackImage:=TBitMap.Create;
  BackImage.PixelFormat := pf32Bit;
  BackImage.Width := Width;
  BackImage.Height := Height;
  BackImage.Canvas.Brush.Color := clBlack;
  BackImage.Canvas.FillRect(Rect(0,0,Width,Height));

  Graphics :=  TGPGraphics.Create(BackImage.Canvas.Handle);
  graphics.SetSmoothingMode(SmoothingModeHighQuality);
  graphics.SetTextRenderingHint(TextRenderingHintAntiAlias);
  Brush:=TGPSolidBrush.Create(ColorToTGPColor(clRed,200));
  FontFamily := TGPFontFamily.Create('Arial narrow');
  aFont := TGPFont.Create(FontFamily,80);
  Pen:=TGPPen.Create(ColorToTGPColor(clRed,200));
  fmt:=TGPStringFormat.Create;
  try
  path := TGPGraphicsPath.Create;
  path.AddString('Test',-1,FontFamily,1,150,MakePoint(100,100),fmt);
  Graphics.DrawPath(pen,path);
  // Graphics.FillPath(brush,path);
  path.Free;
  FontFamily.Free;
  FontFamily := TGPFontFamily.Create('Times New Roman');

  path := TGPGraphicsPath.Create;
  path.AddString(FormatDateTime('hh:nn:ss',now),-1,FontFamily,FontStyleBold or FontStyleItalic,200,MakePoint(200,200),fmt);
  pen.SetWidth(2);
  pen.SetColor(ColorToTGPColor(clNavy,230));
  Graphics.DrawPath(pen,path);
  // Graphics.FillPath(brush,path);
  path.Free;
  pen.Free;

//  Graphics.DrawString(FormatDateTime('hh:nn:ss',now),-1,aFont,MakePoint(0.0,0),Brush);
   winSize.cx := width;
   winSize.cy := Height;
   srcPoint.x := 0;
   srcPoint.y := 0;

   DestPoint := BoundsRect.TopLeft;
   exStyle := GetWindowLongA(handle, GWL_EXSTYLE);
   if (exStyle and WS_EX_LAYERED = 0) then SetWindowLong(handle, GWL_EXSTYLE, (exStyle or WS_EX_LAYERED or WS_EX_TRANSPARENT) );


   With blendFunc do
   begin
     AlphaFormat := 1;
     BlendFlags := 0;
     BlendOp := AC_SRC_OVER;
     SourceConstantAlpha := 255 - C_Alpha;
   end;

   UpdateLayeredWindow(Handle, DC, @DestPoint, @winSize, BackImage.Canvas.Handle,  @srcPoint,clBlack, @blendFunc, 2);

   finally
   ReleaseDC(0, DC);
   BackImage.Free;
   Graphics.Free;
   Brush.Free;
   FontFamily.free;
   aFont.Free;
   fmt.Free;
   end;

end;

procedure TForm2.FormShow(Sender: TObject);
begin
   SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE );
   DoubleBuffered := true;

end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  FormPaint(self);
end;

end.

---

这里有另一个非常便宜的方法，你可以使用AnimateWindowProc。 代码中没有魔力，也许它满足了您的需求。

---

使用带有GDI+@bummi的分层窗口：非常有趣……是否愿意在Delphi中扩展/共享一个示例/链接？谢谢，但我担心这不起作用；我需要这个用于Delphi 2010，prodigy的代码（

DirectDraw.pas

特别是）在此Delphi版本下编译失败（许多错误如下：

[DCC Error]DirectDraw.pas（358）：E2154类型“IDirectDrawSurface”需要完成-在变体记录中不允许使用从prodigy.com网站下载的最新文件）从prodigy中删除Directdrawcode，Emba有自己的代码。从D7到2005200702009，德尔福XE没有尝试使用XE3（离开办公室），我无法删除它（德尔福2010会抱怨），但我得到了，它工作了…确实非常远，但现在我清楚地看到你关于透明分层窗口绘图的观点…所以如果我理解正确，我应该在一个特殊的窗体上绘制工具提示（使用GDI+）并在调用AnimateWindowProc（）时传递其句柄，即
AnimateWindowProc（TransparentForm.handle，250，AW_CENTER或AW_ACTIVATE），对吗？您不会通过AnimateWindowProc设置动画，所有动画都是在分层窗口上绘制完成的。谢谢您的代码bummi！我看了一下代码，当显示工具提示表单时，它确实有一个不希望出现的焦点问题（如果我使用控件，我想可以避免），但是现在它更清楚了，谢谢！。。。在我修改代码后，我会稍后回复你接受答案。再次感谢bummi&很抱歉回复太晚，我尝试了示例项目，但恐怕它不符合我的要求。我发布了一个关于我希望最终结果的详细信息，再次感谢！
unit Unit_Outline;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   ExtCtrls,EXGDIPAPI,EXGDIPOBJ, StdCtrls;

type
  TForm2 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormDblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
   FDown:Boolean;
   FStartx,FstartY ,FendX,FEndY:Integer;
  public
    { Public-Deklarationen }

  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
 Function ColorToTGPColor (c : Tcolor; trans : Byte = 255):TGPColor;
Type
 TBarry=Array[0..3] of Byte;
Var
 Barry:TBarry;
 R:Byte;
begin
  move(C,Barry,4);
  R:=Barry[2];
  Barry[2]:=Barry[0];
  Barry[0]:=R;
  Barry[3]:=trans;
  move(Barry,Result,4);
end;

procedure TForm2.FormDblClick(Sender: TObject);
begin
  Close;
end;

procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   FStartx := X;
   FstartY := Y;
   FDown := true;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssleft in shift then
    begin
     FEndx := X;
     FEndY := Y;
     Paint;
    end;
end;

procedure TForm2.FormPaint(Sender: TObject);
const
   C_Alpha=0;
var
   DestPoint, srcPoint:TPoint;
   winSize:TSize;
   DC         : HDC;
   blendfunc  : BLENDFUNCTION;
   Owner : HWnd;
   curWinStyle:Integer;
   exStyle:Dword;
   BackImage:TBitMap;
   Graphics :  TGPGraphics;
   Brush:TGPSolidBrush;
   FontFamily : TGPFontFamily;
   fmt:TGPStringFormat;
   aFont : TGPFont;
   Pen:TGPPen;
   xx,yy:Integer;
   path : TGPGraphicsPath;
begin

  DC := GetDC(0);
  BackImage:=TBitMap.Create;
  BackImage.PixelFormat := pf32Bit;
  BackImage.Width := Width;
  BackImage.Height := Height;
  BackImage.Canvas.Brush.Color := clBlack;
  BackImage.Canvas.FillRect(Rect(0,0,Width,Height));

  Graphics :=  TGPGraphics.Create(BackImage.Canvas.Handle);
  graphics.SetSmoothingMode(SmoothingModeHighQuality);
  graphics.SetTextRenderingHint(TextRenderingHintAntiAlias);
  Brush:=TGPSolidBrush.Create(ColorToTGPColor(clRed,200));
  FontFamily := TGPFontFamily.Create('Arial narrow');
  aFont := TGPFont.Create(FontFamily,80);
  Pen:=TGPPen.Create(ColorToTGPColor(clRed,200));
  fmt:=TGPStringFormat.Create;
  try
  path := TGPGraphicsPath.Create;
  path.AddString('Test',-1,FontFamily,1,150,MakePoint(100,100),fmt);
  Graphics.DrawPath(pen,path);
  // Graphics.FillPath(brush,path);
  path.Free;
  FontFamily.Free;
  FontFamily := TGPFontFamily.Create('Times New Roman');

  path := TGPGraphicsPath.Create;
  path.AddString(FormatDateTime('hh:nn:ss',now),-1,FontFamily,FontStyleBold or FontStyleItalic,200,MakePoint(200,200),fmt);
  pen.SetWidth(2);
  pen.SetColor(ColorToTGPColor(clNavy,230));
  Graphics.DrawPath(pen,path);
  // Graphics.FillPath(brush,path);
  path.Free;
  pen.Free;

//  Graphics.DrawString(FormatDateTime('hh:nn:ss',now),-1,aFont,MakePoint(0.0,0),Brush);
   winSize.cx := width;
   winSize.cy := Height;
   srcPoint.x := 0;
   srcPoint.y := 0;

   DestPoint := BoundsRect.TopLeft;
   exStyle := GetWindowLongA(handle, GWL_EXSTYLE);
   if (exStyle and WS_EX_LAYERED = 0) then SetWindowLong(handle, GWL_EXSTYLE, (exStyle or WS_EX_LAYERED or WS_EX_TRANSPARENT) );


   With blendFunc do
   begin
     AlphaFormat := 1;
     BlendFlags := 0;
     BlendOp := AC_SRC_OVER;
     SourceConstantAlpha := 255 - C_Alpha;
   end;

   UpdateLayeredWindow(Handle, DC, @DestPoint, @winSize, BackImage.Canvas.Handle,  @srcPoint,clBlack, @blendFunc, 2);

   finally
   ReleaseDC(0, DC);
   BackImage.Free;
   Graphics.Free;
   Brush.Free;
   FontFamily.free;
   aFont.Free;
   fmt.Free;
   end;

end;

procedure TForm2.FormShow(Sender: TObject);
begin
   SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE );
   DoubleBuffered := true;

end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
  FormPaint(self);
end;

end.