@Krool ,how to add this code to your project?
insert link url or edit hyper link:
Private Sub RichTextBox1_LinkEvent(ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long _Code:Const sFriendlyURL As String = "{\rtf1{\field{\*\fldinst{HYPERLINK ""URL""}}{\fldrslt{NAME}}}}" 'by fafalone Function GetRtfCode(Optional ByVal FromSelectArea As Boolean) As String 'add Function By XiaoYao Dim Buffer As String Buffer = vbNullString StreamStringOut Buffer, SF_RTF Or IIf(FromSelectArea, SFF_SELECTION, 0) GetRtfCode = StrToVar(Buffer) 'TextRTF End Function
, ByVal LinkStart As Long, ByVal LinkEnd As Long)
args from:LinkStart ,LinkEnd
Code:Public Sub SetRange(ByVal SStart As Long, ByVal SLen As Long) '?????????????? Dim CR As CHARRANGE CR.cpMin = SStart CR.cpMax = SStart + SLen SendMessage RichTextBoxHandle, EM_EXSETSEL, 0&, CR End Sub Sub EditLinkObj(ByVal txt As String, ByVal LinkUrl As String, ByVal LinkStartA As Long, ByVal LinkEndA As Long, Optional ByVal AddSTR As String = " ") 'add Function By XiaoYao SetRange LinkStartA, LinkEndA - LinkStartA If AddSTR <> "" Then txt = AddSTR & txt & AddSTR AddLink txt, LinkUrl End If End Sub Sub AddLink(txt As String, Url As String) 'add Function By XiaoYao SelText = GetlinkRTF(txt, Url) End Sub Function GetlinkRTF(txt As String, sUrl As String) As String If Len(sUrl) Then GetlinkRTF = Replace(Replace(sFriendlyURL, "URL", sUrl), "NAME", txt) ' Create a hyperlink for the current selection using RTF syntax End If End Function




Reply With Quote