Как обработать события OnMouseDown и OnMouseUp для правой кнопки TButtonedEdit в Delphi?

Delphi , Компоненты и Классы , Кнопки

Обработка событий OnMouseDown и OnMouseUp для правой кнопки TButtonedEdit в Delphi

Проблема и возможные решения

Вопрос от пользователя davornik касается обработки событий нажатия (OnMouseDown) и отпускания (OnMouseUp) правой кнопки компонента TButtonedEdit в Delphi. Стандартный компонент предоставляет только событие OnClick для кнопки, что недостаточно для реализации функциональности "показать/скрыть пароль" при нажатии и отпускании кнопки.

Анализ проблемы

Как правильно отметил Uwe Raabe, кнопки в TButtonedEdit не являются отдельными контролами, а представлены приватным классом TGlyph, производным от TCustomControl. Это означает, что у них нет собственного дескриптора окна (Handle), что усложняет их подклассирование стандартными методами.

Решение через подклассирование

Первое предложенное решение использует поиск дескриптора TGlyph и замену его оконной процедуры:

var
  OldGlyphWndProc: Pointer = nil;

function CustomGlyphWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if Msg = WM_LBUTTONUP then
    Form1.ButtonedEdit1.PasswordChar := '*'
  else if Msg = WM_LBUTTONDOWN then
    Form1.ButtonedEdit1.PasswordChar := #0;
  Result := CallWindowProc(OldGlyphWndProc, hWnd, Msg, wParam, lParam);
end;

procedure SubclassRightButtonGlyph(Edit: TButtonedEdit);
var
  GlyphHandle: HWND;
  ClassName: array[0..255] of Char;
begin
  GlyphHandle := GetWindow(Edit.Handle, GW_CHILD);
  while GlyphHandle <> 0 do begin
    if GetClassName(GlyphHandle, ClassName, Length(ClassName)) > 0 then
      if ClassName = 'TEditButton.TGlyph' then
      begin
        OldGlyphWndProc := Pointer(GetWindowLongPtr(GlyphHandle, GWL_WNDPROC));
        SetWindowLongPtr(GlyphHandle, GWL_WNDPROC, LONG_PTR(@CustomGlyphWndProc));
        Break;
      end;
    GlyphHandle := GetWindow(GlyphHandle, GW_HWNDNEXT);
  end;
end;

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

Однако это решение имеет ограничение - событие WM_LBUTTONUP не всегда срабатывает корректно.

Альтернативное решение с MessageHandler

Uwe Raabe предложил более элегантное решение с использованием хелпера класса и обработчика сообщений:

type
  TEditButtonHelper = class helper for TEditButton
  public
    procedure LinkMessageHandler;
  end;

  TGlyphMessageHandler = class(TWinControlMessageHandler)
  protected
    function HandleMessage(var Message: TMessage): Boolean; override;
  end;

function TGlyphMessageHandler.HandleMessage(var Message: TMessage): Boolean;
begin
  var edt := TButtonedEdit(Control.Parent);
  case Message.Msg of
    WM_LBUTTONDOWN: edt.PasswordChar := #0;
    WM_LBUTTONUP: edt.PasswordChar := '*';
  end;
  Result := inherited;
end;

procedure TEditButtonHelper.LinkMessageHandler;
begin
  Glyph.InitMessageHandler(TGlyphMessageHandler);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ButtonedEdit1.RightButton.LinkMessageHandler;
end;

Это решение работает более стабильно, так как использует официальный механизм обработки сообщений в VCL.

Создание собственного компонента

Для более чистого решения можно создать собственный компонент, наследующий TButtonedEdit:

type
  TPasswordButtonedEdit = class(TButtonedEdit)
  private
    FPasswordVisible: Boolean;
    procedure UpdatePasswordChar;
    procedure RightButtonMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RightButtonMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  protected
    procedure DoRightButtonClick; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

constructor TPasswordButtonedEdit.Create(AOwner: TComponent);
begin
  inherited;
  PasswordChar := '*';
  RightButton.Visible := True;
  RightButton.OnMouseDown := RightButtonMouseDown;
  RightButton.OnMouseUp := RightButtonMouseUp;
end;

procedure TPasswordButtonedEdit.RightButtonMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FPasswordVisible := True;
  UpdatePasswordChar;
end;

procedure TPasswordButtonedEdit.RightButtonMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FPasswordVisible := False;
  UpdatePasswordChar;
end;

procedure TPasswordButtonedEdit.UpdatePasswordChar;
begin
  if FPasswordVisible then
    PasswordChar := #0
  else
    PasswordChar := '*';
end;

procedure TPasswordButtonedEdit.DoRightButtonClick;
begin
  // Переопределяем стандартное поведение клика
  inherited;
end;

Это решение наиболее чистое с точки зрения ООП и может быть легко расширено для добавления дополнительной функциональности.

Заключение

Для обработки событий OnMouseDown и OnMouseUp правой кнопки TButtonedEdit можно использовать:

1. Подклассирование через оконные сообщения (менее надежное)
2. Обработчик сообщений через класс-хелпер (более стабильное)
3. Создание собственного компонента (наиболее правильное с точки зрения архитектуры)

Выбор конкретного метода зависит от требований проекта и предпочтений разработчика. Для простых задач достаточно решения с MessageHandler, для более сложных сценариев лучше создать собственный компонент.

Создано по материалам из источника по ссылке.

Статья описывает методы обработки событий нажатия и отпускания правой кнопки компонента TButtonedEdit в Delphi, включая подклассирование, использование обработчика сообщений и создание собственного компонента.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Кнопки ::