Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0311: Gezielten Snapshot erstellen

 von 

Beschreibung 

Das Form des hier vorgestellten Projektes dient einzig und allein dazu ein Areal auf dem Desktop abzugrenzen. Es kann frei verschoben und in seiner Größe beliebig verändert werden. Bei Betätigung des Buttons wird die grafische Fläche unter dem Formular ausgeschnitten und in die Zwischenablage kopiert.

Dieser Tipp wurde von Florian Rittmeier () komplett überarbeitet.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

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

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

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.

Kommentar von Razorback am 10.07.2008 um 22:42

hätte ne frage und zwar hab ich mir ein screenshot programm gemacht, der 1 screenshot erstellt und abspeichert .bmp
meine frage ist jezt wie ich es hinbekomme das, wenn ich noch 1 screenshot mache z.b. bild2 da steht .... bei mir überschreibt der dann einfach das bild ...

würde mich um antwort freuen

Tobias aka Razorback

Kommentar von Edgar Kalkowski am 16.03.2005 um 18:08

Hallo!

Ich besitzte WinXP mit VB6 und bei mir funktioniert der Code leider nicht wie gewünscht. Es wird zwar ein Bild der richtigen Größe in die Zwischenablage kopiert, jedoch ist es komplett weiß!

Hat jemand eine Ahnung woran das liegt?

MFG

Edgar

Kommentar von PhilippVB am 23.12.2001 um 20:06

Ich hab mal ne Frage: Warum werden in den Zeilen:
ARegion = CreateRectRgn(0, 0, Breite, Hoehe)
RRegion = CreateRectRgn(0, 0, Breite, Hoehe)
zwei identische Regions erstellt??

Kommentar von A. Fuchs am 02.11.2001 um 11:48

Unter NT 4.0 wird jeweils der ganze Bildschirm in die Zwischenablage kopiert.