Jpeg из массива в ImageControl минуя запись на диск. Как?

[EasyRider]

Ситуация: с помощью Winsock принимаю по http картиночку в байтовый массив. Открываю файл c Binary-доступом, Put туда этот массив, файл закрываю, протом LoadPicture(этот файл).

Все прекрасно, но есть непреодолимое желание обойтись без записи файла. Как?


С уважением,
---
Дмитрий.

[EasyRider]

Дополнение: вместо массива может быть строка, если так проще

[alibek]

Лучше все-таки использовать массив.
Вначале отступление. А почему ты не хочешь использовать файл? Если кэшировать в файл, то второй раз это картинку скачивать не придется.
А по существу надо использовать API-функции, создать DC и функцией CopyMemory перенести в него массив. Только на Image ты не сможешь через API рисовать, понадобиться невидимый вспомогательный PictureBox.

P.S. Поспешил ответить. Такое можно сделать с BMP, с JPG скорее всего без файла не обойтись.

[EasyRider]

Спасибо за ответ!

Кэшировать как-раз не нужно, ибо картинка есть изображение с камеры, которое хочется обновлять как можно чаще, а я так думаю, что операции с памятью побыстрее дисковых будут.

Насчет PictureBox - отлично, пусть будет PictureBox, а не Image.

Идея в принципе понятна, буду копать в эту сторону, но вот сразу и вопрос - а выведется ли изображение, если оно изначально в массиве в формате файла JPEG имеется? Там ведь, вроде, ближе к BMP все представляется?

PS. Пока писАл вопрос, ты на него ответил! Еще раз спасибо

[Vi]

Мне как-то раз попался некий код, который загружает картинку из памяти. Я не знаю, насколько она может тебе помочь. Вот код. Он вроде бы работает с ресурсами, но по идее код, который возвращает байтный массив, можно заменить на свой, получаемый через Сокеты.

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

' Here is my code. I tested it by adding a resource 101 on "CUSTOM"
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 Const GMEM_MOVEABLE = &H2
Private Declare Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As Long, myGUID As Any) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hMem&, ByVal DeleteOnRelease&, pStream As IUnknown) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (ByVal pStream As IUnknown, ByVal memSize&, ByVal fRunMode&, myGUID As Any, pPicture As IPicture) As Long

Private Sub Command1_Click()
   Const IID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
   Dim hMem&, lpMem&, bArr() As Byte, myGUID(0 To 15) As Byte
   Dim pStream As IUnknown, myPic As IPicture

   bArr = LoadResData(101, "CUSTOM")
   hMem = GlobalAlloc(GMEM_MOVEABLE, UBound(bArr) + 1)
   If (hMem) Then
      lpMem = GlobalLock(hMem)
      If (lpMem) Then
         Call CopyMemory(ByVal lpMem&, bArr(0), UBound(bArr) + 1)
         Call GlobalUnlock(hMem)
         If CreateStreamOnHGlobal(hMem, 1, pStream) = 0 Then
            If CLSIDFromString(StrPtr(IID_IPicture), myGUID(0)) = 0 Then
               If OleLoadPicture(pStream, UBound(bArr) + 1, 0, myGUID(0), myPic) = 0 Then
                  Set Me.Picture = myPic
                  MsgBox "Sucess!!!"
               End If
            End If
         End If
      End If
      Call GlobalFree(hMem)
   End If
   Erase bArr
End Sub


Есть еще вариант - работать с PropertyBag с обеих сторон. В примере используется хранилище в виде файла, но можно опять же через Сокеты.

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

Private Sub Command1_Click(Index As Integer)
  Dim p As IPictureDisp, f As IFontDisp, pb As PropertyBag, b() As Byte

  On Error Resume Next
 
  Set pb = New PropertyBag
  Select Case Index
  Case 0 ' Store
    Set p = LoadPicture("C:\FORUMS\abc.gif")
    pb.WriteProperty "Image", p
   
    Set f = Text1.Font
    pb.WriteProperty "Font", f
   
    Open "c:\tmp\tmp.bak" For Binary Access Write As #1
      b = pb.Contents
      Put #1, , b
    Close #1
 
  Case 1 ' Restore
   
    Open "c:\tmp\tmp.bak" For Binary Access Read As #1
      ReDim b(LOF(1))
      Get #1, , b
      pb.Contents = b
    Close #1
    Set Picture1.Picture = pb.ReadProperty("Image")
    Set Text1.Font = pb.ReadProperty("Font")
   
  End Select
End Sub


vbskb_ole vbskb_stdpicture vbskb_memory

[tyomitch]

Вот, случайно набрёл на старый топик... Он ещё актуален?
Если да, то я знаю, как сделать сабж через GDI+. Надо кому?

[EvilCoder]

<DELETE>

[tyomitch]

ну - ну... давай, Нам надо

http://mix.web.ur.ru/JPEG.zip
Исходники библиотеки не отдам
Вкратце о реализации: GdipCreateBitmapFromHBITMAP, CreateStreamOnHGlobal, GdipSaveImageToStream

[Approximator]

ну - ну... давай, Нам надо

Исходники библиотеки не отдам

жадина

