Discussion :

[grammaticorene]

Comment sauvegarder une picturebox
Voila je travaille en VB6
dans mon application il y a une picture box dans laquelle je peux changer l'image de fond , je peux aussi dessiner des lignes et rectangle et aussi , je peux drag and drop d'autre picturebox a l'interieur.
comment sauvegarder la picturebox quand j'ai fini de dessiner et de poser d'autre picturebox a l'interieur.
Merci d'avance.

[ProgElecT]

Salut grammaticorene, bienvenue sur DVP

Il est possible de le faire avec GDIplus, un peu lourd mais donne de très grandes possibilités.
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
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
'-------------- utilisé par GDI+ ------------------
Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
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
Public Enum GpStatus
    Gp_Ok = 0
    Gp_GenericError = 1
    Gp_InvalidParameter = 2
    Gp_OutOfMemory = 3
    Gp_ObjectBusy = 4
    Gp_InsufficientBuffer = 5
    Gp_NotImplemented = 6
    Gp_Win32Error = 7
    Gp_WrongState = 8
    Gp_Aborted = 9
    Gp_FileNotFound = 10
    Gp_ValueOverflow = 11
    Gp_AccessDenied = 12
    Gp_UnknownImageFormat = 13
    Gp_FontFamilyNotFound = 14
    Gp_FontStyleNotFound = 15
    Gp_NotTrueTypeFont = 16
    Gp_UnsupportedGdiplusVersion = 17
    Gp_GdiplusNotInitialized = 18
    Gp_PropertyNotFound = 19
    Gp_PropertyNotSupported = 20
End Enum
 
'-------------- APIs GDI+ ------------------
Public Declare Function GdiplusStartup Lib "gdiplus" _
    (token As Long, LInput As GdiplusStartupInput, Optional ByVal lOutPut As Long = 0) As Long
Public Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Public Declare Function GdipCreateFromHDC Lib "gdiplus" _
    (ByVal hdc As Long, graphics As Long) As GpStatus
Public Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _
    (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As GpStatus
Public Declare Function GdipGetImagePixelFormat Lib "gdiplus" _
    (ByVal image As Long, PixelFormat As Long) As GpStatus
Public Declare Function GdipCloneBitmapAreaI Lib "gdiplus" _
    (ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long, _
    ByVal PixelFormat As Long, ByVal srcBitmap As Long, dstBitmap As Long) As GpStatus
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Public Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As GpStatus
Private Declare Function GdipSaveImageToFile Lib "gdiplus" ( _
    ByVal image As Long, ByVal FileName As Long, clsidEncoder As GUID, _
    encoderParams As Any) As Long
 
Public param As GdiplusStartupInput
Public handle_session_gdiplus As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long
 
Public Function SaveFileImage(pFile As String, HandlImag As Long, Optional pFormat As String = "JPG", Optional ByVal pQuality As Long = -1) As Boolean
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}"
 
On Error GoTo Gestion_Erreur
' 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)   ' Type Long
    End With
End If
' Sauvegarde l'image
If lParams.Count > 0 Then
    SaveFileImage = GdipSaveImageToFile(HandlImag, StrPtr(pFile), lEncoder, lParams) = 0
    Else
    SaveFileImage = GdipSaveImageToFile(HandlImag, StrPtr(pFile), lEncoder, Null) = 0
End If
Gestion_Erreur:
If Err.Number <> 0 Then SaveFileImage = False
End Function

Sur un Form, 2 ComboBoxs (ComboFormat et ComboQualiter), 1 CommmandButton, 1 PictureBox et 1 CommonDialog

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
Option Explicit
 
 
Private Sub Form_Load()
Form1.AutoRedraw = True: Form1.ScaleMode = vbPixels
 
ComboFormat.Clear
ComboFormat.AddItem "BMP": ComboFormat.AddItem "GIF": ComboFormat.AddItem "JPG"
ComboFormat.AddItem "PNG": ComboFormat.AddItem "TIF": ComboFormat.ListIndex = 2 'JPG
ComboFormat.Move 16, 4, 53
 
