Delphi中的假，动画Web 2.0的工具提示

Question

初始说明

我的Delphi应用程序中有某些关键领域需要突出显示。我认为标准工具提示不会削减它，对话框太烦人了，无法有所帮助。

Web 2.0 Tooltips（如此CODA风格的气泡示例）不那么侵入性＆amp;满足我的特定需求。

我试图解决问题

最初，我自定义设计了一个工具提示图像，将其放在Devexpress的tdximage组件中（基本上是具有透明PNG支持的宫廷）以及标签，并将其用作自定义工具提示，但是...

>

我的问题是如何像普通/Web工具提示中那样动画？我尝试了AnimateWindow（）。它有效，但是根本没有出现（未绘制文本，仅显示图像）

// Prepare tooltip text
cxTooltipLabel.Caption := 'Translated or dynamic tooltip text';
cxTooltipLabel.Visible := True;
cxTooltipLabel.BringToFront;
// Load custom tooltip image
cxImage.Picture.LoadFromFile(ExePath + 'datatooltip.png');
// Show tooltip!
AnimateWindowProc(cxImage.Handle, 250, AW_CENTER OR AW_ACTIVATE);

重要的是要注意，图像是透明的png ，我愿意使用AnimateWindowProc（）以外的任何解决方案平滑动画，如Coda Tooltips

有什么想法吗？

Answer 1

我有一个摘要，远离您真正搜索的内容，但是我会推荐的技术。任何称为exgdixxx的内容均来自http://www.progdigy.com/?page_id=7（免费），只是更名和改编。

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.

Answer 2

这是另一种非常便宜的方式，您可以使用AnimateWindowProc。代码中没有魔术，也许它可以满足您的需求。coda_src