-
How can I put a screenshot to a pictureobject? I tried the following (took parts of the code from an example how to extract icons from files) but it did not work :(
Code:
Public Type PicBmp
Size As Long
tType As Long
hBMP As Long
hPal As Long
Reserved As Long
End Type
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Public Declare Function OleCreatePictureIndirect _
Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Public Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public 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
Public Function ScreenshotToBitmap() As Picture
Dim pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID
Dim hBM&, hSourceDC&, hDestDC&, h&
Dim dx&, dy&
dx = Screen.Width / Screen.TwipsPerPixelX
dy = Screen.Height / Screen.TwipsPerPixelY
hSourceDC = CreateDC("DISPLAY", "0", "0", 0)
hDestDC = CreateCompatibleDC(hSourceDC)
hBM = CreateCompatibleBitmap(hDestDC, dx, dy)
h = SelectObject(hDestDC, hBM)
Call BitBlt(hDestDC, 0, 0, dx, dy, hSourceDC, 0, 0, vbSrcCopy)
'Fill in with IDispatch Interface ID.
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
'Fill Pic with necessary parts.
With pic
.Size = Len(pic) 'Length of structure.
.tType = vbPicTypeBitmap 'Type of Picture (bitmap).
.hBMP = hBM 'Handle to bitmap.
End With
'Create Picture object.
Call OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic)
'Return the new Picture object.
Set ScreenshotToBitmap = IPic
DeleteDC hSourceDC
DeleteDC hDestDC
DeleteObject h
DeleteObject hBM
End Function
-
You only have to blit the screen to your picture box. Do this:
Code:
dim Temp as Long
Temp = GetWindowDC( GetDesktopWindow)
BitBlt Picture.hDC, 0, 0, Screen.Width / Screen.TwipsPerPixelX, Screen.Height / Screen.TwipsPerPixelY, Temp, 0, 0, vbSrcCopy
I have no VB here so maybe you don't have to scale the size (Just remove the TwipsPerPixel parts). If you need there's also a demo project on my website...
-
But this way i can't access the picture with Picture1.Picture :(
-
...but with Picture1.Image ;)