[EvilCoder]

<DELETE>

[tyomitch]

Нуууу библиотеки ... это уже неинтересно.
К тому же библиотеки у меня есть

Которые умеют в память сохранять?

Исходники библиотеки не отдам

Сам писал?

Ага. Там много всего, почти полноценная ActiveX-обёртка для GDI+, не только сохранение жпегов в память.
Конкретно про сохранение жпегов в память я уже рассказал как сделано:

Вкратце о реализации: GdipCreateBitmapFromHBITMAP, CreateStreamOnHGlobal, GdipSaveImageToStream

Упорному этого должно быть достаточно, чтобы сделать самому.

[Approximator]

Нуууу библиотеки ... это уже неинтересно.
К тому же библиотеки у меня есть

Которые умеют в память сохранять?

Исходники библиотеки не отдам

Сам писал?

Ага. Там много всего, почти полноценная ActiveX-обёртка для GDI+, не только сохранение жпегов в память.
Конкретно про сохранение жпегов в память я уже рассказал как сделано:

Вкратце о реализации: GdipCreateBitmapFromHBITMAP, CreateStreamOnHGlobal, GdipSaveImageToStream

Упорному этого должно быть достаточно, чтобы сделать самому.

Если так подходить, то упорному достаточно вообще задаться целью... и далее можно будет разобраться без советов. Если не было желания давать полный исходник, его ВСЕГДА можно урезать до понятного минимума... а так, просто подразнил, позвенел так сказать чреслами...

[tyomitch]

Если так подходить, то упорному достаточно вообще задаться целью... и далее можно будет разобраться без советов. Если не было желания давать полный исходник, его ВСЕГДА можно урезать до понятного минимума... а так, просто подразнил, позвенел так сказать чреслами...

Ничего не понял. Я тебе дал полнофункциональную библиотеку, у которой к тому же, насколько мне известно, нет аналогов.
Плюс к этому рассказал, как она устроена.
И ты ещё недоволен?

Ты библиотеку-то смотрел в Object Browser-е, чтобы проникнуться её мощью?

[marvan]

встретил вариант:

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

' #Mandix Repository#*****************************************************
' * Programmer Name  : Gareth
' * Web Site         : http://home.mweb.co.za/gs/gslennox/
' * E-Mail           : gareth@w3.to
' * Date             : 25/06/2001
' **********************************************************************
' * Comments         : Picture from Byte Array
' *
' * Converts a byte array containing a JPG/GIF to an IPicture object
' *
' **********************************************************************

Private Function PictureFromBits(abPic() As Byte) As IPicture  ' not a StdPicture!!
   Dim nLow             As Long
   Dim cbMem            As Long
   Dim hMem             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
   hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
   If hMem Then
      ' Lock the memory object and get a pointer to it.
      lpMem = GlobalLock(hMem)
      If lpMem Then
         ' Copy the picture bits to the memory pointer and unlock the handle.
         CopyMemory ByVal lpMem, abPic(nLow), cbMem
         Call GlobalUnlock(hMem)
         ' Create an ISteam from the pictures bits (we can explicitly free hMem
         ' below, but we'll have the call do it...)
         If (CreateStreamOnHGlobal(hMem, CTrue, 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..)
               Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, PictureFromBits)
            End If
         End If
      End If
   End If
Out:
End Function

[tyomitch]

встретил вариант:

В MSDN написано:

Remarks
The stream must be in BMP (bitmap), WMF (metafile), or ICO (icon) format. A picture object created using OleLoadPicture always has ownership of its internal resources (fOwn==TRUE is implied).

(http://msdn.microsoft.com/library/en-us ... z_0k4l.asp)
Однако похоже, что OleLoadPicture и вправду поддерживает GIF/JPEG. Непонятно...

Ну и по поводу самого кода. Выделение памяти с GMEM_MOVEABLE не даёт никаких преимуществ, а только создаёт необходимость её lock-а и unlock-а для использования. Я выделяю с GMEM_FIXED и убеждён, что это лучше и правильнее.

[Approximator]

Если так подходить, то упорному достаточно вообще задаться целью... и далее можно будет разобраться без советов. Если не было желания давать полный исходник, его ВСЕГДА можно урезать до понятного минимума... а так, просто подразнил, позвенел так сказать чреслами...

Ничего не понял. Я тебе дал полнофункциональную библиотеку, у которой к тому же, насколько мне известно, нет аналогов.
Плюс к этому рассказал, как она устроена.
И ты ещё недоволен?

Начнём с того, что мне ты ничего не давал
Далее, ты ничего не говорил о её устройстве (указать имя пары функций это достаточное описание устройства "мощной" библы?:))

Ты библиотеку-то смотрел в Object Browser-е, чтобы проникнуться её мощью?

Причём здесь старые валенки. Здесь вроде бы программисты общаются, а не производители и пользователи. Или ты всех остальных держишь исключительно за пользователей? Всякому программисту интересно прежде всего решение, сиречь исходный код. Хотя бы частично. Хочу, чтобы ты правильно меня понимал, лично я у тебя вообще ничего не прошу, просто мне не понятна твоя позиция. Я бы понял, если бы было наоборот, дал бы куски исходного кода, а библу зажал бы. Здесь ещё есть какое-то рациональное объяснение, а так... Вот я и встрял в разговор. Ладно, судя по всему это просто твой пунктик. Похоже, что в своё время ты намучался с реализацией этой библы, вот и хочешь, чтобы все оценили твои усилия. А народ, как мне кажется, это весьма мало волнует...

[Approximator]

Ну и по поводу самого кода. Выделение памяти с GMEM_MOVEABLE не даёт никаких преимуществ, а только создаёт необходимость её lock-а и unlock-а для использования. Я выделяю с GMEM_FIXED и убеждён, что это лучше и правильнее.

Согласен. Скажу больше, это даже вредно - могёт сильно тормозить.

[tyomitch]

Начнём с того, что мне ты ничего не давал

Давал библиотеку.

Причём здесь старые валенки. Здесь вроде бы программисты общаются, а не производители и пользователи. Или ты всех остальных держишь исключительно за пользователей?

Любой программист - пользователь, по крайней мере Студии и системных библиотек, а чаще ещё целой кучи аддонов, примочек и активиксов. Так что совершенно зря обижаешься.

Всякому программисту интересно прежде всего решение, сиречь исходный код. Хотя бы частично. Хочу, чтобы ты правильно меня понимал, лично я у тебя вообще ничего не прошу, просто мне не понятна твоя позиция. Я бы понял, если бы было наоборот, дал бы куски исходного кода, а библу зажал бы. Здесь ещё есть какое-то рациональное объяснение, а так... Вот я и встрял в разговор. Ладно, судя по всему это просто твой пунктик. Похоже, что в своё время ты намучался с реализацией этой библы, вот и хочешь, чтобы все оценили твои усилия. А народ, как мне кажется, это весьма мало волнует...

Ладно, короче, убедительно выступаешь, развёл меня на кусок исходника

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

Public Sub SaveToJpegToMemory(Data() As Byte, Optional ByVal Quality As Long = -1, Optional ByVal Transformation As EncoderValueTransform = 0)
'Ugh... The longest part of all it.
'1. Parameters.
Dim EncoderClsid As Guid, Parameters As EncoderParameters
    If hImage = 0 Then Exit Sub
    With EncoderClsid
'{557cf401-1a04-11d3-9a73-0000f81ef32e}
       .Data1 = &H557CF401
       .Data2 = &H1A04
       .Data3 = &H11D3
       .Data4(0) = &H9A
       .Data4(1) = &H73
       .Data4(4) = &HF8
       .Data4(5) = &H1E
       .Data4(6) = &HF3
       .Data4(7) = &H2E
    End With
    Parameters.Count = 0
    If Quality >= 0 Then
        With Parameters.Parameter(Parameters.Count)
            With .Guid
'0x1d5be4b5,0xfa4a,0x452d,0x9c,0xdd,0x5d,0xb3,0x51,0x05,0xe7,0xeb
                .Data1 = &H1D5BE4B5
                .Data2 = &HFA4A
                .Data3 = &H452D
                .Data4(0) = &H9C
                .Data4(1) = &HDD
                .Data4(2) = &H5D
                .Data4(3) = &HB3
                .Data4(4) = &H51
                .Data4(5) = &H5
                .Data4(6) = &HE7
                .Data4(7) = &HEB
            End With
            .Type = EncoderParameterValueTypeLong
            .NumberOfValues = 1
            .pValue = VarPtr(Quality)
        End With
        Parameters.Count = Parameters.Count + 1
    End If
    If Transformation <> 0 Then
        With Parameters.Parameter(Parameters.Count)
            With .Guid
'0x8d0eb2d1,0xa58e,0x4ea8,0xaa,0x14,0x10,0x80,0x74,0xb7,0xb6,0xf9
                .Data1 = &H8D0EB2D1
                .Data2 = &HA58E
                .Data3 = &H4EA8
                .Data4(0) = &HAA
                .Data4(1) = &H14
                .Data4(2) = &H10
                .Data4(3) = &H80
                .Data4(4) = &H74
                .Data4(5) = &HB7
                .Data4(6) = &HB6
                .Data4(7) = &HF9
            End With
            .Type = EncoderParameterValueTypeLong
            .NumberOfValues = 1
            .pValue = VarPtr(Transformation)
        End With
        Parameters.Count = Parameters.Count + 1
    End If
'2. Memory.
Dim pStream As Long, hMem As Long, Size As Long
    If hImage = 0 Then Exit Sub
    CreateStreamOnHGlobal 0, 1, pStream
   
    If Parameters.Count = 0 Then
        CheckResult GdipSaveImageToStream(hImage, pStream, EncoderClsid, ByVal 0&)
    Else
        CheckResult GdipSaveImageToStream(hImage, pStream, EncoderClsid, Parameters)
    End If
   
    CheckResult GetHGlobalFromStream(pStream, hMem)
    Size = GlobalSize(hMem)
    ReDim Data(0 To Size - 1)
    CopyMemory Data(0), ByVal GlobalLock(hMem), Size
    GlobalUnlock hMem
    GlobalFree hMem
End Sub


HTH