none
Accurate screen grabbing from a 4k display RRS feed

  • Question

  • The rectangular area screen-grab in my application works fine in all displays up to HD, but a user reports that when employed in his 4k screen laptop it returns only (presumably) the top-left portion of what is requested. I use normal VB screen dimension / navigation techniques with a semi-transparent form overlay, and when required set the form to fully transparent and grab what's underneath it -

    Dim Pleft As Integer = Me.Left
    Dim Ptop As Integer = Me.Top
    Dim Pwidth As Integer = Me.Width
    Dim Pheight As Integer = Me.Height
    Dim Img1 As New Bitmap(Pwidth, Pheight)
    Dim G1 As Graphics = Graphics.FromImage(Img1)
    G1.CopyFromScreen(Pleft, Ptop, 0, 0, Img1.Size)

    but it looks like these fail on a 4k screen without some sort of scaling overview. I don't have such a screen and also I can't find any relevant instructions online ... what should I do?

    Thanks,
    NHB


    AcroNick


    • Edited by AcroNick Friday, July 12, 2019 12:40 PM
    Friday, July 12, 2019 12:31 PM

All replies

  • Hello,

    Both of the methods below can return an image or save to file.

    Capture current window (of a form)

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim sc As New ScreenCapture
        PictureBox1.Image = sc.CaptureWindow(Me.Handle)
    End Sub

    Capture current screen

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim sc As New ScreenCapture
        PictureBox1.Image = sc.CaptureScreen()
    End Sub

    Class for screen captures

    Option Infer On
    
    Imports System
    Imports System.Drawing
    Imports System.Drawing.Imaging
    Imports System.Runtime.InteropServices
    
    
    Public Class ScreenCapture
        ''' <summary>
        ''' Creates an Image object containing a screen shot of the entire desktop
        ''' </summary>
        ''' <returns></returns>
        Public Function CaptureScreen() As Image
            Return CaptureWindow(User32.GetDesktopWindow())
        End Function
        ''' <summary>
        ''' Creates an Image object containing a screen shot of a specific window
        ''' </summary>
        ''' <param name="handle">The handle to the window. (In windows forms,
        ''' this is obtained by the Handle property)</param>
        ''' <returns></returns>
        Public Function CaptureWindow(ByVal handle As IntPtr) As Image
            ' get te hDC of the target window
            Dim hdcSrc As IntPtr = User32.GetWindowDC(handle)
            ' get the size
            Dim windowRect = New User32.RECT()
            User32.GetWindowRect(handle, windowRect)
            Dim width = windowRect.right - windowRect.left
            Dim height = windowRect.bottom - windowRect.top
            ' create a device context we can copy to
            Dim hdcDest As IntPtr = GDI32.CreateCompatibleDC(hdcSrc)
            ' create a bitmap we can copy it to,
            ' using GetDeviceCaps to get the width/height
            Dim hBitmap As IntPtr = GDI32.CreateCompatibleBitmap(hdcSrc, width, height)
            ' select the bitmap object
            Dim hOld As IntPtr = GDI32.SelectObject(hdcDest, hBitmap)
            ' bitblt over
            GDI32.BitBlt(hdcDest, 0, 0, width, height, hdcSrc, 0, 0, GDI32.SRCCOPY)
            ' restore selection
            GDI32.SelectObject(hdcDest, hOld)
            ' clean up 
            GDI32.DeleteDC(hdcDest)
            User32.ReleaseDC(handle, hdcSrc)
            ' get a .NET image object for it
            Dim img As Image = Image.FromHbitmap(hBitmap)
            ' free up the Bitmap object
            GDI32.DeleteObject(hBitmap)
            Return img
        End Function
        ''' <summary>
        ''' Captures a screen shot of a specific window, and saves it to a file
        ''' </summary>
        ''' <param name="handle"></param>
        ''' <param name="filename"></param>
        ''' <param name="format"></param>
        Public Sub CaptureWindowToFile(ByVal handle As IntPtr, ByVal filename As String, ByVal format As ImageFormat)
            Dim img As Image = CaptureWindow(handle)
            img.Save(filename, format)
        End Sub
        ''' <summary>
        ''' Captures a screen shot of the entire desktop, and saves it to a file
        ''' </summary>
        ''' <param name="filename"></param>
        ''' <param name="format"></param>
        Public Sub CaptureScreenToFile(ByVal filename As String, ByVal format As ImageFormat)
            Dim img As Image = CaptureScreen()
            img.Save(filename, format)
        End Sub
        <DllImport("user32.dll", SetLastError:=False)>
        Private Shared Function GetDesktopWindow() As IntPtr
        End Function
    
    
        ''' <summary>
        ''' Helper class containing Gdi32 API functions
        ''' </summary>
        Private Class GDI32
    
            Public Const SRCCOPY As Integer = &HCC0020 ' BitBlt dwRop parameter
            <DllImport("gdi32.dll")>
            Public Shared Function BitBlt(ByVal hObject As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hObjectSource As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Integer) As Boolean
            End Function
            <DllImport("gdi32.dll")>
            Public Shared Function CreateCompatibleBitmap(ByVal hDC As IntPtr, ByVal nWidth As Integer, ByVal nHeight As Integer) As IntPtr
            End Function
            <DllImport("gdi32.dll")>
            Public Shared Function CreateCompatibleDC(ByVal hDC As IntPtr) As IntPtr
            End Function
            <DllImport("gdi32.dll")>
            Public Shared Function DeleteDC(ByVal hDC As IntPtr) As Boolean
            End Function
            <DllImport("gdi32.dll")>
            Public Shared Function DeleteObject(ByVal hObject As IntPtr) As Boolean
            End Function
            <DllImport("gdi32.dll")>
            Public Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
            End Function
        End Class
    
        ''' <summary>
        ''' Helper class containing User32 API functions
        ''' </summary>
        Private Class User32
            <StructLayout(LayoutKind.Sequential)>
            Public Structure RECT
                Public left As Integer
                Public top As Integer
                Public right As Integer
                Public bottom As Integer
            End Structure
            <DllImport("user32.dll")>
            Public Shared Function GetDesktopWindow() As IntPtr
            End Function
            <DllImport("user32.dll")>
            Public Shared Function GetWindowDC(ByVal hWnd As IntPtr) As IntPtr
            End Function
            <DllImport("user32.dll")>
            Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As IntPtr
            End Function
            <DllImport("user32.dll")>
            Public Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef rect As RECT) As IntPtr
            End Function
        End Class
    End Class
    
    



    Please remember to mark the replies as answers if they help and unmarked them if they provide no help, this will help others who are looking for solutions to the same or similar problem. Contact via my Twitter (Karen Payne) or Facebook (Karen Payne) via my MSDN profile but will not answer coding question on either.

    NuGet BaseConnectionLibrary for database connections.

    StackOverFlow
    profile for Karen Payne on Stack Exchange

    Friday, July 12, 2019 12:48 PM
    Moderator
  • Many thanks Karen, I will work through this as soon as I can and exchange notes with my 4k screen user to check it out. Interestingly I have just received another similar note from someone using a W10 installation on a Mac, perhaps this will help his situation too.
    AcroNick


    AcroNick

    Tuesday, July 16, 2019 6:36 AM
  • Hi,

    Do you resolve the issue? If you resolve the issue, please mark the helpful as answer. It will be beneficial to other community.

    Best Regards,

    Alex


    MSDN Community Support Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, July 17, 2019 5:56 AM
    Moderator