В PictureBox из Binary Access Read!!!

[sosed213]

Проблема в следующем! Создавая элементарную программу для тестирования студентов столкнулся с непростой задачей!

В PowerPoint'e создаются слайды, сохраняются как картики. Я открываю эти картинки на чтение и записываю их все в один файл с определённым разделением( название и размер файла)!

Код: Выделить всё

Dim TheBytes() As Byte
Dim inFile As String
Dim i As Integer
Dim lngResult As Long

Open App.Path & "\AllFiles.bin" For Binary Access Write As #1
    For i = 0 To File1.ListCount - 1
        inFile = App.Path & "\" & File1.List(i)
        LenInFile = FileLen(inFile)
        ReDim TheBytes(LenInFile - 1)
       
        Open inFile For Binary Access Read As #2
            Get #2, , TheBytes()
        Close #2
       
        Raz = "[file:\\" & inFile & "\*\" & LenInFile & "/*/]"
       
        Put #1, , Raz
        Put #1, , TheBytes()

    Next i
Close #1

Проблема в следующем, (наверняка никто не сталкивался): как при чтении основного файла "\AllFiles.bin", в PictureBox вставить картинку? Если я из середины главного файла считываю кусок файла-картинки в массив, то как из массива перетащить картинку в PictureBox?

[Хакер]

OleLoadPicture ? и наверное tag_warning. Подождём ответа...

[sosed213]

Парни покапался, нашел! Правда давно. Но судя по количеству просмотров данной темы понимаю что народ нуждается. вот смотрите

Код: Выделить всё

Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Private Declare Function IsEqualGUID Lib "ole32" (rguid1 As GUID, rguid2 As GUID) As Boolean

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long

'Private Const GMEM_FIXED = &H0
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Private Type GUID       ' 16 bytes (128 bits)
    dwData1 As Long     ' 4 bytes
    wData2 As Integer   ' 2 bytes
    wData3 As Integer   ' 2 bytes
    abData4(7) As Byte  ' 8 bytes, zero based
End Type

Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As GUID, ppvObj As Any) As Long

Public Function PictureFromBits(abPic() As Byte) As IPicture  ' not a StdPicture!!
    Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
    Const S_OK = 0     ' indicates successful HRESULT
   
    Dim nLow As Long
    Dim cbMem  As Long
    Dim lpMem  As Long
    Dim IID_IPicture As GUID
    Dim istm As stdole.IUnknown '  IStream
    Dim ipic As IPicture
   
    ' Get the size of the picture's bits
    On Error GoTo Out
    nLow = LBound(abPic)
    On Error GoTo 0
    cbMem = (UBound(abPic) - nLow) + 1
 
    ' Allocate a global memory object
    lpMem = GlobalAlloc(0, cbMem)
    If lpMem Then
            ' Copy the picture bits to the memory pointer
            MoveMemory ByVal lpMem, abPic(nLow), cbMem
            ' Create an ISteam from the pictures bits (we can explicitly free hMem
            ' below, but we'll have the call do it here...)
            If (CreateStreamOnHGlobal(lpMem, 1, istm) = S_OK) Then
                If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
                    ' Create an IPicture from the IStream (the docs say the call does not
                    ' AddRef its last param, but it looks like the reference counts are correct..)
                    OleLoadPicture ByVal ObjPtr(istm), cbMem, 0, IID_IPicture, PictureFromBits
                End If   ' CLSIDFromString
            End If   ' CreateStreamOnHGlobal
    End If   ' lpMem
    GlobalFree lpMem
   
Out:
End Function

Private Sub Command1_Click()
    Dim Fname As String
    Dim FLen As Long
    Dim TheBytes() As Byte
   
    Fname = "C:\pic01.jpg"
    FLen = FLen(Fname)
   
    ReDim TheBytes(FLen)

    Open Fname For Binary Access Read As #1
        Get #1, , TheBytes()
    Close #1
   
    Picture1.Picture = PictureFromBits(TheBytes())
End Sub


Спасибо всем за внимание. Вот только хотелось бы сделать обратную функцию из Picture1.Picture в TheBytes(), это и будет основой моей следующей темы... "Remote Administrator своими руками"

[GM]

Но судя по количеству просмотров данной темы понимаю что народ нуждается. вот смотрите

Незнаю, как ты искал, перед тем как создать тему
http://bbs.vbstreets.ru/viewtopic.php?t ... highlight=

ключевые слова: загрузить картинку с массива

[tyomitch]

Автору предупреждение за ненадлежащее размещение двух топиков.

[sosed213]

Косяк свой признаю и считаю что тема закрыта!