ComboQualiter.Clear
ComboQualiter.AddItem "Qualitée trés moyenne": ComboQualiter.ItemData(0) = 25
ComboQualiter.AddItem "Qualitée moyenne": ComboQualiter.ItemData(1) = 50
ComboQualiter.AddItem "Bonne qualitée": ComboQualiter.ItemData(2) = 75
ComboQualiter.AddItem "Tres bonne qualitée": ComboQualiter.ItemData(3) = 100
ComboQualiter.ListIndex = 3 'Tres bonne qualitée
ComboQualiter.Move 80, 4, 123
 
Command1.Caption = "Enregistrer": Command1.Move 212, 4, 73, 21
 
Picture1.AutoRedraw = True: Picture1.AutoSize = True: Picture1.ScaleMode = vbPixels
Picture1.Move 10, 32
Picture1.Picture = LoadPicture("C:\PersoFrancis\Manipuler une image\Image2.bmp")
Picture1.FontSize = 10: Picture1.FontBold = True
Picture1.Print
Picture1.Print "  Essais en JPG"
Picture1.DrawWidth = 5
Picture1.Circle (Picture1.ScaleWidth / 2, Picture1.ScaleHeight / 2), Picture1.ScaleWidth / 3, vbGreen
 
Me.Height = Screen.Height / 2: Me.Width = Screen.Width / 2
End Sub
Private Sub Form_Initialize()
param.GdiplusVersion = 1
handle_session_gdiplus = 0
If GdiplusStartup(handle_session_gdiplus, param) <> 0 Then
    MsgBox "Impossible d'initialiser GDIplus.DLL", vbInformation
    End
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If handle_session_gdiplus <> 0 Then
    GdiplusShutdown handle_session_gdiplus 'libération explicite de l'espace mémoire
End If
End Sub
 
Private Sub Command1_Click()
        CommonDialog1.Flags = cdlOFNExtensionDifferent + cdlOFNHideReadOnly + cdlOFNOverwritePrompt
        CommonDialog1.Filter = ComboFormat.List(ComboFormat.ListIndex) & "|*." & ComboFormat.List(ComboFormat.ListIndex)
        CommonDialog1.DefaultExt = "." & ComboFormat.List(ComboFormat.ListIndex)
        CommonDialog1.CancelError = True
        On Error Resume Next
        CommonDialog1.ShowSave
        If Err.Number <> 0 Then On Error GoTo 0: Exit Sub
        Dim GraphHandle As Long 'zone graphique
        Dim ImagHandle As Long 'image (pixels) contenu dans cette zone graphique
        Dim ImagSave As Long 'image clone retaillé de ImagHandle
        Dim FormatPixel As Long 'recuperation du format
        Dim QualiteImg As Integer
        Dim pixW As Long, pixH As Long 'pour tailler exactement à la partie interne du picture
 
        Me.Caption = "En cours ....."
        If GdipCreateFromHDC(Picture1.hdc, GraphHandle) = Gp_Ok Then
            If GdipCreateBitmapFromHBITMAP(Picture1.image.Handle, Picture1.image.hpal, ImagHandle) = Gp_Ok Then
                If GdipGetImagePixelFormat(ImagHandle, FormatPixel) = Gp_Ok Then
                    pixW = ScaleX(Picture1.ScaleWidth, Picture1.ScaleMode, vbPixels)
                    pixH = ScaleY(Picture1.ScaleHeight, Picture1.ScaleMode, vbPixels)
                    If GdipCloneBitmapAreaI(0, 0, pixW, pixH, FormatPixel, ImagHandle, ImagSave) = Gp_Ok Then
                        If SaveFileImage(CommonDialog1.FileName, ImagSave, _
                            ComboFormat.List(ComboFormat.ListIndex), _
                            ComboQualiter.ItemData(ComboQualiter.ListIndex)) = True Then
                            GdipDisposeImage ImagSave 'libération explicite de l'espace mémoire
                            Me.Caption = "OK"
                        End If
                    End If
                End If
                GdipDisposeImage ImagHandle 'libération explicite de l'espace mémoire
            End If
            GdipDeleteGraphics GraphHandle 'libération explicite de l'espace mémoire
        End If
        If Me.Caption = "En cours ....." Then
            MsgBox "Sauvegarde non réalisée", , "-ProgElecT-"
            Else
            MsgBox "Fichier Sauvegardé : " & vbCrLf & CommonDialog1.FileName, , "-ProgElecT-"
        End If
