TEdit автозавершение

@berkut_174 · Регистрация: 17.01.2013

Author24 — интернет-сервис помощи студентам

Вот тут есть пример http://delphidabbler.com/tips/111

Delphi

procedure TForm1.EditKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  s1: string;
  s2: string;
begin
  if TEdit(Sender).Text = '' then
    exit;
  s1 := TEdit(Sender).Text;
  s2 := s1;
  with mtDM.LookTable do  {change here for your own lookup stuff...}
  begin
    if not Locate(LookField, TEdit(Sender).Text,[loPartialKey]) then
    begin
      Key := 0;
      if length(s2) = 1 then
      begin
        TEdit(Sender).Text := '';
        exit;
      end;
      System.delete(s2,length(s2),1);
      TEdit(Sender).Text := s2;
      s1 := s2;
      Locate(LookField, TEdit(Sender).Text,[loPartialKey]);
    end;
    s1 := FieldByName(LookField).AsString;
    TEdit(Sender).Text := Copy(
      s1, 1, length(s2)) + copy(s1, length(s2) + 1, length(s1)
     );
    TEdit(Sender).SelStart := Length(s2);
    TEdit(Sender).SelLength := length(s1) - length(s2);
  end;
  inherited;
end;

Но он некорректно работает.
Не могу исправить, чтоб работало.
Помогите, пожалуйста.

Добавлено через 2 часа 21 минуту
Некорректно работает с кириллицей, с энглиш вроде норм.

Добавлено через 26 минут
О, вычитал в сети и переделал так, работает:

Delphi

uses
  LazUTF8;
 
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  s1: string;
  s2: string;
begin
  if TEdit(Sender).Text = '' then
    exit;
  s1 := TEdit(Sender).Text;
  s2 := s1;
  with SQLQuery1 do
  begin
    if not Locate('fio', TEdit(Sender).Text,[loPartialKey]) then
    begin
      Key := 0;
      if UTF8length(s2) = 1 then
      begin
        TEdit(Sender).Text := '';
        exit;
      end;
      System.delete(s2,UTF8length(s2),1);
      TEdit(Sender).Text := s2;
      s1 := s2;
      Locate('fio', TEdit(Sender).Text,[loPartialKey]);
    end;
    s1 := FieldByName('fio').AsString;
    TEdit(Sender).Text := UTF8Copy(
      s1, 1, UTF8length(s2)) + UTF8copy(s1, UTF8length(s2) + 1, UTF8length(s1)
     );
    TEdit(Sender).SelStart := UTF8Length(s2);
    TEdit(Sender).SelLength := UTF8length(s1) - UTF8length(s2);
  end;
  inherited;
end;

Но странности с backspace есть и выделением всей строки (Ctrl+A,Shift+Home/End...)

@volvo · 03.02.2015, 20:17

berkut_174, как-то вот так:

Pascal

procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
const
  fld = 'fio'; // это для упрощения тестирования, у меня поле по-другому называется
var
  s1: string;
  s2: string;
  RLen, LLen : Integer;
begin
  with Sender as TEdit do
  if (Text = '') or ([ssShift, ssCtrl] * Shift <> []) or (key in [8, 16, 17]) then
  // ничего не делаем ...
  else
  begin
    s1 := Text;
    s2 := s1;
    with SQLQuery1 do
    begin
      if not Locate(fld, Text, [loPartialKey]) then
      begin
        Key := 0;
        if UTF8length(s2) = 1 then
        begin
          Text := '';
          exit;
        end;
        UTF8Delete(s2, UTF8length(s2), 1);
        Text := s2;
        s1 := s2;
        Locate(fld, Text, [loPartialKey]);
      end;
      s1 := FieldByName(fld).AsString;
      LLen := UTF8Length(s2); RLen := UTF8length(s1) - UTF8length(s2);
      Text := Utf8LeftStr(s1, LLen) + Utf8RightStr(s1, RLen);
      SelStart := LLen;
      SelLength := RLen;
    end;
  end;
  inherited;
end;

@berkut_174 · 03.02.2015, 20:41 **[ТС]**

