Catching a framework exception - vb.net

I'm having some trouble catching and handling an exception.
My (simplified) application has a picturebox which shows a live video feed from a connected webcam. I'm using the Metrilius Metricam SDK (http://www.metrilus.de/blog/portfolio-items/metricam/) to connect to the webcam.
Using a backgroundworker, I am calling the camera.update function, grabbing the bitmap and setting the picturebox to it. Whenever the user hits Enter, the current frame is grabbed and stored.
As mentioned earlier, an exception is thrown at completely random points in time when the picturebox is being updated with the latest bmp from the camera. As you can see in the code below, I have wrapped the assignment in a try/catch block but it isn't catching it. What could I do to handle this gracefully? The exception draws a big red X on the picturebox and the program has to be closed and restarted.
The picturebox's sizemode property is set to Zoom.
Code below:
Private Sub BG1_DoWork(sender As Object, e As DoWorkEventArgs) Handles BG1.DoWork
While Not BG1.CancellationPending
If pauseCamUpdate = False Then 'PausecamUpdate is a flag that is set to False during calls to store the current frame
i += 1
If i Mod 2 = 0 Then Continue While 'Dropping every nth frame to make the update smoother
If i > 10000 Then
i = 0
End If
Try
activeCam.Update()
pictPhoto.Image = CType(CType(activeCam, WebCam).CalcBitmap(), Bitmap)
'pictPhoto.Invalidate()
Application.DoEvents()
Catch exp As Exception
End Try
End If
End While
End Sub
The exception text minus the loaded assemblies:
See the end of this message for details on invoking
just-in-time (JIT) debugging instead of this dialog box.
************** Exception Text **************
**System.InvalidOperationException: Object is currently in use elsewhere.**
at System.Drawing.Image.get_Height()
at System.Drawing.Image.get_Size()
at
System.Windows.Forms.PictureBox.ImageRectangleFromSizeMode(PictureBoxSizeMode mode)
at System.Windows.Forms.PictureBox.OnPaint(PaintEventArgs pe)
at System.Windows.Forms.Control.PaintWithErrorHandling(PaintEventArgs e,
Int16 layer)
at System.Windows.Forms.Control.WmPaint(Message& m)
at System.Windows.Forms.Control.WndProc(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
at System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
at System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr
wparam, IntPtr lparam)
Thank you for any assistance.

Related

VB.NET Copying myself and then run the copy fails

