0

在 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
4

3 回答 3

1

d-stroyer提到的TLB文件不见了，

但可以在这里找到：https ://web.archive.org/web/20081205081632/http://www.vbaccelerator.com/home/VB/Type_Libraries/Stream/VBSTRM_Type_Library.zip

于 2021-05-12T04:16:39.807 回答
0

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

您必须使用 tlb 来引用 IStream。

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

在这个 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

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

希望这可以帮助。

于 2013-08-13T08:29:34.470 回答
0

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

它具有直接从您的myDCor加载myDIB的功能，以及可以使用不同压缩算法保存为 JPEG 的功能。

另一种选择是使用这个库（我不推荐那么多）：

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

还有这个类似的问题/答案： VB6 可以将图像保存为 JPEG 吗？

至于不使用 DLL 的解决方案 - 我认为这不太可能。我个人使用 FreeImage 解决方案来解决这个问题，我发誓。

于 2013-08-14T00:18:58.033 回答