(-hg)

Mit dem hier vorgestellten ScreenShot-Steuerelement machen Sie Schnappschüsse vom ganzen Bildschirm, von einem Fenster oder einem Steuerelement im Ganzen, oder nur vom Arbeitsbereich eines Fensters oder eines Steuerelements.

	Schnappschüsse vom gesamten Bildschirm und von Fenstern leicht gemacht

Die Technik des Steuerelements beruht darauf, das Abbild des Gerätekontexts des gewünschten Fensters auf seine Oberfläche zu kopieren und in ein Picture-Objekt umzusetzen. Sie können der Methode Shot des Steuerelements den Modus des Schnappschusses und das Handle des "abzufotografierenden" Fensters übergeben (falls nicht der ganze Bildschirm erfasst werden soll). Sie können diese Werte jedoch auch in Eigenschaften voreinstellen.

Die Eigenschaft ScreenShotMode erklärt sich fast von selbst. Ihr Datentyp ist eine Enumeration, und daher sollten Sie auch bei der Zuweisung in der Let-Eigenschaft prüfen, ob ein gültiger Wert aus der Enumeration übergeben worden ist (Visual Basic prüft dies nämlich nicht).

Public Enum ScreenShotModeConstants
  ssScreen
  ssWindow
  ssClientRect
End Enum

Private pScreenShotMode As ScreenShotModeConstants

Public Property Get ScreenShotMode() As ScreenShotModeConstants
  ScreenShotMode = pScreenShotMode
End Property

Public Property Let ScreenShotMode(ByVal New_ScreenShotMode _
 As ScreenShotModeConstants)
  Select Case New_ScreenShotMode
    Case pScreenShotMode
    Case ssScreen To ssClientRect
      pScreenShotMode = New_ScreenShotMode
    Case Else
      Err.Raise 380, Ambient.DisplayName & ".ScreenShotMode"
  End Select
  PropertyChanged "ScreenShotMode"
End Property

Die Eigenschaft Window zur Festlegung des Fenster-Handles erscheint zur Entwicklungszeit nicht im Eigenschaften-Fenster. Eine Angabe zur Entwicklungszeit hätte schließlich keinen Sinn, das sich die Fenster-Handle bei jedem Lauf einer Anwendung ändern.

Private pWindow As Long

Public Property Get Window() As Long
  Window = pWindow
End Property

Public Property Let Window(ByVal New_Window As Long)
  pWindow = New_Window
End Property

Daher wird auch nur der ScreenShot-Modus gespeichert:

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  pScreenShotMode = PropBag.ReadProperty("ScreenShotMode", ssScreen)
  ' ...
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "ScreenShotMode", pScreenShotMode, ssScreen
End Sub

Das Bild des Schnappschusses können Sie jederzeit aus der Eigenschaft Picture auslesen und auch über die Methode Clear löschen.

Public Property Get Picture() As StdPicture
  Set Picture = UserControl.Picture
End Property

Public Function Clear() As StdPicture
  Set UserControl.Picture = Nothing
End Function

Alternativ zu den Voreinstellungen können Sie der Methode Shot einen andere Wert für den ScreenShot-Modus und ein anderes Fenster-Handle als Parameter übergeben. Diese Werte werden dann für diesen einen Aufruf verwendet, ändern jedoch nicht die Voreinstellungen.

Public Function Shot(Optional ByVal ScreenShotMode As Variant, _
 Optional ByVal Window As Variant) As StdPicture
  Dim nScreenShotMode As ScreenShotModeConstants
  Dim nWindow As Long
  Dim nDCSrc As Long
  Dim nRect As RECT

Zunächst wird geprüft, ob ein ScreenShot-Modus übergeben worden ist. Ist dies der Fall, wird er der lokalen Variablen nScreenShotMode zugewiesen. Anderenfalls wird die Voreinstellung verwendet.

  If IsMissing(ScreenShotMode) Then
    nScreenShotMode = pScreenShotMode
  Else
    nScreenShotMode = ScreenShotMode
  End If

Ist als ScreenShot-Modus ssScreen gewählt worden (der gesamte Bildschirm soll abfotografiert werden), wird über die API-Funktion GetDesktopWindow das Fenster-Handle des Desktops zur weiteren Verwendung ermittelt.

  Select Case nScreenShotMode
    Case ssScreen
      nWindow = GetDesktopWindow()

Wurde einer der beiden anderen ScreenShot-Modi gewählt, wird geprüft, ob ein Fenster-Handle als Parameter übergeben worden ist. Ist dies nicht der Fall, wird das voreingestellte Fenster-Handle verwendet.

    Case Else
      If IsMissing(Window) Then
        nWindow = pWindow
      Else
        nWindow = Window
      End If

Anschließend prüft die API-Funktion IsWindow, ob es sich um das Handle eines tatsächlich existierenden Fensters handelt. Ist das Fenster-Handle ungültig, wird ein Fehler ausgelöst und die Funktion verlassen.

      If Not CBool(IsWindow(nWindow)) Then
        Err.Raise ssErrInvalidWindow, Ambient.DisplayName & ".Shot", _
         "Ungültiges Fenster-Handle: " & nWindow
        Exit Function
      End If
  End Select

