Gruss,

Zardoz

Zitat:

werde mir BitBlt anschauen, brauche allerdings die Form bzw. alles was da drauf ist.

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 GetDesktopWindow Lib "user32" () As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc _
  As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
 
Private Sub Command1_Click()
 
  Dim SW&, SH&, Dat1$, DeskHwnd&, DeskHdc&
 
  Dat1 = App.Path & "\Snapshot.bmp"
  If Dir$(Dat1) <> "" Then Kill Dat1
  Me.ScaleMode = vbPixels
  SW = Screen.Width / Screen.TwipsPerPixelX
  SH = Screen.Height / Screen.TwipsPerPixelY
  DeskHwnd = GetDesktopWindow
  DeskHdc = GetDC(DeskHwnd)
  With Picture1
    .Visible = False
    .BorderStyle = vbBSNone
    .AutoRedraw = True
    .Cls
    .Move 0, 0, SW, SH
    Call BitBlt(.hdc, 0, 0, SW, SH, DeskHdc, 0, 0, vbSrcCopy)
    SavePicture .Image, Dat1
    .Cls
    .AutoRedraw = False
  End With
  Call ReleaseDC(DeskHwnd, DeskHdc)
  MsgBox "Bildpfad:" & vbCr & Dat1, vbInformation + vbOKOnly
 
End Sub

Gruss,

Zardoz