Question

我有一个应用程序可以正确捕获应用程序窗口的图像（如果它位于主屏幕的左上角）。
但是，如果不正确，则图像尺寸是不正确的（如果窗口图像的高度靠右边缘并从屏幕顶部向下倾斜，则窗口图像的高度将被拉伸。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”的图像。

Answer 1

您的代码可以简化一些细节。
首先，正如评论中已经提到的，您对GetWindowRect()的声明是不正确的。您需要向其传递一个Window句柄，通常采用IntPtr结构和RECT结构的形式。

当您需要在代码中包含Windows API函数调用时，请参考PInvoke website。许多程序员的经验都是伪造的：）那些代码行。

此处的桌面大小由SystemInformation.PrimaryMonitorSize返回。
您也可以使用Screen.PrimaryScreen.Bounds或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

修改：
一种将原始图像保存到磁盘，将源图像大小减小到特定大小或一部分大小的方法，然后将修改后的图像设置到ClipBoard，准备好以某种方式粘贴。

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

如果应用程序不在0,0

1 个答案: