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






Reply With Quote