Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    text
    copied!<p>You could maybe use one Form as the start form and place a button there "Do Screenshot". Then create a second form, that is maximized and borderless and create a picturebox on it with location (0, 0) and size of the form itself. Anchor this picturebox to all sides of Form2 (so it scales with it just in case). When you click on the button on Form1 you could do the following:</p> <pre><code>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 </code></pre> <p>On Form2 you can then handle the MouseDown, MouseMove and MouseUp events of the Picturebox to let the user draw a rectangle on the image and crop the image at these bounds. Form2 could look something like that:</p> <pre><code>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 &lt; 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 &lt;&gt; DragEnd.X AndAlso DragStart.Y &lt;&gt; 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 &lt;&gt; DragEnd.X AndAlso DragStart.Y &lt;&gt; 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 </code></pre>
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload