Sauver en gif
Ziman
Messages postés
245
Date d'inscription
dimanche 27 avril 2003
Statut
Membre
Dernière intervention
26 septembre 2008
-
21 oct. 2004 à 20:42
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 - 24 févr. 2009 à 07:54
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 - 24 févr. 2009 à 07:54
3 réponses
ShareVB
Messages postés
2676
Date d'inscription
vendredi 28 juin 2002
Statut
Membre
Dernière intervention
13 janvier 2016
26
22 oct. 2004 à 21:05
22 oct. 2004 à 21:05
deleplace
Messages postés
40
Date d'inscription
mardi 4 octobre 2005
Statut
Membre
Dernière intervention
2 mars 2009
24 févr. 2009 à 02:32
24 févr. 2009 à 02:32
Voici un code qui fonctionne parfaitement sou VB6
Private Function ConvertToGif&(Source$, CibleGIF$)
ConvertToGif = Convert(Source, CibleGIF, 2)
End Function
'Précision: Pour obtenir Gif 2, 4, 8, 16, 32, 64 ou 128 couleurs
' a partir d'un BMP
'Source doit être un BMP 8Bits avec palette limitée au nombre de couleurs
dans un module.bas
Declare Function GdiplusStartup& Lib "gdiplus" (Token&, inputbuf As Any, Optional ByVal outputbuf&)
Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token&)
Declare Function GdipLoadImageFromFile& Lib "gdiplus" (ByVal FileName$, image&)
Declare Function GdipSaveImageToFile& Lib "gdiplus" (ByVal image&, ByVal FileName$, clsidEncoder As Any, encoderParams As Any)
Declare Sub GdipDisposeImage Lib "gdiplus" (ByVal image&)
Function Convert&(Source$, Destination$, Optional Q&)
'Q: 0Bmp 1Png 2Gif AutreQJpg
Dim img&, L&(11), T&, S$, Token&
L(4) 1: If GdiplusStartup(Token, L(4)) Then Convert 18: Exit Function
Convert = GdipLoadImageFromFile(StrConv(Source, vbUnicode), img): If Convert Then Exit Function
T Q: If T 1 Then T = 6
If Q > 2 Or Q < 0 Then
T 1: L(5) &H1D5BE4B5: L(6) = &H452DFA4A: L(7) = &HB35DDD9C
L(8) &HEBE70551: L(9) 1: L(10) = 4
If Q < 0 Then L(11) VarPtr(Not Q) Else L(11) VarPtr(Q)
End If
L(0) &H557CF400 + T: L(1) &H11D31A04: L(2) = &H739A&: L(3) = &H2EF31EF8
Convert = GdipSaveImageToFile(img, StrConv(Destination, vbUnicode), L(0), L(4)) ', ByVal 0) autre que Jpeg
GdipDisposeImage img: GdiplusShutdown Token
'Convert returns:
'0 Ok,GenericError,InvalidParameter,OutOfMemory
'4 ObjectBusy,InsufficientBuffer,NotImplemented,Win32Error
'8 WrongState,Aborted,FileNotFound,ValueOverflow
'12 AccessDenied,UnknownImageFormat,FontFamilyNotFound,FontStyleNotFound
'16 NotTrueTypeFont,UnsupportedGdiplusVersion,GdiplusNotInitialized,PropertyNotFound
'20 PropertyNotSupported
End Function
Private Function ConvertToGif&(Source$, CibleGIF$)
ConvertToGif = Convert(Source, CibleGIF, 2)
End Function
'Précision: Pour obtenir Gif 2, 4, 8, 16, 32, 64 ou 128 couleurs
' a partir d'un BMP
'Source doit être un BMP 8Bits avec palette limitée au nombre de couleurs
dans un module.bas
Declare Function GdiplusStartup& Lib "gdiplus" (Token&, inputbuf As Any, Optional ByVal outputbuf&)
Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token&)
Declare Function GdipLoadImageFromFile& Lib "gdiplus" (ByVal FileName$, image&)
Declare Function GdipSaveImageToFile& Lib "gdiplus" (ByVal image&, ByVal FileName$, clsidEncoder As Any, encoderParams As Any)
Declare Sub GdipDisposeImage Lib "gdiplus" (ByVal image&)
Function Convert&(Source$, Destination$, Optional Q&)
'Q: 0Bmp 1Png 2Gif AutreQJpg
Dim img&, L&(11), T&, S$, Token&
L(4) 1: If GdiplusStartup(Token, L(4)) Then Convert 18: Exit Function
Convert = GdipLoadImageFromFile(StrConv(Source, vbUnicode), img): If Convert Then Exit Function
T Q: If T 1 Then T = 6
If Q > 2 Or Q < 0 Then
T 1: L(5) &H1D5BE4B5: L(6) = &H452DFA4A: L(7) = &HB35DDD9C
L(8) &HEBE70551: L(9) 1: L(10) = 4
If Q < 0 Then L(11) VarPtr(Not Q) Else L(11) VarPtr(Q)
End If
L(0) &H557CF400 + T: L(1) &H11D31A04: L(2) = &H739A&: L(3) = &H2EF31EF8
Convert = GdipSaveImageToFile(img, StrConv(Destination, vbUnicode), L(0), L(4)) ', ByVal 0) autre que Jpeg
GdipDisposeImage img: GdiplusShutdown Token
'Convert returns:
'0 Ok,GenericError,InvalidParameter,OutOfMemory
'4 ObjectBusy,InsufficientBuffer,NotImplemented,Win32Error
'8 WrongState,Aborted,FileNotFound,ValueOverflow
'12 AccessDenied,UnknownImageFormat,FontFamilyNotFound,FontStyleNotFound
'16 NotTrueTypeFont,UnsupportedGdiplusVersion,GdiplusNotInitialized,PropertyNotFound
'20 PropertyNotSupported
End Function
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
74
24 févr. 2009 à 07:54
24 févr. 2009 à 07:54
gaffe, si tu intègre ça dans une appli utilisant deja GDI+
sans cela, tu peux prendre les yeux fermés, deleplace est une valeur montante de VbFrance
tu donne le chemin du fichier BMP en entrée
et le chemin du gif souhaité
sans cela, tu peux prendre les yeux fermés, deleplace est une valeur montante de VbFrance
tu donne le chemin du fichier BMP en entrée
et le chemin du gif souhaité