I'm creating a system that capture and decodes QRCode in real-time using timer.tick. I'm using Emgu.cv for camera capture and MessagingToolkit for QR Code decoding. I'm having a problem on scanning.
It lags for every tick. Here's the code:
Dim QrDecoder As QRCodeDecoder = New QRCodeDecoder
Dim Cap As Capture = New Capture
Private Sub CameraTimer_Tick(sender As Object, e As EventArgs) Handles CameraTimer.Tick
Dim img As Image(Of Bgr, Byte) = Cap.QueryFrame().ToImage(Of Bgr, Byte)
PictureBox1.Image = img.ToBitmap()
Try
QrDecoder = New QRCodeDecoder
TextBox1.Text = New String(QrDecoder.decode(New Data.QRCodeBitmapImage(PictureBox1.Image)))
Catch ex As Exception
End Try
End Sub'
Any solutions for removing the lag?
Related
I am reading a large text file in vb.net using System.IO.File.ReadAllLines(TextFileURL). Since the process takes a few seconds to finish, would there be a possibility to use a progress bar?
.
RawFile = System.IO.File.ReadAllLines(TextFileURL)
lines = RawFile.ToList
If arg = "" Then MsgBox("IMPORTER IS DONE")
.
There is no loop or anything that could be used to update the value of the progress bar. Any thoughts or workaround would be appreciated.
The following reads a pretty big .TXT file line by line and reports progress:
Code:
Imports System.IO
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Async Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim dialog As New OpenFileDialog
dialog.Filter = "Text|*.txt"
Dim result = dialog.ShowDialog()
If result <> DialogResult.OK Then
Return
End If
Dim stream = File.OpenRead(dialog.FileName)
Dim reader As New StreamReader(stream)
Dim percentage As Integer
While True
Dim line As String = Await reader.ReadLineAsync()
If line Is Nothing Then
Exit While
End If
' TODO do something with your line
Dim percentD As Double = 1D / stream.Length * stream.Position * 100D
Dim percentI As Integer = Math.Floor(percentD)
If percentI > percentage Then
ProgressBar1.Value = percentI
percentage = percentI
End If
End While
Await stream.DisposeAsync()
End Sub
End Class
Result:
Notes:
this puts a burden on the stream as ultimately reading a line is small data
try using a buffered stream to reduce pressure
notice that I only report when integer percentage is greater than previous
you'd overwhelm UI when updating the progress bar otherwise
there is trivial async usage, you may want to improve that overall
the progress bar doesn't exactly reach 100%, I let you fix that, it's pretty EZ to do
You can use ReadLines instead of ReadAllLines
as docs said, when you are working with very large files, ReadLines can be more efficient:
Dim lstOflines as List(Of String)
For Each line As String In File.ReadLines(TextFileURL)
lstOflines.Add(line)
Next line
For get the total number of lines, you can make a guess based on file Size instead processing two times the file
Code for getting filesize: (use before start processing)
Dim myFile As New FileInfo(TextFileURL)
Dim sizeInBytes As Long = myFile.Length
I'm trying to do the following activity in visual basic:
Take a screenshot of my desktop and hold it in picture box.
Save it on my folder
Send a mail to someone with the image attached
Rename the image and Delete it from the folder
This is a recurring activity for every one hour. So far I have coded for all the steps above but when the script tries to rename the file on the folder I get an error message.
Error code
The code goes something like this:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim theTime As DateTime
theTime = Now.ToLongTimeString
Dim regDate As Date = DateTime.Now()
strDate = regDate.ToString("ddMMMyyyy HH:mm:ss")
'MsgBox(theTime)
'currentfolder = "C:\Users\user\Desktop" + strDate
'My.Computer.FileSystem.CreateDirectory(currentfolder)
If theTime >= #8:00:00 AM# Then
Timer1.Interval = 100
Timer1.Start()
'Timer starts functioning
End If
End Sub
Function Takescreenshot()
Dim bounds As Rectangle
Dim screenshot As System.Drawing.Bitmap
Dim graph As Graphics
Dim FileToDelete As String
FileToDelete = "C:\Users\user\Desktop\1.png"
If System.IO.File.Exists(FileToDelete) = True Then
PictureBox1.Image = Nothing
My.Computer.FileSystem.RenameFile("C:\Users\user\Desktop\1.png", "2.png")
System.IO.File.Delete("C:\Users\user\Desktop\2.png")
End If
bounds = Screen.PrimaryScreen.Bounds
screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
graph = Graphics.FromImage(screenshot)
graph.CopyFromScreen(bounds.X, bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy)
PictureBox1.Image = screenshot
SaveImage("C:\Users\user\Desktop\1.png", PictureBox1.Image)
'Send Email
Second = 0
Timer1.Start()
End Function
Public Sub SaveImage(filename As String, image As Image)
Dim path As String = System.IO.Path.Combine(My.Application.Info.DirectoryPath, filename & ".png")
Dim mySource As New Bitmap(image.Width, image.Height)
Dim grfx As Graphics = Graphics.FromImage(mySource)
grfx.DrawImageUnscaled(image, Point.Empty)
grfx.Dispose()
mySource.Save(filename, System.Drawing.Imaging.ImageFormat.Jpeg)
mySource.Dispose()
End Sub
I need to delete the current image and then save a fresh copy of it. Please help.
Ok I found out a solution for this problem. I actually found out what was the process that was really holding the script from deleting the image.
It was the mail function which I have not added for security reasons. I had to dispose the image that was being added to the email body after the work was done so
img1.Dispose()
solved the issue
I wrote code using Aforge to capture the Video from the camera and its working fine. My problem is when I just start the Camera in the preview mode only without recording the camera (preview window) freezes after 15 or 20 seconds. Then I noticed in the Task Manager that the cause is the process vhost32-clr.exe which starts to consume the memory until reaches +- 1,600 MB then the camera freezes.
Noting that I wrote another code using DirectShow capture instead of Aforge and its working with no issues where the process vhost32-clr.exe does not exceed 30 MB of memory.
Here is my code :
I call below Sub in the form load
Public Sub callCam()
PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
fiF = New FilterInfoCollection(FilterCategory.VideoInputDevice)
finalVideo = New VideoCaptureDevice(fiF(0).MonikerString)
finalVideo.VideoResolution = finalVideo.VideoCapabilities(0)
'finalVideo.ProvideSnapshots = True
AddHandler finalVideo.NewFrame, New NewFrameEventHandler(AddressOf Scapture)
finalVideo.Start()
End Sub
Once the above code is executed, the mentioned vhost32-clr.exe starts to consume the memory then freezes the camera preview, without executing any other code.
below is the Scapture sub
Private Sub Scapture(ByVal sender As Object, ByVal eventArgs As NewFrameEventArgs)
If ButtonVIDEO.BackColor = Color.Black Then 'In case of Preview only (No recording)
Try
BMP = DirectCast(eventArgs.Frame.Clone(), Bitmap) 'Put the data in the bitmap
PictureBox1.Image = DirectCast(eventArgs.Frame.Clone(), Bitmap) 'present it in the Picture Box
Catch ex As Exception
MsgBox(ex.Message)
End Try
Else ' In case of Recording
Try
BMP = DirectCast(eventArgs.Frame.Clone(), Bitmap) 'Put the data in the bitmap
PictureBox1.Image = DirectCast(eventArgs.Frame.Clone(), Bitmap) 'present it in the Picture Box
VFwriter.WriteVideoFrame(BMP) 'Save in Memory
Catch ex As Exception
MsgBox(ex.Message)
End Try
End If
End Sub
Any idea how to solve this problem? I'm sure its related to the code not to the Windows nor Memory, since its working fine with different library.
So i have this piece of code written in VB.NET
and when it gets to about "Dim ping As New Ping" it throws the error "An unhandled exception of type 'System.ArgumentNullException' occurred in System.dll
Additional information: Value cannot be null."
http://pastebin.com/C1nfdzUN
Imports System.Net.NetworkInformation
Public Class Form1
Dim i As Boolean
Dim pingMs As String
'I'm using this in the createTextIcon sub to releases all of the resources that the icon/icons would have used.
Public Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Int32) As Int32
'You should fine tune the font you want to use so the user can see the text you want them to see.
'Certain Fonts will obviously display your text better than other fonts might.
Dim fontToUse As Font = New Font("Microsoft Sans Serif", 8, FontStyle.Regular, GraphicsUnit.Pixel)
'A basic brush with a Dark Blue Color. This should show up pretty well in the icon tray if the user uses the default tray color.
Dim brushToUse As Brush = New SolidBrush(Color.DarkBlue)
'A bitmap used to setup how the icon will display.
Dim bitmapText As Bitmap = New Bitmap(16, 16)
'A simply Grahics object to draw the text to a bitmap.
Dim g As Graphics = Drawing.Graphics.FromImage(bitmapText)
'Will be used to get the Handle to the bitmap Icon.
Dim hIcon As IntPtr
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Application.DoEvents()
Threading.Thread.Sleep(10)
Dim pingTarget As String = ""
Dim numberOfPings As Integer = 0
Dim ping As New Ping
Dim pingRe As PingReply = ping.Send(pingTarget, 1)
Dim o As Boolean = True
Dim delay As Integer = 1
pingTarget = "www.google.com"
i = True
While i
pingMs = pingRe.RoundtripTime.ToString
Label1.Text = pingMs
createTextIcon()
Application.DoEvents()
Do Until o = False
Application.DoEvents()
Threading.Thread.Sleep(10)
delay = delay + 1
If delay = 100 Then
o = False
delay = 1
End If
Loop
o = True
End While
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
i = False
Application.DoEvents()
Close()
End Sub
Sub createTextIcon()
'Clear any previous ‘stuff’ instead of creating a new bitmap.
g.Clear(Color.Transparent)
'Setup the text, font, brush, and position for the system tray icon. For the font type and
'size I used, a good position for the X coordinate is a -1 or -2. And the Y coordinate seems
'to work well at a 5.
'You specify the actual text you want to be displayed in the draw string parameter that you
'want to display in the notify area of the system tray. You will only be able to display a
'few characters, depending on the font, size of the font, and the coordinates you used.
g.DrawString(pingMs, fontToUse, brushToUse, -2, 5)
'Get a handle to the bitmap as a Icon.
hIcon = (bitmapText.GetHicon)
'Display that new usage value image in the system tray.
NotifyText.Icon = Drawing.Icon.FromHandle(hIcon)
'Added this to try and get away from a rare Generic Error from the code above. Using this API Function seems to have stopped that error from happening.
DestroyIcon(hIcon.ToInt32)
End Sub
End Class
You are getting an ArgumentNullException from ping.Send() since pingTarget is an empty string when you call the method.
Move the line
pingTarget = "www.google.com"
above ping.Send().
Hi again my question this time its related with this piece of code, im using the visual studio beta 2012, i cant seem to find the issue, if you guys could help me out ill appreciate it
Public Class Form1
Private Sub fullScreen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles fullScreen.Click
SendKeys.SendWait("^{PRTSC}")
Dim clip As IDataObject = Clipboard.GetDataObject()
If clip.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
Dim screenCapture As Bitmap = CType(clip.GetData(GetType(System.Drawing.Bitmap)), Bitmap)
screenCapture.Save("C:\fullScreenCapture.bmp")
End If
Clipboard.Clear()
End Sub
End Class
Error :
A first chance exception of type 'System.Runtime.InteropServices.ExternalException' occurred in System.Drawing.dll
Additional information: Error genérico en GDI+.
If there is a handler for this exception, the program may be safely continued.
You can take a screen shot more easily by using the following (send keys is always hit and miss in my experience)
Private Function TakeScreenShot() As Bitmap
Dim scrn As Screen = Screen.FromControl(Me)
Dim screenSize As Size = New Size(scrn.Bounds.Width, scrn.Bounds.Height)
Dim screenGrab As New Bitmap(screenSize.Width, screenSize.Height)
Dim g As Graphics = Graphics.FromImage(screenGrab)
g.CopyFromScreen(New Point(scrn.Bounds.X, scrn.Bounds.Y), New Point(0, 0), screenSize)
Return screenGrab
End Function
Are you trying to capture the screen? Why not use VS' classes to capture the screen?
http://forum.codecall.net/topic/51761-creating-a-screen-shot-tool-vbnet