Показать сообщение отдельно
  #5  
Старый 06.09.2012, 05:14
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Вот пример:

Код:
unit tooltipunit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, CommCtrl, ExtCtrls, XPMan;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    XPManifest1: TXPManifest;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

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

var
  Form1     : TForm1;
  TTBalloon : HWND;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  TI : TToolInfo;
begin
  {  ****  "ВОЗДУШНЫЕ ШАРИКИ"  ****  }
  TTBalloon := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, NIL,
      TTS_ALWAYSTIP or TTS_BALLOON,
      integer(CW_USEDEFAULT), integer(CW_USEDEFAULT),
      integer(CW_USEDEFAULT), integer(CW_USEDEFAULT),
      Handle, 0, hInstance, NIL);

  {  Заполняем структуру TOOLINFO для подсказки "воздушный шарик" }
  TI.cbSize   := SizeOf(TToolInfo);
  TI.uFlags   := TTF_SUBCLASS or TTF_TRANSPARENT or TTF_CENTERTIP;
  TI.hwnd     := ProgressBar1.Handle;
  TI.uId      := 0;
  TI.lpszText := '';
  Windows.GetClientRect(ProgressBAr1.Handle, Ti.Rect);

  SendMessage(TTBalloon, TTM_ADDTOOL, 0, Integer(@ti));
  SendMessage(TTBalloon, TTM_SETTITLE, 1, Integer(PAnsiChar('Position')));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DestroyWindow(TTBalloon);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  TI   : TToolInfo;
begin
  ProgressBar1.Position := (ProgressBar1.Position + 5) mod ProgressBar1.Max;

  {  Заполняем структуру TOOLINFO для подсказки "воздушный шарик" }
  TI.cbSize   := SizeOf(TToolInfo);
  TI.uFlags   := TTF_SUBCLASS or TTF_TRANSPARENT or TTF_CENTERTIP;
  TI.hwnd     := ProgressBar1.Handle;
  TI.uId      := 0;
  TI.lpszText := PAnsiChar(Format('Выполнено %d%% процентов', [ProgressBar1.Position]));
  Windows.GetClientRect(ProgressBar1.Handle, Ti.Rect);
  SendMessage(TTBalloon, TTM_SETTOOLINFO, 0, Integer(@ti));
  SendMessage(TTBalloon, TTM_SETTITLE, 1, Integer(PAnsiChar('Position')));
end;

end.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием