Keskustelu: Ohjelmointikysymykset: VB6: Kuvan lataus Imageen (VB5)

setä [16.06.2008 00:12:59]

Joskus ennenkin ehkä kyselty. Kuvan lataus onnistuu LoadPicture-funktiolla, jossa annetaan kuvatiedoston nimi. Kyseessä on sovellus, jossa kuvia on satoja ja niistä näytetään muutama. Kuvat ovat kooltaan noin 10 kB eli aika pieniä. Kuvat ovat joko erillisinä jpg-tiedostoina kuvakansiossa tai kasattuna binääritiedostoon muootoon tiedostonimi ja itse kuvatiedosto merkkijonona. Nyt haluaisin saada kuvat Imageen suoraan tuosta binääritiedostosta ilman että ne tulisi ensin tallentaa erilliseen kuvatiedostoon. Onko mitenkään mahdollista?

neau33 [16.06.2008 20:09:02]

Heippa setä!

joo mahdollista on ja aivan käsittämättömän iisiä... (.NET:ssä vielä iisimpää)

Dim fpath As String, fname As String

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 GlobalLock Lib _
"kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib _
"kernel32" (ByVal hMem As Long) As Long
Private Declare Function OleLoadPicture Lib "olepro32" _
(pStream As Any, ByVal lSize As Long, ByVal _
fRunmode As Long, riid As Any, ppvObj As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias _
"RtlMoveMemory" (ByRef Destination As Any, _
ByRef Source As Any, ByVal Length As Long)

Private Sub Form_Load()

  fpath = Environ("userprofile") & "\Työpöytä\"
  ChDir fpath
  Shell ("cmd /c copy /b *.jpg imgdata.dat"), vbHide

End Sub

Private Sub Command1_Click()


  fname = "imgdata.dat"

  If Dir(fpath & fname) = "" Then
    MsgBox "Kuvadataa ei löydy!"
    Exit Sub
  End If

  Open fpath & fname For Binary Access Read As #1

  If LOF(1) < 100 Then
    Close #1
    MsgBox "Kuvadata on vahingoittunut!"
    Exit Sub
  End If

  Dim fstr As String
  Dim delay As Single

  fstr = Space(LOF(1))
  Get #1, , fstr: Close #1
  Dim fileStrArray() As String

  fstr = Replace(fstr, "ÿØÿà", "SplITteRÿØÿà")
 '(.jpg kuvatiedoston 4 ensimmäistä merkkiä = "ÿØÿà")

  fileStrArray = Split(fstr, "SplITteR")
  fstr = ""

  For i = 1 To UBound(fileStrArray)

back:
    On Error GoTo PicErrorHandler
    Dim imgData() As Byte
    imgData = StrConv(fileStrArray(i), vbFromUnicode)

    Set Image1.Picture = _
    ArrayToPicture(imgData(), 0, UBound(imgData) + 1)

    delay = Timer + 5
    Do While delay > Timer: DoEvents: Loop

    'TAKAISIN Merkkijonoksi & Tiedostoksi
    'fstr = StrConv(imgData, vbUnicode)
    'fname = "imgdata" & Cstr(i) & ".jpg"
    'Open fpath & fname For Binary Access Write As #1
    'Put #1, , fstr: Close #1

    Erase imgData
  Next i
  Exit Sub

PicErrorHandler:
  Err.Clear
  If i < UBound(fileStrArray) Then
   i = i + 1: GoTo back
  End If

End Sub

Public Function ArrayToPicture(inArray() As Byte, _
Offset As Long, Size As Long) As IPicture

    Dim o_hMem  As Long
    Dim o_lpMem  As Long
    Dim aGUID(0 To 3) As Long
    Dim IIStream As IUnknown

    aGUID(0) = &H7BF80980
    aGUID(1) = &H101ABF32
    aGUID(2) = &HAA00BB8B
    aGUID(3) = &HAB0C3000

    On Error GoTo FuncErrorHandler

    o_hMem = GlobalAlloc(&H2&, Size)
    If Not o_hMem = 0& Then
        o_lpMem = GlobalLock(o_hMem)
      If Not o_lpMem = 0& Then
        CopyMemory ByVal o_lpMem, inArray(Offset), Size
        Call GlobalUnlock(o_hMem)
      If CreateStreamOnHGlobal(o_hMem, 1&, IIStream) = 0& Then
        Call OleLoadPicture(ByVal ObjPtr(IIStream), 0&, _
        0&, aGUID(0), ArrayToPicture)
      End If
    End If
  End If

  Exit Function

FuncErrorHandler:
  Err.Clear

End Function

setä [17.06.2008 00:48:27]

Kiitoksia Nea. Sinulta näköjään löytyy ratkaisu ongelmaan kuin ongelmaan. Tuossa kiinnostaa nyt funktio ArrayToPicture. Mistä ihmeestä tuon kehitit? Joitakin juttuja näyttää olevan, mitä ei VB5 tue mutta kylläkin VB6. Ne voi ilmeisesti kyllä kiertää. Tarvitaanko välttämättä tuota parametria vbFromUnicode. Mulla olis periaatteessa valmiina tuo kuvatiedoston data merkkijonona, onko se tuo imgData? Saan sen siis lukemalla binääritiedostosta tietyn pätkän, jonka pituus on kuvatiedoston koko tavuina.

Merri [17.06.2008 11:21:30]

Jos lataat suoraan byte array:n täyteen tarvittavaa dataa, eli et kierrätä turhaan stringin kautta, niin sitten tuota StrConvia ei tarvita. Tuo ArrayToPicture pystyy ottamaan ihan osadataa, kunhan vain offset (eli kuvadatan alkukohta) ja pituus on oikein.

ArrayToPicture taas luo OLE-streamin, joka täytetään ja sitten ladataan kuva täytetystä streamista.

setä [17.06.2008 12:09:39]

Testasin tuon koodin pienin muutoksin korvaamalla replacen ja Splitin muilla säädöillä ja sain toimimaan VB5:llä. Ilmeisesti tuo Byte array:n käyttö on näppärämpi ja lienee nopeampikin. Testasin ydellä kuvatiedostolla eikä sieltä löytynyt merkkijonoa "ÿØÿà" kuin alusta eli tuota Split-operaatiota ei tarvinnut lainkaan. Kuinkas tuo kuvadata ladataan suoraan byte arrayhin. Saako sen Get-käskyllä suoraan byte arrayhin stringin sijaan.
Edit: Sain kokeilemalla toimimaan. Suurkiitokset vihjeistä!

Merri [17.06.2008 15:05:38]

Jep, vahvistetaan se, että on tosiaan (paljon) nopeampaa ladata suoraan byte arrayn kautta :) StrConvit ja Splitit on aikamoisen hitaita operaatioita verrattuna siihen, että suoraan vetää dataa sellaisenaan läpi.

