deleplace
Messages postés
40
Date d'inscription
mardi 4 octobre 2005
Statut
Membre
Dernière intervention
2 mars 2009
23 févr. 2009 à 17:22
Je bute exactement sur le même problème (perte de la couche alpha)
par contre je fait toutes mes conversion sans dll additionnelles
je n'utilise que GdiPlus.dll présente sur tous les PC depuis longtemps
Si tu trouve la solution de sauver en PNG sans perdre la couche alpha, fait moi signe
je te donne mes codes de conversion:
Private Declare Function GdiplusStartup& Lib "gdiplus" (Token&, inputbuf As Any, Optional ByVal outputbuf&)
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token&)
Private Declare Function GdipLoadImageFromFile& Lib "gdiplus" (ByVal FileName$, image&)
Private Declare Function GdipSaveImageToFile& Lib "gdiplus" (ByVal image&, ByVal FileName$, clsidEncoder As Any, encoderParams As Any)
Private Declare Sub GdipDisposeImage Lib "gdiplus" (ByVal image&)
'AnyFormat veut dire BMP,PNG,GIF,JPG, TIF ou RLE
Private Sub LoadPictureAnyFormat(File$, Pic as PictureBox)
Dim TMP$
TMP= environ("TMP") & "\Tmpbmp.tmp
if Convert(File,TMP,0) then exit sub 'Conversion Bmp Failde
Pic.picture=loadpicture(Tmp)
Kill TMP
End Sub
PriVate Function AnyFormatToBmp&(Source$,Cible$)
'Function Inutile Convert(Source,Cible) fait exactement la même chose
AnyFormatToBmp=Convert(File,TMP,0)
End Function
'Si Source posede une couche Alpha, Cible sera un Bmp32Bits(avec couche Alpha)
PriVate Function AnyFormatToPng&(Source$,Cible$)
AnyFormatToPng=Convert(File,TMP,1)
End Function
'Problème si source est un BMP 32 Bits(couche alpha) dans le PNG résultant la couche Alpha sera perdue
PriVate Function AnyFormatToGif&(Source$,Cible$)
AnyFormatToGif=Convert(File,TMP,2)
End Function
PriVate Function AnyFormatToJpg&(Source$,Cible$,Optional TauxJpg& = 75)
AnyFormatToJpg=Convert(File,TMP,TauxJpg)
End Function
Private Function Convert&(Source$, Destination$, Optional Q&)
'Q: 0Bmp 1Png 2Gif Autre QJpg
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 FunctionT 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 IfL(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