in visual basic 6, i have following code which tackes screen capture and encode or converts into JPG, but in a file. (eg. lRes = GdipSaveImageToFile saves JPG file but i dont want to save as file instead the JPG should be saved in memory or in byte array)
i want to save JPG image in memory or a byte array. what should i do.
i dont want to save PNG in memory but encoded JPG in memory, i have search a lot about it but till not found any solution.
Public Sub DesktopToJPG(ByVal filename As String, Optional ByVal Quality As Long = 80, Optional IncludeMouseCursor As Boolean = False)
On Error Resume Next
Dim tSI As GdiplusStartupInput
Dim lRes As Long, lGDIP As Long, lBitmap As Long
Dim X As Long, Y As Long, wide As Long, high As Long
Dim myDIB As Long, myDC As Long, desktopDC As Long
Dim bi24BitInfo As BITMAPINFO
Dim bitmapData() As Byte
Dim pcin As PCURSORINFO
Dim piinfo As ICONINFO
' Starting position/Size of capture (full screen)
X = 0: Y = 0
wide = Screen.Width / Screen.TwipsPerPixelX
high = Screen.Height / Screen.TwipsPerPixelY
'
With bi24BitInfo.bmiHeader
.biBitCount = 24
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(bi24BitInfo.bmiHeader)
.biWidth = wide
.biHeight = high
.biDataSize = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
ReDim bitmapData(0 To .biDataSize - 1)
End With
frmscrcontrol.Caption = UBound(bitmapData)
myDC = CreateCompatibleDC(0)
myDIB = CreateDIBSection(myDC, bi24BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
SelectObject myDC, myDIB
desktopDC = GetDC(0)
BitBlt myDC, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, desktopDC, X, Y, vbSrcCopy Or CAPTUREBLT
' Include mouse cursor?
If IncludeMouseCursor = True Then
pcin.cbSize = Len(pcin)
GetCursorInfo pcin
GetIconInfo pcin.hCursor, piinfo
DrawIcon myDC, pcin.ptScreenPos.X - piinfo.xHotspot, pcin.ptScreenPos.Y - piinfo.yHotspot, pcin.hCursor
If piinfo.hbmMask Then DeleteObject piinfo.hbmMask
If piinfo.hbmColor Then DeleteObject piinfo.hbmColor
End If
Call GetDIBits(myDC, myDIB, 0, bi24BitInfo.bmiHeader.biHeight, bitmapData(0), bi24BitInfo, DIB_RGB_COLORS)
' save as JPG
'------------
'Initialize GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI)
If lRes = 0 Then
' Create the GDI+ bitmap from the image handle
lRes = GdipCreateBitmapFromHBITMAP(myDIB, 0, lBitmap)
If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters
' Initialize the encoder GUID
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
' Initialize the encoder parameters
tParams.Count = 1
With tParams.Parameter ' Quality
' Set the Quality GUID
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
.NumberOfValues = 1
.Type = 4
.Value = VarPtr(Quality)
End With
' Save the image
lRes = GdipSaveImageToFile(lBitmap, StrPtr(filename), tJpgEncoder, tParams)
' Destroy the bitmap
GdipDisposeImage lBitmap
End If
' Shutdown GDI+
GdiplusShutdown lGDIP
End If
If lRes Then
Err.Raise 5, , "Cannot save the image. GDI+ Error:" & lRes
End If
' CLEAN UP
ReleaseDC 0, desktopDC
DeleteObject myDIB
DeleteDC myDC
End Sub
You can use GdipSaveImageToStream, then copy the data to a vb array.
You will have to use a tlb for referencing the IStream.
It took me a while to find the tlb ; it can be downloaded here: http://www.vbaccelerator.com/home/VB/Type_Libraries/Stream/VBSTRM_Type_Library.asp (you will have to add the tlb as reference to your project).
On this vb forum, I found some code to convert the stream to a vb array :
Option Explicit
' Note the parameter type changes...
Private Declare Function GdipSaveImageToStream Lib "gdiplus" (ByVal Image As Long, ByVal Stream As IUnknown, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As IUnknown, Image As Long) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetHGlobalFromStream Lib "ole32" (ByVal ppstm As Long, hGlobal As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Public Function IStreamFromArray(ByVal ArrayPtr As Long, ByVal Length As Long) As stdole.IUnknown
' Purpose: Create an IStream-compatible IUnknown interface containing the
' passed byte aray. This IUnknown interface can be passed to GDI+ functions
' that expect an IStream interface -- neat hack
' ArrayPtr: passed like VarPtr(myArray(0))
' Length: total bytes to be read from ArrayPtr
On Error GoTo HandleError
Dim o_hMem As Long
Dim o_lpMem As Long
If ArrayPtr = 0& Then
CreateStreamOnHGlobal 0&, 1&, IStreamFromArray
ElseIf Length <> 0& Then
o_hMem = GlobalAlloc(&H2&, Length)
If o_hMem <> 0 Then
o_lpMem = GlobalLock(o_hMem)
If o_lpMem <> 0 Then
CopyMemory ByVal o_lpMem, ByVal ArrayPtr, Length
Call GlobalUnlock(o_hMem)
Call CreateStreamOnHGlobal(o_hMem, 1&, IStreamFromArray)
End If
End If
End If
HandleError:
End Function
Public Function IStreamToArray(ByVal hStream As Long, arrayBytes() As Byte) As Boolean
' Return the array contained in an IUnknown interface (stream)
' hStream: passed as ObjPtr(IStream) where IStream declared as IUnknown
' arrayBytes(): an empty byte array; lBound will be zero
Dim o_hMem As Long, o_lpMem As Long
Dim o_lngByteCount As Long
If hStream Then
If GetHGlobalFromStream(ByVal hStream, o_hMem) = 0 Then
o_lngByteCount = GlobalSize(o_hMem)
If o_lngByteCount > 0 Then
o_lpMem = GlobalLock(o_hMem)
If o_lpMem <> 0 Then
ReDim arrayBytes(0 To o_lngByteCount - 1)
CopyMemory arrayBytes(0), ByVal o_lpMem, o_lngByteCount
GlobalUnlock o_hMem
IStreamToArray = True
End If
End If
End If
End If
End Function
Notice that IUnknown is used as generic type for IStream.
Hope this helps.