Kun jätit mainitsematta, niin todetaan mahdollisille muille lukijoille että byte array:n voi tosiaan suoraan Getillä täyttää.

neau33 [17.06.2008 17:00:58]

Heippa taas setä!

jos yhtään tarkemmin perehdyit koodiin niin...sinulle taisi selvitä, että esimerkkiohjelman form_load tapahtumassa pumpataan kaikki aktiivisen hakemiston .jpg filut yhteen .dat tiedostoon, jolloin on mielestäni helpointa erotella kuvat stringistä split-funktion avulla jne... (ja muillekin lukijoille - joillain tuntuu olevan asiaa aina vähän niinkuin jälkikäteen..) no joo...

Elikä jos VB5:ssa ei vbFromUnicode-konversio toimi edellisen esimerkin tavalla niin homma hoituu esim. vaikkapa seuraavasti

'vaihda tähän...

Private Sub Command1_Click()

  fname = "imgdata.dat"

  If Dir(fpath & fname) = "" Then
    MsgBox "Kuvadataa ei löydy!"
    Exit Sub
  End If

  Open fpath & fname For Binary Access Read As #1

  If LOF(1) < 100 Then
    Close #1
    MsgBox "Kuvadata on vahingoittunut!"
    Exit Sub
  End If

  Dim fstr As String
  Dim delay As Single

  fstr = Space(LOF(1))
  Get #1, , fstr: Close #1
  Dim fileStrArray() As String

  'eli siis lisätään stringiin jokaisen tiedosto-
  'pätkän eteen merkkijono "SplITteR" ....
  fstr = Replace(fstr, "ÿØÿà", "SplITteRÿØÿà")

  '... jolloin erotin "SplITteR" haihtuu splitatessa
  'kukin stringin sisältämä tiedosto taulukkoon...
  fileStrArray = Split(fstr, "SplITteR")
  fstr = vbNullString

  For i = 0 To UBound(fileStrArray)
