(Delphi THintWindow) Wie zeichnet man ein transparentes PNG?
ich habe dasDelphi 2010 Code:
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.
Dieses Beispiel hatzwei Fragen:
Ich muss das PNG mit den transparenten Rändern zeichnen.Das Bild selbst ist hier
Wenn Sie dieses Projekt ausführen (Formular hat nur eine Schaltfläche mit dem Namen Button1) und den Hinweis einige Male anzeigen, sollten Sie feststellen, dass die Beschriftung bei jeder Anzeige des Hinweises kühner wird. Ich bin mir ziemlich sicher, dass ich einen Hintergrund vergessen habe, den ich löschen / löschen wollte, aber ich bin mir nicht sicher, wie ich das beheben soll.
Kann mir jemand sagen, wie ich diese beiden Probleme beheben kann?