ГипперСсылка

← →
Алексей Петухов (2005-06-06 13:21) [0]

Здравствуйте, уважаемые Мастера.

Естсь необходимось реализовать в RichEdit-е что-то вроде гиппер ссылки. И что-бы при клике мышкой на ссылке вызывалась процедура в которой можно было обработать код ссылки.

Спасибо за помощь заранее.

← →
sniknik © (2005-06-06 13:53) [1]

TTrainingForm = class(TBaseChildForm) ... DBRichEditTheori: TDBRichEdit; ... private procedure RunLink(var Msg: TMessage); message WM_NOTIFY; ... end; procedure TTrainingForm.RunLink(var Msg: TMessage); var p: TENLink; strURL: string; begin if (PNMHDR(Msg.lParam).code = EN_LINK) then begin p:= TENLink(Pointer(TWMNotify(Msg).NMHdr)^); if (p.Msg = WM_LBUTTONDOWN) then begin SendMessage(DBRichEditTheori.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg))); strURL:= DBRichEditTheori.SelText; ShellExecute(Handle, "open", PChar(strURL), nil, nil, SW_SHOWNORMAL); end end end; procedure TTrainingForm.FormCreate(Sender: TObject); var mask: Word; begin mask:= SendMessage(DBRichEditTheori.Handle, EM_GETEVENTMASK, 0, 0); SendMessage(DBRichEditTheori.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK); SendMessage(DBRichEditTheori.Handle, EM_AUTOURLDETECT, Integer(True), 0); end;
здесь
DBRichEditTheori это RichEdit
TrainingForm это форма на которой он лежит

← →
sniknik © (2005-06-06 13:59) [2]

> DBRichEditTheori это RichEdit
сорри это DBRichEdit. но это неважно, мзначально отлаживалось все равно на RichEdit-е, в программу с базой перенесено потом, эо кусок из нее. (т.е. работать с RichEdit тоже будет)

← →
Чапаев © (2005-06-06 14:05) [3]

На http://rusdoc.ru посмотри, относительно недавно была статья. Хотя там несколько иная задача стояла: автоматически выделять ссылки, а уж при нажатии на ссылку выполняется ассоциированное приложение.

← →
Алексей Петухов (2005-06-06 14:06) [4]

Спасибо попробую

← →
sniknik © (2005-06-06 14:14) [5]

> автоматически выделять ссылки, а уж при нажатии на ссылку выполняется ассоциированное приложение.
вот это [1] тоже самое ...
из хелпа программы

...
Может содержать теоретический материал для каждого вопроса свой, или общий в любом вопросе.
Позволяются ссылки на внешние источники знаний.
Ссылки определяются по префиксам "ftp:", "http:", "www.", "\\", "file:"
Так для определения ссылки на материал в интернете можно написать http:\\сайт.ru или www.сайт.ru (www - эта форма нежелательна изза неоднозначного интерпретирования системой (не на всех машинах сработает в зависимости от настроек), желательно ссылки на www записывать в форме http:\\www.сайт.ru)
Ссылки на компьютер в локальной сети \\server\path\file.ext, не стоит задавать ссылки на файлы в сети через расшаренные файлы, т.к. на другом компе где будут просматривать материал такой расшарки скорее всего не будет.
И ссылки на локальные файлы или на подключенный расшеренный диск file:D:\file.ext.
...

← →
sniknik © (2005-06-06 14:21) [6]

и кстати ссылка не "левая" случайно? зашол посмотреть и не нашол ничего и близко похожего (просто интересно как другие делали), точнее ссылку не даш?

← →
Алексей Петухов (2005-06-07 17:28) [7]

Уточняю Вопрос:

Хотелось бы чтобы у гиперссылки текст и ссылка отличались (в TRichEdit-е это не получилось) - текст гипперссылки был произвольным.

И можно было просмотреть текст в двух вариантах:
1. В "нормальном" режиме где виден только текст ссылки и можно по ней перейти.
2. В режиме "разметки" - где видно и текст и ссылку.

