0

ねえ、私はここにこのコードを持っています:

Dim p As Process = Process.GetProcessesByName("Cal").FirstOrDefault
Dim target_hwnd As Long = FindWindow(vbNullString, "Calculator")

If p IsNot Nothing Then
    SetWindowPos(target_hwnd, 0, winSize(0), winSize(1), winSize(2), winSize(3), 0)
    AppActivate(p.Id)

    Dim img As New Bitmap(145, 145) 'size fo the caption area
    Dim gr As Graphics = Graphics.FromImage(img)

    'sets the offsets and use image size to set region
    gr.CopyFromScreen(New Point(winSize(0) + 44, winSize(1) + 179), Point.Empty, img.Size)
    img.Save("test.jpg", Drawing.Imaging.ImageFormat.Jpeg)
    Process.Start("test.jpg")
End If

ウィンドウが表示されている限り、問題なくスクリーンショットを取得できます。ただし、フォームを画面外に移動すると（フォームが表示されない場合）、黒い画像しかキャプチャされません。

私はこのコードを試してきました：

Private Declare Function PrintWindow Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdcBlt As IntPtr, ByVal nFlags As UInt32) As Boolean
Dim screenCapture As Bitmap
Dim otherForm As New Form

Private Sub CaptureScreen()
    Dim target_hwnd As Long = FindWindow(vbNullString, "Calculator")
    SetWindowPos(target_hwnd, 0, winSize(0), winSize(1), winSize(2), winSize(3), 0)

    screenCapture = New Bitmap(245, 245)
    Dim g As Graphics = Graphics.FromImage(screenCapture)
    Dim hdc As IntPtr = g.GetHdc
    Form1.PrintWindow(target_hwnd, hdc, Nothing)
    g.ReleaseHdc(hdc)
    g.Flush()
    g.Dispose()

    If IO.File.Exists("d:\test.jpg") Then
        IO.File.Delete("d:\test.jpg")
    End If

    screenCapture.Save("d:\test.jpg", Drawing.Imaging.ImageFormat.Jpeg)
End Sub

Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
    CaptureScreen()
End Sub

上記のコードは、ウィンドウが画面外にある場合でも画像をキャプチャします。上記のコードの問題は、最初に投稿したCopyFromScreenで実行できたウィンドウ内の領域のみをキャプチャするように指示できないことです。

これはPrintWindowを使用して可能ですか?

4

1 に答える 1

0

私はこれを行うことができました：

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Dim fileName = "Calculator.jpg"
    Dim fileNameCrop = "Calculator-crop.jpg"
    '     |--b|---|x|
    '     |   |     |            a|-Form Left to image area
    '     |   V     |             |  b|-Form Top to image area
    '     a-->[c]   |             |   |   c|-Image area Width to capture
    '     |         |             |   |    |  c|-Image area Height to capture
    '     |_________|             V   V    V   V     
    Dim CropRect As New Rectangle(97, 189, 36, 29)
    Dim OrignalImage = Image.FromFile(fileName)
    Dim CropImage = New Bitmap(CropRect.Width, CropRect.Height)

    Using grp = Graphics.FromImage(CropImage)
        grp.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor
        grp.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
        grp.DrawImage(OrignalImage, New Rectangle(0, 0, CropRect.Width, CropRect.Height), CropRect, GraphicsUnit.Pixel)
        CropImage.Save(fileNameCrop)
    End Using

    OrignalImage.Dispose()
    CropImage.Dispose()
    'delete org image
    If FileIO.FileSystem.FileExists(fileName) Then FileIO.FileSystem.DeleteFile(fileName)
End Sub

OPに投稿された最初のコードからフォーム画像を保存した後、その領域を切り取るだけです。

于 2013-09-10T17:03:23.587 に答える