vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Oberfläche · Fenster   |   VB-Versionen: VB2005, VB200823.07.10
ScreenCapture statt Form.DrawToBitmap()

Eine Klasse, mit der schnell und einfach Screenshots von Fenstern gemacht werden können.

Autor:   Thomas BosoldBewertung:  Views:  10.948 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Schon mal das gute alte BitBlt vermisst? Das zeichnet immer richtig - ohne Einschränkungen. Einfach unten stehende Klasse einfügen, und schon können per Einzeiler Screenshots und Snapshots von Fenstern gemacht werden.

Imports System
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Drawing.Imaging
 
''' <summary>
''' Stellt Funktionen bereit, mit denen Screenshots 
''' erstellt und gespeichert werden können.
''' </summary>
''' <remarks></remarks>
Public Class ScreenCapture
 
  ''' <summary>
  ''' Erstellt ein Image-Objekt, das den Screenshot 
  ''' des momentanen Desktops enthält.
  ''' </summary>
  ''' <returns>Das Image.</returns>
  ''' <remarks></remarks>
  Public Function CaptureScreen() As Image
    Return CaptureWindow(User32.GetDesktopWindow())
  End Function
 
  ''' <summary>
  ''' Erstellt ein Image-Objekt, das den Screenshot 
  ''' eines angegebenen Fensters enthält.
  ''' </summary>
  ''' <param name="handle">Das Handle des Fensters 
  ''' (Windows.Forms.Form.Handle).</param>
  ''' <returns>Das Image.</returns>
  ''' <remarks></remarks>
  Public Function CaptureWindow(ByVal handle As IntPtr) As Image
    Dim hdcSrc As IntPtr = User32.GetWindowDC(handle)
    Dim windowRect As New User32.RECT()
    User32.GetWindowRect(handle, windowRect)
    Dim width As Integer = windowRect.right - windowRect.left
    Dim height As Integer = windowRect.bottom - windowRect.top
    Dim hdcDest As IntPtr = GDI32.CreateCompatibleDC(hdcSrc)
    Dim hBitmap As IntPtr = GDI32.CreateCompatibleBitmap(hdcSrc, width, height)
    Dim hOld As IntPtr = GDI32.SelectObject(hdcDest, hBitmap)
    GDI32.BitBlt(hdcDest, 0, 0, width, height, hdcSrc, 0, 0, GDI32.SRCCOPY)
    GDI32.SelectObject(hdcDest, hOld)
    GDI32.DeleteDC(hdcDest)
    User32.ReleaseDC(handle, hdcSrc)
    Dim img As Image = Image.FromHbitmap(hBitmap)
    GDI32.DeleteObject(hBitmap)
    Return img
  End Function
 
  ''' <summary>
  ''' Erstellt ein Image-Objekt eines Fensters und speichert es in einer Datei.
  ''' </summary>
  ''' <param name="handle">Das Handle des Fensters 
  ''' (Windows.Forms.Form.Handle).</param>
  ''' <param name="filename">Der Dateiname, 
  ''' unter dem das Image gespeichert wird.</param>
  ''' <param name="format">Das Image-Format (ImageFormat.Gif)</param>
  ''' <remarks></remarks>
  Public Sub CaptureWindowToFile(ByVal handle As IntPtr, _
    ByVal filename As String, ByVal format As ImageFormat)
 
    Dim img As Image = CaptureWindow(handle)
    img.Save(filename, format)
  End Sub
 
  ''' <summary>
  ''' Erstellt ein Image-Objekt vom Desktop und speichert es in einer Datei.
  ''' </summary>
  ''' <param name="filename">Der Dateiname, unter dem das Image gespeichert wird.</param>
  ''' <param name="format">Das Image-Format (ImageFormat.Gif)</param>
  ''' <remarks></remarks>
  Public Sub CaptureScreenToFile(ByVal filename As String, _
    ByVal format As ImageFormat)
 
    Dim img As Image = CaptureScreen()
    img.Save(filename, format)
  End Sub
  ''' <summary>
  ''' Hilfs-Klasse, die GDI32 API Funktionen enthält.
  ''' </summary>
  ''' <remarks></remarks>
  Private Class GDI32
 
    Public Const SRCCOPY As Integer = &HCC0020
 
    <DllImport("gdi32.dll")> _
    Public Shared Function BitBlt( _
    ByVal hObject As IntPtr, _
    ByVal nXDest As Integer, _
    ByVal nYDest As Integer, _
    ByVal nWidth As Integer, _
    ByVal nHeight As Integer, _
    ByVal hObjectSource As IntPtr, _
    ByVal nXSrc As Integer, _
    ByVal nYSrc As Integer, _
    ByVal dwRop As Integer) As Boolean
    End Function
 
    <DllImport("gdi32.dll")> _
    Public Shared Function CreateCompatibleBitmap( _
      ByVal hDC As IntPtr, _
      ByVal nWidth As Integer, _
      ByVal nHeight As Integer) As IntPtr
    End Function
 
    <DllImport("gdi32.dll")> _
    Public Shared Function CreateCompatibleDC( _
      ByVal hDC As IntPtr) As IntPtr
    End Function
 
    <DllImport("gdi32.dll")> _
    Public Shared Function DeleteDC( _
      ByVal hDC As IntPtr) As Boolean
    End Function
 
    <DllImport("gdi32.dll")> _
    Public Shared Function DeleteObject( _
      ByVal hObject As IntPtr) As Boolean
    End Function
 
    <DllImport("gdi32.dll")> _
    Public Shared Function SelectObject( _
      ByVal hDC As IntPtr, _
      ByVal hObject As IntPtr) As IntPtr
    End Function
 
  End Class
  ''' <summary>
  ''' Hilfs-Klasse, die User32 API Funktionen enthält.
  ''' </summary>
  ''' <remarks></remarks>
  Private Class User32
 
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure RECT
      Public left As Integer
      Public top As Integer
      Public right As Integer
      Public bottom As Integer
    End Structure
 
    <DllImport("user32.dll")> _
    Public Shared Function GetDesktopWindow() As IntPtr
    End Function
 
    <DllImport("user32.dll")> _
    Public Shared Function GetWindowDC(ByVal hWnd As IntPtr) As IntPtr
    End Function
 
    <DllImport("user32.dll")> _
    Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, _
      ByVal hDC As IntPtr) As IntPtr
    End Function
 
    <DllImport("user32.dll")> _
    Public Shared Function GetWindowRect(ByVal hWnd As IntPtr, _
      ByRef rect As RECT) As IntPtr
    End Function
 
  End Class
End Class

Aufrufbeispiel:

' Beispiel: Fenster als Bitmap speichern:
Dim f As Form = Me
Dim bm As New Bitmap(f.Width, f.Height)
Dim sc As New ScreenCapture
bm = CType(sc.CaptureWindow(f.Handle), Bitmap)
 
' Beispiel: Screenshot als GIF auf Festplatte speichern:
sc.CaptureScreenToFile("D:\Screenshot.gif", Imaging.ImageFormat.Gif)
 
' oder sofort als Vorschau in einer PictureBox anzeigen
PictureBox1.Image = bm



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.