（Delphi THintWindow）如何繪製透明的PNG？

Question

我有這個德爾福2010代碼：

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. 

這個例子有兩個問題：

1. 我需要用透明邊框繪製PNG。 The image itself is here

2. 如果您運行此項目（窗體只有一個名爲Button1的按鈕），並顯示提示幾次，您應該意識到每次顯示提示時都會顯示標題。我很確定我忘了背景，我忘了清除/擦除，但我不知道如何解決這個問題。

有人可以告訴我如何解決這兩個問題？

Answer 1

您將不得不執行位置和png中所需的提示所需的適配，但「引擎」應按預期工作。我沒有使用GDI +，這會讓我更容易。

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; 
     FCurrAlpha:Integer; 
     FTimer:TTimer; 
     FActivated:Boolean; 
     FLastActive:Cardinal; 
     procedure PrepareBitmap; 
     procedure IncAlpha(Sender:TObject); 
    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; 
    FCurrAlpha    := 1; 
    FTimer     := TTimer.Create(self); 
    FTimer.Interval   := 20; 
    Ftimer.OnTimer   := IncAlpha; 
    Ftimer.Enabled   := false; 
    ThePNG     := TPngImage.Create; 
    ThePNG.Transparent  := True; 
    ThePNG.TransparentColor := clWhite; 
    ThePNG.LoadFromFile('C:\temp\0o36B.png'); 


end; 
// --------------------------------------------------------------------------- // 
destructor TMyHintWindow.Destroy; 
begin 
    FBitmap.Free; 
    ThePNG.Free; 
    inherited; 
end; 
// --------------------------------------------------------------------------- // 

procedure TMyHintWindow.IncAlpha(Sender:TObject); 
begin 
    FCurrAlpha := FCurrAlpha + 10; 
    if FCurrAlpha >= 254 then 
     begin 
      FCurrAlpha := 254; 
      Ftimer.Enabled := false; 
      FActivated := false; 
     end; 
    invalidate; 
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; 
// --------------------------------------------------------------------------- // 



type 
    pRGBQuadArray = ^TRGBQuadArray; 
    TRGBQuadArray = ARRAY[0..$effffff] OF TRGBQuad; 
Procedure SetAlpha(bmp:TBitMap;Alpha:Byte); 
var 
pscanLine32 : pRGBQuadArray; 
i,j:Integer; 
begin 
    Bmp.PixelFormat := pf32Bit; 
    bmp.HandleType := bmDIB; 
    bmp.ignorepalette := true; 
    bmp.alphaformat := afDefined; 
    for i := 0 to bmp.Height -1 do 
    begin 
    pscanLine32 := bmp.Scanline[i]; 
    for j := 0 to bmp.Width -1 do 
     begin 
      pscanLine32[j].rgbReserved := Alpha; 
      pscanLine32[j].rgbBlue := 0; 
      pscanLine32[j].rgbRed := 0; 
      pscanLine32[j].rgbGreen := 0; 
     end; 
    end; 
end; 

Procedure ResetSetAlpha(bmp:TBitMap;r:Trect;Alpha:Byte); 
var 
pscanLine32 : pRGBQuadArray; 
i,j:Integer; 
begin 
    for i := 0 to bmp.Height -1 do 
    begin 
    pscanLine32 := bmp.Scanline[i]; 
    for j := 0 to bmp.Width -1 do 
     begin 
      if (i>=r.Top) and (i<=r.Bottom) and (j>=r.Left) and (j<=r.Right) then 
       pscanLine32[j].rgbReserved := Alpha; 
     end; 
    end; 
end; 


procedure TMyHintWindow.PrepareBitmap; 
var 
r:TRect; 
begin 
    r := Clientrect; 
    r.Top := r.Top + 10; 
    InflateRect(r,-10,-10); 
    FreeAndNil(FBitmap); 
    FBitmap := TBitmap.Create; 
    FBitmap.Width := 230; 
    FBitmap.Height := 61; 
    SetAlpha(FBitmap, 0); 
    FBitmap.Canvas.Font := Screen.HintFont; 
    FBitmap.Canvas.Brush.Style := bsClear; 
    FBitmap.Canvas.Draw(0, 0, ThePNG); 
    DrawText(FBitmap.Canvas.Handle, PChar(Caption), Length(Caption), r,DT_Center or DT_Wordbreak or DT_NOPREFIX); 
    ResetSetAlpha(FBitmap,r,255); 
end; 

// --------------------------------------------------------------------------- // 
procedure TMyHintWindow.ActivateHint(Rect : TRect; const AHint : String); 
var 
    i : Integer; 

begin 
    if (GetTickCount - FLastActive > 250) and (Length(AHint) < 100) then 

    if not FActivated then 
     begin 
     FCurrAlpha := 1; 
     FActivated := true; 
     Caption    := AHint; 
     Canvas.Font   := Screen.HintFont; 
     Width    := 230; // (Rect.Right - Rect.Left) + 16; 
     Height    := 61; // (Rect.Bottom - Rect.Top) + 10; 
     Left := rect.Left - Width div 2; 
     Top := Rect.Top; 
     Ftimer.Enabled := true; 
     ShowWindow(Handle, SW_SHOWNOACTIVATE); 
     SetWindowPos(Handle, HWND_TOPMOST, Left, Top, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); 
     invalidate; 
     end; 
    FLastActive := GetTickCount; 
end; 

// --------------------------------------------------------------------------- // 
procedure TMyHintWindow.Paint; 
var 
    DestPoint, srcPoint:TPoint; 
    winSize:TSize; 
    DC   : HDC; 
    blendfunc : BLENDFUNCTION; 

    Owner : HWnd; 
    curWinStyle:Integer; 

    exStyle:Dword; 
begin 

    PrepareBitmap; 
    DC := GetDC(0); 

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



    With blendFunc do 
    begin 
    AlphaFormat := 1; //=AC_SRC_ALPHA; 
    BlendFlags := 0; 
    BlendOp := AC_SRC_OVER; 
    SourceConstantAlpha := FCurrAlpha; // here you can set Alpha 
    end; 
    UpdateLayeredWindow(Handle, DC, @DestPoint, @winSize, FBitmap.Canvas.Handle, @srcPoint,clBlack, @blendFunc, 2);//=ULW_ALPHA 

    finally 
     ReleaseDC(0, DC); 
    end; 


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!'; 
    ReportMemoryLeaksOnShutDown := true; 
end; 
// --------------------------------------------------------------------------- // 
end.