'Beispiel: VB .Net - ScreenShot von per Mouse ermittelten Bildschirmkoordinaten 'Hinweis : Zum Testen, nach dem Start des Beispiels, auf den Button Create ScreenShot klicken und dann ' einen Rahmen aufziehen. Der aufgezogene Bereich wird beim loslassen der Maustaste im Anwendungsfenster ' angezeigt. ' Option Explicit On Option Strict On Imports System.Runtime.InteropServices Public Class Form1 Public Class WinApi <DllImport("gdi32.dll", CharSet:=CharSet.Auto)> _ Public Shared Function BitBlt _ ( _ ByVal hDestDC As IntPtr, _ ByVal x As Int32, _ ByVal y As Int32, _ ByVal nWidth As Int32, _ ByVal nHeight As Int32, _ ByVal hSrcDC As IntPtr, _ ByVal xSrc As Int32, _ ByVal ySrc As Int32, _ ByVal dwRop As Int32 _ ) _ As Boolean End Function <DllImport("user32.dll", CharSet:=CharSet.Auto)> _ Public Shared Function GetDC _ ( _ ByVal hwnd As IntPtr _ ) _ As IntPtr End Function <DllImport("user32.dll", CharSet:=CharSet.Auto)> _ Public Shared Function ReleaseDC _ ( _ ByVal hwnd As IntPtr, _ ByVal hdc As IntPtr _ ) _ As Int32 End Function Public Const SRCCOPY As Int32 = &HCC0020 End Class Private WithEvents CaptureButton As New Button Private CaptureWindow As New Panel Private WithEvents ImageContainer As New PictureBox Private WithEvents ExitButton As New Button Private ReadOnly Property FrameColor() As Color Get Return Color.Black End Get End Property Private ReadOnly Property FrameStyle() As FrameStyle Get Return FrameStyle.Dashed End Get End Property Private Function CreateBitmap(ByVal Width As Integer, ByVal Height As Integer) As Bitmap Try Return New Bitmap(Width, Height) Catch Return Nothing End Try Return Nothing End Function Private Function Rect(ByVal PositionA As Point, ByVal PositionB As Point) As Rectangle Dim width As Integer, height As Integer Dim x As Integer, y As Integer Dim rc As Rectangle If PositionA.X > PositionB.X Then : width = PositionA.X - PositionB.X : x = PositionB.X - x : Else width = PositionB.X - PositionA.X : x = PositionA.X : End If If PositionA.Y > PositionB.Y Then : height = PositionA.Y - PositionB.Y : y = PositionB.Y : Else height = PositionB.Y - PositionA.Y : y = PositionA.Y : End If rc = New Rectangle(x, y, width, height) Return rc End Function Private Sub SetCaptureWindow() With Me.CaptureWindow .Parent = Me .BorderStyle = BorderStyle.FixedSingle .AutoScroll = True .BackColor = Color.DarkBlue .SetBounds(2, 40, 150, 150) With ImageContainer .Parent = CaptureWindow .SizeMode = PictureBoxSizeMode.AutoSize With CaptureButton .Parent = Me .Text = "Create ScreenShot" .SetBounds(2, 3, 75, 35) With Me .Text = "Create screen shot with screen coordinates" .AcceptButton = CaptureButton With ExitButton .Parent = Me .Text = "Exit" .SetBounds(77, 3, 75, 35) End With End With End With End With End With End Sub Public Structure Coordinates Public BeginningPoints As Point Public EndingPoints As Point End Structure Private c As Coordinates Private Sub MouseEventDown(ByVal e As System.Windows.Forms.MouseEventArgs) With e If .Button = Windows.Forms.MouseButtons.Left Then c.BeginningPoints = New Point(.X, .Y) c.EndingPoints = New Point(.X, .Y) End If End With End Sub Private Sub MouseEventMove(ByVal e As System.Windows.Forms.MouseEventArgs) With e If .Button = Windows.Forms.MouseButtons.Left Then Dim rc As Rectangle = Rect(c.BeginningPoints, c.EndingPoints) ControlPaint.DrawReversibleFrame(rc, FrameColor(), FrameStyle()) c.EndingPoints = New Point(.X, .Y) With c rc = Rect(.BeginningPoints, .EndingPoints) End With ControlPaint.DrawReversibleFrame(rc, FrameColor(), FrameStyle()) End If End With End Sub Private Sub MouseEventUp(ByVal e As System.Windows.Forms.MouseEventArgs) Dim rc As Rectangle = Rect(c.BeginningPoints, c.EndingPoints) ControlPaint.DrawReversibleFrame(rc, FrameColor(), FrameStyle()) Dim hBitmap As Bitmap = Nothing Dim dc As IntPtr Dim Destination As IntPtr With rc If .Width > 0 AndAlso .Height > 0 Then hBitmap = CreateBitmap(.Width, .Height) If hBitmap IsNot Nothing Then dc = WinApi.GetDC(IntPtr.Zero) Dim g As Graphics = Graphics.FromImage(hBitmap) Destination = g.GetHdc() WinApi.BitBlt( _ Destination, _ 0, 0, .Width, .Height, _ dc, _ .X, .Y, _ WinApi.SRCCOPY) With g .ReleaseHdc(Destination) .Dispose() End With WinApi.ReleaseDC(IntPtr.Zero, dc) ImageContainer.Image = (hBitmap) Else Throw New Exception("Bitmap can't be created") End If End If SetStyles(True, 1, Windows.Forms.FormBorderStyle.Sizable, FormWindowState.Normal) End With End Sub Private Sub SetStyles(ByVal Visibility As Boolean, ByVal Opacity As Double, _ ByVal FormStyle As FormBorderStyle, ByVal State As FormWindowState) With Me.ImageContainer .Visible = Visibility With Me.CaptureButton .Visible = Visibility With Me .Opacity = Opacity .FormBorderStyle = FormStyle .WindowState = State End With End With End With End Sub Private Sub CaptureButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) _ Handles CaptureButton.Click If Me.CaptureWindow IsNot Nothing Then Me.CaptureWindow = Nothing SetStyles(False, 0.01, Windows.Forms.FormBorderStyle.None, FormWindowState.Maximized) End Sub Private Sub ExitButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) _ Handles ExitButton.Click With Me .Close() End With End Sub Private Sub ImageContainer_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) _ Handles ImageContainer.MouseDown With e Select Case .Button Case Windows.Forms.MouseButtons.Left Dim sfd As SaveFileDialog = New SaveFileDialog() With sfd .Title = "Save File as .jpg" .InitialDirectory = "c:\" .Filter = "(JPEG File)*.jpg|*.jpg" If ImageContainer IsNot Nothing Then If .ShowDialog = Windows.Forms.DialogResult.OK Then Try ImageContainer.Image.Save(.FileName, System.Drawing.Imaging.ImageFormat.Jpeg) Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Information") End Try Else MessageBox.Show("SaveFileDialog was canceled", "Information") End If Else MessageBox.Show("ImageContainer = Nothing / Saving was canceled.", "Information") End If End With Case Windows.Forms.MouseButtons.Right Const msg As String = "Download from: http://www.visual-basic5.de" MessageBox.Show(msg, "Info") End Select End With End Sub Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) _ Handles Me.Load With Me .CenterToScreen() .SetCaptureWindow() End With Try Dim frm As New Form2 With frm .ShowDialog() End With Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") End Try End Sub Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) _ Handles Me.MouseUp MouseEventUp(e) End Sub Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) _ Handles Me.MouseDown MouseEventDown(e) End Sub Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) _ Handles Me.MouseMove MouseEventMove(e) End Sub Private Sub ImageContainer_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) _ Handles ImageContainer.MouseEnter ImageContainer.Cursor = Cursors.Hand End Sub Private Sub ImageContainer_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) _ Handles ImageContainer.MouseLeave ImageContainer.Cursor = Cursors.Default End Sub End Class