VB.NET - Take a screenshot of all screens on a computer - vb.net

I'm trying to capture any and all screens on a computer, I tried to fiddle with Screen.AllScreens and also something with VirtualScreens that I can't remember, so I moved to PrimaryScreen to make sure everything else worked properly.
Here is my current class:
Public Class wmCapture
Public Shared Function screenCapture()
Dim userName As String = Environment.UserName
Dim savePath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData)
Dim dateString As String = Date.Now.ToString("yyyyMMddHHmmss")
Dim captureSavePath As String = String.Format("{0}\WM\{1}\capture_{2}.png", savePath, userName, dateString)
Dim bmp As Bitmap = New Bitmap( _
Screen.PrimaryScreen.Bounds.Width, _
Screen.PrimaryScreen.Bounds.Height)
Dim gfx As Graphics = Graphics.FromImage(bmp)
gfx.CopyFromScreen( _
Screen.PrimaryScreen.Bounds.Location, _
New Point(0, 0), Screen.PrimaryScreen.Bounds.Size)
bmp.Save(captureSavePath)
End Function
End Class
What should I be using in the Screen namespace to include all active screens?

You were close. I made a couple adjustments and can confirm it's working on my end.
Public Shared Sub screenCapture()
Dim userName As String = Environment.UserName
Dim savePath As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData)
Dim dateString As String = Date.Now.ToString("yyyyMMddHHmmss")
Dim captureSavePath As String = String.Format("{0}\WM\{1}\capture_{2}.png", savePath, userName, dateString)
' This line is modified for multiple screens, also takes into account different screen size (if any)
Dim bmp As Bitmap = New Bitmap( _
Screen.AllScreens.Sum(Function(s As Screen) s.Bounds.Width),
Screen.AllScreens.Max(Function(s As Screen) s.Bounds.Height))
Dim gfx As Graphics = Graphics.FromImage(bmp)
' This line is modified to take everything based on the size of the bitmap
gfx.CopyFromScreen(SystemInformation.VirtualScreen.X,
SystemInformation.VirtualScreen.Y,
0, 0, SystemInformation.VirtualScreen.Size)
' Oh, create the directory if it doesn't exist
Directory.CreateDirectory(Path.GetDirectoryName(captureSavePath))
bmp.Save(captureSavePath)
End Sub

Related

Crop image and save it in database using vb.net

