IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VB 6 et antérieur Discussion :

[VB6] Convertion d'un fichier bmp en jpg [Trucs & Astuces]


Sujet :

VB 6 et antérieur

  1. #21
    Modérateur
    Avatar de ProgElecT
    Homme Profil pro
    Retraité
    Inscrit en
    Décembre 2004
    Messages
    6 067
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Communication - Médias

    Informations forums :
    Inscription : Décembre 2004
    Messages : 6 067
    Points : 17 155
    Points
    17 155
    Par défaut avec GDI+
    Un peu plus de code, mais conversion dans 5 types différents et dans tous les sens (BMP en JPG, JPG en BMP, GIF en TIF ....).
    Pour démonstration, un petit code récuperé dans différent projet personnel
    Sur un Form, 4 Labels, 2 TextBoxs, 1 ComboBox, 1 HScrollBar et enfin un CommandButton et ce
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    Option Explicit
     
    Private Sub Form_Load()
    Me.Height = 4065: Me.Width = 6930
    Me.Caption = "Demo conversion de fichier image"
    Label1.Caption = "Chemin et fichier source": Label1.Move 75, 75, 1695, 195
    Text1.Text = "": Text1.Move 75, 315, 6525, 420
    Label2.Caption = "Chemin et fichier destination": Label2.Move 75, 855, 1980, 195
    Text2.Text = "": Text2.Move 75, 1125, 6525, 420
    Label3.Caption = "Sauvegarder en": Label3.Move 75, 1650, 1140, 195
    Combo1.Move 75, 1890, 1275
    Label4.Caption = "Compression 50/100": Label4.Move 75, 2250, 1560, 195
    HScroll1.Value = 50: HScroll1.Max = 100: HScroll1.Min = 0
    HScroll1.Move 75, 2505, 2085, 240
    Command1.Caption = "Go": Command1.Move 345, 2955, 1410, 405
    Combo1.AddItem "BMP"
    Combo1.AddItem "JPG"
    Combo1.AddItem "GIF"
    Combo1.AddItem "TIF"
    Combo1.AddItem "PNG"
    Combo1.ListIndex = 1
    End Sub
    Private Sub Form_Unload(Cancel As Integer)
    '********************************************
    '*********** Impératif **********************
    '****** pour finir avec la session GDI+ *****
    FinSessionGDI
    '********************************************
    End Sub
     
    Private Sub Command1_Click()
    If SaveFileImage(Text1.Text, "", False, Combo1.Text, HScroll1.Value) = False Then Beep
    End Sub
    Private Sub Combo1_Click()
    If Combo1.ListIndex = 1 Then Label4.Visible = True Else Label4.Visible = False
    HScroll1.Visible = Label4.Visible
    End Sub
    Private Sub HScroll1_Change()
    Label4.Caption = "Compression " & HScroll1.Value & "/100"
    End Sub
    Private Sub HScroll1_Scroll()
    HScroll1_Change
    End Sub
    Dans un module.bas
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    Option Explicit
    '-------------- utilisé par GDI+ et ole32 ---------
    Private Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type
    Private Type EncoderParameter
        GUID As GUID
        NumberOfValues As Long
        Type As Long
        Value As Long
    End Type
    Private Type EncoderParameters
        Count As Long
        Parameter(15) As EncoderParameter
    End Type
    Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
     
    '---------------- pour vérification disponibilité de GDI+ -----------
    Public Type GdiplusStartupInput
        GdiplusVersion As Long
        DebugEventCallback As Long
        SuppressBackgroundThread As Long
        SuppressExternalCodecs  As Long
    End Type
    'création d'un lien en mémoire pour la session d'utilisation GDI+
    Public Declare Function GdiplusStartup Lib "gdiplus" _
        (ByRef token As Long, inputbuf As GdiplusStartupInput, _
        Optional ByVal outputbuf As Long = 0) As Long
    'pour libération de la mémoire du lien session GDI+
    Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
    Dim ParamS As GdiplusStartupInput
    Dim GDISess As Long 'variable conteneur du lien en mémoire pour la session d'utilisation GDI+
     
    'création d'un Bitmap Gdi+ en mémoire, à partir d'un fichier
    Public Declare Function GdipCreateBitmapFromFile Lib "gdiplus" _
        (ByVal FileName As Long, ByRef BITMAP As Long) As Long
    'pour libération de la mémoire du lien du Bitmap Gdi+
    Public Declare Function GdipDisposeImage Lib "gdiplus" _
        (ByVal image As Long) As Long
    'sauvgarde d'une image GDI+, avec fonction encodage
    Private Declare Function GdipSaveImageToFile Lib "gdiplus" ( _
        ByVal image As Long, ByVal FileName As Long, clsidEncoder As GUID, _
        encoderParams As Any) As Long
    Public GDIBitmap As Long 'variable conteneur du Bitmap Gdi+
     
    Public Sub Main()
    ''*****************************************************************
    ''*************Pour detecter si GDI+ sera disponnible *************
    ''*********** Impératif *******************************************
    InitSessionGDI 'GDI+ est-il dispo ?*******************************
    ''********* Indispensable *****************************************
    Form1.Show
    End Sub
    '-------------------------------------------------------------------------------------------
    Private Sub InitSessionGDI()
    ParamS.GdiplusVersion = 1
    If GdiplusStartup(GDISess, ParamS) <> 0 Then
     MsgBox "GDI+ non disponible"
     End
    End If
    End Sub
    Public Sub FinSessionGDI()
    'nettoyage
    If GDIBitmap <> 0 Then GdipDisposeImage GDIBitmap
    GdiplusShutdown GDISess ' Ferme/supprime le lien d'utilisation de Gdi+
    End Sub
    '---------------------------------------------------------------------------------------
    ' Ouverture d'un fichier image
    '---------------------------------------------------------------------------------------
    Private Function OpenFile(ChemFich As String) As Boolean
    ' Création d'un Bitmap Gdi+ à partir du fichier image, si l'opération a réussi,
    'renvoie 0, donc OpenFile = True, sinon renvoie un N° d'erreur donc False
    OpenFile = (GdipCreateBitmapFromFile(StrPtr(ChemFich), GDIBitmap) = 0)
    End Function
     
    Public Function SaveFileImage(ChemFichierSource As String, _
                                    Optional ChemFichierDest As String = "", _
                                    Optional SupprimerSource As Boolean = False, _
                                    Optional pFormat As String = "JPG", _
                                    Optional ByVal pQuality As Integer = -1) As Boolean
     
    If OpenFile(ChemFichierSource) <> True Then
     MsgBox "Erreur recuperation de l'image source", vbCritical, ""
     Exit Function
    End If
    If ChemFichierDest = "" Then
     ChemFichierDest = Left(ChemFichierSource, Len(ChemFichierSource) - 3) & pFormat
    End If
    If UCase(Right(ChemFichierDest, 4)) <> "." & pFormat Then
     ChemFichierDest = ChemFichierDest & "." & pFormat
    End If
     
    On Error GoTo Gestion_Erreur
    Dim lEncoder As GUID
    Dim lParams As EncoderParameters
    Dim lEncoderStr As String
    Const lBmpEncoderStr As String = "{557cf400-1a04-11d3-9a73-0000f81ef32e}"
    Const lJpgEncoderStr As String = "{557cf401-1a04-11d3-9a73-0000f81ef32e}"
    Const lGifEncoderStr As String = "{557cf402-1a04-11d3-9a73-0000f81ef32e}"
    Const lTifEncoderStr As String = "{557cf405-1a04-11d3-9a73-0000f81ef32e}"
    Const lPngEncoderStr As String = "{557cf406-1a04-11d3-9a73-0000f81ef32e}"
     
    Const lQualityParamStr As String = "{1d5be4b5-fa4a-452d-9cdd-5db35105e7eb}"
     
    ' Format de l'encodeur
    Select Case pFormat
     Case "BMP": lEncoderStr = lBmpEncoderStr
     Case "JPG": lEncoderStr = lJpgEncoderStr
     Case "GIF": lEncoderStr = lGifEncoderStr 'image, pas animation
     Case "TIF": lEncoderStr = lTifEncoderStr
     Case "PNG": lEncoderStr = lPngEncoderStr
    End Select
     
    SaveFileImage = True 'Retour de la fonction, si tous se passe bien !!!!
    ' Recherche de l'encodeur Jpeg
    CLSIDFromString StrPtr(lEncoderStr), lEncoder
     
    If pQuality <> -1 And pFormat = "JPG" Then ' Paramètre de l'encodeur Jpeg
     lParams.Count = 1
     With lParams.Parameter(0)
     ' Paramètrage de la qualité (0-100)
     '0 pas de compression qualité maxi, 100 compression maxi qualité mediocre
       CLSIDFromString StrPtr(lQualityParamStr), .GUID
       .NumberOfValues = 1
       .Type = 4    ' Type Long
       .Value = VarPtr(pQuality)
     End With
    End If
    ' Sauvegarde l'image
    If lParams.Count > 0 Then
     SaveFileImage = GdipSaveImageToFile(GDIBitmap, StrPtr(ChemFichierDest), lEncoder, lParams) = 0
     Else
     SaveFileImage = GdipSaveImageToFile(GDIBitmap, StrPtr(ChemFichierDest), lEncoder, Null) = 0
    End If
    GdipDisposeImage GDIBitmap 'libère la mémoire
     
    If SupprimerSource = True Then Kill (ChemFichierSource)
    Gestion_Erreur:
    If Err.Number <> 0 Then SaveFileImage = False
    End Function
    Avant de lancer la démo, ne pas oublier Alt + P puis Alt + P puis Alt + O pour atteindre Objet de démarrage, choisir Sub Main.
    Soyez sympa, pensez -y
    Balises[CODE]...[/CODE]
    Balises[CODE=NomDuLangage]...[/CODE] quand vous mettez du code d'un autre langage que celui du forum ou vous postez.
    Balises[C]...[/C] code intégré dans une phrase.
    Balises[C=NomDuLangage]...[/C] code intégré dans une phrase quand vous mettez du code d'un autre langage que celui du forum ou vous postez.
    Le bouton en fin de discussion, quand vous avez obtenu l'aide attendue.
    ......... et pourquoi pas, pour remercier, un pour celui/ceux qui vous ont dépannés.
    👉 → → Ma page perso sur DVP ← ← 👈

  2. #22
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Octobre 2003
    Messages
    44
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2003
    Messages : 44
    Points : 28
    Points
    28
    Par défaut
    Merci ProgElecT d'avoir été sympa de la redection du code pour GDI+, il fonctionne très bien, nickel. Merci à tous les autres aussi.

  3. #23
    Modérateur
    Avatar de ProgElecT
    Homme Profil pro
    Retraité
    Inscrit en
    Décembre 2004
    Messages
    6 067
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Communication - Médias

    Informations forums :
    Inscription : Décembre 2004
    Messages : 6 067
    Points : 17 155
    Points
    17 155
    Par défaut
    Salut

    Decouverte depuis ce matin, sous OS 64 bits, modifier la ligne 129 du code du module .BAs par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
       .Value = VarPtr(CLng(pQuality)) ' Type Long
    CLng(pQuality)
    Soyez sympa, pensez -y
    Balises[CODE]...[/CODE]
    Balises[CODE=NomDuLangage]...[/CODE] quand vous mettez du code d'un autre langage que celui du forum ou vous postez.
    Balises[C]...[/C] code intégré dans une phrase.
    Balises[C=NomDuLangage]...[/C] code intégré dans une phrase quand vous mettez du code d'un autre langage que celui du forum ou vous postez.
    Le bouton en fin de discussion, quand vous avez obtenu l'aide attendue.
    ......... et pourquoi pas, pour remercier, un pour celui/ceux qui vous ont dépannés.
    👉 → → Ma page perso sur DVP ← ← 👈

Discussions similaires

  1. impression depuis vb6 d'un fichier BMP ou JPG
    Par khalidst dans le forum VB 6 et antérieur
    Réponses: 4
    Dernier message: 29/08/2010, 22h22
  2. Erreur dans la convertion d'un fichier .JPG en .BMP
    Par Duan dans le forum Débuter
    Réponses: 1
    Dernier message: 12/05/2009, 05h51
  3. VBA : Export objet OLE dans fichier bmp, jpg
    Par gérard95 dans le forum VBA Access
    Réponses: 4
    Dernier message: 03/10/2007, 16h29
  4. [C#] Comment convertir une image bmp en jpg !!!
    Par vandeyy dans le forum Windows Forms
    Réponses: 5
    Dernier message: 13/07/2004, 21h37
  5. [TP]Charger un fichier bmp
    Par flavien tetart dans le forum Turbo Pascal
    Réponses: 5
    Dernier message: 30/06/2002, 20h04

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo