|
-
Jul 10th, 2009, 06:44 PM
#1
Thread Starter
New Member
Help ?!?!
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...
Code:
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
Thanks in advance for any help you may be able to provide
-
Jul 10th, 2009, 06:46 PM
#2
Thread Starter
New Member
Re: Help ?!?!
Just in case it is needed..... here is the code to call the mod into action...
Code:
Private Sub Form_Load()
Dim lngEventMask As Long
Dim lngWin32apiResultCode As Long
With RichTextBox1
.Text = ""
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))
.Text = "hello this is a test." & vbCrLf & "this is a link http://www.google.com" & " here." & vbCrLf & _
"http://www.microsoft.com/" & vbNewLine & "mailto:[email protected]" & vbNewLine & "ftp://ftp.microsoft.com/" & vbCrLf & " this is the end."
End With
glngOriginalhWnd = Me.hwnd
glnglpOriginalWndProc = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, AddressOf RichTextBoxSubProc)
End Sub
-
Jul 10th, 2009, 06:57 PM
#3
Re: Help ?!?!
Yes, because you are subclassing. When you subclass, you should never end the program from the VBs END button. Always use the Unload Routine to do your clear ups.
_____________________________________________________________________
----If this post has helped you. Please take time to Rate it.
----If you've solved your problem, then please mark it as RESOLVED from Thread Tools.

-
Jul 10th, 2009, 07:38 PM
#4
Re: Help ?!?!
 Originally Posted by some1uk03
Yes, because you are subclassing. When you subclass, you should never end the program from the VBs END button. Always use the Unload Routine to do your clear ups.
As someluk03 pointed out above, you should also unsubclass the form before you unload your form, if not done sooner.
Last edited by LaVolpe; Jul 10th, 2009 at 09:40 PM.
-
Jul 10th, 2009, 08:46 PM
#5
Thread Starter
New Member
Re: Help ?!?!
ok any chance someone could give me a example of such?
i have at the form unload function
Code:
Private Sub Form_Unload(Cancel As Integer)
Dim lngWin32apiResultCode As Long
lngWin32apiResultCode = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, glnglpOriginalWndProc)
End Sub
-
Jul 10th, 2009, 09:39 PM
#6
Re: Help ?!?!
Ok, you are unsubclassing the form on unload, you shouldn't get any crashes if you run your project and close it normally (i.e., pressing the X close button or pressing Alt+F4).
When uncompiled, and if any of the following occurs before the form is unsubclassed...
1. If you get an error or pause the code in the RichTextBoxSubProc function, you will crash.
2. If you get an error anywhere else and get that debug error window popup, if you click the End button, you will crash. Even if you hit the Debug button, you will probably crash.
3. If you use an END statement in your code before the form is unsubclassed, crash.
4. If you close your project by pressing the blue square End button on the IDE toolbar, crash.
So you can see, that subclassing in IDE is risky, always has been. There are some advanced classes and tools out there to help make subclassing in IDE about 99% safe.
-
Jul 10th, 2009, 09:47 PM
#7
Thread Starter
New Member
Re: Help ?!?!
ah ok, indeed sounds pretty hazardous lol,i have had a few crashes that i cleared up from it before it would close everything but is still doing the same thing without any errors, i guess it kinda makes sense though, thanks for the quick and cortueous reply, .... i guess the next question would be... is there any way to do link detection in a rtb safely then?
-
Jul 10th, 2009, 10:03 PM
#8
Re: Help ?!?!
Recommendation: Toggle subclassing. Since you are comfortable that the hyperlinks are working, don't subclass until you want to test that functionality again. Before you compile the application to an exe ensure you toggle subclassing on.
1. In your form's declaration section, add this: Dim bSubclass As Boolean
2. Tweak your Form_Load to
Code:
bSubclass = False ' change to True to activate subclassing; when activated hope no errors & don't hit End
' your other code
...
If bSubclass Then
glngOriginalhWnd = Me.hwnd
glnglpOriginalWndProc = SetWindowLong(glngOriginalhWnd, GWL_WNDPROC, AddressOf RichTextBoxSubProc)
End If
....
3. Your Form_Unload...
Code:
If bSubclass Then
bSubclass = False
SetWindowLong glngOriginalhWnd, GWL_WNDPROC, glnglpOriginalWndProc
End If
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|