Hello,
I'm developing a small screen capture application to learn some functions like bitmap graphics and I'm having a problem with 3 things, hope you could help me.
1. ListView Refresh/Update. I have a form with a listview that shows thumbnails for all screenshots taken. When the form loads it works very good, but I would like it to refresh. So I added a ContextMenuStrip and when user click refresh it was supposed to refresh and update the screenshots again. If I call my function again, it works pretty good but adds the images again. If I use the listview1.clear() or listview1.items.clear() and then call my function, all the thumbnails will be the same image (first image in folder). Its weird because seems to be the clear "killing" my function. Any suggestion?
I just call ImportImages() function.Code:Dim imagecoll As New Collection() 'Image paths will be stored in this collection Dim Limglst As New ImageList() 'Large ImageList for our ListVie Dim SelectedDirectory As String Dim thmbNailWidth As Integer Dim thmbNailHeight As Integer Dim img, pimg As Bitmap Dim imgsCurnCnt As String Dim StartTime As DateTime Dim i As Integer = 0 'Dim disimg As Bitmap Function GetIndexofImg() As Integer If i < Me.lvImgs.Items.Count Then i += 1 Return i End If End Function Sub ImportImages() Dim userName As String = "ScreenShots" Dim pth As String Dim myDir = My.Settings.saveTo & "/" & userName If Directory.Exists(myDir) Then ' Got files in direcotry! For Each pth In Directory.GetFiles(My.Settings.saveTo & userName) Dim f() As String f = Split(pth, "\") 'To get the file name Array.Reverse(f) Try imagecoll.Add(pth, f(0)) 'Add filename as key to retrive later Catch End Try Try If Directory.Exists(SelectedDirectory) Then File.Copy(pth, SelectedDirectory & "\" & f(0)) MsgBox(SelectedDirectory) End If 'MsgBox(pth & " " & SelectedDirectory) Catch ex As Exception 'MsgBox(ex.Message, MsgBoxStyle.Critical) End Try Next 'Display the images Display(Directory.GetFiles(My.Settings.saveTo & "/" & userName)) End If End Sub Sub Display(ByVal files() As String) System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor Dim fnames() As String = files If thmbNailWidth <> 0 AndAlso thmbNailHeight <> 0 Then Limglst.ImageSize = New Size(thmbNailWidth, thmbNailHeight) Else 'Default size thmbNailWidth = 100 thmbNailHeight = 100 Limglst.ImageSize = New Size(thmbNailWidth, thmbNailHeight) End If Limglst.ColorDepth = ColorDepth.Depth32Bit showimages(fnames) Try Me.lvImgs.LargeImageList = Limglst Catch End Try Dim fn As String For Each fn In fnames Try Dim picwh As New Bitmap(fn) Dim fname As New IO.FileInfo(fn) Me.lvImgs.Items.Add(fname.Name, GetIndexofImg) picwh.Dispose() 'MsgBox(fn) Catch ex As Exception 'MsgBox(ex.Message) End Try Next System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default End Sub Sub showimages(ByVal imgs() As String) Dim image As String For Each image In imgs Try pimg = New Bitmap(image) Limglst.Images.Add(pimg) 'would occur if the file is not an image file Catch Ex As Exception 'MsgBox(ex.Message) End Try Next End Sub
2. Active Window print screen. Well, I managed how to do it, but the print screen in the active Windows gets some borders and not only the active window. It seems that gets the "aero theme glow" so the print also takes some o the backgound in left, right and bottom. Any suggestions in how to avoid this?
My work to get the active window:
And the CaptureScreen Function:Code:If ctrlkey And shiftkey And W = True Then DwmEnableComposition(False) Dim hWnd As IntPtr = GetForegroundWindow() 'Get the foreground window handle If Not hWnd.Equals(IntPtr.Zero) Then 'Check if there is a foreground window Dim rec As New RECT GetWindowRect(hWnd, rec) 'Get the rectangle of the foreground window into a RECT structure CaptureScreen(New Rectangle(rec.left, rec.top, rec.right - rec.left, rec.bottom - rec.top)) End If DwmEnableComposition(True) End If
Code:Dim bmp As New Bitmap(RegionRect.Width, RegionRect.Height) Dim grfx As Graphics = Graphics.FromImage(bmp) grfx.CopyFromScreen(RegionRect.X, RegionRect.Y, 0, 0, RegionRect.Size, CopyPixelOperation.SourceCopy) bmp.Save(captureSavePath)
3. Finally, I have the region screen that made na approach with success, but only works with one monitor. My aproach creates a full creen form with opacity and the user draws a rectangle for the desired área. I acomplished the full screen form to open in the screen where the mouse pointer is, but if the form opens in Monitor2, the screenshot is the selected área but from Monitor1. Any suggestion?
Code:Private Sub regionform_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.TopMost = True Me.WindowState = FormWindowState.Maximized Me.Width = Screen.AllScreens.Sum(Function(s As Screen) s.Bounds.Width) Me.Height = Screen.AllScreens.Sum(Function(s As Screen) s.Bounds.Height) Timer1.Enabled = True Timer1.Interval = 1 Me.Cursor = Cursors.Cross End SubCode:Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs) Using myBrush As New System.Drawing.SolidBrush(Color.FromArgb(255, System.Drawing.Color.White)) Using pen As New Pen(Color.Red, 5) e.Graphics.DrawRectangle(pen, mRect) e.Graphics.FillRectangle(myBrush, mRect) End Using End Using End SubCode:Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs) mRect = New Rectangle(e.X, e.Y, 0, 0) Me.Invalidate() End Sub Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then mRect = New Rectangle(mRect.Left, mRect.Top, e.X - mRect.Left, e.Y - mRect.Top) Me.Invalidate() End If End Sub
Hope that you could help. Maybe those could be silly questions but I can't figure it outCode:Dim captureSavePath As String = String.Format("{0}\{1}\" & My.Settings.defname & "{2}." & My.Settings.format, savePath, userName, dateString) Dim bmp As New Bitmap(mRect.Width, mRect.Height) Dim grfx As Graphics = Graphics.FromImage(bmp) grfx.CopyFromScreen(mRect.X, mRect.Y, 0, 0, mRect.Size, CopyPixelOperation.SourceCopy) bmp.Save(captureSavePath)
BTW, if you have time, what could be the approach to user defined hotkeys?





Reply With Quote
