Tipp 0442 Screenshot erstellen - 2 -
Autor/Einsender:
Datum:
  Frank Grimm
09.03.2005
Entwicklungsumgebung:   VB 6
Im Tipp Screenshot erstellen - 1 - werden unter Verwendung der Zwischenablage Screenshots erstellt.
Dieser Tipp bietet die Möglichkeit, einen Screenshot des Bildschirms in eine PictureBox zu übertragen, ohne die Zwischenablage zu benutzen. Dabei kann zwischen drei verschiedenen Modi gewählt werden:
 1.  Bildgröße nicht anpassen, Bild ggf. abschneiden (Standard)
 2.  PictureBox an Größe des Bildes (hier des Bildschirms) anpassen
 3.  Bild auf Größe der PictureBox anpassen
Letztere Möglichkeit ist langsamer da hier die API-Funktion StretchBlt genutzt wird.
Code im Codebereich des Moduls
 
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 GetSystemMetrics Lib "user32.dll" ( _
        ByVal nIndex As Long) 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 Declare Function StretchBlt Lib "gdi32.dll" ( _
        ByVal hdc 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 nSrcWidth As Long, _
        ByVal nSrcHeight As Long, _
        ByVal dwRop As Long) As Long

Public Enum eCaptureMode
  CropPicture = 0
  SizePicBox = 1
  SizePicture = 2
End Enum

Public Function GetDesktop(ByRef pbPictureBox As PictureBox, _
      Optional ByVal CaptureMode As eCaptureMode = CropPicture) _
      As Boolean

  Dim hDesktop      As Long
  Dim hDesktopDC    As Long
  Dim ScreenWidth   As Long
  Dim ScreenHeight  As Long

  hDesktop = GetDesktopWindow()
  hDesktopDC = GetDC(hDesktop)

  ScreenWidth = GetSystemMetrics(0&)
  ScreenHeight = GetSystemMetrics(1&)

  With pbPictureBox
    If CaptureMode = SizePicBox Then
      .Width = ScreenWidth * Screen.TwipsPerPixelX
      .Height = ScreenHeight * Screen.TwipsPerPixelY
    End If
    .AutoRedraw = True
    .Cls
  End With

  If CaptureMode = CropPicture Or CaptureMode = SizePicBox Then
    Call BitBlt(pbPictureBox.hdc, 0&, 0&, _
                ScreenWidth, ScreenHeight, _
                hDesktopDC, 0&, 0&, vbSrcCopy)

  Else
    Call StretchBlt(pbPictureBox.hdc, 0&, 0&, _
                pbPictureBox.Width \ Screen.TwipsPerPixelX, _
                pbPictureBox.Height \ Screen.TwipsPerPixelY, _
                hDesktopDC, 0&, 0&, _
                ScreenWidth, ScreenHeight, vbSrcCopy)
  End If

  With pbPictureBox
    .AutoRedraw = False
    .Refresh
  End With

  Call ReleaseDC(hDesktop, hDesktopDC)
End Function
 
Code im Codebereich der Form
 
Option Explicit

Private Sub cmdDoScreenshot_Click()
  Call Form_Resize

  If chkHideDuringScreenshot.Value = 1 Then
    Me.Hide
  End If
  DoEvents

  GetDesktop picScreenshot, cboScreenshotType.ItemData( _
        cboScreenshotType.ListIndex)

  If chkHideDuringScreenshot.Value = 1 Then
    Me.Show
  End If
End Sub

Private Sub Form_Load()
  With Me.cboScreenshotType
    .Clear
    .AddItem "Bild ggf.abschneiden"
    .ItemData(.NewIndex) = 0
    .AddItem "Picturebox an Bild anpassen"
    .ItemData(.NewIndex) = 1
    .AddItem "Bild an Picturebox anpassen"
    .ItemData(.NewIndex) = 2

    .ListIndex = 0
  End With
End Sub

Private Sub Form_Resize()
  picScreenshot.Width = Me.ScaleWidth - (picScreenshot.Left * 2)
  picScreenshot.Height = Abs(Me.ScaleHeight - picScreenshot.Top)
End Sub
 
Weitere Links zum Thema
Screenshot erstellen - 1 -

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (4,1 kB) Downloads bisher: [ 1471 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Mittwoch, 18. Mai 2011