пример:
1. версия для печати
2. <A href="http://www.delphimaster.ru/cgi-bin/forum.pl?id=1118049662&n=0&toprint=1">версия для печати</A>

← →
sniknik © (2005-06-07 20:08) [8]

уточняю ответ:
не там ищеш, в таком случае тебе нужен компонент с поддержкой гипертекста а не рич техт формат.

← →
sniknik © (2005-06-07 20:10) [9]

p.s. на самом деле > [7], это не уточнение а полный поворот в другую сторону. имхо.

← →
Alexander Panov © (2005-06-07 20:15) [10]

Можно и в RichEdit, но это не такая простая задача, как кажется.

Как мне видится, общая схема такая:

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

TRecLink=record
FullBeginPos,FullEndPos: Integer; //Исходные позиции в тексте
CurrBegPos, CurrEndPos: Integer; //Текущие позиции
FullLink: String; //Полный текст линка
CurrLink: String; //Текущий текст линка текст линка
end;

Сама гиперссылка при этом удаляется из входного потока, остается текст.

Создаем массив таких структур.

2. Выводим текст в RichEdit, заменяя атрибуты текста на нужные для линков.

3. В RichEdit.OnMouseUp получаем номер символа, на котором пользователь кликнул мышкой, используя сообщение EM_CHARFROMPOS.

4. Для запуска соответствующей программы с нужным линком выбираем из массива структур нужный линк по полученной в п.3 позиции символа.

5. При корректировке пользователем в RichEdit динамически изменяем массив структур.

6. При сохранении в файл выполняем операции, обратную п.1.

В общем-то, вот и все.

если завтра будет время - код допишу. Самому интерсно стало-)

Вот код, не претендующий на целостное решение. Сделан в качестве примера.
Работает только со ссылками вида <a href="Url">text</a>.

unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons, ComCtrls, StdCtrls, RichEdit, ShellApi, ToolWin; type TForm1 = class(TForm) re: TRichEdit; od: TOpenDialog; ToolBar1: TToolBar; SpeedButton1: TSpeedButton; procedure SpeedButton1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public end; TRecLink=class public FPosInStr: Integer; FLengthInStr: Integer; FPosUrlInLink: Integer; FTextInLink: Integer; FPosAfterInStr: Integer; FLink: String; FUrl: String; FText: String; constructor Create(const aLink: String); end; TLinksClass=class private FSrcStr: String; FCurrStr: String; FFileName: String; FLinks: array of TRecLink; procedure ParseSrcStr; function GetCountLinks: Integer; function GetLink(Index: Integer): TRecLink; public FRE: TRichEdit; constructor Create(RE: TRichEdit); destructor Destroy; override; procedure SetBold(const aPos,aLen: Integer); procedure LoadFile(const aFileName: String); function IndexOf(const aPos: Integer): Integer; procedure OpenUrl(const Url: String); procedure reMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure reMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); property CurrStr: String read FCurrStr write FCurrStr; property SrcStr: String read FSrcStr write FSrcStr; property CountLinks: Integer read GetCountLinks; property Links[Index: Integer]: TRecLink read GetLink;default; property Re: TRichEdit read FRE write FRE; end; var Form1: TForm1; LC: TLinksClass; implementation {$R *.dfm} procedure TForm1.SpeedButton1Click(Sender: TObject); begin if Assigned(LC) then LC.Free; LC := nil; if od.Execute then begin LC := TLinksCLass.Create(Re); LC.LoadFile(od.FileName); end; end; { TRecLink } constructor TRecLink.Create(const aLink: String); var nPos: Integer; begin Self.FLink := aLink; Self.FLengthInStr := Length(aLink); nPos := Pos("="",aLink); Self.FPosUrlInLink := nPos+2; nPos := Pos("">",aLink); Self.FUrl := Copy(aLink,Self.FPosUrlInLink, nPos-Self.FPosUrlInLink); Self.FTextInLink := nPos+2; nPos := Pos("</",aLink); Self.FText := Copy(aLink,Self.FTextInLink, nPos-Self.FTextInLink); nPos := Pos("">",aLink); Self.FUrl := Copy(aLink,Self.FPosUrlInLink, nPos-Self.FPosUrlInLink); end; { TLinksClass } constructor TLinksClass.Create(RE: TRichEdit); begin FRE := RE; FRE.OnMouseMove := reMouseMove; FRE.OnMouseUp := reMouseUp; end; destructor TLinksClass.Destroy; begin FRE.Lines.Clear; FRE.OnMouseMove := nil; FRE.OnMouseUp := nil; end; function TLinksClass.GetCountLinks: Integer; begin Result := Length(FLinks); end; function TLinksClass.GetLink(Index: Integer): TRecLink; begin Result := FLinks[Index]; end; procedure TLinksClass.OpenUrl(const Url: String); begin ShellExecute(0, "open", PChar(URL), nil, nil, SW_SHOWNORMAL); end; function TLinksClass.IndexOf(const aPos: Integer): Integer; var i: Integer; begin Result := -1; for i := 0 to LC.CountLinks-1 do begin if (aPos>=LC.Links[i].FPosAfterInStr) and (aPos<=LC.Links[i].FPosAfterInStr+Length(LC.Links[i].FText)) then begin Result := i; Exit; end; end; end; procedure TLinksClass.LoadFile(const aFileName: String); var M: TFileStream; Len: Integer; i: Integer; begin FFileName := aFileName; M := TFileStream.Create(FFileName,fmOpenRead ); Len := M.Size; SetLength(FSrcStr,Len); M.Read(FSrcStr[1],Len); M.Free; ParseSrcStr; FRE.Lines.Text := CurrStr; for i := 0 to CountLinks-1 do begin SetBold(Links[i].FPosAfterInStr,Length(Links[i].FText)); end; end; procedure TLinksClass.ParseSrcStr; var i: Integer; isLink: Boolean; BegPos: Integer; Len: Integer; Link: String; CurrLen: Integer; begin BegPos := 0; FCurrStr := ""; isLink := False; i := 1; Len := 0; CurrLen := 0; SetLength(FCurrStr,Length(FSrcStr)); while i<=Length(FSrcStr) do begin if not isLink then begin if UpperCase(Copy(FSrcStr,i,2))="<A" then begin BegPos := i; isLink := True; end else begin Inc(CurrLen); FCurrStr[CurrLen] := FSrcStr[i]; end; end else begin if UpperCase(Copy(FSrcStr,i,4))="</A>" then begin isLink := False; SetLength(FLinks,Len+1); Link := Copy(FSrcStr,BegPos,i+4-BegPos); FLinks[Len] := TRecLink.Create(Link); FLinks[Len].FPosInStr := BegPos; FLinks[Len].FLengthInStr := Length(Link); Move(FLinks[Len].FText[1],FCurrStr[CurrLen+1],Length(FLinks[Len].FText)); FLinks[Len].FPosAfterInStr := CurrLen; CurrLen := CurrLen+Length(FLinks[Len].FText); Inc(i,3); Inc(Len); end; end; Inc(i); end; end; procedure TLinksClass.reMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var P: TPoint; begin P.X := X; P.Y := Y; if IndexOf(SendMessage(FRE.Handle,EM_CHARFROMPOS,0,Integer(@P)))=-1 then FRE.Cursor := crDefault else FRE.Cursor := crHandPoint; end; procedure TLinksClass.reMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var P: TPoint; Res: Integer; begin P.X := X; P.Y := Y; Res := IndexOf(SendMessage(FRE.Handle,EM_CHARFROMPOS,0,Integer(@P))); if Res=-1 then Exit; OpenUrl(Links[Res].FUrl); end; procedure TLinksClass.SetBold(const aPos, aLen: Integer); begin FRE.SelStart := aPos;

FRE.SelLength := aLen; FRE.SelAttributes.Color := clNavy; FRE.SelAttributes.Style := [fsBold]; FRE.SelLength := 0; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin LC.Free; end; end.

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

ГипперСсылка Найти похожие ветки