Własny Balonik/ToolTip ala Vista/7

Witam i mam nadzieję, że znajdzie się paru zwolenników, którzy są gotowi pomóc :)

Otóż, chcę uzyskać taki efektowny balon.

CEL:

W chwili obecnej zastosowałem taki oto sposób.

Kod odpowiedzialny tworzenie komponentu:

{
    BalloonHint MultiLine
}

unit Balloon;

interface

uses
 Forms, Classes, Controls, StdCtrls, ExtCtrls, Windows, Graphics,
 Messages, SysUtils, Dialogs;

type
  TBalonTekst = array[1..11] of record
    Temat: string[70];
    Tresc: string[25];
    Stan: string[10];
    Typ: string[11];
  end;

type
  TBalon = class(TCustomForm)
  private
    procedure FormPaint(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure OnChange(Sender: TObject);
    procedure WndProc(var message: TMessage); override;
  public
    BalonCzas: Byte;
    BalonLeft: SmallInt;
    BalonTop: SmallInt;
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
    destructor Destroy; override;
    procedure ShowBalon;
    procedure HideBalon;
  end;

implementation

procedure TBalon.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);

 Params.Style     := (Params.Style and not WS_CAPTION) or WS_POPUP;
 Params.ExStyle   := Params.ExStyle or WS_EX_TOOLWINDOW or WS_EX_NOACTIVATE or WS_EX_TOPMOST;
 Params.WndParent := GetDesktopWindow;
end;

procedure TBalon.OnChange(Sender: TObject);
begin
 SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

procedure TBalon.WndProc(var message: TMessage);
begin
 if (message.Msg = WM_SIZE) and (message.WParam = SIZE_MINIMIZED) then Show;

 inherited;
end;

constructor TBalon.CreateNew(AOwner: TComponent; Dummy: Integer = 0);
begin
 inherited;

 BorderStyle  := bsNone;
 AlphaBlend   := False;
 AlphaBlendValue := 230;
 FormStyle    := fsStayOnTop;
 OnPaint      := FormPaint;
 Font.Name    := 'Tahoma';
end;

destructor TBalon.Destroy;
begin
 inherited;
end;

Następnie kod odpowiedzialny za rozmycie i ściemnianie

{Odpowiada za wizualizację ściemniania}
function IntToByte(i: Integer): Byte;
begin
 if i > 255 then Result := 255
 else
 if i < 0 then Result := 0
 else Result := i;
end;

{Ściemnienie}
procedure Darkness(Bitmap: TBitmap; Amount: SmallInt);
var
 W: ^Byte;
 H, V: Integer;
begin
 Bitmap.PixelFormat := pf24bit;
 for V := 0 to Bitmap.Height-1 do
   begin
    W := Bitmap.ScanLine[V];
    for H := 0 to Bitmap.Width*3-1 do
      begin
       W^ := IntToByte(W^ - (W^ * Amount) div 255);
       Inc(W);
      end;
   end;
end;

{Rozmycie}
procedure Blur(var Bitmap: TBitmap);
var
 TL, TC, TR, BL, BC, BR, LL, LC, LR: ^TRGBTriple;
 H, V: Integer;
begin
 Bitmap.PixelFormat := pf24bit;
 for V := 1 to Bitmap.Height-2 do
   begin
    TL := Bitmap.ScanLine[V - 1];
    TC := TL; // to samo Scanline  Bitmap.ScanLine[V - 1]; tylko oszczędniej
    TR := TL;
    BL := Bitmap.ScanLine[V];
    BC := BL;
    BR := BL;
    LL := Bitmap.ScanLine[V + 1];
    LC := LL;
    LR := LL;
    Inc(TC);
    Inc(TR, 2);
    Inc(BC);
    Inc(BR, 2);
    Inc(LC);
    Inc(LR, 2);

    for H := 1 to Bitmap.Width-2 do
      begin
       //Wyciągam srednią z 9 sąsiadujących pixeli
       BC.rgbtRed   := (BC.rgbtRed + BL.rgbtRed + BR.rgbtRed + TC.rgbtRed + TL.rgbtRed + TR.rgbtRed + LL.rgbtRed + LC.rgbtRed + LR.rgbtRed) div 9;
       BC.rgbtGreen := (BC.rgbtGreen + BL.rgbtGreen + BR.rgbtGreen + TC.rgbtGreen + TL.rgbtGreen + TR.rgbtGreen + LL.rgbtGreen + LC.rgbtGreen + LR.rgbtGreen) div 9;
       BC.rgbtBlue  := (BC.rgbtBlue + BL.rgbtBlue + BR.rgbtBlue + TC.rgbtBlue + TL.rgbtBlue + TR.rgbtBlue + LL.rgbtBlue + LC.rgbtBlue + LR.rgbtBlue) div 9;

       //Zwiększam wskaźniki biorąc następne 9 pixeli
       Inc(TL);
       Inc(TC);
       Inc(TR);
       Inc(BL);
       Inc(BC);
       Inc(BR);
       Inc(LL);
       Inc(LC);
       Inc(LR);
      end;
  end;
