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

Вниз

Смена шрифта у Hint   Найти похожие ветки 

← →
ilg ©   (2002-08-15 09:09) [0]

Как можно сменить шрифт(в частности цвет букв) всплывающих подсказок в моей программе?
Заранее, Большое спасибо!

---

← →
Игорь Шевченко ©   (2002-08-15 10:12) [1]

Унаследовать свой класс от THintWindow, к примеру. Посмотреть свойства TApplication.Hintxxxx, к примеру

---

← →
ilg ©   (2002-08-15 14:29) [2]

Игорь Шевченко, извините, можно подробнее?
Не совсем понятно, что делать после того, как унаследовал класс.
И, если можно, пожалуйста с примерами!

---

← →
Игорь Шевченко ©   (2002-08-15 15:02) [3]

К примеру:

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; { Цвет окна Hint"а - черный }
Canvas.RoundRect(R.Left, R.Top, R.Right-1, R.Bottom-5, 6, 6);
Canvas.Font.Color := clWhite; { Цвет надписи Hint"а - белый }
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.


Hint получается с закругленными краями, и белый текст на черном фоне.

Для использования просто добавить в проект unit HSRoundHint

---

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

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

Наверх

Память: 0.47 MB
Время: 0.017 c