Создание и Обработка Гиперссылок в TRichEdit без HTTP и www

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

Вопрос пользователя заключается в необходимости создания гиперссылок в компоненте TRichEdit, которые начинаются не с www или http, а с произвольного текста, например, как в примере <a href="http://www.SomeSite.com/download">Download</a>. Стандартные решения, основанные на автоматическом обнаружении URL, не подходят для такой задачи.

Подход к Решению

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

1. Настройка обработчика событий для компонента TRichEdit, чтобы он отправлял сообщение EM_SETEVENTMASK с установкой флага ENM_LINK. Это нужно сделать один раз после создания TRichEdit и повторять при получении сообщения CM_RECREATEWND.

2. Выделение текста для преобразования в гиперссылку. Можно использовать свойства SelStart и SelLength компонента или отправить сообщение EM_SETSEL или EM_EXSETSEL. Затем необходимо отправить сообщение EM_SETCHARFORMAT с структурой CHARFORMAT2, включающей эффект CFE_LINK для выделенного текста.

3. Субклассирование обработчика сообщений WindowProc для обработки сообщений CN_NOTIFY(EN_LINK) и CM_RECREATEWND. При получении сообщения EN_LINK можно использовать функцию ShellExecute для открытия указанного URL.

Пример Кода

Для демонстрации можно использовать следующий пример кода на Object Pascal (Delphi):

unit Unit1;
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Winapi.RichEdit, Winapi.ShellAPI;
type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    PrevRichEditWndProc: TWndMethod;
    procedure InsertHyperLink(const HyperlinkText: string; const HyperlinkURL: string = '');
    procedure SetRichEditMasks;
    procedure RichEditWndProc(var Message: TMessage);
  public
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
uses
  System.StrUtils;
procedure TForm1.FormCreate(Sender: TObject);
begin
  PrevRichEditWndProc := RichEdit1.WindowProc;
  RichEdit1.WindowProc := RichEditWndProc;
  SetRichEditMasks;
  RichEdit1.Text := 'Would you like to Download Now?';
  RichEdit1.SelStart := 18;
  RichEdit1.SelLength := 12;
  InsertHyperLink('Download Now', 'http://www.SomeSite.com/download');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
  InsertHyperLink('Another Link', 'http://www.anotherlink.com/');
end;
procedure TForm1.InsertHyperLink(const HyperlinkText: string; const HyperlinkURL: string = '');
var
  HyperlinkPrefix, FullHyperlink: string;
  Fmt: CHARFORMAT2;
  StartPos: Integer;
begin
  if HyperlinkURL <> '' then
  begin
    HyperlinkPrefix := Format('HYPERLINK "%s"', [HyperlinkURL]);
    FullHyperlink := HyperlinkPrefix + HyperlinkText;
  end else
    FullHyperlink := HyperlinkText;
  StartPos := RichEdit1.SelStart;
  RichEdit1.SelText := FullHyperlink;
  RichEdit1.SelStart := StartPos;
  RichEdit1.SelLength := Length(FullHyperlink);
  FillChar(Fmt, SizeOf(Fmt), 0);
  Fmt.cbSize := SizeOf(Fmt);
  Fmt.dwMask := CFM_LINK;
  Fmt.dwEffects := CFE_LINK;
  SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));
  if HyperlinkURL <> '' then
  begin
    RichEdit1.SelStart := StartPos;
    RichEdit1.SelLength := Length(HyperlinkPrefix);
    FillChar(Fmt, SizeOf(Fmt), 0);
    Fmt.cbSize := SizeOf(Fmt);
    Fmt.dwMask := CFM_HIDDEN;
    Fmt.dwEffects := CFE_HIDDEN;
    SendMessage(RichEdit1.Handle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@Fmt));
  end;
  RichEdit1.SelStart := StartPos + Length(FullHyperlink);
  RichEdit1.SelLength := 0;
end;
// ... (продолжение кода для обработчика сообщений)

Важные Моменты

• При работе с TRichEdit в контексте TDBRichEdit может потребоваться повторное создание гиперссылок после переключения на другую запись.
• Важно использовать свойство SelText для вставки гиперссылок в существующий текст, чтобы сохранить форматирование.

Этот пример демонстрирует, как создать гиперссылку с произвольным текстом в TRichEdit и обработать клик по такой ссылке.

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

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

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

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

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