（Delphi THintWindow）如何绘制透明PNG？

必须在上面提到的提示中对位置和png进行适应，但是引擎应该如预期的那样工作。我没有使用GDI +，这将使我更容易。

You will to have to perform adaption for position and png in cas of hint needed above, but the "engine" should work as expected. I didn't use GDI+ which would i have made much easier.

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.