Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0311: Gezielten Snapshot erstellen

VB 5/6-Tipp 0311: Gezielten Snapshot erstellen

 von Lothar Kriegerow

Schwierigkeitsgrad:

Verwendete API-Aufrufe: BitBlt, GetDC, GetDesktopWindow, GetWindowRect, ReleaseDC

Download: Download des Beispielprojektes [2,91 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Beschriftungsfeld "Label1"


'Autor: Florian Rittmeier
'E-Mail: Florian@ActiveVB.de
'Nach einer Idee von Lothar Kriegerow

Option Explicit

Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long

Private Declare Function GetDC Lib "user32.dll" ( _
     ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32.dll" ( _
     ByVal hwnd As Long, _
     ByVal hdc As Long) As Long

Private Declare Function GetWindowRect Lib "user32.dll" ( _
     ByVal hwnd As Long, _
     lpRect As RECT) As Long

Private Declare Function BitBlt Lib "gdi32.dll" ( _
    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 Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const SRCCOPY As Long = &HCC0020

Private Sub Command2_Click()
    Dim deskWnd As Long, deskDC As Long, retval As Long
    Dim windowpos As RECT

    ' Device Context des Desktops(Bildschirms) ermitteln
    deskWnd = GetDesktopWindow
    deskDC = GetDC(deskWnd)

    ' Abmessungen des Formulars bestimmen
    retval = GetWindowRect(Me.hwnd, windowpos)
    If retval = 0 Then
        Call MsgBox("Die Abmessungen des Formulars konnten nicht bestimmt werden.", _
                    vbExclamation + vbOKOnly, App.Title)
        Exit Sub
    End If

    ' Größe der Picturebox
    Picture1.Width = Me.ScaleX(windowpos.Right - windowpos.Left, vbPixels, Me.ScaleMode)
    Picture1.Height = Me.ScaleY(windowpos.Bottom - windowpos.Top, vbPixels, Me.ScaleMode)

    Me.Visible = False ' Fenster unsichtbar machen
    DoEvents ' Dem Fenster Zeit geben, dass es verschwindet.

    ' Snapshot des entsprechenden Bereiches machen
    retval = BitBlt(Picture1.hdc, 0, 0, Picture1.Width, Picture1.Height, _
                    deskDC, windowpos.Left, windowpos.Top, SRCCOPY)

    ' Fenster wieder sichtbar machen
    Me.Visible = True

    ' Handle wieder freigeben
    Call ReleaseDC(deskWnd, deskDC)

    ' An dieser Stelle nun überprüfen,
    ' ob wir überhaupt einen erfolgreichen Screenshot gemacht haben
    If retval = 0 Then
        Call MsgBox("Das Snapshot konnte nicht erstellt werden.", _
                    vbExclamation + vbOKOnly, App.Title)
        Exit Sub
    End If

    Picture1.Refresh

    Clipboard.SetData Picture1.Image, vbCFBitmap
    Clipboard.SetData Picture1.Image, vbCFDIB
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 4 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.