Hilfe Array-NIx checken
29.10.2004 13:40:12
Archi
ich habe ein Code gefunden, wo ein GIF ausgelesen wird und dann zwischengespeichert wird in ein Varriant-Array.
Mein Problem ist das ich es nicht schaffe die Funktion richtig aufzurufen...
Bitte um Hilfe
Mein Code zum Aufruf:
Sub testgifladen()
Call gif_laden("H:/Desenhos/Feuer.gif", ?)
End Sub
was muß ich den gif_laden an der stelle der Fragezeichen übergeben?
Und das ist die Funktion...
'GIF-Datei auslesen und Einzelbilder im
'Variant-Array varImage zwischenspeichern
Public Function gif_laden(strDatei As String, _
varimage As Variant) As Boolean
'Dim varimage() As Variant
gif_laden = False
If Dir$(strDatei) = "" Or strDatei = "" Then
MsgBox "Datei " & strDatei & " nicht gefunden.", _
vbInformation
Exit Function
End If
On Error GoTo Fehler
Dim DNr As Integer
Dim Bild_Header As String
Dim Datei_Header As String
Dim strBuffer As String
Dim strBildBuffer As String
Dim intBildZaehler As Integer
Dim lngX As Long
Dim lngY As Long
Dim lngOffsetX As Long
Dim lngOffsetY As Long
Dim lngWarteZeit As Long
Dim strGifEnde As String
Dim lngZeit As Long
Dim Screen As Variant
Dim lngEinzelPic As Variant
strGifEnde = Chr(0) & Chr(33) & Chr(249)
For lngX = 1 To varimage.count - 1
Unload varimage(lngX)
Next lngX
DNr = FreeFile
Open strDatei For Binary Access Read As DNr
strBuffer = String(LOF(DNr), Chr(0))
Get #DNr, , strBuffer
Close DNr
lngX = 1
intBildZaehler = 0
lngY = InStr(1, strBuffer, strGifEnde) + 1
Datei_Header = Left(strBuffer, lngY)
If Left$(Datei_Header, 3) "GIF" Then
MsgBox "Bei der gewaehlten Datei handelt es " + _
"sich nicht um eine Gif-Datei.", vbInformation
Exit Function
End If
gif_laden = True
lngX = lngY + 2
If Len(Datei_Header) >= 127 Then
lngZeit& = Asc(Mid(Datei_Header, 126, 1)) + _
(Asc(Mid(Datei_Header, 127, 1)) * 256&)
Else
lngZeit = 0
End If
Do
intBildZaehler = intBildZaehler + 1
lngY = InStr(lngX, strBuffer, strGifEnde) + 3
If lngY > Len(strGifEnde) Then
DNr = FreeFile
Open "tmp.gif" For Binary As DNr
strBildBuffer = String(Len(Datei_Header) + _
lngY - lngX, Chr(0))
strBildBuffer = Datei_Header & _
Mid(strBuffer, lngX - 1, lngY - lngX)
Put #DNr, 1, strBildBuffer
Bild_Header = Left(Mid(strBuffer, lngX - 1, _
lngY - lngX), 16)
Close DNr
lngWarteZeit = ((Asc(Mid(Bild_Header, 4, 1))) + _
(Asc(Mid(Bild_Header, 5, 1)) * 256&)) * 10&
If intBildZaehler > 1 Then
lngOffsetX = Asc(Mid(Bild_Header, 9, 1)) + _
(Asc(Mid(Bild_Header, 10, 1)) * 256&)
lngOffsetY = Asc(Mid(Bild_Header, 11, 1)) + _
(Asc(Mid(Bild_Header, 12, 1)) * 256&)
Load varimage(intBildZaehler - 1)
varimage(intBildZaehler - 1).Left = varimage(0).Left + _
(lngOffsetX * Screen.TwipsPerPixelX)
varimage(intBildZaehler - 1).Top = varimage(0).Top + _
(lngOffsetY * Screen.TwipsPerPixelY)
End If
varimage(intBildZaehler - 1).Tag = lngWarteZeit
varimage(intBildZaehler - 1).Picture = _
LoadPicture("tmp.gif")
Kill ("tmp.gif")
lngX = lngY
End If
DoEvents
Loop Until lngY = 3
If lngX DNr = FreeFile
Open "tmp.gif" For Binary As DNr
strBildBuffer = String(Len(Datei_Header) + _
Len(strBuffer) - lngX, Chr(0))
strBildBuffer = Datei_Header & _
Mid(strBuffer, lngX - 1, Len(strBuffer) - lngX)
Put #DNr, 1, strBildBuffer
Bild_Header = Left(Mid(strBuffer, lngX - 1, _
Len(strBuffer) - lngX), 16)
Close DNr
lngWarteZeit = ((Asc(Mid(Bild_Header, 4, 1))) + _
(Asc(Mid(Bild_Header, 5, 1)) * 256)) * 10
If intBildZaehler > 1 Then
lngOffsetX = Asc(Mid(Bild_Header, 9, 1)) + _
(Asc(Mid(Bild_Header, 10, 1)) * 256)
lngOffsetY = Asc(Mid(Bild_Header, 11, 1)) + _
(Asc(Mid(Bild_Header, 12, 1)) * 256)
Load varimage(intBildZaehler - 1)
varimage(intBildZaehler - 1).Left = varimage(0).Left + _
(lngOffsetX * Screen.TwipsPerPixelX)
varimage(intBildZaehler - 1).Top = varimage(0).Top + _
(lngOffsetY * Screen.TwipsPerPixelY)
End If
varimage(intBildZaehler - 1).Tag = lngWarteZeit
varimage(intBildZaehler - 1).Picture = _
LoadPicture("tmp.gif")
Kill ("tmp.gif")
End If
lngEinzelPic = varimage.count - 1
Exit Function
Fehler:
MsgBox "Fehler Nummer. " & Err.Number & _
" beim Lesen der Datei.", vbInformation
gif_laden = False
On Error GoTo 0
End Function
'Bildsequenzen anzeigen
Private Sub Timer1_Timer()
If lngBildAnzahl < lngEinzelPic Then
Image1(lngBildAnzahl).Visible = False
lngBildAnzahl = lngBildAnzahl + 1
Image1(lngBildAnzahl).Visible = True
Timer1.Interval = CLng(Image1(lngBildAnzahl).Tag)
Else
lngBildAnzahl = 0
For lngX = 1 To Image1.count - 1
Image1(lngX).Visible = False
Next lngX
Image1(lngBildAnzahl).Visible = True
Timer1.Interval = CLng(Image1(lngBildAnzahl).Tag)
End If
End Sub
Danke euch im voraus
Archi