Многострочная подсказка (Hints)


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. 
Теги:
Hints
Добавлено: 01 Августа 2018 08:29:44 Добавил: Андрей Ковальчук Нравится 0
Добавить
Комментарии:
Нету комментариев для вывода...