Sauvegarder et convertir fichier BMP vers fichier JPG pour VB6 (options image et
Résolu
rebixav
Messages postés
130
Date d'inscription
dimanche 16 décembre 2007
Statut
Membre
Dernière intervention
28 janvier 2013
-
16 août 2012 à 11:28
rebixav Messages postés 130 Date d'inscription dimanche 16 décembre 2007 Statut Membre Dernière intervention 28 janvier 2013 - 19 août 2012 à 08:41
rebixav Messages postés 130 Date d'inscription dimanche 16 décembre 2007 Statut Membre Dernière intervention 28 janvier 2013 - 19 août 2012 à 08:41
1 réponse
rebixav
Messages postés
130
Date d'inscription
dimanche 16 décembre 2007
Statut
Membre
Dernière intervention
28 janvier 2013
19 août 2012 à 08:41
19 août 2012 à 08:41
Et je rajoute encore une petite modification !
je remplace ma sub par :
Public Sub bmp_to_jpg(ByVal fichier_source_bmp$, Optional ByVal fichier_destination_jpg$, Optional ByVal qualite As Byte 75, Optional ByVal effacer_le_fichier_source As Boolean False)
' Conversion de l'image BMP au format JPG pour prendre moins de place
'exemple : bmp_to_jpg "c:\essai"
fichier_source_bmp$ = LCase$(fichier_source_bmp$)
If Right$(fichier_source_bmp$, 4) <> ".bmp" And InStr(1, fichier_source_bmp$, ".") 0 Then fichier_source_bmp$ fichier_source_bmp$ + ".bmp"
If fichier_destination_jpg$ = "" Then
fichier_destination_jpg$ = Left$(fichier_source_bmp$, Len(fichier_source_bmp$) - 4) + ".jpg"
Else
fichier_destination_jpg$ = LCase$(fichier_destination_jpg$)
If Right$(fichier_destination_jpg$, 4) <> ".jpg" And InStr(1, fichier_destination_jpg$, ".") 0 Then fichier_destination_jpg$ fichier_destination_jpg$ + ".jpg"
End If
On Error Resume Next
If Dir(fichier_destination_jpg$) Then Kill fichier_destination_jpg$: DoEvents
Dim Capture As New aDIBSection
Set Capture = New aDIBSection
Capture.CreateFromPicture LoadPicture(fichier_source_bmp$)
Call SaveJPG(Capture, fichier_destination_jpg$, qualite)
DoEvents
If effacer_le_fichier_source = True Then Kill fichier_source_bmp$
Set Capture = Nothing
End Sub
comme cela, aprés avoir créer le fichier bmp on peut l'effacer s'il ne serre plus !
par defaut c'est du False !
je remplace ma sub par :
Public Sub bmp_to_jpg(ByVal fichier_source_bmp$, Optional ByVal fichier_destination_jpg$, Optional ByVal qualite As Byte 75, Optional ByVal effacer_le_fichier_source As Boolean False)
' Conversion de l'image BMP au format JPG pour prendre moins de place
'exemple : bmp_to_jpg "c:\essai"
fichier_source_bmp$ = LCase$(fichier_source_bmp$)
If Right$(fichier_source_bmp$, 4) <> ".bmp" And InStr(1, fichier_source_bmp$, ".") 0 Then fichier_source_bmp$ fichier_source_bmp$ + ".bmp"
If fichier_destination_jpg$ = "" Then
fichier_destination_jpg$ = Left$(fichier_source_bmp$, Len(fichier_source_bmp$) - 4) + ".jpg"
Else
fichier_destination_jpg$ = LCase$(fichier_destination_jpg$)
If Right$(fichier_destination_jpg$, 4) <> ".jpg" And InStr(1, fichier_destination_jpg$, ".") 0 Then fichier_destination_jpg$ fichier_destination_jpg$ + ".jpg"
End If
On Error Resume Next
If Dir(fichier_destination_jpg$) Then Kill fichier_destination_jpg$: DoEvents
Dim Capture As New aDIBSection
Set Capture = New aDIBSection
Capture.CreateFromPicture LoadPicture(fichier_source_bmp$)
Call SaveJPG(Capture, fichier_destination_jpg$, qualite)
DoEvents
If effacer_le_fichier_source = True Then Kill fichier_source_bmp$
Set Capture = Nothing
End Sub
comme cela, aprés avoir créer le fichier bmp on peut l'effacer s'il ne serre plus !
par defaut c'est du False !