Dans le cadre de ses voyages au pays de la programmation.
KCC il a trouvé un super code, tout simple, comme il aime pour pouvoir visualiser un gif animé en VB, sans OCX, sans API, et sans DLL
Juste un timer, mais ça PB il le fait sans, un contole image, mais ça marche meme avec un controle bouton
et voilaEn fin de compte le plus compliqué c'est le nom du createur : Arkadiy Olovyannikov (C'est pas français comme nom)
Je ne crois pas que j'avais vu ça en pure
J'aime pas quand VB y sait faire "quequechose" que PB ne fait pas
Et en plus, le code est tellement simple qu'on dirait du Pure
J'ai fait une rapide recherche et j'ai pas trouvé.
Bon, quoi qu'il en soit, je viens de l'appliquer sur une de mes applis en VB, et il marche du tonnere.
Avec ce code, j'suis meme arrivé a faire marcher un GIF transparent dans une fenetre skinnée, ce qui fait que le GIF il se promene tout seul sur le bureau
Bref, je me suis dit que ce serait une bonne idée de vous le faire partager, bien qu'il soit pas en PB, ne serait ce que si quelqu'un aurait besoin d'un debut de piste pour creer le meme en PB
Ce qui est dingue dans ce code, c'est que y'a rien besoin, pas de DLL, pas d'API juste apparement une lecture du GIF, de ses caracteristique, un enregistrement de ses divers sequences, et puis les visionner les unes apres les autres.
Les codes sur les GIF animés n'etant pas legion, je prend le risque de me faire disputer en le mettant dans la rubrique "TRUC et ASTUCES".
Et puis en plus pour une fois que je peux "offrir" une combine au forum, au lieu de toujours demander quelque chose
, c'est champagne Si c'est pas bien, DOBRO me deplacera
Voila treve de blabla, et pour ceux qui aurait deja un filet de bave dans l'angle de la bouche, voici le code.
Je n'en ai pas besoin pour l'instant en PB, mais peut etre que quelqu'un de vous qui a un peu le temps, et surtout les capacités, pourra le couvertir au cas ou.
Je crois que ça pourrait etre utile pour le forum
Si ça existe déjà, bah excusez moi du derangement et je la remet dans ma culotte
Voici ou télécharger le source pour ceux qui ont VB
http://www.freevbcode.com/ShowCode.Asp?ID=758
Et pour ceux qui l'ont pas (Les veinards
)A mettre dans un module :
Code : Tout sélectionner
Public RepeatTimes As Long 'This one calculates, but don't use in this sample. If You need, You can add simple checking at Timer1_Timer Procedure
Public TotalFrames As Long
Public FrameCount As Long
Public Function LoadGif(sFile As String, aImg As Variant) As Boolean
LoadGif = False
If Dir$(sFile) = "" Or sFile = "" Then
MsgBox "File " & sFile & " not found", vbCritical
Exit Function
End If
On Error GoTo ErrHandler
Dim fNum As Integer
Dim imgHeader As String, fileHeader As String
Dim buf$, picbuf$
Dim imgCount As Integer
Dim i&, j&, xOff&, yOff&, TimeWait&
Dim GifEnd As String
GifEnd = Chr(0) & Chr(33) & Chr(249)
For i = 1 To aImg.Count - 1
Unload aImg(i)
Next i
fNum = FreeFile
Open sFile For Binary Access Read As fNum
buf = String(LOF(fNum), Chr(0))
Get #fNum, , buf 'Get GIF File into buffer
Close fNum
i = 1
imgCount = 0
j = InStr(1, buf, GifEnd) + 1
fileHeader = Left(buf, j)
If Left$(fileHeader, 3) <> "GIF" Then
MsgBox "This file is not a *.gif file", vbCritical
Exit Function
End If
LoadGif = True
i = j + 2
If Len(fileHeader) >= 127 Then
RepeatTimes& = Asc(Mid(fileHeader, 126, 1)) + (Asc(Mid(fileHeader, 127, 1)) * 256&)
Else
RepeatTimes = 0
End If
Do ' Split GIF Files at separate pictures and load them into Image Array
imgCount = imgCount + 1
j = InStr(i, buf, GifEnd) + 3
If j > Len(GifEnd) Then
fNum = FreeFile
Open "temp.gif" For Binary As fNum
picbuf = String(Len(fileHeader) + j - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, j - i)
Put #fNum, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, j - i), 16)
Close fNum
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256&)) * 10&
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256&)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256&)
Load aImg(imgCount - 1)
aImg(imgCount - 1).Left = aImg(0).Left + (xOff * Screen.TwipsPerPixelX)
aImg(imgCount - 1).Top = aImg(0).Top + (yOff * Screen.TwipsPerPixelY)
End If
' Use .Tag Property to save TimeWait interval for separate Image
aImg(imgCount - 1).Tag = TimeWait
aImg(imgCount - 1).Picture = LoadPicture("temp.gif")
Kill ("temp.gif")
i = j
End If
DoEvents
Loop Until j = 3
' If there are one more Image - Load it
If i < Len(buf) Then
fNum = FreeFile
Open "temp.gif" For Binary As fNum
picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, Len(buf) - i)
Put #fNum, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, Len(buf) - i), 16)
Close fNum
TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 256)
Load aImg(imgCount - 1)
aImg(imgCount - 1).Left = aImg(0).Left + (xOff * Screen.TwipsPerPixelX)
aImg(imgCount - 1).Top = aImg(0).Top + (yOff * Screen.TwipsPerPixelY)
End If
aImg(imgCount - 1).Tag = TimeWait
aImg(imgCount - 1).Picture = LoadPicture("temp.gif")
Kill ("temp.gif")
End If
TotalFrames = aImg.Count - 1
Exit Function
ErrHandler:
MsgBox "Error No. " & Err.Number & " when reading file", vbCritical
LoadGif = False
On Error GoTo 0
End FunctionCode : Tout sélectionner
If LoadGif(App.Path + "\ImageGif.gif", Form.ImgGif) Then
FrameCount = 0
Programme.Timer1.Interval = CLng(Programme.ImgSaliere(0).Tag)
Programme.Timer1.Enabled = True
End IfMais encore bien trop pour KCC
Bonne journée a tous
