Полезняшки. Ограничение ввода пользователя в UTF8

У контролов типа TEdit, TMemo и других наследников от TCustomEdit есть свойство – MaxLength. Свойство ограничивает ввод пользователя до указанного количества символов. Это свойство особенно полезно при работе с базами данных – как правило, размер текстовых полей имеет ограничение.

Ну например, при работе с Oracle, если попытаться сохранить строку, которая не помещается в поле в БД, получим ошибку вида:

ORA-12899: value too large for column "OWNER"."TABLE"."COLUMN" (actual: 20, maximum: 15)

Чтобы этого избежать, достаточно у полей ввода выставить MaxLength равным размеру поля в БД, и тогда пользователь просто не сможет ввести строку большего размера.

Однако есть такой нюанс: размер поля в БД может задаваться не в символах, а в байтах. При этом, в зависимости от кодировки со стороны БД, размер символа в байтах может занимать N-е число байт.

Давайте посмотрим, что это может означать.

Предположим, что у нас кодировка – UTF16. В этом случае можно предполагать, что размер символа – два байта. Это будет справедливо для латиницы, кириллицы и большого числа спец.символов. В этом случае, определяя MaxLength для контролов, достаточно делить размер поля на два. (Есть конечно понятие – суррогатная пара, но будем считать, что мы не китайцы.)

А теперь, предположим, что у нас кодировка – UTF8. Вот тут для латиницы – один символ = один байт, для кириллицы – один символ = два байта, а есть ещё символы, которые занимают по три байта (например символ “№”). И просто так ограничить размер поля количеством символов нельзя – нужно ограничивать в байтах.

Для решения проблемы необходимо перехватывать пользовательский ввод (а именно сообщения WM_CHAR и WM_PASTE), вычислять размер строки в байтах в нужной нам кодировке и лишние символы отбрасывать. При этом “дёргать” функцию MessageBeep, сигнализируя пользователю, что что-то не так.

И снова я предлагаю не делать свои наследники от стандартных контролов, а изменять поведение прямо в существующих компонентах. Для этого достаточно в RunTime подменить процедуру WindowProc. Но при этом нам надо где-то хранить ссылку на предыдущую процедуру, поэтому я предлагаю такой класс.

type
  TCustomEditLengthLimiter = class(TComponent)
  private type
    TFriendlyCustomEdit = class(TCustomEdit);
  private
    FCustomEdit: TFriendlyCustomEdit;
    FOldWndProc: TWndMethod;
    procedure NewWndProc(var Message: TMessage);
  protected
    class function CustomLength(const Text: string): Integer; virtual; abstract;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    class procedure Install(ACustomEdit: TCustomEdit);
    class procedure Uninstall(ACustomEdit: TCustomEdit);
  end;

 

Класс TCustomEditLengthLimiter содержит новую процедуру NewWndProc и сохраняет ссылку на предыдущую процедуру в FOldWndProc. В конструкторе в качестве Owner’а указывается модифицируемый контрол. Я решил этот класс наследовать именно от TComponent для того, чтобы наша обёртка над оконной процедурой контрола автоматически удалялась при уничтожении контрола.

Реализация класса у меня получилась такой:

constructor TCustomEditLengthLimiter.Create(AOwner: TComponent);
begin
  FCustomEdit := TFriendlyCustomEdit(AOwner as TCustomEdit);
  inherited Create(AOwner);
  FOldWndProc := FCustomEdit.WindowProc;
  FCustomEdit.WindowProc := NewWndProc;
end;

destructor TCustomEditLengthLimiter.Destroy;
begin
  FCustomEdit.WindowProc := FOldWndProc;
  inherited Destroy;
end;

class procedure TCustomEditLengthLimiter.Install(ACustomEdit: TCustomEdit);
begin
  Create(ACustomEdit);
end;

class procedure TCustomEditLengthLimiter.Uninstall(ACustomEdit: TCustomEdit);
var
  I: Integer;
