Author | Message | Time |
---|---|---|
FyRe | I was wondering if there is a clean way to do AutoDetectURL. I've looked over the net for a long time. I only found a few samples and I created a very messy AutoDetection. This is when the form loads: Form_Load() [code] '// auto detect urls With rtbChat lngEventMask = SendMessage(.HWnd, EM_GETEVENTMASK, 0, ByVal CLng(0)) If lngEventMask Xor ENM_LINK Then lngEventMask = lngEventMask Or ENM_LINK End If lngWin32apiResultCode = SendMessage(.HWnd, EM_SETEVENTMASK, 0, ByVal CLng(lngEventMask)) lngWin32apiResultCode = SendMessage(.HWnd, EM_AUTOURLDETECT, CLng(1), ByVal CLng(0)) End With With rtbWhisper lngEventMask = SendMessage(.HWnd, EM_GETEVENTMASK, 0, ByVal CLng(0)) If lngEventMask Xor ENM_LINK Then lngEventMask = lngEventMask Or ENM_LINK End If lngWin32apiResultCode = SendMessage(.HWnd, EM_SETEVENTMASK, 0, ByVal CLng(lngEventMask)) lngWin32apiResultCode = SendMessage(.HWnd, EM_AUTOURLDETECT, CLng(1), ByVal CLng(0)) End With glngOriginalhWnd = Me.HWnd glnglpOriginalWndProc = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, AddressOf RichTextBoxSubProc)[/code] This is in the Declares mod. [code]'AutoDetectURL Public Const GWL_WNDPROC = (-4) Public Const WM_USER = &H400 Public Const WM_NOTIFY = &H4E Public Const WM_LBUTTONDOWN = &H201 Public Const EM_GETEVENTMASK = WM_USER + 59 Public Const EM_GETTEXTRANGE = WM_USER + 75 Public Const EM_AUTOURLDETECT = (WM_USER + 91) Public Const EM_SETEVENTMASK = WM_USER + 69 Public Const EN_LINK = &H70B Public Const ENM_LINK = &H4000000 Public Const SW_SHOWNORMAL = 1 Type tagNMHDR hwndFrom As Long idFrom As Long code As Long End Type Type CHARRANGE cpMin As Long cpMax As Long End Type Type ENLINK nmhdr As tagNMHDR msg As Long wParam As Long lParam As Long chrg As CHARRANGE End Type Type TEXTRANGE chrg As CHARRANGE lpstrText As Long End Type Public glnglpOriginalWndProc As Long Public glngOriginalhWnd As Long Public Function RichTextBoxSubProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim udtNMHDR As tagNMHDR Dim udtENLINK As ENLINK Dim udtTEXTRANGE As TEXTRANGE Dim strBuffer As String * 128 Dim strOperation As String Dim strFileName As String Dim strDefaultDirectory As String Dim lngHInstanceExecutable As Long Dim lngWin32apiResultCode As Long If uMsg = WM_NOTIFY Then RtlMoveMemory udtNMHDR, ByVal lParam, Len(udtNMHDR) If udtNMHDR.hwndFrom = frmMain.rtbChat.HWnd And udtNMHDR.code = EN_LINK Then RtlMoveMemory udtENLINK, ByVal lParam, Len(udtENLINK) If udtENLINK.msg = WM_LBUTTONDOWN Then strBuffer = "" With udtTEXTRANGE .chrg.cpMin = udtENLINK.chrg.cpMin .chrg.cpMax = udtENLINK.chrg.cpMax .lpstrText = StrPtr(strBuffer) End With With frmMain.rtbChat lngWin32apiResultCode = SendMessage(.HWnd, EM_GETTEXTRANGE, 0, udtTEXTRANGE) End With RtlMoveMemory ByVal strBuffer, ByVal udtTEXTRANGE.lpstrText, Len(strBuffer) strOperation = "open" strFileName = strBuffer lngHInstanceExecutable = ShellExecute(frmMain.HWnd, strOperation, strFileName, vbNullString, strDefaultDirectory, SW_SHOWNORMAL) End If ElseIf udtNMHDR.hwndFrom = frmMain.rtbWhisper.HWnd And udtNMHDR.code = EN_LINK Then RtlMoveMemory udtENLINK, ByVal lParam, Len(udtENLINK) If udtENLINK.msg = WM_LBUTTONDOWN Then strBuffer = "" With udtTEXTRANGE .chrg.cpMin = udtENLINK.chrg.cpMin .chrg.cpMax = udtENLINK.chrg.cpMax .lpstrText = StrPtr(strBuffer) End With With frmMain.rtbWhisper lngWin32apiResultCode = SendMessage(.HWnd, EM_GETTEXTRANGE, 0, udtTEXTRANGE) End With RtlMoveMemory ByVal strBuffer, ByVal udtTEXTRANGE.lpstrText, Len(strBuffer) strOperation = "open" strFileName = strBuffer lngHInstanceExecutable = ShellExecute(frmMain.HWnd, strOperation, strFileName, vbNullString, strDefaultDirectory, SW_SHOWNORMAL) End If End If End If RichTextBoxSubProc = CallWindowProc(glnglpOriginalWndProc, HWnd, uMsg, wParam, lParam) End Function[/code] When the Program closes: [code] 'Autodetecturl Unload Dim lngWin32apiResultCode As Long lngWin32apiResultCode = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, glnglpOriginalWndProc) [/code] Sorry, for such a big message. I know this code is messy and bad coding. I'm just asking for suggestions and anything simpler ;) Thanks. | February 28, 2003, 6:25 AM |
JaMi | how do you declare your SetWindowLong ? | February 28, 2003, 9:41 AM |
Spht | [quote]how do you declare your SetWindowLong ?[/quote] That's a standard Win32 API function. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long | February 28, 2003, 9:53 AM |
Camel | if you ever need to look up an api call, you can use the "api text viewer" that comes with visual studio if you have just vb and not vs, you can usually find it as the first or second result on www.google.com :) | February 28, 2003, 1:06 PM |
FyRe | [code]Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal HWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long [/code] Sorry, thought I added everything. | February 28, 2003, 5:00 PM |
haZe | There is a much smaller and simplified version at http://pscode.com/vb/scripts/ShowCodeAsText.asp?txtCodeId=36414&lngWId=1 | February 28, 2003, 6:15 PM |