{
  Copyright:      Copyright © 2002-2004 gate(n)etwork GmbH. Alle Rechte vorbehalten.
  Author:        Daniel Wischnewski
  State:          Public Domain, only for Delphi-PRAXiS Group
  Remarks:        this Copyright must be included
  Version:        Delphi 2-7
  Description:    Creates a custom hint window

* THIS SOFTWARE IS PROVIDED BY THE AUTHORS ''AS IS'' AND ANY EXPRESS
* OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
* BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
* OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
* EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
}

unit uCustomHint;

interface

uses
  Classes, Windows, Forms, Graphics, Controls, Types;

type
  TGraphicHintWindow = class(THintWindow)
  private
    FActivating: Boolean;
  public
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property Caption;
  end;

var
  CurrentHintImage: String;

const
  BMP_SPACE = 30;

implementation

{ TGraphicHintWindow }

procedure TGraphicHintWindow.ActivateHint(Rect: TRect;
  const AHint: string);
begin
  FActivating := True;
  try
    Caption := AHint;
    Inc(Rect.Bottom, 16);
    Rect.Right := Rect.Right + BMP_SPACE;
    UpdateBoundsRect(Rect);
    // calc screen position
    if Rect.Top + Height > Screen.ActiveForm.Monitor.WorkareaRect.Bottom then
      Rect.Top := Screen.ActiveForm.Monitor.WorkareaRect.Bottom - Height;
    if Rect.Left + Width > Screen.ActiveForm.Monitor.WorkareaRect.Right then
      Rect.Left := Screen.ActiveForm.Monitor.WorkareaRect.Right - Width;
    if Rect.Left < Screen.ActiveForm.Monitor.WorkareaRect.Left then
      Rect.Left := Screen.ActiveForm.Monitor.WorkareaRect.Left;
    if Rect.Bottom < Screen.ActiveForm.Monitor.WorkareaRect.Top then
      Rect.Bottom := Screen.ActiveForm.Monitor.WorkareaRect.Top;
    // set new position
    SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
      SWP_SHOWWINDOW or SWP_NOACTIVATE);
    // redraw
    Invalidate;
  finally
    FActivating := False;
  end;
end;

constructor TGraphicHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  with Canvas.Font do
    Color := clBlack;
end;

procedure TGraphicHintWindow.Paint;
var
  R: TRect;
  Bmp: TBitmap;
begin
  R := ClientRect;
  Inc(R.Left, 2);
  Inc(R.Top, 2);
  // draw left corner
  Bmp := TBitmap.Create;
  try
    try
      with Canvas do
      begin
        Brush.Style := bsSolid;
        Brush.Color := clSkyBlue;
        Pen.Color := clGray;
        Rectangle(0, 0, BMP_SPACE, R.Bottom + 1);
        Bmp.LoadfromFile(CurrentHintImage);
        Draw(4, Succ((R.Bottom - Bmp.Height) div 2), Bmp);
      end;
    except
    end;
  finally
    Bmp.Free;
  end;
  Color := clWhite;
  // draw text
  Canvas.Brush.Style := bsClear;
  Canvas.TextOut(Succ(BMP_SPACE), (R.Bottom div 2) - (Canvas.Textheight(Caption)
      div 2), Caption);
end;

initialization
  CurrentHintImage := '';

end.

if Rect.Top + Height > Screen.ActiveForm.Monitor.WorkareaRect.Bottom then