(Delphi THintWindow) ¿Cómo dibujar un PNG transparente?
tengo estodelphi 2010 código:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Math, ExtCtrls, pngimage;
type
TMyHintWindow = class(THintWindow)
private
FBitmap : TBitmap;
ThePNG : TPngImage;
FRegion : THandle;
procedure FreeRegion;
protected
procedure CreateParams(var Params : TCreateParams); override;
procedure Paint; override;
procedure Erase(var Message : TMessage); message WM_ERASEBKGND;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure ActivateHint(Rect : TRect; const AHint : String); Override;
end;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender : TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1 : TForm1;
implementation
{$R *.dfm}
// --------------------------------------------------------------------------- //
constructor TMyHintWindow.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FBitmap := TBitmap.Create;
FBitmap.PixelFormat := pf32bit;
FBitmap.HandleType := bmDIB;
FBitmap.Transparent := True;
FBitmap.TransparentMode := tmAuto; // }tmFixed;
FBitmap.TransparentColor := clWhite;
FBitmap.AlphaFormat := {afPremultiplied; // }afDefined;
ThePNG := TPngImage.Create;
ThePNG.Transparent := True;
ThePNG.TransparentColor := clWhite;
ThePNG.LoadFromFile('D:\project-1\tooltip.png');
FBitmap.LoadFromFile('D:\project-1\tooltip.bmp');
end;
// --------------------------------------------------------------------------- //
destructor TMyHintWindow.Destroy;
begin
FBitmap.Free;
FreeRegion;
inherited;
end;
// --------------------------------------------------------------------------- //
procedure TMyHintWindow.CreateParams(var Params : TCreateParams);
const
CS_DROPSHADOW = $20000;
begin
inherited;
Params.Style := Params.Style - WS_BORDER;
Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;
end;
// --------------------------------------------------------------------------- //
procedure TMyHintWindow.FreeRegion;
begin
if FRegion <> 0 then
begin
SetWindowRgn(Handle, 0, True);
DeleteObject(FRegion);
FRegion := 0;
end;
end;
// --------------------------------------------------------------------------- //
procedure TMyHintWindow.ActivateHint(Rect : TRect; const AHint : String);
var
i : Integer;
begin
Caption := AHint;
Canvas.Font := Screen.HintFont;
FBitmap.Canvas.Font := Screen.HintFont;
DrawText(Canvas.Handle, PChar(Caption), Length(Caption), Rect, DT_CALCRECT or DT_NOPREFIX);
Width := 230; // (Rect.Right - Rect.Left) + 16;
Height := 61; // (Rect.Bottom - Rect.Top) + 10;
FBitmap.Width := Width;
FBitmap.Height := Height;
Left := Rect.Left;
Top := Rect.Top;
FreeRegion;
with Rect do
FRegion := CreateRoundRectRgn(1, 1, Width, Height, 3, 3);
if FRegion <> 0 then
SetWindowRgn(Handle, FRegion, True);
AnimateWindowProc(Handle, 300, AW_BLEND);
SetWindowPos(Handle, HWND_TOPMOST, Left, Top, 0, 0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);
end;
// --------------------------------------------------------------------------- //
procedure TMyHintWindow.Paint;
var
CaptionRect : TRect;
begin
with FBitmap.Canvas do
begin
Font.Color := clWindowText;
Brush.Style := bsClear;
end; // with
CaptionRect := Rect(25, 26, Width - 10, Height - 10);
SetBkMode(Canvas.Handle, TRANSPARENT);
DrawText(FBitmap.Canvas.Handle, PChar(Caption), Length(Caption), CaptionRect, DT_WORDBREAK OR DT_NOPREFIX);
BitBlt(Canvas.Handle, 0, 0, Width, Height, FBitmap.Canvas.Handle, 0, 0, SRCERASE{SRCCOPY});
end;
// --------------------------------------------------------------------------- //
procedure TMyHintWindow.Erase(var Message : TMessage);
begin
Message.Result := 0;
end;
// --------------------------------------------------------------------------- //
procedure TForm1.FormCreate(Sender : TObject);
begin
HintWindowClass := TMyHintWindow;
Button1.Hint := 'This is a nice fake tooltip!';
end;
// --------------------------------------------------------------------------- //
end.
Este ejemplo tienedos cuestiones:
Necesito dibujar el PNG con los bordes transparentes.La imagen en sí está aquí.
Si ejecuta este proyecto (el formulario tiene solo un botón llamado Button1) y muestra la sugerencia varias veces, debe darse cuenta de que el título se vuelve más nítido cada vez que se muestra la sugerencia. Estoy bastante seguro de que olvidé un fondo. Olvidé borrar / borrar, pero no estoy seguro de cómo solucionarlo.
¿Puede alguien decirme cómo solucionar estos dos problemas?