【问题标题】:screen capture with 2 windows forms带有 2 个窗口形式的屏幕截图
【发布时间】:2013-12-06 23:11:44
【问题描述】:

我正在尝试制作屏幕捕获应用程序,但我在理解代码时遇到了问题。据我了解,Form2 窗口是将被捕获的部分。那么为什么当我运行这个应用程序时,FOrm1 会覆盖整个屏幕呢?如何使 Form1 窗口可见,然后在单击按钮时激活 mousedown 事件并将 Form1 隐藏到系统三中?这是我看到的一个例子,没有别的 我只想在按下按钮时激活区域截图。不是马上。

Public Class Form1

    Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = Keys.Escape Then
            Me.Close()
        End If
    End Sub

    Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
        Form2.Show()
        Form2.Location = Cursor.Position
        Form2.Location = Form2.Location
    End Sub

    Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
        Form2.Size = Cursor.Position - Form2.Location
    End Sub

    Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
        Form2.Hide()
        Me.Hide()
        Dim bounds As Form2
        Dim screenshot As System.Drawing.Bitmap
        Dim graph As Graphics
        bounds = Form2
        screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
        graph = Graphics.FromImage(screenshot)
        graph.CopyFromScreen(Form2.Bounds.X, Form2.Bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy)
        Form2.BackgroundImage = screenshot
        Dim sPath As New SaveFileDialog
        sPath.Filter = "Image (*.png)|*,*"
        sPath.ShowDialog()
        Dim bmp As Bitmap
        Try
            bmp = Form2.BackgroundImage
            bmp.Save(sPath.FileName + ".png")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
        Me.Close()
    End Sub

    Private Sub Form1_Resize(sender As Object, e As EventArgs) Handles Me.Resize
        Try
            If Me.WindowState = FormWindowState.Minimized Then
                Me.Visible = False
                ScreenShot.Visible = True
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
End Class

【问题讨论】:

  • 这在 XP 上会出错。您没有等待足够长的时间来让所有其他窗口重新粉刷自己。你得睡一会儿。

标签: .net vb.net


【解决方案1】:

您可以使用一个表单作为开始表单并在其中放置一个按钮“做屏幕截图”。 然后创建第二个窗体,最大化且无边框,并在其上创建一个带有位置 (0, 0) 和窗体本身大小的图片框。将此图片框锚定到 Form2 的所有侧面(以便以防万一)。 当您单击 Form1 上的按钮时,您可以执行以下操作:

Private Sub CaptureScreen()
    Dim dWidth As Integer = Screen.PrimaryScreen.Bounds.Width
    Dim dHeight As Integer = Screen.PrimaryScreen.Bounds.Height
    Dim bmp As New Bitmap(dWidth, dHeight)
    Dim g As Graphics = Graphics.FromImage(bmp)
    g.CopyFromScreen(0, 0, 0, 0, New Size(dWidth, dHeight))
    g.Dispose()
    If Not IsNothing(Form2.PictureBox1.Image) Then Form2.PictureBox1.Image.Dispose()
    Form2.PictureBox1.Image = bmp
    Form2.ShowDialog()
End Sub

Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
    CaptureScreen()
End Sub

然后,您可以在 Form2 上处理 Picturebox 的 MouseDown、MouseMove 和 MouseUp 事件,让用户在图像上绘制一个矩形并在这些边界处裁剪图像。 Form2 可能看起来像这样:

Public Class Form2
Dim IsDragging As Boolean = False
Dim DragStart As Point = New Point(0, 0)
Dim DragEnd As Point = New Point(0, 0)
Dim OriginalImage As Bitmap
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    Me.Close()
End Sub
Dim LastTime As Date = Date.Now

Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
    If (Date.Now - LastTime).TotalMilliseconds < 15 Then Exit Sub
    If IsDragging Then
        DragEnd = e.Location
        ShowRectangle()
    End If
    LastTime = Date.Now
End Sub

Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
    If IsDragging AndAlso DragStart.X <> DragEnd.X AndAlso DragStart.Y <> DragEnd.Y Then

        'Do the cropping on OriginalImage here

        If Not IsNothing(PictureBox1.Image) Then PictureBox1.Image.Dispose()
        PictureBox1.Image = CType(OriginalImage.Clone, Bitmap)
    End If
    IsDragging = False
End Sub

Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
    If Not IsNothing(OriginalImage) Then OriginalImage.Dispose()
    OriginalImage = CType(PictureBox1.Image.Clone, Bitmap)
    DragStart = e.Location
    DragEnd = e.Location
    IsDragging = True


End Sub
Private Sub ShowRectangle()
    If (Not IsNothing(OriginalImage)) AndAlso DragStart.X <> DragEnd.X AndAlso DragStart.Y <> DragEnd.Y Then
        Dim NewBmp As Bitmap = CType(OriginalImage.Clone, Bitmap)
        Dim g As Graphics = Graphics.FromImage(NewBmp)
        g.DrawRectangle(Pens.Red, Math.Min(DragStart.X, DragEnd.X), Math.Min(DragStart.Y, DragEnd.Y), Math.Abs(DragStart.X - DragEnd.X), Math.Abs(DragStart.Y - DragEnd.Y))
        g.Dispose()
        If Not IsNothing(PictureBox1.Image) Then PictureBox1.Image.Dispose()
        PictureBox1.Image = NewBmp
    End If
End Sub
End Class

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2012-07-02
    • 2013-11-26
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多