Fausse infobulle animée de type Web 2.0 en Delphi

Question

Explication initiale

Il y a certaines zones clés dans mon application delphi que je dois mettre en évidence. J'ai décidé que les infobulles standard ne suffiraient pas et que les boîtes de dialogue seraient trop ennuyeuses pour être utiles.

Les infobulles du Web 2.0 (comme cet exemple de bulle de style Coda ) sont moins intrusifs et répondent bien mieux à mes besoins spécifiques.

Ma tentative de résoudre le problème

Au départ, j'ai conçu une image d'infobulle personnalisée, je l'ai placée dans un composant TdxImage de DevExpress (qui est en fait une image TI avec un support PNG transparent) avec une étiquette et je les ai utilisés comme infobulle personnalisée mais...

Mon problème est le suivant Comment puis-je animer comme dans les infobulles normales/web ? J'ai essayé AnimateWindow(). Cela a fonctionné, mais le texte n'est pas apparu pas du tout (le texte n'est pas dessiné, seule l'image est affichée)

// 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);

Il est important de noter que l'image est une PNG transparent Je suis prêt à utiliser n'importe quelle solution autre que AnimateWindowProc() tant qu'il s'agit de pas lourd et donnez-moi une animation fluide comme dans le Infobulles de Coda

Une idée, les gars ?

Answer 1

J'ai obtenu un extrait, très éloigné de ce que vous recherchez réellement, mais la technique est celle que je recommande. Tout ce qui s'appelle EXGDIxxx provient de http://www.progdigy.com/?page_id=7 (gratuit), juste renommé et adapté.

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

Voici un autre moyen très bon marché, qui consiste à utiliser AnimateWindowProc. Il n'y a pas de magie dans le code, peut-être cela répond-il à vos besoins. coda_src