begin
  for I := ACustomEdit.ComponentCount - 1 downto 0 do
    if ACustomEdit.Components[I] is TCustomEditLengthLimiter then
    begin
      ACustomEdit.Components[I].Free;
      Exit;
    end;
end;

procedure TCustomEditLengthLimiter.NewWndProc(var Message: TMessage);
  function AllowInputChar(const Ch: Char): Boolean;
  var
    CheckStr: string;
    CursorPos: Integer;
  begin
    Result := True;
    if (Ch > #0) and (Ch <> #8) then
    begin
      CheckStr := FCustomEdit.Text;
      CursorPos := FCustomEdit.SelStart + 1;
      Delete(CheckStr, CursorPos, FCustomEdit.SelLength);
      Insert(Ch, CheckStr, CursorPos);
      if CustomLength(CheckStr) > FCustomEdit.MaxLength then
      begin
        Result := False;
        Beep;
      end;
    end;
  end;

  procedure DoPasteText(const Text: string);
  var
    CheckStr: string;
    CursorPos: Integer;
    CharsCount: Integer;
  begin
    CheckStr := FCustomEdit.Text;
    CursorPos := FCustomEdit.SelStart + 1;
    Delete(CheckStr, CursorPos, FCustomEdit.SelLength);
    Insert(Text, CheckStr, CursorPos);

    Dec(CursorPos);
    CharsCount := Length(Text);
    while (CharsCount > 0) and (CustomLength(CheckStr) > FCustomEdit.MaxLength) do
    begin
      Delete(CheckStr, CursorPos + CharsCount, 1);
      Dec(CharsCount);
    end;
    FCustomEdit.SelText := Copy(Text, 1, CharsCount);

    if (CharsCount = 0) and (Text <> '') then
      Beep;
  end;

begin
  case Message.Msg of
    WM_CHAR:
      if FCustomEdit.MaxLength > 0 then
        if not AllowInputChar(Char(TWMChar(Message).CharCode)) then
          Exit;
    WM_PASTE:
      if FCustomEdit.MaxLength > 0 then
      begin
        DoPasteText(Clipboard.AsText);
        Exit;
      end;
  end;

  FOldWndProc(Message);
end;

Тут всё достаточно просто. При создании обёртки назначается новая процедура, при удалении – возвращается старая. Самое интересное – в самой процедуре, тут обрабатываются интересующие нас сообщения, в которых:

• формируется строка (которую ожидает увидеть пользователь);
• проверяется размер строки методом CustomLength;
• если размер больше, чем установленный MaxLength, то ограничиваем или отменяем пользовательский ввод.

Обратите внимание на метод CustomLength – он абстрактный. Для ограничения в нужной нам кодировке достаточно создать наследник с реализацией этого метода. Вот так выглядит код для кодировки UTF8:

  TUTF8EditLengthLimiter = class(TCustomEditLengthLimiter)
  protected
    class function CustomLength(const S: string): Integer; override;
  end;

class function TUTF8EditLengthLimiter.CustomLength(const S: string): Integer;
begin
  Result := Length(UTF8Encode(S));
end;

Использовать в коде это можно так:

  TUTF8EditLengthLimiter.Install(Edit1);
  TUTF8EditLengthLimiter.Install(Memo1);

 

А теперь сюрприз. Или задачка. В VCL есть компонент – TCombobox. Если у него установлен стиль csDropDown или csSimple, то комбобокс ведёт себя как обычный Edit. Однако он наследуется от TCustomCombo, а не от TCustomEdit, поэтому предложенную обёртку так просто использовать не получится.

Предложите свой вариант, как можно реализовать класс (или классы), чтобы избежать дублирования кода и можно было использовать один метод для включения обёртки и над TEdit и над TCombobox.

UPD: в следующей заметке предложено решение. Там же можно скачать исходник целиком.