rebixav
Messages postés130Date d'inscriptiondimanche 16 décembre 2007StatutMembreDernière intervention28 janvier 2013
-
16 août 2012 à 11:28
rebixav
Messages postés130Date d'inscriptiondimanche 16 décembre 2007StatutMembreDernière intervention28 janvier 2013
-
19 août 2012 à 08:41
Permet de faire une convertion d'un fichier BMP vers JPG !
mais comme j'ai mis des heures à trouver car le tire "CAPTURE D'ÉCRAN EN JPG"
n'était pas ce que je chercher, j'ai décider de poster celui-ci en ajoutant une petite contribution !
et ajouter dans le module "Conversion_BMP_JPG" cela :
Public Sub bmp_to_jpg(ByVal fichier_source_bmp$, Optional ByVal fichier_destination_jpg$, Optional ByVal qualite = 75)
' 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
Set Capture = Nothing
End Sub
Comme cela en une ligne vous pouvez convertir un fichier bmp en jpg :
call bmp_to_jpg "c:\essai.bmp","c:\essai.jpg",50
ou mème :
bmp_to_jpg "c:\essai"
j'ai essayer cela marche !
mais comme je l'ai dit j'ajoute seulement 0.001% du travail fait avant par JACK !
rebixav
Messages postés130Date d'inscriptiondimanche 16 décembre 2007StatutMembreDernière intervention28 janvier 2013 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 !