如何让richedit控件实现超连接功能！up有分。
如何让richedit控件实现超连接功能！
我在df中能实现但在vb中就不知道如何了。郁闷！！
问题点数：100、回复次数：9Top
1 楼bobob（静思）回复于 2003-08-03 18:18:22 得分 0
期待高手~Top
2 楼rainstormmaster（暴风雨 v2.0）回复于 2003-08-03 22:40:09 得分 10
'如何建立简单的超级连接？
'API函数声明
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'打开某个网址
ShellExecute 0, "open", "http://www.dbgnu.com", vbNullString, vbNullString, 3
'给某个信箱发电子邮件
ShellExecute hWnd, "open", "mailto:zhaosihua@263.net", vbNullString
Top
3 楼xkdh（）回复于 2003-08-05 10:20:35 得分 40
要想让richedit控件实现超连接功能首先必须知道你所用的richedit控件是用的riched32.dll还是用的riched20.dll。如果是后者，无疑可以实现，但就我所知道的vb6的richedit还没有用riched20.dll。我想现在最好的方法就是看看微软有没有发布新的版本。否则根据csdn自己写控件。Top
4 楼hc_z（石泉）回复于 2003-08-05 11:59:22 得分 0
学习Top
5 楼alicky（周松）回复于 2003-08-05 12:31:42 得分 0
RichTextBox 控件不支持链Top
6 楼xf1hao（萧方）回复于 2003-08-11 10:33:38 得分 0
我说的就是rich20.dll（V3.0）的使用方法啊。
那位大哥有资料就给我发一下。谢谢了。Top
7 楼TechnoFantasy（（VB MVP）www.applevb.com）回复于 2003-08-11 11:40:19 得分 20
试试这个：
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Const WM_USER = &H400
Const EM_AUTOURLDETECT = WM_USER + 91
Private Sub Command1_Click()
RichTextBox1.Text = " http://www.applevb.com"
End Sub
Private Sub Command2_Click()
Call SendMessage(RichTextBox1.hwnd, EM_AUTOURLDETECT, True, 0)
End Sub
Top
8 楼TechnoFantasy（（VB MVP）www.applevb.com）回复于 2003-08-11 11:43:42 得分 30
用这个方法，首先创建一个bas文件，加入以下代码：
Option Explicit
Private Type NMHDR
hWndFrom As Long
idFrom As Long
code As Long
End Type
Private Type CHARRANGE
cpMin As Long
cpMax As Long
End Type
Private Type ENLINK
hdr As NMHDR
msg As Long
wParam As Long
lParam As Long
chrg As CHARRANGE
End Type
Private Type TEXTRANGE
chrg As CHARRANGE
lpstrText As String
End Type
'Used to change the window procedure which kick-starts the subclassing
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
'Used to call the default window procedure for the parent
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
'Used to set and retrieve various information
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
'Used to copy... memory... from pointers
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)
'Used to launch the URL in the user's default browser
Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Const WM_NOTIFY = &H4E
Const EM_SETEVENTMASK = &H445
Const EM_GETEVENTMASK = &H43B
Const EM_GETTEXTRANGE = &H44B
Const EM_AUTOURLDETECT = &H45B
Const EN_LINK = &H70B
Const WM_LBUTTONDBLCLK = &H203
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_MOUSEMOVE = &H200
Const WM_RBUTTONDBLCLK = &H206
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_SETCURSOR = &H20
Const CFE_LINK = &H20
Const ENM_LINK = &H4000000
Const GWL_WNDPROC = (-4)
Const SW_SHOW = 5
Dim lOldProc As Long 'Old windowproc
Dim hWndRTB As Long 'hWnd of RTB
Dim hWndParent As Long 'hWnd of parent window
Public Sub EnableURLDetect(ByVal hWndTextbox As Long, ByVal hWndOwner As Long)
'Don't want to subclass twice!
If lOldProc = 0 Then
'Subclass!
lOldProc = SetWindowLong(hWndOwner, GWL_WNDPROC, AddressOf WndProc)
'Tell the RTB to inform us when stuff happens to URLs
SendMessage hWndTextbox, EM_SETEVENTMASK, 0, ByVal ENM_LINK Or SendMessage(hWndTextbox, EM_GETEVENTMASK, 0, 0)
'Tell the RTB to start automatically detecting URLs
SendMessage hWndTextbox, EM_AUTOURLDETECT, 1, ByVal 0
hWndParent = hWndOwner
hWndRTB = hWndTextbox
End If
End Sub
Public Sub DisableURLDetect()
'Don't want to unsubclass a non-subclassed window
If lOldProc Then
'Stop URL detection
SendMessage hWndRTB, EM_AUTOURLDETECT, 0, ByVal 0
'Reset the window procedure (stop the subclassing)
SetWindowLong hWndParent, GWL_WNDPROC, lOldProc
'Set this to 0 so we can subclass again in future
lOldProc = 0
End If
End Sub
Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim uHead As NMHDR
Dim eLink As ENLINK
Dim eText As TEXTRANGE
Dim sText As String
Dim lLen As Long
'Which message?
Select Case uMsg
Case WM_NOTIFY
'Ooo! A notify message! Something exciting must be happening...
'Copy the notification header into our structure from the pointer
CopyMemory uHead, ByVal lParam, Len(uHead)
'Peek inside the structure
If (uHead.hWndFrom = hWndRTB) And (uHead.code = EN_LINK) Then
'Yay! Some kind of kinky linky message.
'Now that we know its a link message, we can copy the whole ENLINK structure
'into our structure
CopyMemory eLink, ByVal lParam, Len(eLink)
'What kind of message?
Select Case eLink.msg
Case WM_LBUTTONDBLCLK
'Double clicked the link!
'Set up out TEXTRANGE struct
eText.chrg.cpMin = eLink.chrg.cpMin
eText.chrg.cpMax = eLink.chrg.cpMax
eText.lpstrText = Space$(1024)
'Tell the RTB to fill out our TEXTRANGE with the text
lLen = SendMessage(hWndRTB, EM_GETTEXTRANGE, 0, eText)
'Trim the text
sText = Left$(eText.lpstrText, lLen)
'Launch the browser
ShellExecute hWndParent, vbNullString, sText, vbNullString, vbNullString, SW_SHOW
'Other miscellaneous messages
Case WM_LBUTTONDOWN
Case WM_LBUTTONUP
Case WM_RBUTTONDBLCLK
Case WM_RBUTTONDOWN
Case WM_RBUTTONUP
Case WM_SETCURSOR
End Select
End If
End Select
'Call the stored window procedure to let it handle all the messages
WndProc = CallWindowProc(lOldProc, hwnd, uMsg, wParam, lParam)
End Function
Top
9 楼TechnoFantasy（（VB MVP）www.applevb.com）回复于 2003-08-11 11:45:02 得分 0
然后在Form1中加入一个RichTextBox控件，在Form1中加入以下代码：
Private Sub Form_Load()
EnableURLDetect RichTextBox1.hwnd, Me.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
DisableURLDetect
End SubTop
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