I'm trying to make it possible to run my project, copy itself to update.exe and then run that update.exe for the purpose of testing the update routine.
The problem I'm having is that the exefile is copied succesfully but when update.exe is then starts, it just always crashes.
If I abort the update.exe program from the crash, but my main exe still runs, I can then just start update.exe from explorer and all works fine. I can't for life figure out why update.exe crashes if it is started after it was copied from another exefile.
Here's the code:
Public Class Updater
Public sFullname As String
Public sExename As String
Public sArguments As String
Public Sub New()
'Constructor
Me.Initiate()
Me.FakeUpdate()
Me.DoUpdate()
'MsgBox(Me.sFullname)
End Sub
Private Sub Initiate()
Dim sCmdLine As String = Environment.CommandLine()
Dim iPos = sCmdLine.IndexOf("""", 2)
Me.sFullname = sCmdLine.Substring(1, iPos - 1).Trim()
Dim iPos2 = sFullname.LastIndexOf("\")
Me.sExename = sFullname.Substring(iPos2 + 1).Trim()
Me.sArguments = sCmdLine.Substring(iPos + 1).Trim()
End Sub
Private Sub FakeUpdate()
'If we start the app with -fakeupdate parameter, copy myself to update.exe, then run update.exe to debug the update process.
If Me.sArguments = "-fakeupdate" Then
FileCopy(Me.sFullname, "update.exe")
Shell("update.exe")
End If
End Sub
Private Sub DoUpdate()
If Me.sExename = "update.exe" Then
MsgBox("DoUpdate called from update.exe")
End If
End Sub
End Class
Public Class Form1
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim Updater As New Updater
End Sub
End Class
The project is configured that it runs with parameter -fakeupdate
The code is part of a larger project, but I have commented out all other code and still receive this error.
The error I'm getting from update.exe: Length cannot be less than null. Parametername: length
System.ArgumentOutOfRangeException: Length cannot be less than null.
Parameternaam: length
bij System.String.InternalSubStringWithChecks(Int32 startIndex, Int32 length, Boolean fAlwaysCopy)
bij Todo_List.Updater.Initiate() in S:\VB Projects\Todo List\Todo List\Form1.vb:regel 19
bij Todo_List.Updater..ctor() in S:\VB Projects\Todo List\Todo List\Form1.vb:regel 8
bij Todo_List.Form1.Form1_Load(Object sender, EventArgs e) in S:\VB Projects\Todo List\Todo List\Form1.vb:regel 594
bij System.EventHandler.Invoke(Object sender, EventArgs e)
bij System.Windows.Forms.Form.OnLoad(EventArgs e)
bij System.Windows.Forms.Control.CreateControl(Boolean fIgnoreVisible)
bij System.Windows.Forms.Control.CreateControl()
bij System.Windows.Forms.Control.WmShowWindow(Message& m)
bij System.Windows.Forms.Control.WndProc(Message& m)
bij System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
bij System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)
EDIT: small update, it also goes wrong if I don't even copy the file. Just shell("update.exe") goes wrong. I even created a button on the form to launch it upon click and it fails every time. But if I run it from explorer, all is fine.
This is weird behavior, possibly even a bug, but I figured it out.
Apparently, if you use shell ("program.exe") to start a program, and from within that program, you call Environment.CommandLine() it will just be program.exe, whereas if you doubleclick the program from explorer it will be C:\MyPath\program.exe instead.
In order to solve it, I had to change my code as follows:
Private Sub FakeUpdate()
Dim sShell As String
'If we start the app with -fakeupdate parameter, copy myself to update.exe, then run update.exe to debug the update process.
If Me.sArguments = "-fakeupdate" Then
FileCopy(Me.sFullname, "update.exe")
sShell = My.Computer.FileSystem.CurrentDirectory & "\update.exe"
Shell(sShell)
End If
End Sub
Now it works correctly, both from explorer AND from launching the program from within the program.

Receiving System.NotSupportedException when trying to make a string ProperCase (VB)

Private Sub btnNewStudent_Click(sender As Object, e As EventArgs) Handles btnNewStudent.Click
Dim name As String = InputBox("Enter the Student's Name", "Name", "Student Name")
name = StrConv(name, vbProperCase)
addStudent(name)
If name = "" Then
errorMessage("Please Enter a Name")
lstStudents.Items.Remove("")
End If
End Sub
Error Description:
"System.NotSupportedException: No data is available for encoding
1252. For information on defining a custom encoding, see the documentation for the Encoding.RegisterProvider method.
Error Details:
System.NotSupportedException HResult=0x80131515 Message=No data
is available for encoding 1252. For information on defining a custom
encoding, see the documentation for the Encoding.RegisterProvider
method. Source=Microsoft.VisualBasic.Core StackTrace: at
Microsoft.VisualBasic.Strings.StrConv(String str, VbStrConv
Conversion, Int32 LocaleID) at
StudentTrackerVB.frmStudentTrackers.btnNewStudent_Click(Object sender,
EventArgs e) in E:\College\Year 2\Unit 15 - Object Oriented
Programming\Assignment
3\StudentTrackerVB\StudentTrackerVB\Form1.vb:line 11 at
System.Windows.Forms.Control.OnClick(EventArgs e) at
System.Windows.Forms.Button.OnClick(EventArgs e) at
System.Windows.Forms.Button.OnMouseUp(MouseEventArgs mevent) at
System.Windows.Forms.Control.WmMouseUp(Message& m, MouseButtons
button, Int32 clicks) at
System.Windows.Forms.Control.WndProc(Message& m) at
System.Windows.Forms.ButtonBase.WndProc(Message& m) at
System.Windows.Forms.Button.WndProc(Message& m) at
System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
at System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, WM msg,
IntPtr wparam, IntPtr lparam)
When I try to make name into ProperCase, it comes up with an error. I've done a similar thing for items in an array making them UpperCase which works perfectly. But for some reason, this doesn't?
What am I doing wrong xD
Try using Globalization
Dim ti As Globalization.TextInfo = Globalization.CultureInfo.CurrentCulture.TextInfo
name = ti.ToTitleCase(name)
Changing Case

naudio not releasing file after dispose vb.net, It's really an declaration issue I think

I only post here when I'm really stuck, so here goes.
I'm creating a program where I can edit the metadata of MP3 files (with all data pulled from a mysql db), using taglib-sharp.
If I preview an audio file using naudio, I can hear the audio no problems and I can stop it, so that is all good.
For the sake of what is happening in my code, It's a matter of choosing a file from a listbox, and then I push a 'play' button to start, and another button to stop. My error is showing up with a right click context menu when I'm trying to save metadata.
The problem is when I go to edit the metadata of that same file I just played, the error appears - as per this shown in the following example of code. When I try and call the mp3.save() line, I receive the following error:
************** Exception Text **************
System.IO.IOException: The process cannot access the file
'C:\temp\test.mp3' because it is being used by another process. at
System.IO.__Error.WinIOError(Int32 errorCode, String maybeFullPath)
at System.IO.FileStream.Init(String path, FileMode mode, FileAccess
access, Int32 rights, Boolean useRights, FileShare share, Int32
bufferSize, FileOptions options, SECURITY_ATTRIBUTES secAttrs, String
msgPath, Boolean bFromProxy, Boolean useLongPath, Boolean checkHost)
at System.IO.FileStream..ctor(String path, FileMode mode, FileAccess
access, FileShare share) at
TagLib.File.LocalFileAbstraction.get_WriteStream() at
TagLib.File.set_Mode(AccessMode value) at
TagLib.NonContainer.File.Save() at
LinersDB_META.Form1.menuChoice(Object sender, EventArgs e) in
C:\Users\smonro\source\repos\WindowsApp1\WindowsApp1\Form1.vb:line
2281 at System.Windows.Forms.ToolStripItem.RaiseEvent(Object key,
EventArgs e) at
System.Windows.Forms.ToolStripMenuItem.OnClick(EventArgs e) at
System.Windows.Forms.ToolStripItem.HandleClick(EventArgs e) at
System.Windows.Forms.ToolStripItem.HandleMouseUp(MouseEventArgs e)
at System.Windows.Forms.ToolStrip.OnMouseUp(MouseEventArgs mea) at
System.Windows.Forms.ToolStripDropDown.OnMouseUp(MouseEventArgs mea)
at System.Windows.Forms.Control.WmMouseUp(Message& m, MouseButtons
button, Int32 clicks) at
System.Windows.Forms.Control.WndProc(Message& m) at
System.Windows.Forms.ToolStrip.WndProc(Message& m) at
System.Windows.Forms.ToolStripDropDown.WndProc(Message& m) at
System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg,
IntPtr wparam, IntPtr lparam)
etc
I know why it's happening, but I'm lost as to how to solve it.
According to this page, (which is in C#) I need to release the "Mp3FileReader".
In my case, it would be "data" - this:
Dim data As New NAudio.Wave.Mp3FileReader(file)
The problem is, it's in a private sub, as a private variable.
However, I'm struggling to see how I can make this declaration public, when I need to have file also declared, but it would also need to be known too, and reinitialized every time I choose a different audio file.
Any thoughts?
Should I just try and rearrange my program to work differently? Thanks in advance.
'...
Imports System.IO 'File Operations
Imports TagLib ' Tagging
Imports NAudio
'...
'Wave out device for playing the sound
Public Shared Wave1 As New NAudio.Wave.WaveOut 'Wave out device for playing the sound
Public Sub start_audio()
Dim file As String = "C:\test\test.mp3"
If IO.File.Exists(file) Then
Dim data As New NAudio.Wave.Mp3FileReader(file)
Wave1.Init(data)
Wave1.Play()
End If
End Sub
Public Sub Button5_Click_1(sender As Object, e As EventArgs) Handles Button5.Click
Wave1.Stop()
End Sub
Public Sub menuChoice(ByVal sender As Object, ByVal e As EventArgs)
Dim item = CType(sender, ToolStripMenuItem)
Dim selection = CInt(item.Tag)
Select Case selection
Case 1
' Remove the Artwork
'Insert Album art and save to file and dispose.
If IO.File.Exists(GLOBAL_Full_Path) Then
Wave1.Stop()
Wave1.Dispose()
System.GC.Collect()
System.GC.WaitForPendingFinalizers()
Dim mp3 As TagLib.File = TagLib.File.Create(GLOBAL_Full_Path)
' Clear the artwork from the file.. (It's a big process)
Dim pics As Picture = New Picture()
Dim picsFrame As New TagLib.Id3v2.AttachedPictureFrame(pics)
picsFrame.MimeType = System.Net.Mime.MediaTypeNames.Image.Jpeg
'set the type of picture (front cover)
picsFrame.Type = TagLib.PictureType.FrontCover
picsFrame.Description = "" ' So the Actual location of the image is not stored in the file. This would otherwise reveal internal systems to the public.
'Id3v2 allows more than one type of image, just one is needed here.
Dim pictFrames() As TagLib.IPicture = {picsFrame}
'set the pictures in the tag
mp3.Tag.Pictures = pictFrames
' ******************************************
' Error occurs here after a file has been played.
mp3.Save()
' Error occurs here
' ******************************************
mp3.Dispose()
End If
Case Else
End Select
End Sub
After #TnTinMn pointed me in the right direction, I solved the issue in the end. While this is not the full example, I've now solved this by adding and changing a couple of minor things.
Imports NAudio
' NEW/required to get the Mp3FileReader, so it can be dynamically populated.
Imports NAudio.Wave
Dim WavePlayOut As New NAudio.Wave.WaveOut 'Wave out device for playing the sound
Dim WaveFile As String = "" ' *** NEW/Declared ***
Dim WaveData As Mp3FileReader ' *** Changed ***
Public Sub start_audio()
If File_ListView.SelectedItems.Count > 0 Then
WaveFile = TxtBx_Path.Text & "\" & File_ListView.FocusedItem.Text
If WavePlayOut IsNot Nothing Then
WavePlayOut = New NAudio.Wave.WaveOut
End If
If WaveData IsNot Nothing Then
WaveData.Dispose()
WaveData = New Mp3FileReader(WaveFile)
If WaveData.Length > 1 Then
If IO.File.Exists(WaveFile) Then
WavePlayOut.Init(WaveData)
WavePlayOut.Play()
End If
End If
Else
WaveData = New Mp3FileReader(WaveFile)
If WaveData.Length > 1 Then
If IO.File.Exists(WaveFile) Then
WavePlayOut.Init(WaveData)
WavePlayOut.Play()
End If
End If
End If
End If
End Sub
To unload the audio file, use the following:
If WaveData IsNot Nothing Then
WaveData.Dispose()
End If
If WavePlayOut IsNot Nothing Then
WavePlayOut.Stop()
WavePlayOut.Dispose()
End If

Odd Progress Value Behaviour when SendMessage Color to Progress Bar

I am using SendMessage to change the colour of a progress bar. This works ok but I am seeing some odd behaviour related to the progress bar value.
When the bar is green it works as expected, but when it is red or yellow the bar is one block position out of sync with the progress bar value. The example code below steps down through progress bar values from 4 to 0 with progress bar maximum set to 4.
When the bar is green progress value 4 gives a full bar and all integer steps down to zero behave as expected. But when the bar is red or yellow it shows full bar or no bar for value 4 depending on where it was before. It shows FULL BAR for progress value 3, then steps down 1 block out of sync with the value until finally it shows no blocks when the progress value resets to maximum. If this sounds confusing then I'm with you all the way.
I am an avid trawler of SO and have been for many years and to date my questions have always been answered without the need to specifically ask. But while I can find a lot of progress bar questions I can't find any that relate to this issue and it is seriously confusing me. Am I missing something in my code or is this a bug?
Public Class Form1
Private Declare Auto Function SendMessage Lib "user32.dll"
(ByVal hWnd As IntPtr, ByVal msg As Integer,
ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Sub Form1_Shown(sender As Object, e As EventArgs)
ProgressBar1.Maximum = 4
ProgressBar1.Value = ProgressBar1.Maximum
End Sub
'Step down through progress bar values (4 to 0)
Private Sub Step(sender As Object, e As EventArgs) Handles CmdStep.Click
If ProgressBar1.Value > 0 Then
ProgressBar1.Increment(-1)
Else 'Progress bar back to Max after reaching zero
ProgressBar1.Value = ProgressBar1.Maximum
End If
'Show current progress bar value
TextBox1.Text = ProgressBar1.Value
End Sub
'Set colour (1 to 3)
Private mProgressColour As Integer = 1 'Initial colour: Green
Private Sub TBox(sender As Object, e As EventArgs) Handles TextBox2.TextChanged
'Change the progress bar colour according to colour value selected (1 to 3)
If TextBox2.Text <> "" Then
mProgressColour = CInt(TextBox2.Text)
SendMessage(ProgressBar1.Handle, &H410, mProgressColour, 0)
End If
End Sub
End Class
EDIT: Following advice from Visual Vincent I looked into class declarations and although it didn't fix this problem he gave me some good advice. Because Vincent pointed me to a C# declaration example I rewrote the program in C# and it exhibits exactly the same odd behaviour when changing progress bar colours. I apologise if mixing C# and VB in a question is bad form but in this case I think it's valid as the problem seems to be common to both.
As with the VB version (above) a new project was started, the controls added to the form and the code entered into the form class. No other code, events or background workers to interfere with the program flow.
using System.Runtime.InteropServices; //For [DllImport]
namespace WindowsFormsApp1
{
public partial class Form1 : Form
{
public Form1(){InitializeComponent();}
[DllImport("user32.dll")]
public static extern int SendMessage(IntPtr hWnd, int wMsg, IntPtr wParam, IntPtr lParam);
private void Form1_Load(object sender, EventArgs e)
{
ProgressBar1.Maximum = 4;
ProgressBar1.Value = ProgressBar1.Maximum;
}
private void CmdStep_Click(object sender, EventArgs e)
{
if (ProgressBar1.Value > 0)
{
ProgressBar1.Increment(-1);
}
else //Progress bar back to Max after reaching zero
{
ProgressBar1.Value = ProgressBar1.Maximum;
}
TextBox1.Text = Convert.ToString(ProgressBar1.Value); //Show current progress bar value
}
private int mProgressColour = 1; //Green
private void TextBox2_TextChanged(object sender, EventArgs e)
{
//Change the progress bar colour according to colour selected in TextBox2 (1 to 3)
if (TextBox2.Text != "")
{
mProgressColour = Convert.ToInt32(TextBox2.Text); //Convert Text box value to Integer
IntPtr ipProgColour = (IntPtr)mProgressColour; //Then convert the Integer to IntPtr
SendMessage(ProgressBar1.Handle, 0x410, ipProgColour, IntPtr.Zero); //Do it!
}
}
}
}
The screengrab below shows the C# program outputs. I haven't shown the green bar because it behaves normally and I have used the yellow bar this time just to show that this colour bar exhibits the same behaviour as the red coloured bar.
I have been racking my brain trying to think of causes. It's like the red/yellow coloured bar data bits are rotated. But I assume it's the same object as the green bar, it has the same handle. But maybe it's not and that's just mind-blowing. Any ideas guys? If you get a bit of time can I humbly ask you try running this code by copy pasting it into a new form like the one shown and let me know that I'm not going mad! Thanks.
The problem seems to be an internal buffering bug as identified by Hans Passant.
The bug was reported to Microsoft as suggested by Visual Vincent.
The workaround is to Increment(0) after ProgressBar.Value statements.
Note that ProgressBar.Refresh and Update do not resolve this issue.
The following subroutine is from the VB code example with the Increment(0) fix added.
'Step down through progress bar values (4 to 0)
Private Sub CmdStep_Click(sender As Object, e As EventArgs) Handles CmdStep.Click
If ProgressBar1.Value > 0 Then
ProgressBar1.Value -= 1
Else 'Progress bar back to Max after reaching zero
ProgressBar1.Value = ProgressBar1.Maximum
End If
''''''''''''''''''''''''''
ProgressBar1.Increment(0) ' Incrementing by zero causes the progress bar to update
''''''''''''''''''''''''''
'Show current progress bar value
TextBox1.Text = ProgressBar1.Value
End Sub

Intercept single or double mouse click - only execute double click code on double click

I have a situation where I am handling both single & double mouse click events on a form. In both cases something has to be loaded, however when a double click occurs, I do not wish to execute the code attached to the single click event.
Is there a way to intercept the mouse click's and check if double or single and then execute the right event appropriately?
Perhaps by intercepting the WndProc of the window or something?
No, that's pretty much impossible unless you have a time machine. And it doesn't really even make sense once you understand how Windows distinguishes double-clicks from single-clicks.
It turns out that Raymond Chen (a developer on the Windows Shell team) explains exactly that in a blog entry titled "Logical consequences of the way Windows converts single-clicks into double-clicks".
Specifically, Windows only knows to interpret something as a double-click because a second click has occurred within the interval specified by the GetDoubleClickTime function. Because it would require clairvoyance (as Raymond so eloquently puts it) to determine ahead of time if something is going to be a single or double click, the window manager goes ahead and sends a WM_LBUTTONDOWN message as soon as the first click is received. The WM_LBUTTONDBLCLK message is only sent later, after the second click is confirmed to actually represent a double-click. The upshot is that your application will always receive two WM_LBUTTONDOWN messages for each WM_LBUTTONDBLCLK message that is received.
Now, the .NET Framework designers understood how this process works and designed the events that are raised accordingly. Of course, they can't do anything about a single click always occurring before a double-click, but they were able to suppress the second click message if it is determined that the user intended that to be part of a double-click event. As the documentation for the Control.MouseClick event (which roughly corresponds to the WM_LBUTTONDOWN message) tells us:
Two single clicks that occur close enough in time, as determined by the mouse settings of the user's operating system, will generate a MouseDoubleClick event instead of the second MouseClick event.
Raymond's blog article that I linked to above does, however, propose a possible workaround for apps and developers who insist on a design where the double-click action is unrelated to the single-click action (although neither of us recommend that you actually do this):
Now suppose you're a program that nevertheless wants to continue with the dubious design of having the double-click action be unrelated to the single-click action. What do you do?
Well, one thing you could do is to do nothing on receipt of the WM_LBUTTONDOWN message aside from set a timer to fire in GetDoubleClickTime() milliseconds. [Corrected 10am.] If you get a WM_LBUTTONDBLCLK message within that time, then it was a double-click after all. If you don't, then it must have been a single-click, so you can do your single-click action (although a bit late).
Here is code to do what you requested.
Public Class Form1
Const WM_LBUTTONDOWN As Integer = &H201
Const WM_LBUTTONDBLCLK As Integer = &H203
Private WithEvents tmrDoubleClicks As Timer
Dim isDblClk As Boolean
Dim firstClickTime As Date
Dim doubleClickInterval As Integer
Sub New()
' This call is required by the designer.
InitializeComponent()
tmrDoubleClicks = New Timer
' Add any initialization after the InitializeComponent() call.
tmrDoubleClicks.Interval = 50
doubleClickInterval = CInt(Val(Microsoft.Win32.Registry.CurrentUser.
OpenSubKey("Control Panel\Mouse").
GetValue("DoubleClickSpeed", 1000)))
End Sub
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
If disposing AndAlso tmrDoubleClicks IsNot Nothing Then
tmrDoubleClicks.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Select Case m.Msg
Case WM_LBUTTONDOWN
If Not isDblClk Then
firstClickTime = Now
tmrDoubleClicks.Start()
End If
Case WM_LBUTTONDBLCLK
isDblClk = True
tmrDoubleClicks.Stop()
DoubleClickActivity()
isDblClk = False
Case Else
MyBase.WndProc(m)
End Select
End Sub
Private Sub DoubleClickActivity()
'implement double click activity here
Dim r As New Random(Now.TimeOfDay.Seconds)
Me.BackColor = Color.FromArgb(r.Next(0, 255),
r.Next(0, 255),
r.Next(0, 255))
End Sub
Private Sub SingleClickActivity()
'implement single click activity here
Beep()
End Sub
Private Sub tmrDoubleClicks_Tick(ByVal sender As Object,
ByVal e As System.EventArgs
) Handles tmrDoubleClicks.Tick
If Now.Subtract(firstClickTime).TotalMilliseconds >
doubleClickInterval Then
'since there was no other click within the doubleclick speed,
'stop waiting and fire the single click activity
isDblClk = False
tmrDoubleClicks.Stop()
SingleClickActivity()
End If
End Sub
End Class
The crux of this code is to delay firing the click event till the double click time elapses. If within that time, another click event occurs within that time, the double click event is called without calling the click event. If, however, there is no double click, the click event is called.
This delay is particularly noticeable on computers that have a longer double click speed. On a typical computer, the double click speed is 500ms so the code will run the click event somewhere between 500ms and 600ms after a click occured.