Graphischer Hint mit eigenen Bitmap

[toms]

Hallo !

    property Picture: TPicture read FPicture write SetPicture; Ich musste den Code zuerst mal du DelForEx jagen, da der Code äussert ungewöhlich formatiert ist.
Habe auch ein paar Änderungen vorgenommen. (ist jedoch noch nicht fertig und könnten noch Fehler vorhanden sein!)

Delphi-Quellcode:

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

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

 *********************************************************}
unit GraphicHint;

interface

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

type
  TGraphicHintWindow = class(THintWindow)
  private
    FPicture: TPicture;
    FActivating: Boolean;
    procedure SetPicture(Value: TPicture);
  public
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  protected
    procedure Paint; override;
  published
    property Caption;
    property Picture: TPicture read FPicture write SetPicture;
  end;

procedure Register;

implementation


constructor TGraphicHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPicture := TPicture.Create;
  with Canvas.Font do
  begin
    Name := 'Arial';
    Style := Style + [fsBold];
    Color := clBlack;
  end;
end;

destructor TGraphicHintWindow.Destroy;
begin
  if FPicture <> nil then
    FreeAndNil(FPicture);
  inherited;
end;

procedure TGraphicHintWindow.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TGraphicHintWindow.Paint;
var
  R: TRect;
  bmp: TBitmap;
begin
  R := ClientRect;
  Inc(R.Left, 2);
  Inc(R.Top, 2);
  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;
  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;
    Inc(Rect.Bottom, 14); // Höhe des Hint
    Rect.Right := Rect.Right + 20; // Breite des Hint
    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;}



procedure Register;
begin
  RegisterComponents('Eigene', [TGraphicHintWindow]);
end;

end.