end;

Następnie procedura Paint

procedure TBalon.FormPaint(Sender: TObject);
var
 TempRegion: HRGN;
 Dc: HDC;
 SourceRect: TRect;
 FBackground: TBitmap;
begin
 {Kolor tła}
 Color := $001F1F1F; {czarny}
 
 {Obwódka balonika - biała}
 with Canvas.Brush Do
   begin
    Color := clWhite;
    Style := bsSolid;
   end;
 
 {Malowanie obwódki}
 TempRegion := CreateRectRgn(0, 0, 2, 2);
 GetWindowRgn(Handle, TempRegion);
 FrameRgn(Canvas.Handle, TempRegion, Canvas.Brush.Handle, 3, 3);
 DeleteObject(TempRegion);

 {Obwódka balonika - ciemna}
 with Canvas.Brush Do
   begin
    Color := $001F1F1F;
    Style := bsSolid;
   end;

 {Malowanie obwódki}
 TempRegion := CreateRectRgn(0, 0, 2, 2);
 GetWindowRgn(Handle, TempRegion);
 FrameRgn(Canvas.Handle, TempRegion, Canvas.Brush.Handle, 1, 1);
 DeleteObject(TempRegion);
 
 {Pobranie screenshota balonika}
 FBackground := TBitmap.Create;
 with Fbackground do
   begin
    Width  := Balon.Width;
    Height := Balon.Height;
   end;

 SourceRect.TopLeft := ClientToScreen(ClientRect.TopLeft);
 SourceRect.BottomRight := ClientToScreen(ClientRect.BottomRight);
 
 {Operacje na screenshocie, rozmycie/ściemnienie}
 Dc := CreateDC('DISPLAY', nil, nil, nil);
 try
  Canvas.Handle := Dc;
  Fbackground.Canvas.CopyRect(ClientRect, Canvas, SourceRect);

  {Rozmycie}
  Blur(Fbackground);

  {Ściemnienie}
  //Darkness(Fbackground, 70);
 finally
  DeleteDC(Dc);
 end;

 {TEMP START}
 if Fbackground = nil then ShowMessage('cos nie tak')
 else Fbackground.SaveToFile('zrzut.bmp');
 {TEMP END}
 
 {Malowanie przetworzonego screenshota na baloniku}
 Dc := CreateDC('DISPLAY', nil, nil, nil);
 try
  Canvas.Handle := Dc;
  Canvas.Draw(Left, Top, Fbackground);
 finally
  FBackground.Free;
  DeleteDC(Dc);
 end;
end;

I na końcu już samo wyświetlenie balonika

procedure TBalon.ShowBalon;
var
 FormRegion, ArrowRegion: HRGN;
 Arrow: array [0..2] Of TPoint;
begin
 {Szerokość i wysokość balonika}
 ClientHeight := 150;
 ClientWidth  := 300;

 {Położenie balonika}
 Left := BalonLeft - ClientWidth - 5;
 Top  := BalonTop - ClientHeight;

 {Kształt balonika}
 FormRegion := CreateRoundRectRgn(0, 0, ClientWidth, ClientHeight - 24, 16, 16);

 {Strzałka wychodząca u dołu balonika}
 Arrow[0] := Point((Width div 2) - 25, ClientHeight - 25);
 Arrow[1] := Point(Width div 2, ClientHeight);
 Arrow[2] := Point((Width div 2) + 25, ClientHeight - 25);
 ArrowRegion := CreatePolygonRgn(Arrow, 3, WINDING);

 {Operacje na wyglądzie balonika}
 CombineRgn(FormRegion, FormRegion, ArrowRegion, RGN_OR);
 DeleteObject(ArrowRegion);
 SetWindowRgn(Handle, FormRegion, True);
 
 {Pokazanie balonika}
 Visible := False;
 ShowWindow(Handle, SW_SHOWNOACTIVATE);
 Visible := True;
end;

procedure TBalon.HideBalon;
begin
 if Visible then Visible := False;
end;

end.

Samo utworzenie balonika bez rozmycia wygląda tak:

Ale chcąc uzyskać efekt doCELowy, musze rozmyć całość... udało mi się to w ten sposób:

Jak widać rozmycie wyszło na całym zrzucie... bo pozostało jeszcze nałożenie tego zrzutu na balonik tak, aby wszystko poza krawędziami usunąć.

DO ZROBIENIA:

• nałożenie rozmycia na balonik tak, aby to co poza balonikiem nie było brane pod uwagę (jak widać na w/w zrzucie)
• cień pod balonikiem

Ktoś chętny aby pomóc ? :)

Ok, namiastka cienia:

procedure TBalon.CreateParams(var Params: TCreateParams);
 const
  CS_DROPSHADOW = $20000;
begin
 inherited CreateParams(Params);

 Params.Style     := (Params.Style and not WS_CAPTION) or WS_POPUP;
 Params.ExStyle   := Params.ExStyle or WS_EX_TOOLWINDOW or WS_EX_NOACTIVATE or WS_EX_TOPMOST;
 Params.WndParent := GetDesktopWindow;
 Params.WindowClass.Style := Params.WindowClass.style or CS_DROPSHADOW;
end;

Pozostaje jeszcze usunięcie wszystkie poza balonikiem...

Opi napisał(a)

DO ZROBIENIA:

• nałożenie rozmycia na balonik tak, aby to co poza balonikiem nie było brane pod uwagę (jak widać na w/w zrzucie)

Spróbuj pobawić się regionami.

Hi! Sorry, I only know English - this is an old post, but I found it from Google search, and it helped me with a problem I was having.
I have a suggestion, it might not be what you're looking for, but I'll leave it for you to think about anyway ;)

procedure Blur(var Bitmap: TBitmap{NEW CODE}; const Control: TCustomControl{END NEW CODE});
var
  TL, TC, TR, BL, BC, BR, LL, LC, LR: ^TRGBTriple;
  H, V: Integer;
  // --- NEW CODE ---
  ClientRegion: HRGN;
  // --- END NEW CODE ---
begin
  ...

  // --- NEW CODE ---
  ClientRegion := CreateRectRgn(0, 0, 0, 0);
  GetWindowRgn(Control.Handle, ClientRegion);
  // --- END NEW CODE ---

  for V := 1 to Bitmap.Height-2 do begin
    ...
    for H := 1 to Bitmap.Width-2 do begin
    
      // --- NEW CODE ---
      if PtInRegion(ClientRegion, H, V) then begin
      // -- END NEW CODE ---
    
        //Wyciągam srednią z 9 sąsiadujących pixeli
        BC.rgbtRed   := (BC.rgbtRed + BL.rgbtRed + BR.rgbtRed + TC.rgbtRed + TL.rgbtRed + TR.rgbtRed + LL.rgbtRed + LC.rgbtRed + LR.rgbtRed) div 9;
        BC.rgbtGreen := (BC.rgbtGreen + BL.rgbtGreen + BR.rgbtGreen + TC.rgbtGreen + TL.rgbtGreen + TR.rgbtGreen + LL.rgbtGreen + LC.rgbtGreen + LR.rgbtGreen) div 9;
        BC.rgbtBlue  := (BC.rgbtBlue + BL.rgbtBlue + BR.rgbtBlue + TC.rgbtBlue + TL.rgbtBlue + TR.rgbtBlue + LL.rgbtBlue + LC.rgbtBlue + LR.rgbtBlue) div 9;
      // --- NEW CODE ---
      end;
      // --- END NEW CODE ---

      //Zwiększam wskaźniki biorąc następne 9 pixeli
      Inc(TL);
      Inc(TC);
      Inc(TR);
      Inc(BL);
      Inc(BC);
      Inc(BR);
      Inc(LL);
      Inc(LC);
      Inc(LR);
    end;
  end;

