(德尔福视窗)如何绘制透明的 PNG

我有这个德尔福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-1tooltip.png');
     FBitmap.LoadFromFile('D:project-1tooltip.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.

此示例有两个问题：

我需要用透明边框绘制 PNG。图像本身在这里
如果您运行此项目（窗体只有一个名为 Button1 的按钮），并且显示提示几次，您应该意识到每次显示提示时标题都会变得更粗。我很确定我忘记了忘记清除/擦除的背景，但我不确定如何解决。

有人可以告诉我如何解决这两个问题吗？

您将不得不在上面需要的提示中对位置和 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:tempo36B.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.

相关内容

最新更新

热门标签：