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

{********************************************************* 

 Mit Hilfe des folgendes Codes lassen sich leicht beliebige 
 Hints erstellen. Dazu muss nur dir Prozedur "Paint" den 
 Wьnschen entsprechend angepasst werden. 

 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); 

  { 
   Hier kцnnen beliebige Schrift Eigenschaften gesetzt 
   werden. 

   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.Top, 2); 

  {******************************************************* 
   Der folgende Code ist ein Beispiel wie man die Paint 
   Prozedur nutzen kann um einen benutzerdefinierten Hint 
   zu erzeugen. 

   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.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; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  HintWindowClass := TGraphicHintWindow; 
  Application.ShowHint := False; 
  Application.ShowHint := True; 
end; 

Взято с сайта



Содержание раздела

---

---