Capture still image from webcam (DirectSHowLib, VB.NET) - vb.net

I'm ashamed, but I'll ask anyway: which is the most straightforward way to take a picture from a webcam with its default size and color-depth?
I started playing with DirectShowLib but I'm clueless... Can anyone guive me a guidance?
Imports DirectShowLib
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
PictureBox1.Image = Nothing
Dim Cam As DsDevice = DsDevice.GetDevicesOfCat(FilterCategory.VideoInputDevice).FirstOrDefault
If Cam IsNot Nothing Then
Stop
' ... what now?
End If
End Sub
End Class

DirectShowLib's samples DxSnap, DxWebCam (C#) show how to capture from a webcam. There is also VB.NET DxLogoVB there, it does a different thing but is still good if you also look for some DriectShow.NET + VB.NET sample code.
DxWebCam:
A poor man's web cam program. This application runs as a Win32 Service.
It takes the output of a capture graph, turns it into a stream of JPEG
files, and sends it thru TCP/IP to a client application.
DxSnap:
Use DirectShow to take snapshots from the Still pin of a capture
device. Note the MS encourages you to use WIA for this, but if
you want to do in with DirectShow and C#, here's how.
Note that this sample will only work with devices that output uncompressed
video as RBG24. This will include most webcams, but probably zero tv tuners.

Ok, the best I was able to do depends on AForge.Controls and AForge.Video.DirectShow and is working with this code, which I intend to improve (it is a rough scratch - but takes the picture):
Public Class Form1
Private Sub Test() Handles Me.Load
Dim rf As New RolleiFlex
PictureBox1.Image = rf.Click
End Sub
End Class
Public Class RolleiFlex
Public Sub New()
Dim vDevices = New AForge.Video.DirectShow.FilterInfoCollection(FilterCategory.VideoInputDevice)
Devices = vDevices.Cast(Of FilterInfo).Select(
Function(fi) New Device With {
.Name = fi.Name,
.MonikerString = fi.MonikerString}).ToArray
SelectedDevice = Devices.FirstOrDefault
vDevices = Nothing
End Sub
Public Devices As Device()
Public Property SelectedDevice As Device
Public Class Device
Public Property Name As String
Public Property MonikerString As String
End Class
Public Function Click() As Bitmap
Dim retBmp As Bitmap
Dim camera As New AForge.Controls.VideoSourcePlayer
camera.VideoSource = New VideoCaptureDevice(SelectedDevice.MonikerString)
camera.Start()
Do
retBmp = camera.GetCurrentVideoFrame
If retBmp Is Nothing Then Threading.Thread.Sleep(100)
Loop While retBmp Is Nothing
camera.Stop()
camera.Dispose()
camera = Nothing
Return retBmp
End Function
End Class

Related

vb.net winforms download without blocking

