Link to home
Start Free TrialLog in
Avatar of mehdi_m
mehdi_m

asked on

create balloon tooltips

Hi

I know how to make a tooltip like balloon. and when a mouse go over the component it will be activated.

I want to activate it myself; for example activate it for an unlimited times, and then disappear it.

my other problem is this; in the following code the tooltip can be set to the components that have Handle property, and will not work with components which don't have handle like label,... can not operate. how could I change it to include them.

my code is:

------------------------------------------------------------------------
uses Commctrl;

const
  TTS_BALLOON    = $40;
  TTM_SETTITLE = (WM_USER + 32);

var
  hTooltip: Cardinal;
  ti: TToolInfo;
  buffer : array[0..255] of char;

procedure CreateToolTips(hWnd: Cardinal);
begin
  hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or TTS_BALLOON, Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil);
  if hToolTip <> 0 then
  begin
    SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
    ti.cbSize := SizeOf(TToolInfo);
    ti.uFlags := TTF_SUBCLASS;
    ti.hInst  := hInstance;
  end;
end;

procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer; Text, Title: PChar);
var
  Item: THandle;
  Rect: TRect;
begin
  Item := hWnd;
  if (Item <> 0) and (GetClientRect(Item, Rect)) then
  begin
    lpti.hwnd := Item;
    lpti.Rect := Rect;
    lpti.lpszText := Text;
    SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));
    FillChar(buffer, SizeOf(buffer), #0);
    lstrcpy(buffer, Title);
    if (IconType > 3) or (IconType < 0) then IconType := 0;
    SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CreateToolTips(Form1.Handle);
  AddToolTip(Memo1.Handle, @ti, 1, 'Tooltip text', 'Title');
end;

{
IconType can be:

 0 - No icon
 1 - Information
 2 - Warning
 3 - Error
}
------------------------------------------------------------------------

Thank you very much.
Avatar of Member_2_248744
Member_2_248744
Flag of United States of America image

hello  mehdi_m, , this is not so simple, a TGraphicControl (TLabel, TSpeedButton) are just a "Drawing" that Delphi does on the Parent Window DC, so you will need to move your code UP to the parent window and then set a rectangle in the  TToolInfo to a Rectangle of the Graphic control, as for showing an "On Demand" tool Tip you will need to NOT use the TTF_SUBCLASS style flag and then call a WM_MOUSEMOVE as a TTM_RELAYEVENT message. .
Avatar of mehdi_m
mehdi_m

ASKER

hi  Slick812

The above code is not mine, so I don't understand all of that. can you explain more about showing an "On Demand" tool tip ,  "TTF_SUBCLASS"  and  "TTM_RELAYEVENT".

thank you for your help.

mehdi_m
OK, this is a rather complicated system set up to use the Tool Tips. . . I was not able to ever get the tool tip to be shown anywhere except where the cursor was at the time I called  ShowCallTip  , it may be posible, but I could not do it, Here is some code in a unit called    ToolTipS.pas

this has several functions and procedures which I hope you can tell what they do by there names, this unit is  NOT  meant to be a working and functional unit for tool tips, but I am just trying to show some code to use the Tool Tip,  - -




unit ToolTipS;

interface

type
  TIconType = (itNone, itInfo, itWarn, itError);

function Get_hToolTip: Cardinal;

function CreateToolTips(hParent: Cardinal): Boolean;

function SetToolTipTitle(const Title: String; IconType: TIconType): Boolean;

function AddToolAutoTip(hTipWnd: Cardinal; const Text: String): Boolean;

function AddToolCallTip(const TipText: String; hOtherWnd: Cardinal): Integer;

procedure ShowCallTip(Index: Cardinal);

procedure HideCallTip;

implementation

uses
  Windows, Messages, Commctrl;

const
  Zero = 0;
  TTS_BALLOON    = $40;
  TTM_SETTITLE = (WM_USER + 32);
  iUseDef: Integer = Integer(CW_USEDEFAULT);

var
  hTooltip: Cardinal = Zero;
  hToolParent: Cardinal = Zero;
  hOther: Cardinal = Zero;
  aryTipText: array of String;


function Get_hToolTip: Cardinal;
begin
Result := hToolTip;
end;


function CreateToolTips(hParent: Cardinal): Boolean;
begin
if not IsWindow(hParent) then
  begin
  Result := False;
  Exit;
  end;

hToolTip := CreateWindowEx(Zero, TOOLTIPS_CLASS{'Tooltips_Class32'}, nil,
                     {TTS_ALWAYSTIP or} TTS_BALLOON, iUseDef, iUseDef,
                     iUseDef, iUseDef, hParent, Zero, hInstance, nil);
hToolParent := hParent;
if hToolTip = Zero then
  Result := False
  else
  Result := True;
end;


function SetToolTipTitle(const Title: String; IconType: TIconType): Boolean;
begin
if SendMessage(hToolTip, TTM_SETTITLE, Ord(IconType), Integer(PChar(Title))) = Zero then
  Result := False
  else
  Result := True;
end;


function AddToolAutoTip(hTipWnd: Cardinal; const Text: String): Boolean;
var
InfoTool: TToolInfo;
begin
Result := False;
if (hToolTip = Zero) or (not IsWindow(hTipWnd)) then Exit;

if GetClientRect(hTipWnd, InfoTool.Rect) then
  begin
  with InfoTool do
    begin
    cbSize := SizeOf(toolInfo);
    uId := Zero;
    hwnd := hTipWnd;
    uFlags := TTF_SUBCLASS;
    hInst  := Zero;
    lpszText := PChar(Text);
    end;
  if SendMessage(hToolTip, TTM_ADDTOOL, Zero, Integer(@InfoTool)) <> Zero then
    Result := True;
  end;
end;


function AddToolCallTip(const TipText: String; hOtherWnd: Cardinal): Integer;
var
InfoTool: TToolInfo;
begin
Result := -1;
if (hToolTip = Zero) or (not IsWindow(hOtherWnd)) then Exit;
hOther := hOtherWnd;
setLength(aryTipText, Length(aryTipText)+1);
aryTipText[High(aryTipText)] := TipText;

if High(aryTipText) > Zero then
  begin
  Result := High(aryTipText);
  Exit;
  end;

with InfoTool do
  begin
  cbSize := SizeOf(toolInfo);
  uId := hToolParent;
  hwnd := hToolParent;
  SetRect(Rect,3,3,20,18);
  uFlags := TTF_IDISHWND;
  hInst  := hInstance;
  lpszText := PChar(TipText);
  end;
if SendMessage(hToolTip, TTM_ADDTOOL, Zero, Integer(@InfoTool)) <> Zero then
    Result := High(aryTipText)
    else
    setLength(aryTipText, Zero);
end;



procedure ShowCallTip(Index: Cardinal);
var
InfoTool: TToolInfo;
Msg1: TMsg;
begin
if Integer(Index) > High(aryTipText) then Exit;
with InfoTool do
  begin
  cbSize := SizeOf(toolInfo);
  uId := hToolParent;
  hwnd := hToolParent;
  SetRect(Rect,3,3,20,18);
  uFlags := TTF_IDISHWND;
  hInst  := hInstance;
  lpszText := PChar(aryTipText[Index]);
  end;
SendMessage(hToolTip, TTM_UPDATETIPTEXT, Zero, Integer(@InfoTool));

Msg1.hwnd := hToolParent;
Msg1.message := WM_MOUSEMOVE;
Msg1.wParam := Zero;
Msg1.lParam := MakeLParam(5,5);
Msg1.time := GetTickCount;
Msg1.pt.x := 5;
Msg1.pt.y := 5;
ClientToScreen(hToolParent,Msg1.pt);

SendMessage(hToolTip, TTM_RELAYEVENT, Zero, Integer(@Msg1));
end;


procedure HideCallTip;
var
Msg1: TMsg;
begin
Msg1.hwnd := hOther;
Msg1.message := WM_MOUSEMOVE;
Msg1.wParam := Zero;
Msg1.lParam := MakeLParam(5,5);
Msg1.time := GetTickCount;
Msg1.pt.x := 5;
Msg1.pt.y := 5;
ClientToScreen(hToolParent,Msg1.pt);

SendMessage(hToolTip, TTM_RELAYEVENT, Zero, Integer(@Msg1));

Msg1.message := WM_MOUSEMOVE;
Msg1.wParam := Zero;
Msg1.lParam := MakeLParam(40,40);
Msg1.time := GetTickCount;
Msg1.pt.x := 40;
Msg1.pt.y := 40;
ClientToScreen(hToolParent,Msg1.pt);

SendMessage(hToolTip, TTM_RELAYEVENT, Zero, Integer(@Msg1));
end;


end.



= = = = = = = =  = = = = = = = = = = = = = = = = = = = = = = = =

as I said, I could not get the tool tips to do what I wanted (show tip a a position away from the cursor), so  I do not know how to do that, maybe this will help you?
Avatar of mehdi_m

ASKER

I noted your code, dear Slick812

I just want to create a window (like a ballon tooltip) and show it in a specified place (x,y) of my form. I don't think that it's so hard.

I can create a window with CreateWindow, but can not show it !

could you please help me to show a window with its handle or else?

thank you.
mehdi_m
???
I am not sure about what you want to do? Maybe you can say more what you are trying to do, It seems you want to make Ballooon hints that you have control of?
I was going from your question about the API Tool Tip and showed some code for using that in my comment, I can give more code or explanation on that if you like, , , ,

in your last comment, you seem to change the "Subject" of this question to How to show a window that you create with a  CreateWindow( ) function, whch I can help you with. .

However, the Delphi coding set up (In my opinion) is not made to do this sort of thing, it is made to use a TForm for any separate "Windows" that you will need. . .

but the "Hint" or "Tool Tip" type of windows are handled by the delphi THint  of the delphi Application, I have seen some components that have alternate "THint" looks like bubble and transparent, if you do not have much expeience with API window creation, you may do better with a delphi Hint Component which the maker has tested. . .

I do not mean to make this harder (more difficult) for you, but the things you may need to do to make your own Hint windows may thake some coding to do (not a Delphi object sort of thing)

I will try and help however I can. . . .
you asked about having a window to show up using the CreateWindow API, there are several ways, but here is some code I would use to do that . The main code is in the  DoPopUpWindow  procedure, however I initialize and register the window Class in the forms OnCreate

main form's code -



  TForm1 = class(TForm)
    sbut_MakePopUpWnd: TSpeedButton;
    sbut_ClosePopUp: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure sbut_MakePopUpWndClick(Sender: TObject);
    procedure sbut_ClosePopUpClick(Sender: TObject);

  private
    { Private declarations }
    wClass: TWndClass;
    hPopUp: THandle;
    procedure DoPopUpWindow(X, Y, Width: Integer; const Caption: String);

implementation


function WndProc1(hWnd, iMsg, WParam, LParam: Integer): Integer; stdCall;
begin
case iMsg of
  WM_CTLCOLORSTATIC:
    begin
    SetBkColor(WParam,GetSysColor(COLOR_INFOBK));
    Result := GetSysColorBrush(COLOR_INFOBK);
    Exit;
    end;
  WM_LBUTTONUP: PostMessage(hWnd, WM_CLOSE, 0,0);
  end;

Result := DefWindowProc(hWnd, iMsg, WParam, LParam);
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
hPopUp := 0;
ZeroMemory(@wClass, SizeOf(wClass));

with wClass do
  begin
  Style := CS_SAVEBITS;
  hInstance := sysInit.hInstance;
  lpfnWndProc :=   @WndProc1;
  hbrBackground := COLOR_INFOBK+1;
  lpszClassName := 'Some class name here';
  hCursor := LoadCursor(0,IDC_ARROW);
  end;

windows.RegisterClass(wClass);
end;


procedure TForm1.DoPopUpWindow(X, Y, Width: Integer; const Caption: String);
var
Rect1: TRect;
scnDC: THandle;
begin
Rect1 := Rect(3,3,Width-6,6);
scnDC := GetDC(0);
SelectObject(scnDC, GetStockObject(ANSI_VAR_FONT));
// you will need to have a way to size the window according to the amount of text in it
DrawText(scnDC,PChar(Caption),-1, Rect1, DT_WORDBREAK or DT_EDITCONTROL or DT_CALCRECT);
// I use the DrawText function with the DT_CALCRECT to calculate the rectangle
ReleaseDC(0, scnDC);
// add 6 for the border of 3
hPopUp := CreateWindow(wClass.lpszClassName,' ', WS_POPUP or WS_BORDER{or WS_VISIBLE},
                X, Y, Rect1.Right+6, Rect1.Bottom+5, Form1.Handle, 0, hInstance, nil);
// be sure to have a Forms's handle as the parent handle in CreateWindow

if hPopUp = 0 then
  begin
  ShowMessage('NO hPopup');
  Exit;
  end;

// I use a STATIC for text display, but you can just draw on the DC instead
SendMessage(
CreateWindow('STATIC',PChar(Caption),WS_VISIBLE or WS_CHILD,3,3,Rect1.Right,
      Rect1.Bottom-1, hPopUp, 44, hInstance, nil)
   , WM_SETFONT, GetStockObject(ANSI_VAR_FONT), 0);
end;

procedure TForm1.sbut_MakePopUpWndClick(Sender: TObject);
begin
DoPopUpWindow(Left+40,Top+50, 160, 'This is a PopUp window with text on it, to read'#10'and some more text');
// the system uses the AnimateWindow to show a Tip
// the AW_BLEND is not avaiable in window systems older than Win 2000
if not AnimateWindow(hPopUp, 120, AW_BLEND {AW_SLIDE or AW_VER_POSITIVE}) then
  ShowWindow(hPopUp, SW_SHOWNA);
end;

procedure TForm1.sbut_ClosePopUpClick(Sender: TObject);
begin
if hPopUp <> 0 then
  begin
  AnimateWindow(hPopUp, 120, AW_HIDE or AW_BLEND {AW_SLIDE or AW_VER_NEGATIVE});
  DestroyWindow(hPopUp);
  hPopUp := 0;
  end;
end;


 - - - - - - - - - - - - - - - - - - - - - - -

this does not do any "Shape" like a Balloon, but just shows a rectangle hint type of window
Avatar of mehdi_m

ASKER

Dear Slick812

I test your code but function "AnimateWindow" returns False and nothing happens.

thank you.
mehdi_m

OK, as far as I know the AnimateWindow function works, ,  but I also added the code for a False AnimateWindow, it just has the
ShowWindow(hPopUp, SW_SHOWNA);
------

if not AnimateWindow(hPopUp, 120, AW_BLEND {AW_SLIDE or AW_VER_POSITIVE}) then
  ShowWindow(hPopUp, SW_SHOWNA);

I tested this code i both win XP and win 98, and it worked for me, the main code for the winow creation is in the procedure -

procedure TForm1.DoPopUpWindow(X, Y, Width: Integer; const Caption: String);

but I do not know what to help you with, since it worked for me, and I can not find a problem if I do not have one?
If you are interested in the windows  API  window creation using the CreateWindow(  )  function, you might look at the web site at -

http://www.angelfire.com/hi5/delphizeus/index.html

which has some lessons on how to use the create window, but this is not an easy thing to understand, , , , , , it may be faster for you to just get a "Hint Component" and use that component, or copy some code from it

ASKER CERTIFIED SOLUTION
Avatar of Member_2_248744
Member_2_248744
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of mehdi_m

ASKER

hi

Thank you for introducing me that useful site. I found the component that I looking for. (TBalloonControl; the hint with controling not to disapear and popup on demand meaning with code)

I will distribute it here for others who read this question and may like to have it:

the whole component can be downloaded from this url ;      http://www.torry.net/vcl/misceff/hints/jwbballoon.zip

this is the component source code (Balloon.pas)

//----------------------------------------------------------------

{
    Balloon - using Balloon-shaped windows in your Delphi programs
    Copyright (C) 2003 JWB Software

    Web:   http://people.zeelandnet.nl/famboek/delphi/
    Email: jwbsoftware@zeelandnet.nl
}

Unit Balloon;

Interface

Uses
  Forms, Classes, Controls, StdCtrls, ExtCtrls, Windows, Graphics,
  Messages, SysUtils;

Type
  TBalloonType     = (blnInfo, blnError, blnWarning);
  TBalloonHoriz    = (blnLeft, blnMiddle, blnRight);
  TBalloonVert     = (blnTop, blnCenter, blnBottom);
  TBalloonPosition = (blnArrowTopLeft, blnArrowTopRight, blnArrowBottomLeft, blnArrowBottomRight);

Type
      TBalloonControl = class(TComponent)
      private
            FTitle: string;
    FText: TStringList;
            FDuration, FPixelCoordinateX, FPixelCoordinateY: Integer;
            FHorizontal: TBalloonHoriz;
            FVertical: TBalloonVert;
            FPosition: TBalloonPosition;
            FControl: TWinControl;
            FBalloonType: TBalloonType;

    procedure SetText(Value: TStringList);
      public
            procedure ShowControlBalloon;
            procedure ShowPixelBalloon;
      published
            property Text: TStringList read FText write SetText;
            property Title: string read FTitle write FTitle;
            property Duration: Integer read FDuration write FDuration;
            property Horizontal: TBalloonHoriz read FHorizontal write FHorizontal;
            property Vertical: TBalloonVert read FVertical write FVertical;
            property Position: TBalloonPosition read FPosition write FPosition;
            property Control: TWinControl read FControl write FControl;
            property PixelCoordinateX: Integer read FPixelCoordinateX write FPixelCoordinateX;
            property PixelCoordinateY: Integer read FPixelCoordinateY write FPixelCoordinateY;
            property BalloonType: TBalloonType read FBalloonType write FBalloonType;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
      end;

Type
  TBalloon = class(TCustomForm)
  private
    lblTitle: TLabel;
    lblText: TLabel;
    pnlAlign: TPanel;
    iconBitmap: TImage;
    tmrExit: TTimer;
    procedure FormPaint(Sender: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure OnMouseClick(Sender: TObject);
    procedure OnExitTimer(Sender: TObject);
    procedure OnChange(Sender: TObject);
    procedure WndProc(var message: TMessage); override;
  public
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
    procedure ShowBalloon(blnLeft, blnTop: Integer; blnTitle, blnText: string; blnType: TBalloonType; blnDuration: Integer; blnPosition: TBalloonPosition);
    procedure ShowControlBalloon(blnControl: TWinControl; blnHoriz: TBalloonHoriz; blnVert: TBalloonVert; blnTitle, blnText: string; blnType: TBalloonType; blnDuration: Integer);
  end;

procedure register;

implementation

{$R balloon.res}

procedure register;
begin
  RegisterComponents('ComponentsX', [TBalloonControl]);
end;

constructor TBalloonControl.Create(AOwner: TComponent);
begin
      inherited;
      FText := TStringList.Create;
end;

destructor TBalloonControl.Destroy;
begin
      FText.Free;
      Inherited;
end;

procedure TBalloonControl.SetText(Value: TStringList);
begin
  FText.Assign(Value);
end;

Procedure TBalloonControl.ShowControlBalloon();
var
      Balloon: TBalloon;
begin
      Balloon := TBalloon.CreateNew(Owner);
      Balloon.ShowControlBalloon(FControl, FHorizontal, FVertical, FTitle, Trim(FText.Text), FBalloonType, FDuration);
end;

procedure TBalloonControl.ShowPixelBalloon();
var
      Balloon: TBalloon;
begin
      Balloon := TBalloon.CreateNew(nil);
      Balloon.ShowBalloon(FPixelCoordinateX, FPixelCoordinateY, FTitle, Trim(FText.Text), FBalloonType, FDuration, FPosition);
end;

procedure TBalloon.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 TBalloon.OnMouseClick(Sender: TObject);
begin
  Release;
end;

procedure TBalloon.OnExitTimer(Sender: TObject);
begin
  Release;
end;

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

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

Constructor TBalloon.CreateNew(AOwner: TComponent; Dummy: Integer = 0);
begin
  inherited;

  OnActivate   := OnChange;
  OnDeactivate := OnChange;
  OnShow       := OnChange;
  BorderStyle  := bsNone;
  FormStyle    := fsStayOnTop;
  OnPaint      := FormPaint;
  Color        := clInfoBk;
  Font.Name    := 'Tahoma';

  pnlAlign   := TPanel.Create(Self);
  lblTitle   := TLabel.Create(Self);
  lblText    := TLabel.Create(Self);
  iconBitmap := TImage.Create(Self);
  tmrExit    := TTimer.Create(Self);

  OnClick             := OnMouseClick;
  iconBitmap.OnClick  := OnMouseClick;
  pnlAlign.OnClick    := OnMouseClick;
  lblTitle.OnClick    := OnMouseClick;
  lblText.OnClick     := OnMouseClick;

  lblTitle.Parent      := Self;
  lblTitle.ParentColor := True;
  lblTitle.ParentFont  := True;
  lblTitle.AutoSize    := True;
  lblTitle.Font.Style  := [fsBold];
  lblTitle.Left        := 34;
  lblTitle.Top         := 12;

  lblText.Parent      := Self;
  lblText.ParentColor := True;
  lblText.ParentFont  := True;
  lblText.AutoSize    := True;
  lblText.Left        := 10;

  iconBitmap.Parent      := Self;
  iconBitmap.Transparent := True;
  iconBitmap.Left        := 10;
  iconBitmap.Top         := 10;

  tmrExit.Enabled  := False;
  tmrExit.Interval := 0;
  tmrExit.OnTimer  := OnExitTimer;
end;

Procedure TBalloon.FormPaint(Sender: TObject);
var
  TempRegion: HRGN;
begin
  with Canvas.Brush do
  begin
    Color := clBlack;
    Style := bsSolid;
  end;

  TempRegion := CreateRectRgn(0,0,1,1);
  GetWindowRgn(Handle, TempRegion);
  FrameRgn(Canvas.Handle, TempRegion, Canvas.Brush.handle, 1, 1);
  DeleteObject(TempRegion);
end;

Procedure TBalloon.ShowControlBalloon(blnControl: TWinControl; blnHoriz: TBalloonHoriz; blnVert: TBalloonVert; blnTitle, blnText: string; blnType: TBalloonType; blnDuration: Integer);
Var
  Rect: TRect;
  blnPosLeft, blnPosTop: Integer;
  blnPosition: TBalloonPosition;
begin
  GetWindowRect(blnControl.Handle, Rect);

  blnPosTop  := 0;
  blnPosLeft := 0;

  if blnVert = blnTop then
    blnPosTop := Rect.Top;

  if blnVert = blnCenter then
    blnPosTop := Rect.Top + Round((Rect.Bottom - Rect.Top) / 2);

  if blnVert = blnBottom then
    blnPosTop := Rect.Bottom;

  if blnHoriz = blnLeft then
    blnPosLeft := Rect.Left;

  if blnHoriz = blnMiddle then
    blnPosLeft := Rect.Left + Round((Rect.Right - Rect.Left) / 2);

  if blnHoriz = blnRight then
    blnPosLeft := Rect.Right;

  blnPosition := blnArrowBottomRight;

  if ((blnHoriz = blnRight) and (blnVert = blnBottom)) or ((blnHoriz = blnMiddle) and (blnVert = blnBottom)) then
    blnPosition := blnArrowBottomRight;

  if (blnHoriz = blnLeft) and (blnVert = blnBottom) or ((blnHoriz = blnLeft) and (blnVert = blnCenter)) then
    blnPosition := blnArrowBottomLeft;

  if (blnHoriz = blnLeft) and (blnVert = blnTop) or ((blnHoriz = blnMiddle) and (blnVert = blnTop)) then
    blnPosition := blnArrowTopLeft;

  if (blnHoriz = blnRight) and (blnVert = blnTop) or ((blnHoriz = blnRight) and (blnVert = blnCenter)) then
    blnPosition := blnArrowTopRight;

  ShowBalloon(blnPosLeft, blnPosTop, blnTitle, blnText, blnType, blnDuration, blnPosition);
end;

procedure TBalloon.ShowBalloon(blnLeft, blnTop: Integer; blnTitle, blnText: string; blnType: TBalloonType; blnDuration: Integer; blnPosition: TBalloonPosition);
var
  ArrowHeight, ArrowWidth: Integer;
  FormRegion, ArrowRegion: HRGN;
  Arrow: array [0..2] of TPoint;
  ResName: string;
begin
  ArrowHeight := 20;
  ArrowWidth  := 20;

  lblTitle.Caption := blnTitle;

  if blnPosition = blnArrowBottomRight then
    lblTitle.Top := lblTitle.Top + ArrowHeight;

  if blnPosition = blnArrowBottomLeft then
    lblTitle.Top := lblTitle.Top + ArrowHeight;

  lblText.Top     := lblTitle.Top + lblTitle.Height + 8;
  lblText.Caption := blnText;

  if blnPosition = blnArrowBottomRight then
    iconBitmap.Top := iconBitmap.Top + ArrowHeight;

  if blnPosition = blnArrowBottomLeft then
    iconBitmap.Top := iconBitmap.Top + ArrowHeight;

  case blnType Of
    blnError:
      ResName := 'ERROR';
    blnInfo:
      ResName := 'INFO';
    blnWarning:
      ResName := 'WARNING';
    else
      ResName := 'INFO';
   end;
  iconBitmap.Picture.Bitmap.LoadFromResourceName(HInstance, ResName);

  if blnPosition = blnArrowBottomRight then
    ClientHeight := lblText.Top + lblText.Height + 10;
  if blnPosition = blnArrowBottomLeft then
    ClientHeight := lblText.Top + lblText.Height + 10;
  if blnPosition = blnArrowTopLeft then
    ClientHeight := lblText.Top + lblText.Height + 10 + ArrowHeight;
  if blnPosition = blnArrowTopRight then
    ClientHeight := lblText.Top + lblText.Height + 10 + ArrowHeight;

  if (lblTitle.Left + lblTitle.Width) > (lblText.Left + lblText.Width) then
    Width := lblTitle.Left + lblTitle.Width + 10
  else
    Width := lblText.Left + lblText.Width + 10;

  if blnPosition = blnArrowTopLeft then
   begin
    Left := blnLeft - (Width - 20);
    Top  := blnTop - (Height);
   end;

  if blnPosition = blnArrowTopRight then
  begin
    Left := blnLeft - 20;
    Top  := blnTop - (Height);
  end;

  if blnPosition = blnArrowBottomRight then
  begin
    Left := blnLeft - 20;
    Top  := blnTop - 2;
  end;

  if blnPosition = blnArrowBottomLeft then
  begin
    Left := blnLeft - (Width - 20);
    Top  := blnTop - 2;
  end;

  FormRegion := 0;

  if blnPosition = blnArrowTopLeft then
  begin
    FormRegion := CreateRoundRectRgn(0, 0, Width, Height - (ArrowHeight - 2), 7, 7);

    Arrow[0] := Point(Width - ArrowWidth - 20, Height - ArrowHeight);
    Arrow[1] := Point(Width - 20, Height);
    Arrow[2] := Point(Width - 20, Height - ArrowHeight);
  end;

  if blnPosition = blnArrowTopRight then
  begin
    FormRegion := CreateRoundRectRgn(0, 0, Width, Height - (ArrowHeight - 2), 7, 7);

    Arrow[0] := Point(20, Height - ArrowHeight);
    Arrow[1] := Point(20, Height);
    Arrow[2] := Point(20 + ArrowWidth, Height - ArrowHeight);
  end;

  if blnPosition = blnArrowBottomRight then
  begin
    FormRegion := CreateRoundRectRgn(0, ArrowHeight + 2, Width, Height, 7, 7);

    Arrow[0] := Point(20, 2);
    Arrow[1] := Point(20, ArrowHeight + 2);
    Arrow[2] := Point(20 + ArrowWidth, ArrowHeight + 2);
  end;

  if blnPosition = blnArrowBottomLeft then
  begin
    FormRegion := CreateRoundRectRgn(0, ArrowHeight + 2, Width, Height, 7, 7);

    Arrow[0] := Point(Width - 20, 2);
    Arrow[1] := Point(Width - 20, ArrowHeight + 2);
    Arrow[2] := Point(Width - 20 - ArrowWidth, ArrowHeight + 2);
  end;

  ArrowRegion := CreatePolygonRgn(Arrow, 3, WINDING);

  CombineRgn(FormRegion, FormRegion, ArrowRegion, RGN_OR);
  DeleteObject(ArrowRegion);
  SetWindowRgn(Handle, FormRegion, True);

  Visible := False;
  ShowWindow(Handle, SW_SHOWNOACTIVATE);
  Visible := True;

  tmrExit.Interval := blnDuration * 1000;
  tmrExit.Enabled  := True;
end;

end.

//----------------------------------------------------------------

it has a property named Delay for specifying how long does it take for hint to disapear, or you can set it to zero for avoiding from disapearing the hint.

at last, I thank you again Slickers for your helps. the pings are yours.

mehdi_m