Dicas - Criando ToolTips no estilo Balão

Você precisa estar logado para dar um feedback. Clique aqui para efetuar o login
Para efetuar o download você precisa estar logado. Clique aqui para efetuar o login
Confirmar voto
0
 (1)  (0)

Nesta dica veremos como criar ToolTips no estilo balão, parecido com o do Windows XP.

Criando ToolTips no estilo Balão

 

Nesta dica veremos como criar ToolTips no estilo balão, parecido com o do Windows XP. Para ilustrar este exemplo utilizaremos o componente Memo. Os passos necessários para implementá-lo são os seguintes:

1) Inclua um componente Memo no seu formulário;

 

Obs: A propriedade showHint do componente Memo1 deve estar configurada como False, senão haverá dois hints para o componente: o nativo do Delphi e o criado por esse exemplo. Agora, caso você deseje realmente ter dois hints, deixe a propriedade showHint como True e escreva o seu texto na propriedade Hint.

 

2) Escreva o código a seguir, de forma que a sua Unit se pareça com o texto abaixo:

 

unit untBalloonToolTip;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Commctrl, StdCtrls;

 

type

  TForm1 = class(TForm)

    Memo1: TMemo;

    procedure FormCreate(Sender: TObject);

  private

    { Private declarations }

  public

    { public declarations }

end;

 

const

  TTS_BALLOON = $40;

  TTM_SETTITLE = (WM_USER + 32);

 

var

  Form1: TForm1;

  hTooltip: Cardinal;

  ti: TToolInfo;

  buffer : array[0..255] of char;

 

implementation

 

{$R *.dfm}

 

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.FormCreate(Sender: TObject);

const

  TipoDoIcone = 1;

begin

  CreateToolTips(Form1.Handle);

  AddToolTip(Memo1.Handle, @ti, TipoDoIcone, 'Texto do ToolTip', 'Título do ToolTip');

end;

end.

 

TipoDoIcone pode ser:

0 - Sem Ícone

1 - Informação

2 - Aviso

3 - Erro  

 
Você precisa estar logado para dar um feedback. Clique aqui para efetuar o login
Receba nossas novidades
Ficou com alguma dúvida?