Prevents blurring outside of the window. In my version (modification of a commercial component called MCHintBox) I had trouble calling DrawText on the canvas after Blur (not sure why), so I made an 'inner' region and XOR'd it with the balloon hint region, then only a thin border area around the outside is blurred (sort of works) - in pseudo-code, something like:

type
  TBalon = class(TCustomForm)
  private
    FArrow: array[0..2] of TPoint;
    FClientRect: FRect;
    ...
  end;
...

procedure TBalon.ShowBalon;
var
  FormRegion, ArrowRegion: HRGN;
  Arrow: array [0..2] Of TPoint;
begin
  {Szerokość i wysokość balonika}
  ClientHeight := 150;
  ClientWidth  := 300;
  FClientRect := Rect(0, 0, ClientWidth, ClientHeight - 24);
  ...

  {Strzałka wychodząca u dołu balonika}
  Arrow[0] := Point((Width div 2) - 25, ClientHeight - 25);
  Arrow[1] := Point(Width div 2, ClientHeight);
  Arrow[2] := Point((Width div 2) + 25, ClientHeight - 25);
  FArrow[0] := Arrow[0];
  FArrow[1] := Arrow[1];
  FArrow[2] := Arrow[2];
  ...
end;

procedure TBalon.Blur(var Bitmap: TBitmap);
var
  TL, TC, TR, BL, BC, BR, LL, LC, LR: ^TRGBTriple;
  H, V: Integer;

  ClientRegion, InnerRectangleRegion, InnerArrowRegion, InnerClientRegion, CombinedClientRegion: HRGN;
begin
 Bitmap.PixelFormat := pf24bit;

  // ---
  FClientRect.Left := FClientRect.Left + 2;
  FClientRect.Top := FClientRect.Top + 2;
  FClientRect.Right := FClientRect.Right - 1;
  FClientRect.Bottom := FClientRect.Bottom - 2;

  FArrow[0].X := FArrow[0].X + 2;
  FArrow[0].Y := FArrow[0].Y;
  FArrow[1].X := FArrow[1].X + 2;
  FArrow[1].Y := FArrow[1].Y - 6;
  FArrow[2].X := FArrow[2].X - 6;
  FArrow[2].Y := FArrow[2].Y;


  ClientRegion := CreateRectRgn(0, 0, 0, 0);
  GetWindowRgn(Handle, ClientRegion);
  InnerRectangleRegion := CreateRoundRectRgn(FClientRect.Left, FClientRect.Top, FClientRect.Right, FClientRect.Bottom, 3, 3);
  InnerArrowRegion := CreatePolygonRgn(FFlagPoints, 3, WINDING);
  InnerClientRegion := CreateRectRgn(0, 0, 0, 0);
  CombineRgn(InnerClientRegion, InnerRectangleRegion, InnerArrowRegion, RGN_OR);
  CombinedClientRegion := CreateRectRgn(0, 0, 0, 0);
  CombineRgn(CombinedClientRegion, ClientRegion, InnerClientRegion, RGN_XOR);
  // ---

 for V := 1 to Bitmap.Height-2 do
   begin
    TL := Bitmap.ScanLine[V - 1];
    TC := TL; // to samo Scanline  Bitmap.ScanLine[V - 1]; tylko oszczędniej
    TR := TL;
    BL := Bitmap.ScanLine[V];
    BC := BL;
    BR := BL;
    LL := Bitmap.ScanLine[V + 1];
    LC := LL;
    LR := LL;
    Inc(TC);
    Inc(TR, 2);
    Inc(BC);
    Inc(BR, 2);
    Inc(LC);
    Inc(LR, 2);

    for H := 1 to Bitmap.Width-2 do begin


      // ---
      if PtInRegion(CombinedClientRegion, H, V) then begin
      // ---

       //Wyciągam srednią z 9 sąsiadujących pixeli
       BC.rgbtRed   := (BC.rgbtRed + BL.rgbtRed + BR.rgbtRed + TC.rgbtRed + TL.rgbtRed + TR.rgbtRed + LL.rgbtRed + LC.rgbtRed + LR.rgbtRed) div 9;
       BC.rgbtGreen := (BC.rgbtGreen + BL.rgbtGreen + BR.rgbtGreen + TC.rgbtGreen + TL.rgbtGreen + TR.rgbtGreen + LL.rgbtGreen + LC.rgbtGreen + LR.rgbtGreen) div 9;
       BC.rgbtBlue  := (BC.rgbtBlue + BL.rgbtBlue + BR.rgbtBlue + TC.rgbtBlue + TL.rgbtBlue + TR.rgbtBlue + LL.rgbtBlue + LC.rgbtBlue + LR.rgbtBlue) div 9;

      // ---
      end;
      // ---

       //Zwiększam wskaźniki biorąc następne 9 pixeli
       Inc(TL);
       Inc(TC);
       Inc(TR);
       Inc(BL);
       Inc(BC);
       Inc(BR);
       Inc(LL);
       Inc(LC);
       Inc(LR);
      end;
  end;