Сообщение от volvo

как-то вот так:

Вот на эти строчки ругается:

Delphi

1 2	UTF8Delete(s2, UTF8length(s2), 1); Text := Utf8LeftStr(s1, LLen) + Utf8RightStr(s1, RLen);

unit1.pas(163,22) Error: Call by var for arg no. 1 has to match exactly: Got "ShortString" expected "AnsiString"
unit1.pas(170,26) Error: Identifier not found "Utf8LeftStr"

Я вот так сделал, но теперь твою строку добавил ещё:

Delphi

procedure TfMain.Edit1TypeKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState); 
const
  LookField = 'fio';
var
  s1, s2: string;
begin
  with TEdit(Sender) do
  if (Text = '') OR ([ssShift, ssCtrl] * Shift <> []) OR (Key in [8, 16, 17]) then
    Exit;
  s1 := TEdit(Sender).Text;
  s2 := s1;
  with SQLQuery1 do
  begin
    if not Locate(LookField, TEdit(Sender).Text,[loPartialKey]) then
    begin
      TEdit(Sender).Text := s1;
      Exit;
    end;
    s1 := FieldByName(LookField).AsString;
    TEdit(Sender).Text := UTF8Copy(s1, 1, UTF8length(s2)) + UTF8copy(s1, UTF8length(s2) + 1, UTF8length(s1));
    TEdit(Sender).SelStart := UTF8Length(s2);
    TEdit(Sender).SelLength := UTF8length(s1) - UTF8length(s2);
    {if Key = 8 then    <-- вот тут обработка backspace
    begin
      TEdit(Sender).SelStart := UTF8Length(s2) - 1;
      TEdit(Sender).SelLength := UTF8length(s1) - UTF8length(s2) + 1;
    end;}
  end;
  inherited;

У меня вот не получается создать на главной форме эту процедуру и вызывать её потом так:

Delphi

1	fMain.NameProcedure(FieldName);

Просто у меня много где нужно, чтоб по сто раз не писать в обработчик событий...

@volvo · 03.02.2015, 21:04

berkut_174, и Utf8LeftStr и Utf8RightStr описаны ровно там же, в LazUTF8. Это во-первых. Во-вторых: я не предлагал ставить Exit, не надо этого мне приписывать. С ним код работать откажется тут же (по крайней мере, у меня - отказался). Именно if/then/else, иначе непонятно каким образом еще раз осуществляется заход в обработчик OnKeyUp, и все рушится. Кроме всего прочего - у тебя не вызывается inherited в случае, когда условие истинно. А у меня вызывается.

Сообщение от berkut_174

не получается создать на главной форме эту процедуру

Какую "эту"? И почему это надо делать отдельной процедурой? Обязательно себе жизнь усложнить? Лучшее, что можно сделать - это:

Pascal

procedure TForm1.NameProcedure(var Edit: TEdit; fld: string);
var
  s1, s2 : string;
  RLen, LLen : Integer;
begin
  with Edit do
  begin
    s1 := Text;
    s2 := s1;
    with SQLQuery1 do
    begin
      if not Locate(fld, Text, [loPartialKey]) then
      begin
        if UTF8length(s2) = 1 then
        begin
          Text := '';
          exit;
        end;
        UTF8Delete(s2, UTF8length(s2), 1);
        Text := s2;
        s1 := s2;
        Locate(fld, Text, [loPartialKey]);
      end;
      s1 := FieldByName(fld).AsString;
      LLen := UTF8Length(s2); RLen := UTF8length(s1) - UTF8length(s2);
      Text := Utf8LeftStr(s1, LLen) + Utf8RightStr(s1, RLen);
      SelStart := LLen;
      SelLength := RLen;
    end;
  end;
 
// и вызывать:
procedure TForm1.Edit4KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var ed : TEdit;
begin
  with Sender as TEdit do
  if (Text = '') or ([ssShift, ssCtrl] * Shift <> []) or (key in [8, 16, 17]) then
  // ничего не делаем ...
  else
  begin
    ed := Sender as TEdit;
    NameProcedure(ed, 'fio');
  end;
  inherited;
