Как сделать графический hint?

{*********************************************************
 With the following Code you can simply create custom hints.
 You just have to change the procedur "Paint".
 *********************************************************}

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;
 {...}
constructor TGraphicHintWindow.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 {
  Here you can set custom Font Properties:
  }

 with Canvas.Font do
 begin
  Name := 'Arial';
  Style := Style + [fsBold];
  Color := clBlack;
 end;
end;
procedure TGraphicHintWindow.Paint;
var
 R: TRect;
 bmp: TBitmap;
begin
 R := ClientRect;
 Inc(R.Left, 2);
 Inc(R., 2);
 {*******************************************************
  The folowing Code ist an example how to create a custom
  Hint Object. :
  }

 bmp := TBitmap.Create;
 bmp.LoadfromFile('D:\hint.bmp');
 with Canvas do
 begin
  Brush.Style := bsSolid;
  Brush.Color := clsilver;
  Pen.Color := clgray;
  Rectangle(0, 0, 18, R.Bottom + 1);
  Draw(2,(R.Bottom div 2) - (bmp.Height div 2), bmp);
 end;
 bmp.Free;
 //Beliebige HintFarbe
 //custom Hint Color
 Color := clWhite;
 Canvas.Brush.Style := bsClear;
 Canvas.TextOut(20, (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;
  //Hцhe des Hints setzen setzen
  //Set the "Height" Property of the Hint
  Inc(Rect.Bottom, 14);
  //Breite des Hints setzen
  //Set the "Width" Property of the Hint
  Rect.Right := Rect.Right + 20;
  UpdateBoundsRect(Rect);
  if Rect. + Height > Screen.DesktopHeight then
  Rect. := 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.Desktop then Rect.Bottom := Screen.Desktop;
  SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect., Width, Height,
  SWP_SHOWWINDOW or SWP_NOACTIVATE);
  Invalidate;
 finally
  FActivating := False;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 HintWindowClass := TGraphicHintWindow;
 Application.ShowHint := False;
 Application.ShowHint := True;
end;

Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...