Форум: "Основная";
Текущий архив: 2005.06.29;
Скачать: [xml.tar.bz2];

Вниз

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

← →
Алексей Петухов   (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&amp;n=0&amp;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, но это не такая простая задача, как кажется.

---

← →
Alexander Panov ©   (2005-06-07 21:55) [11]

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

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.

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

---

← →
Alexander Panov ©   (2005-06-07 23:25) [12]

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

---

← →
Alexander Panov ©   (2005-06-08 11:52) [13]

Вот код, не претендующий на целостное решение. Сделан в качестве примера.
Работает только со ссылками вида <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;

---

← →
Alexander Panov ©   (2005-06-08 11:52) [14]

 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.

---

← →
Alexander Panov ©   (2005-06-08 11:53) [15]

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

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.06.29;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.51 MB
Время: 0.053 c