end;

Thanks Mik115 [soczek]

Teraz prezentuje się to tak:

Jednak cieniowanie nie zadziała z poniższym przykładem... :/
Poza tym tworzenie rozmycia jest teraz wyraźnie długie.

Cały kod:

unit Balloon;

interface

uses
 Forms, Classes, Controls, StdCtrls, ExtCtrls, Windows, Graphics,
 Messages, SysUtils, Dialogs;

type
  TBalonTekst = array[1..11] of record
    Temat: string[70];
    Tresc: string[25];
    Stan: string[10];
    Typ: string[11];
  end;

type
  TBalon = class(TCustomForm)
  private
    FArrow: array[0..2] of TPoint;
    FClientRect: TRect;
    procedure FormPaint(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure OnChange(Sender: TObject);
    procedure WndProc(var message: TMessage); override;
  public
    BalonCzas: Byte;
    BalonLeft: SmallInt;
    BalonTop: SmallInt;
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
    destructor Destroy; override;
    procedure ShowBalon;
    procedure HideBalon;
    procedure Blur(var Bitmap: TBitmap);
  end;

var
 Przelot: Byte = 0;

implementation

procedure TBalon.CreateParams(var Params: TCreateParams);
begin
 inherited CreateParams(Params);

 Params.Style     := (Params.Style and not WS_CAPTION) or WS_POPUP;
 Params.ExStyle   := Params.ExStyle or WS_EX_TOOLWINDOW or WS_EX_NOACTIVATE or WS_EX_TOPMOST;
 Params.WndParent := GetDesktopWindow;
end;

procedure TBalon.OnChange(Sender: TObject);
begin
 SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

procedure TBalon.WndProc(var message: TMessage);
begin
 if (message.Msg = WM_SIZE) and (message.WParam = SIZE_MINIMIZED) then Show;

 inherited;
end;

constructor TBalon.CreateNew(AOwner: TComponent; Dummy: Integer = 0);
begin
 inherited;

 BorderStyle  := bsNone;
 AlphaBlend   := False;
 AlphaBlendValue := 230;
 FormStyle    := fsStayOnTop;
 OnPaint      := FormPaint;
 Font.Name    := 'Tahoma';
end;

destructor TBalon.Destroy;
begin
 inherited;
end;

{Odpowiada za wizualizację ściemniania}
function IntToByte(i: Integer): Byte;
begin
 if i > 255 then Result := 255
 else
 if i < 0 then Result := 0
 else Result := i;
end;

{Ściemnienie}
procedure Darkness(Bitmap: TBitmap; Amount: SmallInt);
var
 W: ^Byte;
 H, V: Integer;
begin
 Bitmap.PixelFormat := pf24bit;
 for V := 0 to Bitmap.Height-1 do
   begin
    W := Bitmap.ScanLine[V];
    for H := 0 to Bitmap.Width*3-1 do
      begin
       W^ := IntToByte(W^ - (W^ * Amount) div 255);
       Inc(W);
      end;
   end;
end;

procedure TBalon.Blur(var Bitmap: TBitmap);
var
 TL, TC, TR, BL, BC, BR, LL, LC, LR: ^TRGBTriple;
 H, V: Integer;
 FFlagPoints: HRGN;
 ClientRegion, InnerRectangleRegion, InnerArrowRegion, InnerClientRegion, CombinedClientRegion: HRGN;
begin
 Bitmap.PixelFormat := pf24bit;

 FClientRect.Left := FClientRect.Left + 2;
 FClientRect.Top := FClientRect.Top + 2;
 FClientRect.Right := FClientRect.Right - 1;
 FClientRect.Bottom := FClientRect.Bottom - 2;

 FArrow[0].X := FArrow[0].X + 2;
 FArrow[0].Y := FArrow[0].Y;
 FArrow[1].X := FArrow[1].X + 2;
 FArrow[1].Y := FArrow[1].Y - 6;
 FArrow[2].X := FArrow[2].X - 6;
 FArrow[2].Y := FArrow[2].Y;

 ClientRegion := CreateRectRgn(0, 0, 0, 0);
 GetWindowRgn(Handle, ClientRegion);
 InnerRectangleRegion := CreateRoundRectRgn(FClientRect.Left, FClientRect.Top, FClientRect.Right, FClientRect.Bottom, 3, 3);
 InnerArrowRegion := CreatePolygonRgn(FFlagPoints, 3, WINDING);
 InnerClientRegion := CreateRectRgn(0, 0, 0, 0);
 CombineRgn(InnerClientRegion, InnerRectangleRegion, InnerArrowRegion, RGN_OR);
 CombinedClientRegion := CreateRectRgn(0, 0, 0, 0);
 CombineRgn(CombinedClientRegion, ClientRegion, InnerClientRegion, RGN_XOR);

 for V := 1 to Bitmap.Height-2 do
   begin
    TL := Bitmap.ScanLine[V - 1];
    TC := TL; // to samo Scanline  Bitmap.ScanLine[V - 1]; tylko oszczędniej
    TR := TL;
    BL := Bitmap.ScanLine[V];
    BC := BL;
    BR := BL;
    LL := Bitmap.ScanLine[V + 1];
    LC := LL;
    LR := LL;
    Inc(TC);
    Inc(TR, 2);
    Inc(BC);
    Inc(BR, 2);
    Inc(LC);
    Inc(LR, 2);

    for H := 1 to Bitmap.Width-2 do
      begin

       if PtInRegion(CombinedClientRegion, H, V) then
         begin
          //Wyciągam srednią z 9 sąsiadujących pixeli
          BC.rgbtRed   := (BC.rgbtRed + BL.rgbtRed + BR.rgbtRed + TC.rgbtRed + TL.rgbtRed + TR.rgbtRed + LL.rgbtRed + LC.rgbtRed + LR.rgbtRed) div 9;
          BC.rgbtGreen := (BC.rgbtGreen + BL.rgbtGreen + BR.rgbtGreen + TC.rgbtGreen + TL.rgbtGreen + TR.rgbtGreen + LL.rgbtGreen + LC.rgbtGreen + LR.rgbtGreen) div 9;
          BC.rgbtBlue  := (BC.rgbtBlue + BL.rgbtBlue + BR.rgbtBlue + TC.rgbtBlue + TL.rgbtBlue + TR.rgbtBlue + LL.rgbtBlue + LC.rgbtBlue + LR.rgbtBlue) div 9;
         end;

       //Zwiększam wskaźniki biorąc następne 9 pixeli
       Inc(TL);
       Inc(TC);
       Inc(TR);
       Inc(BL);
       Inc(BC);
       Inc(BR);
       Inc(LL);
       Inc(LC);
       Inc(LR);
      end;
   end;
end;

procedure TBalon.FormPaint(Sender: TObject);
var
 TempRegion: HRGN;
 Dc: HDC;
 SourceRect: TRect;
 FBackground: TBitmap;
begin

 {Kolor tła}
 Color := $001F1F1F; {czarny}
 
 {Obwódka balonika - biała}
 with Canvas.Brush Do
   begin
    Color := clWhite;
    Style := bsSolid;
   end;
 
 {Malowanie obwódki}
 TempRegion := CreateRectRgn(0, 0, 2, 2);
 GetWindowRgn(Handle, TempRegion);
 FrameRgn(Canvas.Handle, TempRegion, Canvas.Brush.Handle, 3, 3);
 DeleteObject(TempRegion);

 {Pobranie screenshota balonika}
 FBackground := TBitmap.Create;
 with Fbackground do
   begin
    Width  := ClientWidth;//Balon.Width;
    Height := ClientHeight;//Balon.Height;
   end;

 SourceRect.TopLeft := ClientToScreen(ClientRect.TopLeft);
 SourceRect.BottomRight := ClientToScreen(ClientRect.BottomRight);
 
 {Operacje na screenshocie, rozmycie/ściemnienie}
 Dc := CreateDC('DISPLAY', nil, nil, nil);
 try
  Canvas.Handle := Dc;
  Fbackground.Canvas.CopyRect(ClientRect, Canvas, SourceRect);

  {Rozmycie}
  Blur(Fbackground);

  {Ściemnienie}
  //Darkness(Fbackground, 70);
 finally
  DeleteDC(Dc);
 end;

 {Malowanie przetworzonego screenshota na baloniku}
 Dc := CreateDC('DISPLAY', nil, nil, nil);
 try
  Canvas.Handle := Dc;
  Canvas.Draw(Left, Top, Fbackground);
 finally
  FBackground.Free;
  DeleteDC(Dc);
 end;
end;

procedure TBalon.ShowBalon;
var
 FormRegion, ArrowRegion: HRGN;
 Arrow: array [0..2] Of TPoint;
begin
 {Szerokość i wysokość balonika}
 ClientHeight := 150;
 ClientWidth  := 300;
 FClientRect := Rect(0, 0, ClientWidth, ClientHeight - 24);

 {Położenie balonika}
 Left := BalonLeft - ClientWidth - 5;
 Top  := BalonTop - ClientHeight;

 {Kształt balonika}
 FormRegion := CreateRoundRectRgn(0, 0, ClientWidth, ClientHeight - 24, 10, 10);

 {Strzałka wychodząca u dołu balonika}
 Arrow[0] := Point((Width div 2) - 25, ClientHeight - 25);
 Arrow[1] := Point(Width div 2, ClientHeight);
 Arrow[2] := Point((Width div 2) + 25, ClientHeight - 25);
 FArrow[0] := Arrow[0];
 FArrow[1] := Arrow[1];
 FArrow[2] := Arrow[2];
 ArrowRegion := CreatePolygonRgn(Arrow, 3, WINDING);

 {Operacje na wyglądzie balonika}
 CombineRgn(FormRegion, FormRegion, ArrowRegion, RGN_OR);
 DeleteObject(ArrowRegion);
 SetWindowRgn(Handle, FormRegion, True);
 
 {Pokazanie balonika}
 Visible := False;
 ShowWindow(Handle, SW_SHOWNOACTIVATE);
 Visible := True;
end;

procedure TBalon.HideBalon;
begin
 if Visible then Visible := False;
end;

end.

Wywołanie:

uses
  Balloon;

var
  Balon: TBalon;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Balon := TBalon.CreateNew(Parent);

 {Położenie balona}
 Balon.BalonLeft   := Screen.DesktopWidth;
 Balon.BalonTop   := Screen.WorkAreaHeight;
 Balon.BalonCzas := 25;

 Balon.ShowBalon;
end;

Pomogę Ci, tylko musze znaleźć na to czas.

Moja sugestia:
Jest komponent pozwalający na tworzenie form o dowolnym kształcie. Nawet z dziurami w środku. Kreujesz maskę i podajesz jako parametr w komponencie.
Wszelkie operacje graficzne robisz na formie, nawet jeśli jest prostokątna to widać tylko to co mieści się w obszarze maski.
Zmieniając maskę możesz zmieniać kształt i wielkość.
Mało, komponent pozwala na regulację stopnia przeźroczystości.
Teraz nie pamiętam jego nazwy bo go dawno nie używałem.
Zerknę jak będę w domu.

A czemu tak?
Bo możesz podejżeć zawartośc komponentu i zobaczyć jak oni to zrobili.
Druga ważna zaleta - twój balonik ma wszystkie własności formatki.
Ma własny Canvas i możesz umieszczać Labelki, przyciski itp.
A to juz dużo.

Ten komponent to CoolForm, ale odpada...

Zauważ, że powyższy przykład balonika nie korzysta z żadnej zewnętrznej bitmapy, a tego wymaga CoolForm.