|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
Динамическая подсказка
ЗДравствуйте. Как мне можно реализовать динамическую подсказку? То есть чтобы она обнавляла значение постоянно как только она появляется. Есть код
Код:
...dalnost: TProgressBar;... procedure TForm1.dalnostMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin nazhal:=true; dalnost.Position:=dalnost.max*x div dalnost.Width; end; procedure TForm1.dalnostMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if nazhal then dalnost.Position:=dalnost.max*x div dalnost.Width; dalnost.hint:=inttostr(dalnost.Position); end; procedure TForm1.dalnostMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if nazhal then dalnost.Position:=dalnost.max*x div dalnost.Width; nazhal:=false; end; |
#2
|
||||
|
||||
TBaloonHint есть в некоторых Delphi там можно задать время жизни подсказки, а так посмотри Application.HintHidePause
Код сырец |
#3
|
||||
|
||||
так http://zalil.ru/33728619 ?
нужно мышку навести на ProgressBar. Пишу программы за еду. __________________ |
#4
|
||||
|
||||
Экзешник какрас то что нужно, только какие компоненты нужны для создания такой подсказки?
|
#5
|
||||
|
||||
Вот пример:
Код:
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 в.д. |
#6
|
||||
|
||||
практически тютелька-в-тютельку)
Пишу программы за еду. __________________ |
Этот пользователь сказал Спасибо NumLock за это полезное сообщение: | ||
Klyaksa (06.09.2012)
|
#7
|
||||
|
||||
А вот ваш экзешник размером меньше чем мой. Но это уже другая тема.
|
#8
|
||||
|
||||
Цитата:
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |