{ TdwHint }
procedure TdwHint.ActivateHint(Arect: TRect;
const AHint:
string);
begin
inherited ActivateHint(Arect, AHint);
end;
function TdwHint.CalcHintRect(MaxWidth: Integer;
const AHint:
string;
AData: Pointer): TRect;
var
h: Integer;
w: Integer;
HeightHeaderFont, HeightFont: Integer;
Header, Body:
string;
BodyRect: TRect;
begin
ParseHintText(AHint, Header, Body);
if Header<>'
'
then
begin
Canvas.Font.Style:=[fsBold];
h:=Canvas.TextHeight(Header);
w:=Canvas.TextWidth(Header);
h:=h+5;
Canvas.Font.Style:=[];
DrawText(Canvas.Handle, PChar(Body), Length(Body), BodyRect, DT_LEFT
or DT_WORDBREAK
or DT_CALCRECT);
h:=h+BodyRect.Height;
if BodyRect.Width>w
then
w:=BodyRect.Width;
h:=h+10;
w:=w+10;
Result:=Rect(0, 0, w, h);
end;
end;
procedure TdwHint.CreateParams(
var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style:=Params.Style - WS_BORDER;
if (Win32Platform = VER_PLATFORM_WIN32_NT)
and
((Win32MajorVersion > 5)
or
((Win32MajorVersion = 5)
and (Win32MinorVersion >=1)))
then
Params.WindowClass.style := Params.WindowClass.style
or $00020000;
end;
procedure TdwHint.Paint;
var
DC: HDC;
Rect, HeaderRect, BodyRect: TRect;
HeaderTextRect, BodyTextRect: TRect;
HeaderFont, BodyFont: HFONT;
HeaderFontName, BodyFontName: PWideChar;
Brush: HBRUSH;
pen: HPEN;
Header, Body:
string;
fontheight: Integer;
begin
DC:=Canvas.Handle;
Rect:=ClientRect;
Brush:=CreateSolidBrush(ColorToRGB(clInfoBk));
FillRect(
DC, Rect, Brush);
ParseHintText(Caption, Header, Body);
HeaderRect:=Rect;
Canvas.Font.Style:=[fsBold];
HeaderRect.Height:=Canvas.TextHeight(Header)+3;
BodyRect:=Rect;
BodyRect.Top:=HeaderRect.Top+HeaderRect.Height;
Canvas.Font.Style:=[];
HeaderTextRect:=HeaderRect;
BodyTextRect:=BodyRect;
HeaderTextRect.Top:=HeaderTextRect.Top+2;
HeaderTextRect.Left:=HeaderTextRect.Left+2;
BodyTextRect.Top:=BodyTextRect.Top+2;
BodyTextRect.Left:=BodyTextRect.Left+2;
fontheight:=-MulDiv(8, GetDeviceCaps(
DC, LOGPIXELSY), 72);
if Header<>'
'
then
begin
Brush:=CreateSolidBrush(ColorToRGB(clLime));
FillRect(
DC, HeaderRect, Brush);
HeaderFontName:='
Tahoma';
HeaderFont:=CreateFont(fontheight,0,0,0,FW_BOLD,0,0,0,ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, HeaderFontName);
SelectObject(
DC, HeaderFont);
DrawText(
DC, PChar(Header), -1, HeaderTextRect, DT_LEFT
or DT_NOPREFIX);
BodyFontName:='
Tahoma';
BodyFont:=CreateFont(fontheight,0,0,0,FW_NORMAL,0,0,0,ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, HeaderFontName);
SelectObject(
DC, BodyFont);
DrawText(
DC, PChar(Body), -1, BodyTextRect, DT_LEFT
or DT_NOPREFIX
or DT_WORDBREAK);
MoveToEx(
DC, Rect.Left, Rect.Top+HeaderRect.Height,
nil);
LineTo(
DC, Rect.Right, Rect.Top+HeaderRect.Height);
DeleteObject(HeaderFont);
DeleteObject(BodyFont);
end else begin
Canvas.TextRect(Rect, 5, 5, Caption);
end;
end;
procedure TdwHint.ParseHintText(HintText:
string;
var Header, Body:
string);
begin
if Pos(LineFeed, HintText)>0
then
begin
Header:=Copy(HintText, 1, Pos(LineFeed , HintText)-2);
Body:=Copy(HintText, Pos(LineFeed, HintText)+1, Length(HintText));
end else
begin
Header:='
';
Body:=HintText;
end;
end;