end;

Передавать ссылку на Edit-таки придется, очень много завязано на этот компонент внутри...

@berkut_174 · 03.02.2015, 21:21 **[ТС]**

Сообщение от volvo

С ним код работать откажется тут же (по крайней мере, у меня - отказался).

У меня работает: и с else работает, и без него, и с Exit.

Про Utf8LeftStr и Utf8RightStr -- странно, не хочет компилировать, курсор перемещается после s2:

Delphi

1	UTF8Delete(s2{сюда}, UTF8length(s2), 1);

И ошибка на 163 строке.

Про остальное понял, спасибо!

Блоги программистов
Обновление сайта www.historian.by Reglage 05.01.2025 Обещал подвести итоги 2024 года для сайта. Однако начну с того, что изменилось за неделю. Добавил краткий урок по последовательности действий при анализе вредоносных файлов и значительно улучшил урок. . .	Как использовать GraphQL в C# с HotChocolate Programming 05.01.2025 GraphQL — это современный подход к разработке API, который позволяет клиентам запрашивать только те данные, которые им необходимы. Это делает взаимодействие с API более гибким и эффективным по. . .	Модель полного двоичного суматора с помощью логических операций (python) AlexSky-coder 04.01.2025 def binSum(x:list, y:list): s=^y] p=x and y for i in range(1,len(x)): s. append((x^y)^p) p=(x and y)or(p and (x or y)) return s x=list() y=list()	Это мы не проходили, это нам не задавали...(асихронный счётчик с управляющим сигналом задержки). Hrethgir 04.01.2025 Асинхронный счётчик на сумматорах (шестиразрядный по числу диодов на плате, но наверное разрядов будет больше - восемь или шестнадцать, а диоды на старшие), так как триггеры прошли тестирование и. . .	Руководство по созданию бота для Телеграм на Python IT_Exp 04.01.2025 Боты для Телеграм представляют собой автоматизированные программы, которые выполняют различные задачи, взаимодействуя с пользователями через интерфейс мессенджера. В данной статье мы рассмотрим,. . .	Применение компонентов PrimeVue в Vue.js 3 на TypeScript BasicMan 04.01.2025 Введение в PrimeVue и настройка окружения PrimeVue представляет собой мощную библиотеку компонентов пользовательского интерфейса для Vue. js 3, которая предоставляет разработчикам богатый набор. . .
Как стать Senior developer cpp_developer 04.01.2025 В современной индустрии разработки программного обеспечения позиция Senior Developer представляет собой не просто следующую ступень карьерной лестницы, а качественно новый уровень профессионального. . .	Что известно о дате выхода Windows 12 и чего от нее ждать IT_Exp 04.01.2025 В мире технологий постоянно происходят изменения, и операционные системы не являются исключением. Windows 11, выпущенная в октябре 2021 года, принесла множество инноваций и улучшений, но. . .	Что новенького в .NET Core 9 Programming 04.01.2025 Обзор ключевых изменений в . NET Core 9 Платформа . NET Core продолжает активно развиваться, и версия 9 представляет собой значительный шаг вперед в эволюции этой технологии. Новый релиз. . .	Инструкция по установке python3.13.1 в Debian 12 AlexSky-coder 03.01.2025 sudo apt update sudo apt install build-essential zlib1g-dev libncurses5-dev libgdbm-dev libnss3-dev libssl-dev libreadline-dev libffi-dev wget. . .	Затестил триггеры. архив проекта прилагаю с GOA файлами в настройках архиватора проектов. Hrethgir 03.01.2025 В этот раз нет закольцованности, потому что от неё только глюки, как я понял, логика не вырезанная. Триггеры очень быстрые если верить измерениям с помощью анализатора от Gowin. Есть ещё регистры,. . .	Python в помощь DevOps IT_Exp 03.01.2025 Причины использования Python в работе DevOps Python стал неотъемлемой частью мира DevOps, и это не случайно. Этот язык программирования обладает множеством преимуществ, которые делают его. . .

	03.02.2015, 21:21