End Sub

Attention de modifier la ligne 24 pour donner un chemin et nom de fichier valide.
Les lignes 25 à 29 modifient l'aspect de l'image pour démontrer le résultat de l'enregistrement.

Les 2 ComboBoxs permettent de choisir le type de sauvegarde et, le cas échéant, la compression.

Le code provient d'un source (Capture d'écran entier ou sélection, sauvegarde avec GDI+), je pense n'avoir laissé que les APIs et les variables utiles.

[l_autodidacte]

ProgElecT
S'il est débutant(on le sait pas), c'est un peu lourd comme tu l'as dit.
Moi j'opterais pour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Command1_Click()
 SavePicture Picture1.Picture, "C:\Pic.jpg"
  ' ou encore pour bmp
 SavePicture Picture1.Picture, "C:\Pic.bmp"
End Sub

[ProgElecT]

Salut l_autodidacte

SavePicture, instruction
.................................
si c'est un fichier bitmap ou icône, un métafichier ou un métafichier étendu, il est enregistré au même format que son fichier d'origine. Pour les fichiers GIF ou JPEG, il est enregistré en tant que fichier bitmap.

Les éléments graphiques d'une propriété Image sont toujours enregistrés comme images bitmap (fichiers .bmp), quel que soit leur format d'origine.

Même en changeant le type dans le nom du fichier, on enregistre en en fait en BMP
Tu m'as donné le doute, alors j'ai essayé, un BMP chargé d'un poids de 2.28M, sauvegardé en .JPG reste au même poids,
............................................................un JPG chargé d'un poids de 48.6K, sauvegardé en .JPG passe à 493K.

[ProgElecT]

Salut

Une version beaucoup plus légère, sur un Form, 1 PictureBox et 1 CommandButton

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()
Form1.AutoRedraw = True: Form1.ScaleMode = vbPixels
Command1.Caption = "Enregistrer": Command1.Move 212, 4, 73, 21
 
Picture1.AutoRedraw = True: Picture1.AutoSize = True: Picture1.ScaleMode = vbPixels
Picture1.Move 10, 32
Picture1.Picture = LoadPicture("E:\PersoFrancis novembre 2014\Manipuler une image\Image2.bmp")
Picture1.FontSize = 10: Picture1.FontBold = True
Picture1.Print
Picture1.Print "  Essais en JPG"
Picture1.DrawWidth = 5
Picture1.Circle (Picture1.ScaleWidth / 2, Picture1.ScaleHeight / 2), Picture1.ScaleWidth / 3, vbGreen
 
Me.Height = Screen.Height / 2: Me.Width = Screen.Width / 2
End Sub
Private Sub Command1_Click()
SavePicture Picture1.Image, "C:\ImgTemporaire.BMP" 'sauvegarde en .BMP temporairement 65.9K
 
Dim ImgFile As Object, ImgProcess As Object
'Création conteneur pour l'image à manipuler
Set ImgFile = CreateObject("WIA.ImageFile")
Set ImgProcess = CreateObject("WIA.ImageProcess") 'Création du gestionnaire de filtre
 
ImgFile.LoadFile ("C:\Pic.BMP") 'Chargement de l'image dans le conteneur
'parametres pour la l'enregistrement en .JPG
ImgProcess.Filters.Add ImgProcess.FilterInfos("Convert").FilterID
ImgProcess.Filters(1).Properties("FormatID").Value = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
ImgProcess.Filters(1).Properties("Quality").Value = 90
Set ImgFile = ImgProcess.Apply(ImgFile) 'applique les paramètres à l'image .BMP qui vient d'être chargée
 
On Error Resume Next
Kill ("C:\ImgTemporaire.BMP") 'Supprime le fichier .BMP temporaire
If Err Then Err.Clear
 
ImgFile.SaveFile ("C:\Pic.JPG") 'sauvegarde en .JPG 12.2K
DoEvents
 
Kill ("C:\ImgTemporaire.BMP") 'Supprime le fichier .BMP temporaire
 
Set ImgProcess = Nothing: Set ImgFile = Nothing
End Sub

Attention, pensez a modifier les chemins et noms suivant vos besoins.