在visual basic 6中，我有以下代码可以解决屏幕捕获和编码或转换为JPG，但是在文件中。 （例如。lRes = GdipSaveImageToFile保存JPG文件，但我不想保存为文件，而是将JPG保存在内存或字节数组中）
我想将JPG图像保存在内存或字节数组中。我该怎么办。
我不想在内存中保存PNG但在内存中编码JPG， 我已经搜索了很多，但直到找不到任何解决方案。
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
答案 0 :(得分：1)
d-stroyer提到的TLB文件不见了，
答案 1 :(得分：0)
您可以使用GdipSaveImageToStream，然后将数据复制到vb数组。
您必须使用tlb来引用IStream。
我花了一段时间才找到了tlb;它可以在这里下载：http://www.vbaccelerator.com/home/VB/Type_Libraries/Stream/VBSTRM_Type_Library.asp （您必须添加tlb作为项目的参考）。
在this vb forum上，我找到了一些将流转换为vb数组的代码：
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
请注意，IUnknown用作IStream的泛型类型。
希望这有帮助。
答案 2 :(得分：0)
我的建议是使用FreeImage。它是一个不需要注册的DLL。除了您的EXE之外，它没有其他要求。
它具有直接从您的myDC或myDIB加载的功能，以及可以使用不同的压缩算法保存为JPEG的功能。
另一种选择是使用这个库（我不建议这么多）：
还有类似的问题/答案： Can VB6 save an image as a JPEG?
对于不使用DLL的解决方案 - 我不相信它是完全可能的。我个人使用FreeImage解决方案来解决这个问题，我发誓。