URL в RichEdit

[Shouldercannon]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, MMSystem, ShellApi, RichEdit, ExtCtrls,
sSkinProvider, sSkinManager, sButton;

type
TForm1 = class(TForm)
Logo: TImage;
RichEdit1: TRichEdit;
sSkinProvider1: TsSkinProvider;
sBOK: TsButton;
procedure FormCreate(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
protected
procedure WndProc(var Message: TMessage); override;
end;

var
Form1: TForm1;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm1.WndProc(var Message: TMessage);
var
p: TENLink;
strURL: string;
begin
if (Message.Msg = WM_NOTIFY) then
begin
if (PNMHDR(Message.lParam).code = EN_LINK) then
begin
p:=TENLink(Pointer(TWMNotify(Messag e).NMHdr)^);
if (p.Msg = WM_LBUTTONDOWN) then
begin
SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
strURL:=RichEdit1.SelText;
ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL);
end
end
end;

inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
mask: Word;
begin
mask:=SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
RichEdit1.Text:='http://www.programmersforum.ru';
end;

end.

Такой код превращает в ссылки записи, которые начинаются с http://. Помогите его модифицировать, чтобы он воспринимал как ссылку запись начинающуюся на dchub://.

[Dj_smart]

Могу только порекомендовать только RichView. Скачать.

[TaTT DoGG]

скорее всего в стандартный процедурах нету dchub://
так что самому придётся лопатить весь текст
если начинается на dchub:// и заканчивается на "пробел", то делаем ссылкой )

[Shouldercannon]

RichView надо покупать. Придётся отслеживать dchub://.

[eoln]

Я уж не знаю есть ли dchub://www, но если да, то можно и с RichEdit'ом поизвращаться

procedure TForm1.WndProc(var Message: TMessage);
var
  p: TENLink;
  strURL: string;
begin  
  if (Message.Msg = WM_NOTIFY) then
  if (PNMHDR(Message.lParam).code = EN_LINK) then
  begin
    p:=TENLink(Pointer(TWMNotify(Message).NMHdr)^);
    if (p.Msg = WM_LBUTTONDOWN) then
    begin
      SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
      strURL:=RichEdit1.SelText;
      if copy(richedit1.text, RichEdit1.SelStart - 8, 8)='dchub://'
      then strURL:='dchub://'+strURL;
      showmessage('Открывание '+strURL);
      ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL)
    end
  end;
  inherited
end;

procedure TForm1.FormCreate(Sender: TObject);
var 
  mask: Word;
begin  
  mask:=SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
  SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
  SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
  RichEdit1.Text:='dchub:// www.site.ru' + #13+#10+
  'http://www.programmersforum.ru привет';
end;

"dchub:// " - после "//" пробел можно окрасить в синий и подчеркнуть (SelStart, SelLength, SelAttribute) для красоты
Если программа FlyLincDC (или подобная) установлена, то открывает.
Да, вот ещё, если кликнуть по пустому месту, открывается последняя ссыска в тексте - отслеживай это.

[Shouldercannon]

Да, вот ещё, если кликнуть по пустому месту, открывается последняя ссыска в тексте - отслеживай это.

Это если курсор находится под ней.
Получилось хорошо, только адреса хабов не начинаются на www. Вот например dchub://hub.mypenza.ru

[eoln]

Ну тогда ищите или другой способ или ещё раз поизвращайтесь, заменив if copy(richedit1.text, RichEdit1.SelStart - 8, 8)='dchub://' then strURL:='dchub://'+strURL; на

      if copy(richedit1.text, RichEdit1.SelStart - 8, 8)='dchub://'
      then begin
        delete(strURL, 1, 4);
        strURL:='dchub://'+strURL;
      end;

где RichEdit1.Text:='dchub:// www.hub.mypenza.ru' + #13+#10+
'http://www.programmersforum.ru привет';
Переходить будет, но в тексте должны присутствовать www

[Shouldercannon]

Уже лучше. Спасибо.

[Квэнди]

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

Такой код превращает в ссылки записи, которые начинаются с http://. Помогите его модифицировать, чтобы он воспринимал как ссылку запись начинающуюся на dchub://.

Не правда он подсвечивает любую ссылку, которая зарегистрирована как протокол в системе. Можете просто зарегистрировать протокол с идентификатором dchub

var reg:tregistry;
begin
reg:=tregistry.Create;
reg.RootKey:=HKEY_Classes_Root;
if not(reg.KeyExists('dchub')) then
begin
reg.OpenKey('dchub',true);
reg.WriteString('','URL:dchub Protocol');
reg.WriteString('URL Protocol','');
reg.OpenKey('DefaultIcon',true);
reg.WriteString('',<путь к выполняемому файлу программы>);
reg.CloseKey;
reg.OpenKey('dchub\shell\open\command',true);
reg.WriteString('',<путь к выполняемому файлу программы>+' %1');
reg.CloseKey;
end;
reg.Free;

[Shouldercannon]

Не работает. Протокол зарегистрируется, а толку? Это не влияет на RichEdit.