unit MHint;

interface

uses
 SysUtils, WinTypes, WinProcs, Messages,
 Classes, Graphics, Controls, Forms, Dialogs;
 
type
 TMHint = class(TComponent)
 private
 ScreenSize: Integer;
 FActive: Boolean;
 FSeparator: Char;
 FOnShowHint: TShowHintEvent;
 protected
 procedure SetActive(Value: Boolean);
 procedure SetSeparator(Value: char);
 procedure NewHintInfo(var HintStr: string; 
 var CanShow: Boolean;
 var HintInfo: THintInfo);
 public
 constructor Create(AOwner: TComponent); override;
 published
 property Active: Boolean
 read FActive write SetActive;
 property Separator: Char
 read FSeparator write SetSeparator;
 end;

procedure Register;

implementation

constructor TMHint.Create(AOwner: TComponent);

begin
 inherited Create(AOwner);
 FActive := True;
 FSeparator := '@';
 Application.OnShowHint := NewHintInfo;
 ScreenSize := GetSystemMetrics(SM_CYSCREEN);
end;

procedure TMHint.SetActive(Value: Boolean);
begin
 FActive := Value;
end;

procedure TMHint.SetSeparator(Value: Char);
begin
 FSeparator := Value;
end;

procedure TMHint.NewHintInfo(var HintStr: string; 
 var CanShow: Boolean;
 var HintInfo: THintInfo);
var 
 I: Byte;
begin
 if FActive then
 begin
 I := Pos(FSeparator, HintStr);
 while I > 0 do
 begin
 HintStr[I] := #13;
 I := Pos(FSeparator, HintStr);
 end;
 if HintInfo.HintPos.Y+10 > ScreenSize then
 HintInfo.HintPos.Y := ScreenSize-11;
 end;
end;

procedure Register;
begin
 RegisterComponents('MyComponents', [TMHint]);
end;
end.

Получить ссылку на материал