0

Visual Basic 6 では、スクリーン キャプチャを処理して JPG にエンコードまたは変換する次のコードがありますが、ファイル内にあります。（例：lRes = GdipSaveImageToFileJPGファイルを保存しますが、ファイルとして保存したくない代わりに、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

0

GdipSaveImageToStream を使用してから、データを vb 配列にコピーできます。

IStream を参照するには、tlb を使用する必要があります。

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 と一緒に存在すること以外の要件はありません。

myDCまたはから直接ロードするmyDIB機能と、さまざまな圧縮アルゴリズムで JPEG に保存できる機能があります。

もう 1 つの方法は、このライブラリを使用することです (あまりお勧めしません)。

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 に答える