Just added a new module to one of my projects which came from pscode.com , to make clickable links in a rtb. And allthough it does its job... and does what it is supposed to. Whenever i run the project from "debug" mode, and stop/or close the running instance, it closes vb as well....... anyone have any idea why this is happening?? the code in the module is as follows...
Thanks in advance for any help you may be able to provideCode:Option Explicit Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any) As Long Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 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 Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long) 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 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_SETEVENTMASK = WM_USER + 69 Public Const EM_AUTOURLDETECT = WM_USER + 91 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 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 = Form1.RichTextBox1.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 Form1.RichTextBox1 lngWin32apiResultCode = SendMessage(.hwnd, EM_GETTEXTRANGE, 0, udtTEXTRANGE) End With RtlMoveMemory ByVal strBuffer, ByVal udtTEXTRANGE.lpstrText, Len(strBuffer) strOperation = "open" strFileName = strBuffer lngHInstanceExecutable = ShellExecute(Form1.hwnd, strOperation, strFileName, vbNullString, strDefaultDirectory, SW_SHOWNORMAL) End If End If End If RichTextBoxSubProc = CallWindowProc(glnglpOriginalWndProc, hwnd, uMsg, wParam, lParam) End Function




Reply With Quote