Delphi World - Hint любой формы
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Hint любой формы

Подключите модуль CoolHint к любому проекту и пользуйтесь


unit CoolHint;

interface

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

type
  TddgHintWindow = class(THintWindow)
  private
    FRegion: THandle;
    procedure FreeCurrentRegion;
  public
    destructor Destroy; override;
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
end;

implementation

destructor TddgHintWindow.Destroy;
begin
  FreeCurrentRegion;
  inherited;
  Destroy;
end;

procedure TddgHintWindow.CreateParams(var Params: TCreateParams);
{ We need to remove the border created on the Windows API-level }
{ when the window is created. }
begin
  inherited; // ???
  CreateParams(Params);
  Params.Style := Params.Style and not ws_Border; // remove border
end;

procedure TddgHintWindow.FreeCurrentRegion;
{ Regions, like other API objects, should be freed when you are }
{ through using them. Note, however, that you cannot delete a }
{ region which is currently set in a window, so this method sets }
{ the window region to 0 before deleting the region object. }
begin
  if FRegion <> 0 then // if Region is alive...
  begin
    SetWindowRgn(Handle, 0, True); // set win region to 0
    DeleteObject(FRegion); // kill the region
    FRegion := 0; // zero out field
  end;
end;

procedure TddgHintWindow.ActivateHint(Rect: TRect; const AHint: string);
{ Called when the hint is activated by putting the mouse pointer }
{ above a control. }
begin
  with Rect do
    Right := Right + Canvas.TextWidth('WWWW'); // add some slop
  BoundsRect := Rect;
  FreeCurrentRegion;
  with BoundsRect do
    { Create a round rectangular region to display the hint window }
    FRegion := CreateRoundRectRgn(0, 0, Width, Height, Width, Height);
  if FRegion <> 0 then
    SetWindowRgn(Handle, FRegion, True); // set win region
  inherited;
  ActivateHint(Rect, AHint); // call inherited
end;

procedure TddgHintWindow.Paint;
{ This method gets called by the WM_PAINT handler. It is }
{ responsible for painting the hint window. }
var
  R: TRect;
begin
  R := ClientRect; // get bounding rectangle
  Inc(R.Left, 1); // move left side slightly
  Canvas.Font.Color := clInfoText; // set to proper color
  { paint string in the center of the round rect }
  DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_VCENTER);
end;

var
  OldHintClass: THintWindowClass;

function SetNewHintClass(AClass: THintWindowClass): THintWindowClass;
var
  DoShowHint: Boolean;
begin
  Result := HintWindowClass; // return value is old hint window
  DoShowHint := Application.ShowHint;
  if DoShowHint then
    Application.ShowHint := False; // destroy old hint window
  HintWindowClass := AClass; // assign new hint window
  if DoShowHint then
    Application.ShowHint := True; // create new hint window
end;

initialization
  OldHintClass := SetNewHintClass(TddgHintWindow);

finalization
  SetNewHintClass(OldHintClass);

end.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования