vb6屏幕捕获GdipSaveImageToFile类似的函数，用于字节数组。

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)

在visual basic 6中，我有以下代码，它将屏幕捕获和编码或转换为JPG，但在文件中。(如。lRes = GdipSaveImageToFile保存了JPG文件，但是我不想作为文件保存，而应该将JPG保存在内存或字节数组中)

i want to save JPG image in memory or a byte array. what should i do.

我想将JPG图像保存在内存或字节数组中。我应该做什么。

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.

我不想把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

2 个解决方案

#1

You can use GdipSaveImageToStream, then copy the data to a vb array.

您可以使用GdipSaveImageToStream，然后将数据复制到vb数组中。

You will have to use a tlb for referencing the IStream.

您将不得不使用tlb来引用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).

我花了一段时间才找到tlb;可以在这里下载:http://www.vbaccelerator.com/home/VB/Type_Libraries/Stream/VBSTRM_Type_Library.asp(您必须将tlb添加为对项目的引用)。

On this vb forum, I found some code to convert the stream to a vb array :

在这个vb论坛上，我找到了一些代码将流转换成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

Notice that IUnknown is used as generic type for IStream.

注意，IUnknown被用作IStream的泛型类型。

Hope this helps.

希望这个有帮助。

#2

My suggestion would be to use FreeImage. It's a single DLL that does NOT require registering. It has no other requirements other than existing alongside your EXE.

我的建议是使用免费图片。它是一个不需要注册的DLL。除了与EXE一起存在之外，它没有其他需求。

It has functions for loading directly from your myDC or myDIB, and a function that can save out to JPEG with different compression algorithms.

它具有直接从myDC或myDIB加载的函数，以及可以使用不同的压缩算法将其保存到JPEG的函数。

Another alternative is using this library (which I don't recommend as much):

另一种选择是使用这个库(我不推荐太多):

http://www.vbaccelerator.com/home/VB/Code/vbMedia/Saving_Pictures_to_JPG/Using_Intel_JPG_Library/article.asp

There's also this similar question/answer: Can VB6 save an image as a JPEG?

还有一个类似的问题/答案:VB6能否将图像保存为JPEG格式?

As for a solution that uses no DLLs - I don't believe it's quite possible. I personally use the FreeImage solution for this very problem, and I swear by it.

至于不使用dll的解决方案，我认为不太可能。我个人使用*图像解决方案来解决这个问题，我发誓。

#1