I'm following a tutorial on Image Cropping with resizing using vb.net . Everything works well, But instead of saving it
on the hard disk. I want to save it on my database(SQLServer).
This is the code of saving on a disk
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cropSaveBtn.Click
Dim tempFileName As String
Dim svdlg As New SaveFileDialog()
svdlg.Filter = "JPEG files (*.jpg)|*.jpg|All files (*.*)|*.*"
svdlg.FilterIndex = 1
svdlg.RestoreDirectory = True
If svdlg.ShowDialog() = Windows.Forms.DialogResult.OK Then
tempFileName = svdlg.FileName 'check the file exist else save the cropped image
Try
Dim img As Image = PreviewPictureBox.Image
SavePhoto(img, tempFileName, 225)
Catch exc As Exception
MsgBox("Error on Saving: " & exc.Message)
End Try
End If
End Sub
Public Function SavePhoto(ByVal src As Image, ByVal dest As String, ByVal w As Integer) As Boolean
Try
Dim imgTmp As System.Drawing.Image
Dim imgFoto As System.Drawing.Bitmap
imgTmp = src
imgFoto = New System.Drawing.Bitmap(w, 225)
Dim recDest As New Rectangle(0, 0, w, imgFoto.Height)
Dim gphCrop As Graphics = Graphics.FromImage(imgFoto)
gphCrop.SmoothingMode = SmoothingMode.HighQuality
gphCrop.CompositingQuality = CompositingQuality.HighQuality
gphCrop.InterpolationMode = InterpolationMode.High
gphCrop.DrawImage(imgTmp, recDest, 0, 0, imgTmp.Width, imgTmp.Height, GraphicsUnit.Pixel)
Dim myEncoder As System.Drawing.Imaging.Encoder
Dim myEncoderParameter As System.Drawing.Imaging.EncoderParameter
Dim myEncoderParameters As System.Drawing.Imaging.EncoderParameters
Dim arrayICI() As System.Drawing.Imaging.ImageCodecInfo = System.Drawing.Imaging.ImageCodecInfo.GetImageEncoders()
Dim jpegICI As System.Drawing.Imaging.ImageCodecInfo = Nothing
Dim x As Integer = 0
For x = 0 To arrayICI.Length - 1
If (arrayICI(x).FormatDescription.Equals("JPEG")) Then
jpegICI = arrayICI(x)
Exit For
End If
Next
myEncoder = System.Drawing.Imaging.Encoder.Quality
myEncoderParameters = New System.Drawing.Imaging.EncoderParameters(1)
myEncoderParameter = New System.Drawing.Imaging.EncoderParameter(myEncoder, 60L)
myEncoderParameters.Param(0) = myEncoderParameter
imgFoto.Save(dest, jpegICI, myEncoderParameters)
imgFoto.Dispose()
imgTmp.Dispose()
Catch ex As Exception
End Try
End Function
I want it to save the picture to SQL Server 2008 (Image data type) together with my two data just like this
Using cmd As New SqlClient.SqlCommand("dbo.uspAdd", cn)
cmd.CommandType = CommandType.StoredProcedure
cmd.Parameters.Add("#firstname", SqlDbType.VarChar, 100).Value = txtName.Text
cmd.Parameters.Add("#lastName", SqlDbType.VarChar, 100).Value = txtSurname.Text
'add insert picture code here
cmd.ExecuteNonQuery()
MsgBox("Save Record New record Successfully")
End Using
And now i'm stuck for almost 8 hours finding ways on how to fix this.Can anyone help me to solve this. Any help would be very much appreciated.
I would suggest converting the image to Base64 and then storing it as a string.
Then when you want to get the image back you need to convert it back from Base64 to an image.
You can convert an image to Base64 using this code:
Public Function ConvertImageToBase64(ByRef img As Image, ByVal format As System.Drawing.Imaging.ImageFormat) As String
Dim ImgStream As MemoryStream = New MemoryStream()
img.Save(ImgStream, format)
ImgStream.Close()
Dim ByteArray() As Byte = ImgStream.ToArray()
ImgStream.Dispose()
Return Convert.ToBase64String(ByteArray)
End Function
(http://www.dailycoding.com/posts/convert_image_to_base64_string_and_base64_string_to_image.aspx)
And to convert it back to an image you can use this code:
Public Function ConvertBase64ToImage(ByVal base64 As String) As Image
Dim img As System.Drawing.Image
Dim MS As System.IO.MemoryStream = New System.IO.MemoryStream
Dim b64 As String = base64.Replace(" ", "+")
Dim b() As Byte
b = Convert.FromBase64String(b64)
MS = New System.IO.MemoryStream(b)
img = System.Drawing.Image.FromStream(MS)
Return img
End Function
(http://snipplr.com/view/27514/vbnet-base64-to-image/)
Now you can basically add the image as a string, like this:
Dim Base64Bitmap As String = ConvertImageToBase64(img, System.Drawing.Imaging.ImageFormat.Png)
cmd.Parameters.Add("#Image", SqlDbType.VarChar, Base64Bitmap.Length).Value = Base64Bitmap

Display Camera Image in VS PictureBox W/0 Saving To PC Drive

If I save (to disk) the image transferred from the camera, I can display it in a PictureBox, as follows:
Dim picNum As Integer = 1
Dim imgName As String
Dim imgExt As String
Dim WiaDialog1 As New WIA.CommonDialog
Dim WiaDevice1 As WIA.Device = WiaDialog1.ShowSelectDevice(WIA.WiaDeviceType.CameraDeviceType, False, False)
imgName = WiaDevice1.Items(picNum).Properties("Item Name").Value
imgExt = "." & WiaDevice1.Items(picNum).Properties("Filename extension").Value
Dim image1 As WIA.ImageFile = WiaDevice1.Items(picNum).Transfer(WIA.FormatID.wiaFormatPNG)
image1.SaveFile("C:\PhotoSort\CameraNew2\" & imgName & imgExt)
image1 = "C:\PhotoSort\CameraNew2\" & imgName & imgExt"
PictureBox1.Image = image1
I want to display the transferred image, in a similar VB code manner,. without saving it to disk
You can display image from physical location like
Picturebox1.Image=Image.FromFile("Path");

Saving image over open file, A Generic error occurred in GDI+

I'm having trouble with my code, I'm trying to make a simple captcha for my program. The first time I run the sub it works fine, I'm guessing because the file is not "open" in my program. The second time I get the GDI+ error. I'm pretty sure this is an issue with the bitmaps being locked the 2nd time around, I'm just a little stuck.
Sub generatePasswordImage(password As String)
'This is the image where we are going to write the text on it.
Dim stringMasterImageName As String = Application.StartupPath + "\MasterImage.jpg"
Dim bitmapImage As Bitmap = New System.Drawing.Bitmap(stringMasterImageName)
Dim bitmapMasterImage As Bitmap = New System.Drawing.Bitmap(bitmapImage, New Size(400, 150))
Dim graphicsMasterImage As Graphics = Graphics.FromImage(bitmapMasterImage)
'Set the alignment based on the coordinates
Dim stringformatWriteTextFormat As StringFormat = New StringFormat()
stringformatWriteTextFormat.Alignment = StringAlignment.Center
'Do some rotation effects
Dim Generator As System.Random = New System.Random()
Dim rotation As Integer = Generator.Next(-10, 5)
graphicsMasterImage.RotateTransform(rotation)
Dim centerImgWidth As Integer = Generator.Next(CInt(graphicsMasterImage.VisibleClipBounds.Size.Width / 3), CInt(graphicsMasterImage.VisibleClipBounds.Size.Width / 2))
Dim centerImgHiehgt As Integer = Generator.Next(CInt(graphicsMasterImage.VisibleClipBounds.Size.Height / 3), CInt(graphicsMasterImage.VisibleClipBounds.Size.Height / 2))
'Set the font color
Dim colorStringColor As Color = System.Drawing.Color.Black
graphicsMasterImage.DrawString(password, New Font("Tahoma", 14, FontStyle.Bold), _
New SolidBrush(colorStringColor), New Point(centerImgWidth, centerImgHiehgt), stringformatWriteTextFormat)
Dim stringOutPutFileName As String = Application.StartupPath + "\Pass.jpg"
bitmapMasterImage.Save(stringOutPutFileName, System.Drawing.Imaging.ImageFormat.Jpeg)
bitmapMasterImage.Dispose()
bitmapImage.Dispose()
End Sub

streamwriter in windows store app - write text to file in VB

Does anybody have VB code to emulate Streamwriter for Windows Store?
I know it's been replaced by StorageFolder class but there is no VB sample in MSDN and I can't seem to translate properly from c# examples. Any help would be appreciated. I am just trying to write text (CSV) to a file and save it to the documents folder. In the code below windows store want a stream instead of strPath when I try dim-ing a streamwriter. (been playing with pickerdialog too, but that might be the next hurdle).
Dim strpath As String = Windows.Storage.Pickers.PickerLocationId.DocumentsLibrary & "\" & strFileName
'Build String for file*******************
Dim swExport As StreamWriter = New StreamWriter(strpath)
swExport.Flush()
For x = 0 To intCount - 1
strLine = "WriteSomeText"
swExport.WriteLine(strLine)
Next x
Possibly the simplest approach would be to use a MemoryStream if you like StreamWriter, so something like:
Dim sessionData As New MemoryStream()
' TODO: stage data in sessionData
Dim swExport As StreamWriter = New StreamWriter(sessionData)
swExport.Flush()
For x = 0 To intCount - 1
strLine = "WriteSomeText"
swExport.WriteLine(strLine)
Next x
Dim file As StorageFile = await ApplicationData.Current.RoamingFolder.CreateFileAsync("towns.json", CreationCollisionOption.ReplaceExisting)
Using (fileStream As Stream = await file.OpenStreamForWriteAsync())
sessionData.Seek(0, SeekOrigin.Begin)
await sessionData.CopyToAsync(fileStream)
await fileStream.FlushAsync()
End Using
I was making it too difficult. To write to a file I just needed to use storagefolder and storagefile. I have also included the FileSavePicker in the code (note that filetypechoices is mandatory)
Private Async Function btnExport_Click(sender As Object, e As RoutedEventArgs) As Task
'Calls Filepicker to determine location
'Calls Sqlite to select ALL
'Creates CSV file to be saved at location chosen
'save to file
Dim intCount As Integer = "5"
Dim x As Integer
Dim strLine As String 'hold each line for export file
'Create FileName based on date
Dim strDate As String = Date.Today.ToString("MMddyyyy")
Dim strFileName As String = "Export" & strDate & ".csv"
' Configure save file dialog box
Dim dlgPicker As New Windows.Storage.Pickers.FileSavePicker
'add types for picker (manditory field)
Dim types = New List(Of String)
types.Add(".csv")
types.Add(".txt")
'set picker parameters
dlgPicker.SuggestedStartLocation = Windows.Storage.Pickers.PickerLocationId.Downloads
dlgPicker.SuggestedFileName = strFileName '"Document" '
dlgPicker.FileTypeChoices.Add("CSV/TXT", types) 'manditory
dlgPicker.DefaultFileExtension = ".csv" 'Filter files by extension
dlgPicker.CommitButtonText = "Save"
' Show save file dialog box
Dim SaveCSV = Await dlgPicker.PickSaveFileAsync()
'************************get data************
Dim sbExport As Text.StringBuilder = New Text.StringBuilder
sbExport.AppendLine(strHeader)
For x = 0 To intCount - 1
strLine = "Get the text you want to write here"
sbExport.AppendLine(strLine)
Next x
'************************************
'write data to file
Await FileIO.WriteTextAsync(SaveCSV, sbExport.ToString)
Dim mb As MessageDialog = New MessageDialog("Done")
Await mb.ShowAsync()
End Function

How to Display a Bmp in a RTF control in VB.net

I Started with this C# Question
I'm trying to Display a bmp image inside a rtf Box for a Bot program I'm making.
This function is supposed to convert a bitmap to rtf code whis is inserted to another rtf formatter srtring with additional text. Kind of like Smilies being used in a chat program.
For some reason the output of this function gets rejected by the RTF Box and Vanishes completly. I'm not sure if it the way I'm converting the bmp to a Binary string or if its tied in with the header tags
lb.SelectedRtf = FormatText(build.ToString, newColor)
'returns the RTF string representation of our picture
Public Shared Function PictureToRTF(ByVal Bmp As Bitmap) As String
'Create a new bitmap
Dim BmpNew As New Bitmap(Bmp.Width, Bmp.Height, Imaging.PixelFormat.Format24bppRgb)
Dim gr = Graphics.FromImage(BmpNew)
gr.DrawimageUnscaled(Bmp, 0, 0)
gr.dispose()
Dim stream As New MemoryStream()
BmpNew.Save(stream, System.Drawing.Imaging.ImageFormat.Bmp)
Dim bytes As Byte() = stream.ToArray()
Dim str As String = BitConverter.ToString(bytes, 0).Replace("-", String.Empty)
'header to string we want to insert
Using g As Graphics = Main.CreateGraphics()
xDpi = g.DpiX
yDpi = g.DpiY
End Using
Dim _rtf As New StringBuilder()
' Calculate the current width of the image in (0.01)mm
Dim picw As Integer = CInt(Math.Round((Bmp.Width / xDpi) * HMM_PER_INCH))
' Calculate the current height of the image in (0.01)mm
Dim pich As Integer = CInt(Math.Round((Bmp.Height / yDpi) * HMM_PER_INCH))
' Calculate the target width of the image in twips
Dim picwgoal As Integer = CInt(Math.Round((Bmp.Width / xDpi) * TWIPS_PER_INCH))
' Calculate the target height of the image in twips
Dim pichgoal As Integer = CInt(Math.Round((Bmp.Height / yDpi) * TWIPS_PER_INCH))
' Append values to RTF string
_rtf.Append("{\pict\wbitmap0")
_rtf.Append("\picw")
_rtf.Append(Bmp.Width.ToString)
' _rtf.Append(picw.ToString)
_rtf.Append("\pich")
_rtf.Append(Bmp.Height.ToString)
' _rtf.Append(pich.ToString)
_rtf.Append("\wbmbitspixel24\wbmplanes1")
_rtf.Append("\wbmwidthbytes40")
_rtf.Append("\picwgoal")
_rtf.Append(picwgoal.ToString)
_rtf.Append("\pichgoal")
_rtf.Append(pichgoal.ToString)
_rtf.Append("\bin ")
_rtf.Append(str.ToLower & "}")
Return _rtf.ToString
End Function
Public Function FormatText(ByVal data As String, ByVal newColor As fColorEnum) As String
data = System.Net.WebUtility.HtmlDecode(data)
data = data.Replace("|", " ")
Dim reg As New Regex("\$(.[0-9]+)\$")
If reg.IsMatch(data) Then
Dim meep As String = Regex.Match(data, "\$(.[0-9]+)\$").Groups(1).ToString
Dim idx As Integer = Convert.ToInt32(meep)
Dim img As String = Fox2RTF(idx)
If img IsNot Nothing Then data = Regex.Replace(data, "\$(.[0-9]+)\$", img)
End If
Dim myColor As System.Drawing.Color = fColor(newColor)
Dim ColorString = "{\colortbl ;"
ColorString += "\red" & myColor.R & "\green" & myColor.G & "\blue" & myColor.B & ";}"
Dim FontSize As Integer = cMain.ApFont.Size
Dim FontFace As String = cMain.ApFont.Name
FontSize *= 2
Dim test As String = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033" & ColorString & "{\fonttbl{\f0\fcharset0 " & FontFace & ";}}\viewkind4\uc1\fs" & FontSize.ToString & data & "\par}"
Return "{\rtf1\ansi\ansicpg1252\deff0\deflang1033" & ColorString & "{\fonttbl{\f0\fcharset0 " & FontFace & ";}}\viewkind4\uc1\fs" & FontSize.ToString & data & "\cf0 \par}"
End Function
Private Function Fox2RTF(ByRef Img As Integer) As String
Dim shape As New FurcadiaShapes(Paths.GetDefaultPatchPath() & "system.fsh")
Dim anims As Bitmap() = Helper.ToBitmapArray(shape)
' pic.Image = anims(Img)
Return PictureToRTF.PictureToRTF(anims(Img))
End Function
Never found the Soultion I was hoping for with this.. But I did find a work around http://www.codeproject.com/Articles/30902/RichText-Builder-StringBuilder-for-RTF