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.
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

|