Re: Detecting URLs on typing

Return to index

Author

Message

Petko Georgiev

Posted: 04/14/2004 16:25:14

Thank you very much Sergey! This is an excellent example and does exactly

what I want.

Regards,

Petko Georgiev

"Sergey Tkachenko" <[email protected]> wrote in message

news:[email protected]...

> This code autodetects URLs in text.

> When the user types space or Enter character, the code checks if the caret

> is at the end of URL. If yes, it makes a hyperlink of it and set its tag.

>

> It's assumed that you use RichViewActions

> (http://www.trichview.com/resources/actions/): hypertext style is returned

> by rvActionsResource.rvActionInsertHyperlink1.GetHyperlinkStyleNo(rve).

> Otherwise create your own procedure for calculation of hypertext style.

>

> function IsAddress(const str: String): Boolean;

> var s: String;

> begin

>   // Checks for prefix.

>   // For better results, it should check for lengths...

>   s := AnsiLowerCase(str);

>   Result :=

>         (Pos('http://',   s)=1) or

>         (Pos('ftp://',    s)=1) or

>         (Pos('file://',   s)=1) or

>         (Pos('gopher://', s)=1) or

>         (Pos('mailto:', s)=1) or

>         (Pos('https://',  s)=1) or

>         (Pos('news:',     s)=1) or

>         (Pos('telnet:',   s)=1) or

>         (Pos('wais:',     s)=1) or

>         (Pos('www.',      s)=1) or

>         (Pos('ftp.',      s)=1);

> end;

>

> function IsEmail(const s: String): Boolean;

> var p1, p2: Integer;

>    pchr: PChar;

> begin

>   //'@' must exist and '.' must be after it. This is not a comprehensive

> test,

>   //but I think that it's ok

>   Result := False;

>   p1 := Pos('@', s);

>   if p1=0 then exit;

>   pchr := StrRScan(PChar(s),'.');

>   if pchr = nil then exit;

>   p2 := pchr - PChar(s)+1;

>   if p1>p2 then exit;

>   Result := True;

> end;

>

> function MakeURL(rve: TCustomRichViewEdit): Boolean;

> var ItemNo, WordEnd, WordStart, CurStyleNo: Integer;

>     s: String;

> begin

>   Result := False;

>   rve := rve.TopLevelEditor;

>   if rve.SelectionExists then

>     exit;

>   ItemNo := rve.CurItemNo;

>   if rve.GetItemStyle(ItemNo)<0 then

>     exit;

>   WordEnd := rve.OffsetInCurItem;

>   if WordEnd<=1 then

>     exit;

>   s := rve.GetItemTextA(ItemNo);

>   WordStart := WordEnd-1;

>   while (WordStart>1) and (s[WordStart-1]<>' ') do

>     dec(WordStart);

>   s := Copy(s, WordStart, WordEnd-WordStart);

>   if IsEmail(s) or IsAddress(s) then begin

>     CurStyleNo := rve.CurTextStyleNo;

>     rve.SetSelectionBounds(ItemNo, WordStart, ItemNo, WordEnd);

>

>

rve.ApplyTextStyle(rvActionsResource.rvActionInsertHyperlink1.GetHyperlinkSt

> yleNo(rve));

>     rve.SetCurrentTag(Integer(StrNew(PChar(s))));

>     rve.SetSelectionBounds(rve.CurItemNo, rve.OffsetInCurItem,

> rve.CurItemNo, rve.OffsetInCurItem);

>     rve.CurTextStyleNo := CurStyleNo;

>     Result := True;

>   end;

> end;

>

> procedure TForm3.RichViewEdit1KeyDown(Sender: TObject; var Key: Word;

>   Shift: TShiftState);

> begin

>   if Key in [VK_RETURN, VK_SPACE] then

>     MakeURL(TCustomRichViewEdit(Sender));

> end;

>

>