如果应用程序不在 0,0,捕获另一个应用程序的屏幕截图时的图像大小会发生变化

Image size when capturing a screenshot of another application changes if application not at 0,0

我有一个应用程序可以正确捕获应用程序的图像 window 如果它位于主屏幕的左上角。
但如果不是,则图像尺寸不正确(window 图像高度在右边距和屏幕顶部向下时会被拉伸。Application at 0,0

Imports System.Data.SqlClient
Imports System.Runtime.InteropServices
Imports Microsoft.VisualBasic.Strings
Imports System
Imports System.Data
Imports System.Data.OleDb

Public Class Form1
    Public Declare Function GetWindowRect Lib "user32" (ByVal HWND As Integer, ByRef lpRect As Rectangle) As Integer
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

    End Sub
    Private Sub BtnCapture_Click(sender As Object, e As EventArgs) Handles BtnCapture.Click

        Dim FoundApplication As Boolean = False
        Dim localAll As Process() = Process.GetProcesses()
        Dim rect As New Rectangle
        Dim Top As Int32 = 0
        Dim Left As Int32 = 0
        Dim width As Int32
        Dim height As Int32
        Dim hwnd As IntPtr
        Dim memoryImage As Bitmap

        For Each x As Process In localAll
            GetWindowRect(x.MainWindowHandle, rect)
            If x.ProcessName.ToString = "calc" Then

                width = rect.Width
                height = rect.Height
                Top = rect.Top
                Left = rect.Left
                hwnd = x.MainWindowHandle
                FoundApplication = True
                Exit For

            End If
        Next

        If FoundApplication Then
            ' do nothing - set above
        Else
            ' set the default to entire Primary screen if Calc not found
            width = Screen.PrimaryScreen.Bounds.Width
            height = Screen.PrimaryScreen.Bounds.Height
        End If

        Dim MyGraphics As Graphics = Graphics.FromHwnd(hwnd)
        Dim s As New Size(width, height)
        memoryImage = New Bitmap(width, height, myGraphics)
        Dim memoryGraphics As Graphics = Graphics.FromImage(memoryImage)
        memoryGraphics.CopyFromScreen(Top, Left, 0, 0, s)
        Clipboard.SetImage(memoryImage)

        RtbLog.AppendText(Today().ToShortDateString & " " & Now().ToShortTimeString & vbCrLf)
        RtbLog.Paste()
        myGraphics.Dispose()
    End Sub
End Class

这个简单版本展示了我正在处理的行为。
如果 "calc" 位于左上角,则完美 - 将其向下或向左移动,图像会包含屏幕的其他部分,并且可能会切断 "calc".

的图像

您的代码可以在一些细节上进行简化。
首先,正如评论中已经提到的,您对 GetWindowRect() is not correct. You need to pass it a Window handle, usually in the form of an IntPtr structure, and a RECT 结构的声明。

当您需要在代码中包含 Windows API 函数调用时,请参考 PInvoke website。很多程序员的经验锻造了:)那几行代码。

此处的桌面大小由 SystemInformation.PrimaryMonitorSize 返回。
您也可以使用 Screen.PrimaryScreen.Bounds or SystemInformation.VirtualScreen.
选择最适合您的计划。

Imports System.Diagnostics
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Runtime.InteropServices

<DllImport("user32.dll")>
Private Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef lpRect As RECT) As Boolean
End Function

<StructLayout(LayoutKind.Sequential)>
Public Structure RECT
    Public Left As Integer
    Public Top As Integer
    Public Right As Integer
    Public Bottom As Integer
End Structure

Private Sub BtnCapture_Click(sender As Object, e As EventArgs) Handles BtnCapture.Click
    Dim wRect As RECT = Nothing
    Dim WindowArea As Rectangle = Nothing

    Dim FindProcess As Process = Process.GetProcessesByName("calc").FirstOrDefault()
    If FindProcess IsNot Nothing AndAlso CInt(FindProcess.MainWindowHandle) > 0 Then
        If GetWindowRect(FindProcess.MainWindowHandle, wRect) Then
            WindowArea = Rectangle.FromLTRB(wRect.Left, wRect.Top, wRect.Right, wRect.Bottom)
        End If
    End If
    If WindowArea = Nothing Then WindowArea = New Rectangle(Point.Empty, SystemInformation.PrimaryMonitorSize)
    Using img As Image = New Bitmap(WindowArea.Width, WindowArea.Height, PixelFormat.Format32bppArgb)
        Using g As Graphics = Graphics.FromImage(img)
            g.SmoothingMode = SmoothingMode.HighQuality
            g.CopyFromScreen(WindowArea.Location, Point.Empty, WindowArea.Size, CopyPixelOperation.SourceCopy)
            img.Save("[The Image Path]", ImageFormat.Png)
            ScaleToClipboard(img, 65.0F) '65% of its original size or 
        End Using
    End Using
    '(...) Other processing
End Sub

编辑:
一种将原始图像保存到磁盘的方法,将源图像大小减小到特定大小或它的一部分,然后将修改后的图像设置到剪贴板,准备粘贴到某个接收者。

ScaleToClipboard([Source Image], [Percent of Original] As Single)
ScaleToClipboard([Source Image], [Specific Size] As Size)

示例:
ScaleToClipboard([Source Image], 72.0F)
ScaleToClipboard([Source Image], New Size(200, 125))

Private Sub ScaleToClipboard(SourceImage As Image, SizeScale As Single)
    Dim NewSize As SizeF = New SizeF((SourceImage.Width \ 100) * SizeScale, (SourceImage.Height \ 100) * SizeScale)
    ScaleToClipboard(SourceImage, Size.Round(NewSize))
End Sub

Private Sub ScaleToClipboard(SourceImage As Image, SizeScale As Size)
    Using img As Image = New Bitmap(SourceImage, Size.Round(SizeScale))
        Using g As Graphics = Graphics.FromImage(img)
            g.SmoothingMode = SmoothingMode.HighQuality
            g.InterpolationMode = InterpolationMode.HighQualityBicubic
            g.DrawImage(SourceImage, New Rectangle(Point.Empty, SizeScale))
            Clipboard.SetImage(TryCast(img.Clone(), Image))
        End Using
    End Using
End Sub