I'm downloading files .mp3 and my goal is not to have even a minimum GUI freezing during downloading.
My aim is also to display the bites received in a progress bar and through labels.
This code is working, but sometimes is freezing without any reason, sometimes the progress bar doesn't work until file is completely done.
So far, this is the "best" code I found online for a completely working progress bar during a download, but still gets problems.
How do you think I can increase performances? How can I make a resistant and reliable working progressbar? How can I download also large file without GUI freezing? I tried (curiosity) to download a 600 mb file and it completely freeze, not responding and not giving any issue back.
Thanks
EDIT1: I'm trying with this,eventhough I'm lost on high waves.. Any idea on how can I use this code and insert it into Jimi Answer? Answer
Imports System.IO
Imports System.IO.Path
Imports System.Net
Public Class Form1
Private downloader As MyDownloader = Nothing
Private Sub btnStartDownload_Click(sender As Object, e As EventArgs) Handles btnStartDownload.Click
Dim progress = New Progress(Of String)(
Sub(data)
MsgBox("we are on the UI thread here")
End Sub)
Dim url As Uri = New Uri(TextBox1.Text)
downloader = New MyDownloader()
'How can I remove this second? I don't need download from url every 1 second.
downloader.StartDownload(progress, url, 1)
End Sub
And
Imports System.ComponentModel
Imports System.Diagnostics
Imports System.Net
Imports System.Net.Http
Imports System.Text.RegularExpressions
Imports System.Threading
Public Class MyDownloader
Private Shared ReadOnly client As New HttpClient()
client.DownloadProgressChanged += AddressOf Client_DownloadProgressChanged
client.DownloadFileCompleted += AddressOf Client_DownloadFileCompleted
Private interval As Integer = 0
Private Sub Client_DownloadFileCompleted(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
System.Windows.Forms.MessageBox.Show("Download OK!", "Message", MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub
Public Sub StartDownload(progress As IProgress(Of String), url As Uri, intervalSeconds As Integer)
interval = intervalSeconds * 1000
Task.Run(Function() DownloadAsync(progress, url))
End Sub
Private Sub Client_DownloadProgressChanged(ByVal sender As Object, ByVal e As DownloadProgressChangedEventArgs)
ProgressBar1.Minimum = 0
Dim receive As Double = Double.Parse(e.BytesReceived.ToString())
Dim total As Double = Double.Parse(e.TotalBytesToReceive.ToString())
Dim percentage As Double = receive / total * 100
label2.Text = $"{String.Format("{0:0.##}", percentage)}%"
ProgressBar1.Value = Integer.Parse(Math.Truncate(percentage).ToString())
End Sub
Private Async Function DownloadAsync(progress As IProgress(Of String), url As Uri) As Task
Dim pattern As String = "<(?:[^>=]|='[^']*'|=""[^""]*""|=[^'""][^\s>]*)*>"
Dim downloadTimeWatch As Stopwatch = New Stopwatch()
downloadTimeWatch.Start()
Do
Try
Dim response = Await client.GetAsync(url, HttpCompletionOption.ResponseContentRead)
Dim data = Await response.Content.ReadAsStringAsync()
data = WebUtility.HtmlDecode(Regex.Replace(data, pattern, ""))
progress.Report(data)
Dim delay = interval - CInt(downloadTimeWatch.ElapsedMilliseconds)
Await Task.Delay(If(delay <= 0, 10, delay))
downloadTimeWatch.Restart()
Catch ex As Exception
End Try
Loop
End Function
End Class
I'm Seriously lost on it, I tried to delete cancel download as I am not going to stop any download and I tried also to delete Download from url every 1 second as I just need one time download for every link.
Thanks

EMGUCV facial recognition issue in VB.NET

I'm trying to implement a web app with VB.NET which is supposed to perform facial recognition on images in a folder using EMGUCV library. Anyway, when I call method train on the facerecognizer object a strange exception is raised:
'OpenCV: 0 <= _rowRange.start && _rowRange.start <= _rowRange.end && _rowRange.end <= m.rows
Here's my test code:
Imports System.Drawing
Imports Emgu.CV
Imports Emgu.CV.Face
Imports Emgu.CV.Structure
Imports Emgu.CV.Util
Public Class _Default
Inherits Page
Protected Sub Page_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
End Sub
Protected Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim images As New Mat
Dim Palb0 = "c://IMGDB//Alberto//0.jpg"
Dim Palb1 = "c://IMGDB//Alberto//1.jpg"
Dim Pcon0 = "c://IMGCONFRONTO//0.jpg"
images.PushBack(CvInvoke.Imread(Palb0, CvEnum.LoadImageType.Grayscale))
images.PushBack(CvInvoke.Imread(Palb1, CvEnum.LoadImageType.Grayscale))
Dim model = New EigenFaceRecognizer(80, Double.PositiveInfinity)
Dim labels As New VectorOfInt
Dim a(0) As Integer
a(0) = 0
labels.Push(a)
model.Train(images, labels)
Dim imgConf As Mat
imgConf = CvInvoke.Imread(Pcon0, CvEnum.LoadImageType.Grayscale)
model.Predict(imgConf)
Dim PR As FaceRecognizer.PredictionResult
Dim dst = PR.Distance
Dim lbl = PR.Label
MsgBox(dst)
End Sub
End Class
I tryed nearly everything but can' solve it. Any help will be really appreciated.
I managed to find a solution myself.
The roblem was really as simpe as the type of object I used for the constructor. It was supposed to be a VectorOfMat instead of Mat. the class couldn't work because it expected an array.
Dim images As New VectorOfMat
Another problem was in the constructor itself. It was supposed to be:
Dim model As New EigenFaceRecognizer(80, Double.PositiveInfinity)
One more piece of advice: If the train method doesen't receive an array of mat of at least two images, it will throw another exception. The images are supposed to be of the same size or (strange) the object will throw one more exception.
Finally the correct code for the predictionresult is:
Dim PR As FaceRecognizer.PredictionResult = model.Predict(imgConf)
and you get eigenfaces prediction distance:
Dim dis = PR.Distance
Hope this can get somebody out of trouble.
Ceers.

Trying to write IP address to textbox in Visual Basic

I am trying to write a simple program that finds the public IP for the computer it is being used on. However, I am not sure how to set the text of the TextBox to the IP address that is found. Can anyone help me?
Code:
Imports System.Net
Imports System.Text
Imports System.Text.RegularExpressions
Public Class Form1
Private Function GetMyIP() As IPAddress
Using wc As New WebClient
Return IPAddress.Parse(Encoding.ASCII.GetString(wc.DownloadData("http://tools.feron.it/php/ip.php")))
End Using
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
TextBox1.Text = (GetMyIP())
End Sub
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs)
End Sub
End Class
First, you should use Option Strict On. That would point out to you that you need to use
TextBox1.Text = GetMyIP().ToString()
Next, if you examine the headers from that web page you will see it returns the result in UTF-8 encoding, so you should use Encoding.UTF8 instead of Encoding.ASCII. Unfortunately, that still does not work - I will write more on that later.
However, WebClient has a DownloadString method which works well in this case:
Private Function GetMyIP() As IPAddress
Using wc As New WebClient
Dim url = "http://tools.feron.it/php/ip.php"
Dim x = wc.DownloadString(url)
Return IPAddress.Parse(x.Trim())
End Using
End Function
If you still want to use DownloadData, you should examine the returned bytes: you would find that the data you want is preceded by the bytes 0xEF 0xBB 0xBF. I do not know why. This is messing up the string that you want if you download it as an array of bytes.
You could use LINQ to remove the strange bytes:
Private Function GetMyIP() As IPAddress
Using wc As New WebClient
Dim url = "http://tools.feron.it/php/ip.php"
Dim x = wc.DownloadData(url)
Dim y = Encoding.UTF8.GetString(x.Where(Function(b) b < 128).ToArray())
Return IPAddress.Parse(y)
End Using
End Function
(I could have used Encoding.ASCII in there because the bytes over 127 have been removed.)

Is there away to switch from a Worker Thread to the Main (UI) thread?

I apologize in advance if my question is too long-winded. I looked at the question “How to update data in GUI with messages that are being received by a thread of another class?” and it is very close to what I am trying to do but the answer was not detailed enough to be helpful.
I have converted a VB6 app to VB.NET (VS2013). The main function of the app is to send queries to a Linux server and display the results on the calling form. Since the WinSock control no longer exists, I’ve created a class to handle the functions associated with the TcpClient class. I can successfully connect to the server and send and receive data.
The problem is that I have multiple forms that use this class to send query messages to the server. The server responds with data to be displayed on the calling form. When I try to update a control on a form, I get the error "Cross-thread operation not valid: Control x accessed from a thread other than the thread it was created on." I know I’m supposed to use Control.InvokeRequired along with Control.Invoke in order to update controls on the Main/UI thread, but I can’t find a good, complete example in VB. Also, I have over 50 forms with a variety of controls on each form, I really don’t want to write a delegate handler for each control. I should also mention that the concept of threads and delegates is very new to me. I have been reading everything I can find on this subject for the past week or two, but I’m still stuck!
Is there some way to just switch back to the Main Thread? If not, is there a way I can use Control.Invoke just once to cover a multitude of controls?
I tried starting a thread just after connecting before I start sending and receiving data, but netStream.BeginRead starts its own thread once the callback function fires. I also tried using Read instead of BeginRead. It did not work well if there was a large amount of data in the response, BeginRead handled things better. I feel like Dorothy stuck in Oz, I just want to get home to the main thread!
Thanks in advance for any help you can provide.
Option Explicit On
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.Threading
Friend Class ATISTcpClient
Public Event Receive(ByVal data As String)
Private Shared WithEvents oRlogin As TcpClient
Private netStream As NetworkStream
Private BUFFER_SIZE As Integer = 8192
Private DataBuffer(BUFFER_SIZE) As Byte
Public Sub Connect()
Try
oRlogin = New Net.Sockets.TcpClient
Dim localIP As IPAddress = IPAddress.Parse(myIPAddress)
Dim localPrt As Int16 = myLocalPort
Dim ipLocalEndPoint As New IPEndPoint(localIP, localPrt)
oRlogin = New TcpClient(ipLocalEndPoint)
oRlogin.NoDelay = True
oRlogin.Connect(RemoteHost, RemotePort)
Catch e As ArgumentNullException
Debug.Print("ArgumentNullException: {0}", e)
Catch e As Net.Sockets.SocketException
Debug.Print("SocketException: {0}", e)
End Try
If oRlogin.Connected() Then
netStream = oRlogin.GetStream
If netStream.CanRead Then
netStream.BeginRead(DataBuffer, 0, BUFFER_SIZE, _
AddressOf DataArrival, DataBuffer)
End If
Send(vbNullChar)
Send(User & vbNullChar)
Send(User & vbNullChar)
Send(Term & vbNullChar)
End If
End Sub
Public Sub Send(newData As String)
On Error GoTo send_err
If netStream.CanWrite Then
Dim sendBytes As [Byte]() = Encoding.UTF8.GetBytes(newData)
netStream.Write(sendBytes, 0, sendBytes.Length)
End If
Exit Sub
send_err:
Debug.Print("Error in Send: " & Err.Number & " " & Err.Description)
End Sub
Private Sub DataArrival(ByVal dr As IAsyncResult)
'This is where it switches to a WorkerThread. It never switches back!
On Error GoTo dataArrival_err
Dim myReadBuffer(BUFFER_SIZE) As Byte
Dim myData As String = ""
Dim numberOfBytesRead As Integer = 0
numberOfBytesRead = netStream.EndRead(dr)
myReadBuffer = DataBuffer
myData = myData & Encoding.ASCII.GetString(myReadBuffer, 0, numberOfBytesRead)
Do While netStream.DataAvailable
numberOfBytesRead = netStream.Read(myReadBuffer, 0, myReadBuffer.Length)
myData = myData & Encoding.ASCII.GetString(myReadBuffer, 0, numberOfBytesRead)
Loop
'Send data back to calling form
RaiseEvent Receive(myData)
'Start reading again in case we don‘t have the entire response yet
If netStream.CanRead Then
netStream.BeginRead(DataBuffer, 0,BUFFER_SIZE,AddressOf DataArrival,DataBuffer)
End If
Exit Sub
dataArrival_err:
Debug.Print("Error in DataArrival: " & err.Number & err.Description)
End Sub
Instead of using delegates one could use anonymous methods.
Singleline:
uicontrol.Window.Invoke(Sub() ...)
Multiline:
uicontrol.Window.Invoke(
Sub()
...
End Sub
)
If you don't want to pass an UI control every time you need to invoke, create a custom application startup object.
Friend NotInheritable Class Program
Private Sub New()
End Sub
Public Shared ReadOnly Property Window() As Form
Get
Return Program.m_window
End Get
End Property
<STAThread()> _
Friend Shared Sub Main()
Application.EnableVisualStyles()
Application.SetCompatibleTextRenderingDefault(False)
Dim window As New Form1()
Program.m_window = window
Application.Run(window)
End Sub
Private Shared m_window As Form
End Class
Now, you'll always have access to the main form of the UI thread.
Friend Class Test
Public Event Message(text As String)
Public Sub Run()
Program.Window.Invoke(Sub() RaiseEvent Message("Hello!"))
End Sub
End Class
In the following sample code, notice that the Asynchronous - Unsafe run will throw a Cross-thread exception.
Imports System.Threading
Imports System.Threading.Tasks
Public Class Form1
Public Sub New()
Me.InitializeComponent()
Me.cbOptions = New ComboBox() With {.TabIndex = 0, .Dock = DockStyle.Top, .DropDownStyle = ComboBoxStyle.DropDownList} : Me.cbOptions.Items.AddRange({"Asynchronous", "Synchronous"}) : Me.cbOptions.SelectedItem = "Asynchronous"
Me.btnRunSafe = New Button() With {.TabIndex = 1, .Dock = DockStyle.Top, .Text = "Run safe!", .Height = 30}
Me.btnRunUnsafe = New Button() With {.TabIndex = 2, .Dock = DockStyle.Top, .Text = "Run unsafe!", .Height = 30}
Me.tbOutput = New RichTextBox() With {.TabIndex = 3, .Dock = DockStyle.Fill}
Me.Controls.AddRange({Me.tbOutput, Me.btnRunUnsafe, Me.btnRunSafe, Me.cbOptions})
Me.testInstance = New Test()
End Sub
Private Sub _ButtonRunSafeClicked(s As Object, e As EventArgs) Handles btnRunSafe.Click
Dim mode As String = CStr(Me.cbOptions.SelectedItem)
If (mode = "Synchronous") Then
Me.testInstance.RunSafe(mode)
Else 'If (mode = "Asynchronous") Then
Task.Factory.StartNew(Sub() Me.testInstance.RunSafe(mode))
End If
End Sub
Private Sub _ButtonRunUnsafeClicked(s As Object, e As EventArgs) Handles btnRunUnsafe.Click
Dim mode As String = CStr(Me.cbOptions.SelectedItem)
If (mode = "Synchronous") Then
Me.testInstance.RunUnsafe(mode)
Else 'If (mode = "Asynchronous") Then
Task.Factory.StartNew(Sub() Me.testInstance.RunUnsafe(mode))
End If
End Sub
Private Sub TestMessageReceived(text As String) Handles testInstance.Message
Me.tbOutput.Text = (text & Environment.NewLine & Me.tbOutput.Text)
End Sub
Private WithEvents btnRunSafe As Button
Private WithEvents btnRunUnsafe As Button
Private WithEvents tbOutput As RichTextBox
Private WithEvents cbOptions As ComboBox
Private WithEvents testInstance As Test
Friend Class Test
Public Event Message(text As String)
Public Sub RunSafe(mode As String)
'Do some work:
Thread.Sleep(2000)
'Notify any listeners:
Program.Window.Invoke(Sub() RaiseEvent Message(String.Format("Safe ({0}) # {1}", mode, Date.Now)))
End Sub
Public Sub RunUnsafe(mode As String)
'Do some work:
Thread.Sleep(2000)
'Notify any listeners:
RaiseEvent Message(String.Format("Unsafe ({0}) # {1}", mode, Date.Now))
End Sub
End Class
End Class
Thank you to those who took the time to make suggestions. I found a solution. Though it may not be the preferred solution, it works beautifully. I simply added MSWINSCK.OCX to my toolbar, and use it as a COM/ActiveX component. The AxMSWinsockLib.AxWinsock control includes a DataArrival event, and it stays in the Main thread when the data arrives.
The most interesting thing is, if you right click on AxMSWinsockLib.DMSWinsockControlEvents_DataArrivalEvent and choose Go To Definition, the object browser shows the functions and delegate subs to handle the asynchronous read and the necessary delegates to handle BeginInvoke, EndInvoke, etc. It appears MicroSoft has already done the hard stuff that I did not have the time or experience to figure out on my own!

Creating a Serial Port in code in VB.net

I am trying to create a serial port in VB.net using code only. Because I am creating a class library I cannot use the built-in component. I have tried instantiating a new SeialPort() object, but that does not seem to be enough. I'm sure there is something simple I am missing and any help would be greatly appreciated! Thanks!
P.S. I should add that the problem I am having at this time is getting the code to handle the datareceived event. Other than that it might be working, but I can't tell because of that problem.
If you want to use the events make sure you declare your serialPort object using the 'withevents'. The below example will allow you to connect to a serial port, and will raise an event with the received string.
Imports System.Threading
Imports System.IO
Imports System.Text
Imports System.IO.Ports
Public Class clsBarcodeScanner
Public Event ScanDataRecieved(ByVal data As String)
WithEvents comPort As SerialPort
Public Sub Connect()
Try
comPort = My.Computer.Ports.OpenSerialPort("COM5", 9600)
Catch
End Try
End Sub
Public Sub Disconnect()
If comPort IsNot Nothing AndAlso comPort.IsOpen Then
comPort.Close()
End If
End Sub
Private Sub comPort_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles comPort.DataReceived
Dim str As String = ""
If e.EventType = SerialData.Chars Then
Do
Dim bytecount As Integer = comPort.BytesToRead
If bytecount = 0 Then
Exit Do
End If
Dim byteBuffer(bytecount) As Byte
comPort.Read(byteBuffer, 0, bytecount)
str = str & System.Text.Encoding.ASCII.GetString(byteBuffer, 0, 1)
Loop
End If
RaiseEvent ScanDataRecieved(str)
End Sub
End Class
I found this article to be quite good.
The code i wrote from it is:
port = new System.IO.Ports.SerialPort(name, 4800, System.IO.Ports.Parity.None, 8, System.IO.Ports.StopBits.One);
port.DataReceived += new System.IO.Ports.SerialDataReceivedEventHandler(port_DataReceived);
port.Open();
void port_DataReceived(object sender, System.IO.Ports.SerialDataReceivedEventArgs e)
{
buffer = port.ReadLine();
// process line
}
Sorry it's C# but...
The only issue I have with it is if the port is dropped while it's open, the app seems to fail on exit.
Thank you all for your help, especially the answer about instantiating a class using the WithEvents keyword.
I found a really great article that explains how to create a manager class for the serial port. It also discusses sending Binary as well as Hex data to the serial port. It was quite helpful.
http://www.dreamincode.net/forums/showtopic37361.htm
I have used the SerialPort .Net class in a past project and I worked fine. You really don't need anything else. Check the hardware setting in the control panel and make sure you instantiate the class with the same parameters.