unit UHINTPRO2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TGraphicHintWindow = class(THintWindow)
constructor Create(AOwner: TComponent); override;
private
FActivating: Boolean;
public
procedure ActivateHint(Rect: TRect; const AHint: string); override;
protected
procedure Paint; override;
published
property Caption;
end;
var ConstColorFONT,ConstCOLOR1,ConstCOLOR2,ConstHintRPenColor:TColor;
ConstTextLeft,ConstHintSpacePlus,ConstHintFontSize,ConstHintRPenWith,ConstHintRAcncho:Integer;
ConstHintFontStyle,ConstHintRStyle:Integer;
ConstImagenBoolean:Boolean;
ConstFicheroBMP,ConstHintFontNAme:string;
implementation
constructor TGraphicHintWindow.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ConstColor1:=ClBlue; ConstTextLeft:=32; ConstHintSpacePlus:=200; ConstImagenBoolean:=False; ConstFicheroBMP:='';
ConstHintFontNAme:='Arial'; ConstHintFontSize:=10; ConstHintFontStyle:=1; ConstColorFont:=clYellow;
ConstHintRPenWith:=1; ConstHintRAcncho:=30; ConstHintRPenColor:=clGray; ConstHintRStyle:=0; ConstColor2:=clYellow;
with Canvas.Font do
begin
Name := ConstHintFontNAme;
if (ConstHintFontStyle>3) or (ConstHintFontStyle<0) then ConstHintFontStyle:=0;
case ConstHintFontStyle of
0:Style:=Style +[];
1:Style:=Style +[fsBold];
2:Style:=Style +[fsItalic];
3:Style:=Style +[fsBold,fsItalic];
end;
Size:=ConstHintFontSize;
Color :=ConstColorFONT;
end;
end;
procedure TGraphicHintWindow.Paint;
var
R: TRect;
bmp: TBitmap;
begin
R := ClientRect;
Inc(R.Left, 2);
Inc(R.Top, 2);
bmp := TBitmap.Create;
if ConstImagenBoolean=True then bmp.LoadfromFile(ConstFicheroBMP);
with Canvas.Font do
begin
Name := ConstHintFontNAme;
if (ConstHintFontStyle>3) or (ConstHintFontStyle<0) then ConstHintFontStyle:=0;
case ConstHintFontStyle of
0:Style:=Style +[];
1:Style:=Style +[fsBold];
2:Style:=Style +[fsItalic];
3:Style:=Style +[fsBold,fsItalic];
end;
Size :=ConstHintFontSize;
Color :=ConstColorFONT;
end;
with Canvas do begin
if (ConstHintRStyle>7) or (ConstHintRStyle<0) then ConstHintRStyle:=0;
case ConstHintRStyle of
0:Brush.Style := bsSolid;
1:Brush.Style := bsClear;
2:Brush.Style := bsHorizontal;
3:Brush.Style := bsVertical;
4:Brush.Style := bsFDiagonal;
5:Brush.Style := bsBDiagonal;
6:Brush.Style := bsCross;
7:Brush.Style := bsDiagCross;
end;
Brush.Color :=ConstColor2;
Pen.Color :=ConstHintRPenColor;
Pen.Width :=ConstHintRPenWith;
Rectangle(0, 0, ConstHintRAcncho, R.Bottom + 1);
Draw(2,(R.Bottom div 2) - (bmp.Height div 2), bmp);
end;
bmp.Free;
Color :=ConstColor1;
Canvas.Brush.Style := bsClear;
Canvas.TextOut(ConstTextLeft, (R.Bottom div 2) - (Canvas.Textheight(Caption) div 2), Caption);
end;
procedure TGraphicHintWindow.ActivateHint(Rect: TRect; const AHint: string);
begin
FActivating := True;
try
Caption := AHint;
Inc(Rect.Bottom, 14);
Rect.Right := Rect.Right +ConstHintSpacePlus;
UpdateBoundsRect(Rect);
if Rect.Top + Height > Screen.DesktopHeight then
Rect.Top := Screen.DesktopHeight - Height;
if Rect.Left + Width > Screen.DesktopWidth then
Rect.Left := Screen.DesktopWidth - Width;
if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;
SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
SWP_SHOWWINDOW or SWP_NOACTIVATE);
Invalidate;
finally
FActivating := False;
end;
end;
end.