Hi all

I needed the functionality, so I wrote this.

Please comment and suggest corrections, before it goes to the source code Forum.
I would really like suggestions on how to implement cut'n paste from MS word.
It's only tested on Windows 98 SE. DK.
Best Regards
Peter Scheutz

' RichEdit DDT Hyperlink sample, showing how to create a
' Richedit Control with Hyperlink functionality.
' By Peter Scheutz, released As Public Domain - November 28, 2000
' Compile, execute, select some text, click "Make Hyperlink",
' enter link Text, press [ok], move mouse over link.
' Link text could be: [url="http://www.powerbasic.com"]www.powerbasic.com[/url]   or [url="http://www.powerbasic.com"]http://www.powerbasic.com[/url] 
' or mailto:[email protected]
' Rich Edit control 2 or later
' 1) Make it possible To paste rtf From MS Word And Preserve the
'    hyperlinks. I hope that someone in the PB forum can help with that.
' 2) Add  "richEd_Hyperlink_RemoveLink" function.
' 3) Add  "richEd_Hyperlink_CleanUpLinks" function, to use when
'    text is changed by copy and paste
' "Small RichEdit sample",
' By Borje Hagsten, released As Public Domain - April 24, 2000
' The method was taken from:
' [url="http://www.wdj.com/archive/1108/feature.html"]http://www.wdj.com/archive/1108/feature.html[/url] 

#Compile Exe
#Dim All

#Include "WIN32API.INC" 'Some include files
Global hRichEd As Long

Type charformat2a
    cbSize As Long
    dwMask As Dword
    dwEffects As Dword
    yHeight As Long
    yOffset As Long
    crTextColor As Dword
    bCharSet As Byte
    bPitchAndFamily As Byte
    szFaceName As Asciiz * %LF_FACESIZE
    wpad2 As Integer
    wWeight As Word
    sSpacing As Integer
    crBackColor As Dword
    lcid As Long
    dwReserved As Dword
    sStyle As Integer
    wKerning As Word
    bUnderlineType As Byte
    bAnimation As Byte
    bRevAuthor As Byte
    bReserved1 As Byte
End Type

    nmhdr As NMHDR
    msg As Dword
    wParam As Long
    lParam As Long
    chrg As CHARRANGE
End Type


%CFM_LINK = &H20 '/* Exchange hyperlink extension */
%CFM_LCID = &H2000000
%CFE_LINK = &H20
%EN_LINK = &H70b
%ENM_LINK = &H4000000

Global hEdit As Long

Declare CallBack Function DlgCallback()

Global richEd_Hyperlink_Hyperlinks() As String
Global richEd_Hyperlink_HyperlinksCount As Long

Function richEd_Hyperlink_GetFreeID() As Long
    Incr richEd_Hyperlink_HyperlinksCount
    ReDim Preserve richEd_Hyperlink_Hyperlinks(1 To richEd_Hyperlink_HyperlinksCount)
    Function= richEd_Hyperlink_HyperlinksCount
End Function

Function richEd_Hyperlink_GetHyperLink(ID As Long) As String
    If ID>0 And ID<=richEd_Hyperlink_HyperlinksCount Then _
        Function= richEd_Hyperlink_Hyperlinks(ID)
End Function

Function richEd_Hyperlink_SetLink( ByVal ID As Long ) As Long
    Local cf As charformat2a
    cf.cbSize = Len( cf ) 'Length of structure
    cf.dwMask = %CFM_LCID  Or %CFM_LINK 'Set mask to link and id only

    cf.dwEffects = %CFE_LINK
    cf.lcid = ID
    Call SendMessage( hEdit, %EM_SETCHARFORMAT, %SCF_SELECTION, VarPtr( cf ))

End Function

Function richEd_Hyperlink_AddLink() As Long
    Local ID As Long
    Local url As String
    If ID>0 Then
        url = InputBox$(" Type the link text")
        If Len(url)>2 Then  ' do a check for a valid Url here?
            Call richEd_Hyperlink_SetLink(ID)
        End If
    End If
End Function

Function richEd_Hyperlink_UrlClicked(ByVal ID As Long) As Long
    Call ShellExecute(%NULL,"open",richEd_Hyperlink_GetHyperLink( ID ),"","",%SW_SHOW)
End Function

