image - Delphi 中伪造的类似 Web 2.0 的动画工具提示

Question

初始说明

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

Web 2.0 工具提示(如 this Coda-style bubble example)对我的特定需求影响较小且更好。

我解决问题的尝试

最初我自定义设计了一个工具提示图像，将它与标签一起放在 DevExpress 的 TdxImage 组件(基本上是一个支持透明 PNG 的 TImage)中，并将它们用作自定义工具提示但是......

我的问题是 我怎样才能像普通/网络工具提示一样制作动画？我尝试了 AnimateWindow()。它有效，但文本没有出现(没有绘制文本，只显示图像)

// Prepare tooltip text
cxTooltipLabel.Caption := 'Translated or dynamic tooltip text';
cxTooltipLabel.Visible := True;
cxTooltipLabel.BringToFront;

// Load custom tooltip image
cxImage.Picture.LoadFromFile(ExePath + 'data\tooltip.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.