Автоматическое создание гиперссылок для email-адресов в TRichEdit в Delphi

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

В статье рассматривается вопрос автоматического создания гиперссылок для email-адресов в компоненте TRichEdit, используемом в среде разработки Delphi. Это полезная функция, которая позволяет быстро переходить по ссылкам на электронную почту, кликнув по адресу в тексте.

Контекст задачи

Компонент TRichEdit в Delphi имеет свойство EnableURLs, которое автоматически преобразует интернет-адреса в гиперссылки. Однако для email-адресов такая функция не работает по умолчанию. Пользователь пытался реализовать подобную функциональность для email-адресов, но его решение работает только визуально.

Решение пользователя

В коде, предоставленном пользователем, используется регулярное выражение для поиска email-адресов и их форматирования. Однако это решение не делает email-адреса кликабельными.

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

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

1. Присвоить каждому email-адресу в тексте префикс mailto:, который делает его кликабельным.
2. Обновить форматирование текста таким образом, чтобы email-адреса отображались как гиперссылки.

Пример кода на Object Pascal, который реализует данное решение:

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Настройка таймера для проверки emails
  TimerEmailCheck.Enabled := False;
  TimerEmailCheck.Interval := 500; // Интервал в 500 мс, можно настроить
end;

function InsertMailtoForEmails(const AText: string): string;
var
  LRegex: TRegEx;
  LMatches: TMatchCollection;
  LOutput: TStringBuilder;
  LCurrentPos: Integer;
  LMatch: TMatch;
begin
  // Регулярное выражение для поиска email
  LRegex := TRegEx.Create('(?:[a-z0-9!#$%''*+/=?^_`{|}~-]+(?:.[a-z0-9!#$%''*+/=?^_`{|}~-]+)*|"(?:[x01-x08x0bx0cx0e-x1fx21x5bx5dx7f]|\[x01-x09x0bx0cx0e-x7f])*")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9]{1,2}).){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9]{1,2})|(?:[a-z0-9-]*[a-z0-9]:(?:[x01-x08x0bx0cx0e-x1fx21-x5ax53-x7f]|\[x01-x09x0bx0cx0e-x7f])+)(?:s*)', [roIgnoreCase, roMultiLine]);
  LMatches := LRegex.Matches(AText);
  // Проверка, есть ли совпадения с email
  if LMatches.Count = 0 then
    Exit(AText);

  LOutput := TStringBuilder.Create;
  try
    LCurrentPos := 1;

    for LMatch in LMatches do
    begin
      // Добавляем текст до текущего совпадения
      LOutput.Append(Copy(AText, LCurrentPos, LMatch.Index - LCurrentPos));

      // Проверяем, нужно ли добавить 'mailto:'
      if not LMatch.Value.StartsWith('mailto:', True) then
      begin
        // Добавляем 'mailto:' перед email
        LOutput.Append('mailto:' + LMatch.Value);
      end
      else
      begin
        // Email уже имеет префикс 'mailto:' или предшествует ему
        LOutput.Append(LMatch.Value);
      end;

      LCurrentPos := LMatch.Index + LMatch.Length;
    end;

    // Добавляем оставшийся текст
    LOutput.Append(Copy(AText, LCurrentPos, Length(AText) - LCurrentPos + 1));
    Result := LOutput.ToString;
  finally
    LOutput.Free;
  end;
end;

procedure TForm1.TimerEmailCheckTimer(Sender: TObject);
var
  LNewText: string;
begin
  TimerEmailCheck.Enabled := False;
  LNewText := InsertMailtoForEmails(RichEdit1.Text);
  // Если текст изменился, обновляем форматирование
  if not LNewText.Equals(RichEdit1.Text) then
  begin
    RichEdit1.OnChange := nil;
    try
      RichEdit1.Text := LNewText;
      // Обновляем масштаб, чтобы исправить ошибку, связанную с изменением размера шрифта
      RichEdit1.Zoom := RichEdit1.Zoom + 1;
      RichEdit1.Zoom := RichEdit1.Zoom - 1;
      // Применяем формат гиперссылки для найденных email
      RichEdit1.SelAttributes.Color := clBlue;
      RichEdit1.SelAttributes.Style := [fsUnderline];
      RichEdit1.SelAttributes.Link := True;
      RichEdit1.SetSel(0, Length(LNewText), False);
      RichEdit1.SetSelAttributes;
    finally
      RichEdit1.OnChange := RichEdit1Change;
    end;
  end;
end;

procedure TForm1.RichEdit1Change(Sender: TObject);
begin
  // Перезапускаем таймер при каждом изменении текста
  TimerEmailCheck.Enabled := False;
  TimerEmailCheck.Enabled := True;
end;

Заключение

В данной статье было рассмотрено решение для автоматического создания гиперссылок для email-адресов в TRichEdit. Представленный код можно использовать в проектах на Delphi для реализации данной функциональности.

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

Контекст задачи описывает процесс автоматического преобразования email-адресов в кликабельные гиперссылки внутри компонента TRichEdit в Delphi, используя регулярные выражения и программирование на Object Pascal.

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

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

:: Главная :: TMemo и TRichEdit ::