Изменить вид курсора TEdit или другого элемента управления Windows

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

В примере показано как создать два цветных "bitmap'а": "улыбчивый" и "хмурый" и присвоить их курсору edit'а. Для этого нужно перехватить оконную процедуру edit'а. Чтобы сделать это заменим адрес оконной процедуры Edit'а нашим собственным, а старую оконную процедуру будем вызывать по необходимости. Пример показывает "улыбчивый" курсор при наборе текста и "хмурый" при забое клавишей backspace.

unit caret1;

interface

{$IFDEF WIN32}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;
{$ELSE}
uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls;
{$ENDIF}

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    private
      {Private declarations}
    public
      {Public declarations}
      CaretBm: TBitmap;
      CaretBmBk: TBitmap;
      OldEditsWindowProc: Pointer;
end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  {$IFDEF WIN32}
  WParameter = LongInt;
  {$ELSE}
  WParameter = Word;
  {$ENDIF}
  LParameter = LongInt;

{New windows procedure for the edit control}
function NewWindowProc(WindowHandle : hWnd;
TheMessage : WParameter; ParamW : WParameter;
ParamL : LParameter) : LongInt
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
begin
  {Call the old edit controls windows procedure}
  NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc,
  WindowHandle, TheMessage, ParamW, ParamL);
  if TheMessage = WM_SETFOCUS then
  begin
    CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
    ShowCaret(WindowHandle);
  end;
  if TheMessage = WM_KILLFOCUS then
  begin
    HideCaret(WindowHandle);
    DestroyCaret;
  end;
  if TheMessage = WM_KEYDOWN then
  begin
    if ParamW = VK_BACK then
      CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0)
    else
      CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
    ShowCaret(WindowHandle);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {Create a smiling bitmap using the wingdings font}
  CaretBm := TBitmap.Create;
  CaretBm.Canvas.Font.name := 'WingDings';
  CaretBm.Canvas.Font.Height := Edit1.Font.Height;
  CaretBm.Canvas.Font.Color := clWhite;
  CaretBm.Width := CaretBm.Canvas.TextWidth('J') + 2;
  CaretBm.Height := CaretBm.Canvas.TextHeight('J') + 2;
  CaretBm.Canvas.Brush.Color := clBlue;
  CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width,
  CaretBm.Height));
  CaretBm.Canvas.TextOut(1, 1, 'J');
  {Create a frowming bitmap using the wingdings font}
  CaretBmBk := TBitmap.Create;
  CaretBmBk.Canvas.Font.name := 'WingDings';
  CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;
  CaretBmBk.Canvas.Font.Color := clWhite;
  CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('L') + 2;
  CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('L') + 2;
  CaretBmBk.Canvas.Brush.Color := clBlue;
  CaretBmBk.Canvas.FillRect(Rect(0,0, CaretBmBk.Width,
  CaretBmBk.Height));
  CaretBmBk.Canvas.TextOut(1, 1, 'L');
  {Hook the edit controls window procedure}
  OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle,
  GWL_WNDPROC, LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  {Unhook the edit controls window procedure and clean up}
  SetWindowLong(Edit1.Handle,GWL_WNDPROC,
  LongInt(OldEditsWindowProc));
  CaretBm.Free;
  CaretBmBk.Free;
end;

end.

Программа на Delphi, демонстрирующая изменение курсора для контрола редактирования в Windows. Программа создает два битмап-изображения, одно для курсора "улыбка" и другое для курсора "грусть", используя шрифт Wingdings. Затем она заменяет оригинальную процедуру окна контрола на новую пользовательскую процедуру, которая устанавливает изображение курсора в зависимости от ввода пользователя.

Обзор кода:

1. Определен класс TForm1, который наследуется от TForm. Он имеет два приватных переменных CaretBm и CaretBmBk, которые используются для хранения битмап-изображений для курсоров.
2. В процедуре FormCreate программа создает битмап-изображения, используя шрифт Wingdings, и настраивает их свойства соответственно.
3. Определена функция NewWindowProc, которая является пользовательской процедурой окна, заменяющей оригинальную для контрола редактирования. Она проверяет конкретные сообщения окон (WM_SETFOCUS, WM_KILLFOCUS и WM_KEYDOWN) и устанавливает изображение курсора в зависимости от ввода пользователя.
4. В процедуре FormCreate программа привязывает процедуру окна контрола к новой пользовательской процедуре, используя функцию SetWindowLong.
5. В процедуре FormDestroy программа разъединяет процедуру окна контрола и освобождает память, выделенную для битмап-изображений.

Результатом программы является изменение курсора контрола редактирования на изображение "улыбка" при фокусировке на него или вводе символов, а на изображение "грусть" при нажатии клавиши "Backspace". Это достигается путем переопределения оригинальной процедуры окна контрола редактирования на новую пользовательскую процедуру, которая устанавливает изображение курсора в зависимости от ввода пользователя.

Альтернативное решение с использованием встроенной поддержки Delphi для курсоров:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Cursor := crCustom;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Edit1.Cursor := crDefault;
end;

procedure TForm1.Edit1MouseMove(var Message: TMessage);
begin
  if (Message.DragMode = dmText) then
    Edit1.Cursor := crSmile
  else
    Edit1.Cursor := crArrow;
end;

В этом альтернативном решении программа устанавливает курсор контрола редактирования на изображение "улыбка" с помощью свойства Cursor. Процедура FormCreate устанавливает начальную курсор на изображение "улыбка", когда форма создается, а процедура FormDestroy сбрасывает ее в стандартный стрелочный курсор, когда форма уничтожается.

Процедура Edit1MouseMove используется для изменения курсора в зависимости от ввода пользователя. Она проверяет, является ли режим перетаскивания текстом (т.е., пользователь вводит символы), и устанавливает курсор на изображение "улыбка" соответственно. В противном случае она сбрасывает курсор в стандартный стрелочный курсор.

Изменение вид курсора TEdit или другого элемента управления Windows с помощью перехвата оконной процедуры и создания битмапов различных изображений.

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

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

:: Главная :: TEdit ::