Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2002.09.23;
Скачать: CL | DM;

Вниз

Custom Hint   Найти похожие ветки 

 
SergLight ©   (2002-09-10 15:46) [0]

Необходимо создавать свою подсказку (текст + картинка + форматирование).
Подскажите какие-либо идеи на этот счет.


 
Игорь Шевченко ©   (2002-09-10 15:48) [1]

Наследник от класса THintWindow.
Пример:
unit HSRoundHint;

interface
uses Windows, Classes, Controls, Forms, Messages, Graphics;

type
THSHintWindow = class (THintWindow)
private
FRegion : THandle;
procedure FreeCurrentRegion;
public
destructor Destroy; override;
procedure ActivateHint (Rect : TRect; const AHint : String); override;
procedure Paint; override;
procedure CreateParams (var Params : TCreateParams); override;
end;

implementation

{ THSHintWindow }

procedure THSHintWindow.ActivateHint(Rect: TRect; const AHint: String);
begin
with Rect do
Inc(Right, Canvas.TextWidth ("W"));
BoundsRect := Rect;
FreeCurrentRegion();
with BoundsRect do
FRegion := CreateRoundRectRgn (0, 0, Width, Height, 6, 6);
if FRegion <> 0 then
SetWindowRgn (Handle, FRegion, true);
inherited;
end;

procedure THSHintWindow.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params do
Style := Style AND NOT WS_BORDER;
end;

destructor THSHintWindow.Destroy;
begin
FreeCurrentRegion;
inherited;
end;

procedure THSHintWindow.FreeCurrentRegion;
begin
if FRegion <> 0 then begin
SetWindowRgn (Handle, 0, true);
DeleteObject (FRegion);
FRegion := 0;
end;
end;

procedure THSHintWindow.Paint;
var R : TRect;
begin
R := ClientRect;
Canvas.Pen.Color := clBtnFace;
Canvas.Brush.Style := bsClear;
Canvas.Brush.Color := clBlack;
Canvas.RoundRect(R.Left, R.Top, R.Right-1, R.Bottom-5, 6, 6);
Canvas.Font.Color := clWhite;
DrawText (Canvas.Handle, PChar(Caption), Length (Caption), R,
DT_NOPREFIX OR DT_WORDBREAK OR DT_CENTER OR DT_VCENTER);
end;

initialization
Application.ShowHint := false;
HintWindowClass := THSHintWindow;
Application.ShowHint := true;
end.


 
SergLight ©   (2002-09-10 16:00) [2]


> Игорь Шевченко ©

Большое спасибо.



Страницы: 1 вся ветка

Текущий архив: 2002.09.23;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.012 c
3-73577
Азазелло
2002-09-03 14:48
2002.09.23
Нормально ли работает Filtered у TClientDataSet?


1-73632
Злой!!!
2002-09-12 12:21
2002.09.23
Таблицы с многострочными ячейками. Какой нужен компонент?


14-73877
Driverrr
2002-08-28 21:32
2002.09.23
Искусственный интеллект


3-73480
Morgan3212
2002-08-27 16:13
2002.09.23
БД


3-73499
Antipich
2002-08-31 19:04
2002.09.23
Таблицы *.XML