バイナリ画像データを直接PictureBoxにロードするには？
解決初めて投稿します、宜しくお願いします
改ざんした画像バイナリデータをバイト型で読み取り、
元の画像バイナリデータに修正して
ファイルに保存せずに直接PictureBoxにロードしたいのですが
なにかいい方法はあるでしょうか
画像データはどれだけ増えるかわかっていません
Dim fd As Integer
Dim Data() As Byte
fd = FreeFile()
Open App.Path & Text1.Text & ".JPEG" For Binary As fd
ReDim Data(LOF(fd) - 1)
'改ざん済み画像データ取得
Get fd3, 1, Data
'改ざんデータを元のデータに修正
.....................
'ここでData()画像をPictureBoxにロード
Close fd
アドバイス宜しくお願いします
先々週、某メーリングリストに投稿したサンプルです。参考になれば。
Option Explicit
Private Const S_OK As Long = 0&
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Declare Function CreateStreamOnHGlobal Lib "ole32" _
(ByVal hGlobal As Long, _
ByVal fDeleteOnRelease As Long, _
ByRef ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" _
(ByVal pStream As Long, _
ByVal lSize As Long, _
ByVal fRunmode As Long, _
ByRef riid As UUID, _
ByRef ppvObj As Any) As Long
Private Const GMEM_MOVEABLE As Long = &H2&
Private Declare Function GlobalAlloc Lib "kernel32" _
(ByVal uFlags As Long, _
ByVal dwBytes 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 GlobalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" _
(ByVal pDest As Long, _
ByRef pSource As Byte, _
ByVal dwLength As Long)
Public Function BytesToPicture(ByRef PicBin() As Byte) As Picture
Dim Low As Long, High As Long, Size As Long
Dim IID_IPicture As UUID
Dim oPicture As IPicture
Low = LBound(PicBin)
High = UBound(PicBin)
Size = High - Low + 1
'{7BF80980-BF32-101A-8BBB-00AA00300CAB}
With IID_IPicture
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(3) = &HAA
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
Dim hMem As Long
Dim lpMem As Long
Dim lRet As Long
Dim Stm As IUnknown
hMem = GlobalAlloc(GMEM_MOVEABLE, Size)
If hMem = 0 Then
Exit Function
End If
lpMem = GlobalLock(hMem)
If lpMem <> 0 Then
RtlMoveMemory ByVal lpMem, PicBin(Low), Size
GlobalUnlock hMem
lRet = CreateStreamOnHGlobal(hMem, 1, Stm)
If lRet = S_OK Then
OleLoadPicture ObjPtr(Stm), Size, 0, IID_IPicture, oPicture
End If
GlobalFree hMem
End If
Set BytesToPicture = oPicture
Set oPicture = Nothing
End Function
早速貴重なサンプル有難う御座いました
思っていた事が簡単にできてしまいました
APIはよくわからなかったのですが
サンプルを眺めて勉強したいと思います
本当に有難う御座いました
| ツイート |  |