Dann werden entsprechend dem gewählten ScreenShot-Modus und anhand des nun vorliegenden Fenster-Handles der Gerätekontext (API-Funktionen GetDC bzw. GetWindowDC), die Größe des Fensters ermittelt und das UserControl auf diese Größe gesetzt.

  With UserControl
    Select Case nScreenShotMode
      Case ssScreen
        nDCSrc = GetDC(nWindow)
        With nRect
          .Right = Screen.Width \ Screen.TwipsPerPixelX
          .Bottom = Screen.Height \ Screen.TwipsPerPixelY
        End With
        .Size Screen.Width, Screen.Height
      Case ssWindow
        nDCSrc = GetWindowDC(nWindow)
        GetWindowRect nWindow, nRect

Hier ist zu beachten, dass das mit GetWindowRect ermittelte Rechteck die Position des Fensters in absoluten Bildschirmkoordinaten beschreibt. Wir brauchen jedoch eigentlich nur die Breite und die Höhe und müssen daher die Werte der linken oberen Ecke (.Left und .Top) von denen der unteren rechten Ecke (.Right und .Bottom) abziehen und dann auf 0 setzen.

        With nRect
          .Right = .Right - .Left
          .Left = 0
          .Bottom = .Bottom - .Top
          .Top = 0
        End With
        .Size nRect.Right * Screen.TwipsPerPixelX, _
         nRect.Bottom * Screen.TwipsPerPixelY
      Case ssClientRect
        nDCSrc = GetDC(nWindow)

Die API-Funktion GetClientRect liefert die Ausdehnung des Arbeitsbereiches des gewünschten Fensters direkt - die Koordinaten der oberen linken Ecke sind 0.

        GetClientRect nWindow, nRect
        .Size nRect.Right * Screen.TwipsPerPixelX, _
         nRect.Bottom * Screen.TwipsPerPixelY
    End Select

Da das UserControl unsichtbar ist, müssen wir AutoRedraw einschalten, damit wir eine nichtflüchtige Fläche zum Übertragen des Bildes zur Verfügung haben. Damit nicht versehentlich Reste vom letzten Schnappschuss stören, löschen wir den Bildinhalt sicherheitshalber.

    .AutoRedraw = True
    .Cls

Der Aufruf der API-Funktion BitBlt überträgt nun das Bild aus dem oben ermittelten Gerätekontext in den Gerätekontext des UserControls.

    BitBlt .hDC, 0, 0, .ScaleWidth, .ScaleHeight, _
     nDCSrc, 0, 0, vbSrcCopy
    ReleaseDC nWindow, nDCSrc

Das übertragene Bild wird mit

    Set .Picture = .Image

als Picture-Objekt gesichert und gelöscht. Zur Freigabe der speicherfressenden Zeichenfläche schalten wir AutoRedraw wieder aus und setzen das UserControl auf die kleinstmögliche Größe von 1 x 1 Pixel.

    .Cls
    .AutoRedraw = False
    .Size Screen.TwipsPerPixelX, Screen.TwipsPerPixelY

Nun setzen wir das Picture-Objekt als Rückgabewert der Funktion.

Als kleines Komfort-Feature und lösen wir hier das selbstdefinierte Ereignis Done aus, dem ebenfalls das Picture-Objekt als Ereignisparameter übergeben wird. Dieses Ereignis ist ganz nützlich, da es an ganz anderer Stelle ausgewertet werden kann, als der, von der der Methoden-Aufruf erfolgt ist.

    Set Shot = .Picture
    RaiseEvent Done(.Picture)
  End With
End Function

Damit sind die wesentlichsten Bestandteile des ScreenShot-Steuerelements beschrieben. Nun folgen noch die Deklarationen der benötigten API-Funktionen im einzelnen:

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
 ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
 ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
 ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetClientRect Lib "user32" _
 (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" _
 (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" _
 (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
 (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function IsWindow Lib "user32" _
 (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
 (ByVal hwnd As Long, ByVal hDC As Long) As Long

Zur Laufzeit ist das Steuerelement unsichtbar (InvisibleAtRuntime) und zur Entwicklungszeit stellt es sich als in der Größe unveränderliches Symbol dar ("Mehr scheinen als sein")

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    ' ...    
    cmdBack.Visible = Not Ambient.UserMode
End Sub

Private Sub UserControl_Resize()
    Static sInProc As Boolean
    
    If sInProc Then
        Exit Sub
    Else
        sInProc = True
    End If
    If Not Ambient.UserMode Then
        UserControl.Size 32 * Screen.TwipsPerPixelX, _
         32 * Screen.TwipsPerPixelY
    End If
    sInProc = False
End Sub

Copyright © 1999 - 2023 Harald M. Genauck, ip-pro gmbh  /  Impressum