Function richEd_Hyperlink_HandleURL(ByVal hWnd As Long, lpLink As ENLINK) As Long
    Local linkCf2 As charformat2a
    Local chrg As CHARRANGE
    Call SendMessage(hEdit,%EM_HIDESELECTION,%True,0)
     ' cache current selection
    Call SendMessage(hEdit,%EM_EXGETSEL,0,VarPtr(chrg))

    Call SendMessage( hEdit, %EM_EXSETSEL, 0, VarPtr( lpLink.chrg ))
    linkCf2.cbSize = Len( linkCf2 ) 'Length of structure
    linkCf2.lcid = 0
    Call SendMessage( hEdit, %EM_GETCHARFORMAT, %True, VarPtr( linkCf2 ))

    ' restore old selection
    Call SendMessage(hEdit,%EM_EXSETSEL,0,VarPtr(chrg))
    Call SendMessage(hEdit,%EM_HIDESELECTION,%False,0)
    Select Case lpLink.msg
           Case %WM_LBUTTONDOWN
            Call richEd_Hyperlink_UrlClicked(linkCf2.lcid)
            Function=%True : Exit Function
           Case %WM_LBUTTONDBLCLK, %WM_LBUTTONUP ' Swallow these button events
                Function=%True : Exit Function
           Case %WM_MOUSEMOVE
                 Control Set Text hWnd, %IDURLLABEL, richEd_Hyperlink_GetHyperLink( linkCf2.lcid )
            Function=%True : Exit Function
    End Select
End Function


Function PbMain
    Local hDlg As Long, rText As String

    'hRichEd = LoadLibrary("RICHED32.DLL")
    hRichEd = LoadLibrary( "Riched20.DLL" )
    Call InitCommonControls

    Dialog New 0, "DDT RichEdit Hyperlinks demo",,, 320, 138, %WS_THICKFRAME Or %WS_CAPTION Or %WS_SYSMENU Or %WS_MAXIMIZEBOX To hDlg
    Control Add Button, hDlg, %IDOK, "&Make Hyperlink", 140, 6, 70, 14
    Control Add Label, hDlg, %IDURLLABEL, "Empty", 2, 2, 100, 14

    Control Add "RichEdit20A", hDlg, %ID_RICHEDIT, "", 6, 6, 126, 110, _

    Control Handle hDlg, %ID_RICHEDIT To hEdit

'    Call SendMessage( hEdit, %EM_AUTOURLDETECT, %True, 0 )
    Call SendMessage( hEdit, %EM_SETEVENTMASK, 0, %ENM_LINK )

    rText = Repeat$( 30, "Compile, execute, select some text, click 'Make Hyperlink' " ) 'Create and set some text
    Call SendMessage( hEdit, %WM_SETTEXT, 0, StrPtr( rText ))
    SetFocus hEdit

    Dialog Show Modal hDlg Call DlgCallback

End Function

' Main callback procedure for all controls
CallBack Function DlgCallback()
    Local hiLparam As Integer
    Local loLparam As Integer
    Local enlink As ENLINK
    Local enlinkPtr As ENLINK Ptr
    'cache these and avoid sign loss if sending them to subs later on.
    hiLparam = HiWrd( CbLparam )
    loLparam = LoWrd( CbLparam )

Select Case CbMsg

    Case %WM_NOTIFY
        ' get a Pointer to the ENLINK structure
        enlinkPtr = CbLparam
        enlink = @enlinkPtr
        ' MSDN states that it's better to use enlink.nmhdr.idFrom than Wparam for ID detection.
        If enlink.nmhdr.code = %EN_LINK And enlink.nmhdr.idFrom = %ID_RICHEDIT Then
            Call SetWindowLong(CbHndl,%DWL_MSGRESULT, richEd_Hyperlink_HandleURL(CbHndl,enlink))

            Function=%True ': Exit Function
        End If
        Function=%False ': Exit Function
    Case %WM_COMMAND
        Select Case CbCtl
            Case %IDOK
                Call richEd_Hyperlink_AddLink() 'The sub will prompt for link text

        End Select
    Case %WM_SIZE
        MoveWindow GetDlgItem( CbHndl, %ID_RICHEDIT ), 4, 40, loLparam - 8, hiLparam - 50, - 1

End Select
End Function

[This message has been edited by Peter Scheutz (edited November 29, 2000).]