вторник, 12 января 2021 г.

Создаем системный хинт

Начиная с Delphi 2009 у компонента TEdit появилось замечательное булевое свойство "NumbersOnly". Его роль понятна из названия - ограничения вводимых символов (только цифры). При попытке ввести иной символ всплывает системный хинт:


Данный хинт является системным, т.е. генерируется самой ОС Windows. Если мы хотим повесить такой хинт на определенные события, придётся создавать его "вручную". Т.е. с помощью API-функций для работы с окнами.

Создадим три процедуры: для создания хинта, для его показа и для сокрытия/удаления:

const
  TOOLTIPS_CLASS    = 'tooltips_class32';

  TTS_ALWAYSTIP     = $01;
  TTS_NOPREFIX      = $02;
  TTS_BALLOON       = $40;

  TTF_SUBCLASS      = $0010;
  TTF_TRACK         = $0020;
  TTF_TRANSPARENT   = $0100;
  TTF_CENTERTIP     = $0002;

  TTM_ACTIVATE      = WM_USER + 1;
  TTM_ADDTOOL       = WM_USER + 50;
  TTM_TRACKACTIVATE = WM_USER + 17;
  TTM_TRACKPOSITION = WM_USER + 18;
  TTM_SETTITLE      = WM_USER + 32;

var
  ToolTipHandle: Cardinal;
  ToolInfo: TToolInfo;

procedure CreateToolTips();
var
  vRect: TRect;

begin
  ToolTipHandle := CreateWindowEx(WS_EX_TOPMOST,
                                  TOOLTIPS_CLASS,
                                  nil,
                                  WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
                                  Integer(CW_USEDEFAULT),
                                  Integer(CW_USEDEFAULT),
                                  Integer(CW_USEDEFAULT),
                                  Integer(CW_USEDEFAULT),
                                  Application.Handle,
                                  0,
                                  Application.Handle,
                                  nil);

  GetWindowRect(Application.Handle, &vRect);
end;

procedure AddToolTip(Sender: TObject; IconType: Integer; Title: AnsiString; Text: PWideChar);
var
  vControl: TWinControl;
  vCaretPos: TPoint;
  X, Y: Integer;

begin
  vControl := Sender as TWinControl;

  if ToolTipHandle = 0 then
    exit();

  SetWindowPos(ToolTipHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);

  ToolInfo.cbSize := SizeOf(TToolInfo);
  ToolInfo.uFlags := {TTF_CENTERTIP or} TTF_TRACK or TTF_TRANSPARENT or TTF_SUBCLASS;
  ToolInfo.hwnd   := vControl.Handle;
  ToolInfo.hInst  := Application.Handle;

  GetClientRect(ToolInfo.hwnd, ToolInfo.Rect);
  ToolInfo.lpszText := Text;

  GetCaretPos(vCaretPos);
  X := vControl.ClientOrigin.X + vCaretPos.X;
  Y := vControl.ClientOrigin.Y + vControl.ClientHeight - vCaretPos.Y;

  SendMessage(ToolTipHandle, TTM_ADDTOOL,       WPARAM(1), LPARAM(@ToolInfo));
  SendMessage(ToolTipHandle, TTM_SETTITLE,      IconType,  LPARAM(PWideChar(Title)));
  SendMessage(ToolTipHandle, TTM_TRACKPOSITION, WPARAM(0), LPARAM(MakeLong(X, Y)));
  SendMessage(ToolTipHandle, TTM_TRACKACTIVATE, WPARAM(1), LPARAM(@ToolInfo));
end;

procedure HideToolTip();
begin
  SendMessage(ToolTipHandle, TTM_TRACKACTIVATE, WPARAM(0), LPARAM(@ToolInfo));
  SendMessage(ToolTipHandle, TTM_DELTOOL,       WPARAM(0), LPARAM(@ToolInfo));
end;

При создании формы создаем наш хинт, показывать его будем в событии OnKeyPress у TEdit'а, ну а закрывать по таймеру

procedure TForm1.edtLogKeyPress(Sender: TObject; var Key: Char);
begin
  if not charinset(Key,['0'..'9', ',', #8]) then
  begin
    MessageBeep(MB_ICONWARNING);
    AddToolTip(Sender, 3, 'Недопустимый символ', 'Разрешены только цифры и запятая');
    Timer.Enabled := True;
    Key := #0;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  CreateToolTips();
end;

procedure TForm1.TimerTimer(Sender: TObject);
begin
  HideToolTip();
  Timer.Enabled := False;
end;
Получаемый результат:

Комментариев нет:

Отправить комментарий