back:

   On Error GoTo PicErrorHandler

    'tämä hidastaa, mutta sehän ei ole minun ongelmani...
    ReDim imgData(0) As Byte
    For j = 0 To Len(fileStrArray(i)) - 1
      Dim tmpLng As Long
      'pistetään filu-Stringin merkit longiksi
      tmpLng = CLng(Asc(Mid(fileStrArray(i), j + 1, 1)))
      'ja muutetaan longit funktiossa tavuiksi, jolloin
      'matkalla ei pääse tapahtumaan ylivuotoja...
      imgData(j) = LongToByte(tmpLng)
      If j < Len(fileStrArray(i)) - 1 Then _
      ReDim Preserve imgData(UBound(imgData) + 1)
    Next j

    'jne...
    Set Image1.Picture = _
    ArrayToPicture(imgData(), 0, UBound(imgData) + 1)

    'delay siksi että jaksoin katsella kutakin
    'kuvaa aina 5 sekkaa kerralla...
    delay = Timer + 5
    Do While delay > Timer: DoEvents: Loop
    Erase imgData

  Next i

  Erase fileStrArray
  Exit Sub

PicErrorHandler:
  Err.Clear
  If i < UBound(fileStrArray) Then
   i = i + 1: GoTo back
  End If

End Sub

...ja lisää tämä

Public Function LongToByte(ByVal lng As Long) As Byte

 Dim o_Byte As Byte
 CopyMemory o_Byte, ByVal VarPtr(lng), Len(lng)
 LongToByte = o_Byte

End Function

setä [17.06.2008 17:53:22]

Replace ja Split eivät toimi VB5:ssä. StrConv kyllä toimi mutta ei tarvi kun lukee datan suotaan arrayhin.

Newb [17.06.2008 18:12:33]

setä kirjoitti:

Replace ja Split eivät toimi VB5:ssä. StrConv kyllä toimi mutta ei tarvi kun lukee datan suotaan arrayhin.

Tässä VB5:lle Split ja Replace.

setä [17.06.2008 18:42:11]

Kiitos vinkeistä, mutta joudun erottelemaan datan tunnusluvun mukaan, jolla kuva liitetään tiettyyn henkilöön. Binääritiedostossa on tuo tunnus, kuvadatan pituus tavuina ja kuvadata. Näitä muutama sata. Testailen miten näppärimmin käy datan luku arrayhin.

setä [17.06.2008 23:26:51]

Tuo ArrayToPicture on jopa hieman nopeampi kuin LoadPicture-funktio. Suurin hyöty on kuitenkin kun kaikki yli 600 kuvatiedostoa voi niputtaa yhteen binääritiedostoon ja lukea suoraan sieltä. Jälleen kerran sain täältä ratkaisun ongelmaani ja melkoisen nopeasti.

neau33 [18.06.2008 06:53:25]

Heippa taas setä!

tässä vielä toimiva Split-funktio jos vaikka ilmaantuis joskus tarvetta...

'Generaaleihin tai Public'si moduuliin
Private aputaulu() As String

käyttö:

    Dim taulu() As string
    taulu = Splittaa(merkkijono$, erotin$)

Public Function Splittaa(ByVal Merkkijono As _
String, ByVal erotin As String, Optional ByVal ok As Boolean, _
Optional ByVal apuT As Variant) As Variant

  If Not ok Then
    ReDim Preserve aputaulu(0) As String
  Else
    aputaulu = apuT
  End If

  Dim sijainti As Long, i As Long

  sijainti = InStr(1, Merkkijono, erotin, vbBinaryCompare)
  If Left(Merkkijono, Len(erotin)) = erotin Then
    Merkkijono = Right(Merkkijono, _
    Len(Merkkijono) - Len(erotin))
    Splittaa Merkkijono, erotin, True, aputaulu
  ElseIf sijainti > 0 And _
  Left(Merkkijono, Len(erotin)) <> erotin Then
    aputaulu(UBound(aputaulu)) = _
    Left(Merkkijono, sijainti - 1)
    Merkkijono = _
    Right(Merkkijono, Len(Merkkijono) _
    - Len(aputaulu(UBound(aputaulu))))
    ReDim Preserve aputaulu(UBound(aputaulu) + 1)
    Splittaa Merkkijono, erotin, True, aputaulu
  ElseIf sijainti = 0 And _
  Len(Merkkijono) > 0 Then
    aputaulu(UBound(aputaulu)) = Merkkijono
  End If
  Splittaa = aputaulu()

End Function

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät

Kilpailu