новый компонент

[Zloi_tapoG]

прокоментируйте пожалуйста подробней код компонента:

 {
Автор компонента: Алексей Смышляев. 
Написан 21.06.2003. 
Компонент основан на компоненте GRMHint.
Позволяет задавать шрифт и цвет подсказок.
Удачи в использовании. 
Сайт автора: www.alois.com.ru
E-mail автора: alois1981@mail.ru
}
 
unit AloisHint;
 
interface
 
uses
  SysUtils, WinTypes, WinProcs, Messages,
  Classes, Graphics, Controls, Forms, Dialogs;
 
type
  TAloisHint = class(TComponent)
  private
   FSeparate_str: Char;
   ScreenSize: Integer;
   FActive: Boolean;
   FOnShowHint: TShowHintEvent;
   FColor:TColor;
   FFont:TFont;
   FOnFontChange : TNotifyEvent;
   procedure SetFont(Value: TFont); virtual;
   function GetFont:TFont; virtual;
  protected//устнавливаем свойства компонента
    procedure SetActive(Value: Boolean);
    procedure SetSeparate_str(Value: char);
    procedure NewHintInfo(var HintStr: string;
    var CanShow: Boolean;
    var HintInfo: THintInfo);
  public
 
  published
    constructor Create(aowner: Tcomponent); override;
 
    destructor destroy; override;
 
    property Font: TFont read GetFont write SetFont;
    property Active: Boolean read FActive write SetActive;
    property Separate_str: Char read FSeparate_str write SetSeparate_str;
    property Color:TColor read FColor write FColor;
    property OnFontChange:TNotifyEvent read     FOnFontChange write FOnFontChange;
  end;
 
procedure Register;
 
implementation
 
constructor TAloisHint.Create(AOwner: TComponent);
begin
inherited Create(AOwner);//вызываем предка
FActive := True;//устанавливаем значения по умолчанию
FSeparate_str := '*';
FColor:=clWindow;
Application.OnShowHint := NewHintInfo;
ScreenSize := GetSystemMetrics(SM_CYSCREEN);
FFont := TFont.Create;
FFont.Style := [];
FFont.Name := 'Arial';
FFont.Size := 8;
end;
 
destructor TAloisHint.destroy;//освобождаем память 
begin
  FFont.Destroy;
  inherited destroy;
end;
 
procedure TAloisHint.SetActive(Value: Boolean);
begin
FActive := Value;
end;
 
procedure TAloisHint.SetSeparate_str(Value: Char);
begin
FSeparate_str := Value;
end;
 
procedure TAloisHint.NewHintInfo(var HintStr: string;//процедура 
//при которой надпись движется вместе со стрелкой)
var CanShow: Boolean;
var HintInfo: THintInfo);
var 
I: Byte;
a:integer;
begin
if FActive then
begin
I := Pos(FSeparate_str, HintStr);
while I > 0 do
begin
HintStr[I] := #13;
I := Pos(FSeparate_str, HintStr);
end;
if HintInfo.HintPos.Y+10 > ScreenSize then
HintInfo.HintPos.Y := ScreenSize-11;
hintinfo.CursorRect.Top:=999;
hintinfo.HintColor:=FColor;
for a := 0 to Application.ComponentCount - 1 do
if Application.Components[a] is THintWindow then
with THintWindow(Application.Components[a]).Canvas do
begin
Font.Name:=FFont.Name;
Font.Color:=FFont.Color;
Font.Style:=FFont.Style;
Font.Size:=FFont.Size;
Font.Charset:=FFont.Charset;
Font.PixelsPerInch:=FFont.PixelsPerInch;
Font.Height:=FFont.Height;
end;
end;
end;
 
procedure TAloisHint.SetFont(Value: TFont);
begin
if Assigned(Value) then
FFont.Assign(Value);
if Assigned(FOnFontChange) then OnFontChange(self);
end;
 
function TAloisHint.GetFont:TFont;
begin
Result:=FFont;
end;
 
procedure Register;
begin
  RegisterComponents('AloisPack', [TAloisHint]);
end;
 
end.

[ZuBy]

а что обратится к автору слабо?
E-mail автора: alois1981@mail.ru

[mihali4]

Все можно сделать гораздо проще.
В примере перехватывается событие Application.OnShowHint и изменяется шрифт Hint'а.

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{Private declarations}
public
procedure MyShowHint(var HintStr: string; var CanShow: Boolean;var HintInfo: THintInfo);
{Public declarations}
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MyShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
var i : integer;
begin
for i := 0 to Application.ComponentCount - 1 do
if Application.Components[i] is THintWindow then
with THintWindow(Application.Components[i]).Canvas do
begin
Font.Name:= 'Arial';
Font.Size:= 18;
Font.Style:= [fsBold];
HintInfo.HintColor:= clWhite;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnShowHint := MyShowHint;
end;