Главная страница
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
1-73676
GGWIN
2002-09-10 18:41
2002.09.23
TStringList вложенный в TStringList


7-73914
Ascan_
2002-07-12 14:57
2002.09.23
Отсылаем 13к, а доходит только 8к.


4-73930
oleg_er
2002-08-01 07:19
2002.09.23
Кем заблокирован файл?


4-73950
Vladimir Prokofiev
2002-08-01 14:22
2002.09.23
Как в MDI-application избавиться от появления ScroollBar,


1-73748
Андрусь
2002-09-11 18:12
2002.09.23
такой вот немного детский вопрос