Enregistrer le contenu d'une picturebox

Résolu
GregYoung
Messages postés
29
Date d'inscription
samedi 21 avril 2018
Statut
Membre
Dernière intervention
23 décembre 2018
- 2 juin 2018 à 19:14
GregYoung
Messages postés
29
Date d'inscription
samedi 21 avril 2018
Statut
Membre
Dernière intervention
23 décembre 2018
- 3 juin 2018 à 10:01
Bonjour à tous,
Je cherche à sauvegarder une image chargée dans une picturebox, à laquelle je modifie (ensuite) la couleur d'arrière-plan. Le Hic c'est que l'image enregistrée n'inclue pas ma couleur d'arrière-plan.
NB : La couleur d'arrière-plan m'est indispensable puisque la zone enregistrable est plus grande que l'image source.

Voilà mon code :
Dim DestFolder As String = My.Computer.FileSystem.SpecialDirectories.MyPictures & "\RESIZED\"

 Dim myEncoder As Encoder = Encoder.Quality
 Dim jpgEncoder As ImageCodecInfo = GetEncoder(ImageFormat.Jpeg)
 Dim myEncoderParameters As New EncoderParameters(1)
 myEncoderParameter = New EncoderParameter(myEncoder, 100&)
 myEncoderParameters.Param(0) = myEncoderParameter
 myImage.Save(DestFolder & "maPhoto.jpg", jpgEncoder, myEncoderParameters)


Qqn aurait une idée ?
(Merci par avance)

2 réponses

cs_Le Pivert
Messages postés
7745
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 mai 2022
129
2 juin 2018 à 20:49
Bonjour,

avec une capture de control:

https://codes-sources.commentcamarche.net/source/54783-capture-de-controles

je m'en suis servi dans ce programme pour ajouter un fond a l'image:

https://codes-sources.commentcamarche.net/source/100589-visionneuse-d-image

Tu mets ta PictureBox dans un control plus grand dans lequel tu ajoutes ton fond. Ensuite il suffit de faire la capture de ce control


voilà
0
cs_Le Pivert
Messages postés
7745
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
20 mai 2022
129
3 juin 2018 à 08:17
en relisant ton code, je ne vois aucune trace de ta PictureBox. Je pense que c'est plus simple que je ne le pensais.

Voir ce cours sur la PictureBox:

https://plasserre.developpez.com/cours/vb-net/?page=ui-winforms4#LVIII-O-1

@+ Le Pivert
0
GregYoung
Messages postés
29
Date d'inscription
samedi 21 avril 2018
Statut
Membre
Dernière intervention
23 décembre 2018

Modifié le 3 juin 2018 à 09:35
Merci. Je suis finalement parvenu à mes fins, grâce à tes commentaires depuis ce post https://codes-sources.commentcamarche.net/forum/affich-10069723-decouper-ou-rogner-une-image.
Je vais uploader mon code (même s'il n'est pas tout-à-fait 'codiquement correct' ;-)
0
GregYoung
Messages postés
29
Date d'inscription
samedi 21 avril 2018
Statut
Membre
Dernière intervention
23 décembre 2018

3 juin 2018 à 10:01
Voilà. Trouvé ! Grâce à cs_Le Pivert :
PRINCIPE : Découper une zone d'image en forme 'carrée' ou 'rectangulaire' prenant en charge la couleur d'arrière-plan en cas de dépassement, depuis un Powerpacks.RectangleShape.
Picturebox1 (Image source) est un contrôle appartenant à Panel1
Picturebox2 (Image finale) n'a pas de contrôles-enfant.
La couleur d'arrière-plan ainsi que le redimensionnement du cadre 'rectangulaire' sont gérés par des trackbars (code non présent).
Et enfin, l'enregistrement de l'image se fait en jpeg (qualité 100%) à l'aide de l'encodeur.

Il y a probablement plus simple, mais ce code fonctionne déjà admirablement bien.


Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports Microsoft.VisualBasic
Imports System.Drawing.Imaging
Imports System.Windows.Forms

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.TransparencyKey = Me.BackColor
        ShapeContainer1.BringToFront()
        AddHandler RectangleShape1.MouseDown, AddressOf cadre_MouseDown
        AddHandler RectangleShape1.MouseMove, AddressOf cadre_MouseMove
End Sub

#Region "MOUVEMENT DU CADRE DE SELECTION"
    Dim x1, x2, y1, y2 As Integer
    Private Sub cadre_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        If e.Button = System.Windows.Forms.MouseButtons.Left Then
            x1 = e.X
            y1 = e.Y
        End If
    End Sub

    Private Sub cadre_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        Dim myCadre As PowerPacks.RectangleShape = CType(sender, PowerPacks.RectangleShape)

        If e.Button = System.Windows.Forms.MouseButtons.Left Then
            If myCadre.Left + (e.X - x1) > -1 And myCadre.Top + (e.Y - y1) > -1 And
                myCadre.Left + (e.X - x1) + myCadre.Width < Panel1.Width And myCadre.Top + (e.Y - y1) + myCadre.Height < Panel1.Height Then
                x2 = e.X - x1
                y2 = e.Y - y1

                myCadre.Location = New Point(myCadre.Left + x2, myCadre.Top + y2)
                Me.Panel1.Refresh()
            End If
        Else
            Decouper()
        End If
    End Sub
#End Region

 Private Sub Decouper()
        Dim rect, Rect_forCadre As Rectangle, bit As Bitmap

        With PictureBox1
            If .Image Is Nothing Then Exit Sub
            rect = New Rectangle(-(.Left - RectangleShape1.Left), -(.Top - RectangleShape1.Top), RectangleShape1.Width, RectangleShape1.Height) ' Zone de sélection
            bit = New Bitmap(.Image, .Width, .Height)   ' Image depuis PictureBox1
        End With

        Dim CropImage = New Bitmap(ShapeContainer1.Width, ShapeContainer1.Height) ' Dimensions de l'Image finale
        Dim g As Graphics = Graphics.FromImage(CropImage)
        With g
            .Clear(Color.FromArgb(255, tk_ColorR.Value, tk_ColorG.Value, tk_ColorB.Value))
            .InterpolationMode = InterpolationMode.HighQualityBicubic
            .PixelOffsetMode = PixelOffsetMode.HighQuality
            .CompositingQuality = CompositingQuality.HighQuality

            Dim rect_posX As Single = CSng((PictureBox2.Width - RectangleShape1.Width) / 2)
            Dim rect_posY As Single = CSng((PictureBox2.Height - RectangleShape1.Height) / 2)

            ' Dessin de l'Image dans le PictureBox2
            .DrawImage(bit, rect_posX, rect_posY, rect, GraphicsUnit.Pixel)

            ' Dessin du cadre
            Dim mypen As New Pen(Color.White)
            Rect_forCadre = New Rectangle(rect_posX, rect_posY, RectangleShape1.Width, RectangleShape1.Height)
            .DrawRectangle(mypen, Rect_forCadre)
        End With

        With PictureBox2
            .Image = CropImage ' Affichage de l'Image finale dans la PictureBox2
            .Size = Panel1.Size
            .Visible = True
        End With
    End Sub

 Private Sub btnEnregistrer_Click(sender As Object, e As EventArgs) Handles btnEnregistrer.Click
        ' Importer System.Drawing.Imaging
        Dim DestFolder As String = My.Computer.FileSystem.SpecialDirectories.MyPictures & "\RESIZED\"
        If Not My.Computer.FileSystem.DirectoryExists(DestFolder) Then My.Computer.FileSystem.CreateDirectory(DestFolder)

        Dim rect As Rectangle = New Rectangle((PictureBox2.Width - RectangleShape1.Width) / 2, (PictureBox2.Height - RectangleShape1.Height) / 2,
                                              RectangleShape1.Width, RectangleShape1.Height)

        Dim CropImage As Bitmap = New Bitmap(RectangleShape1.Width, RectangleShape1.Height)
        Dim g As Graphics = Graphics.FromImage(CropImage)
        g.DrawImage(PictureBox2.Image, 0, 0, rect, GraphicsUnit.Pixel)

        Try
            Dim myEncoder As Encoder = Encoder.Quality
            Dim jpgEncoder As ImageCodecInfo = GetEncoder(ImageFormat.Jpeg)
            Dim myEncoderParameters As New EncoderParameters(1)

            myEncoderParameter = New EncoderParameter(myEncoder, 100&)
            myEncoderParameters.Param(0) = myEncoderParameter
            CropImage.Save(DestFolder & "maPhoto.jpg", jpgEncoder, myEncoderParameters)

            Application.DoEvents()
            JouerSon(My.Resources.Valide)

        Catch ex As Exception
            MsgBox("Erreur d'enregistrement")
        End Try
    End Sub

  Private Function GetEncoder(ByVal format As ImageFormat) As ImageCodecInfo
        Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageDecoders()
        Dim codec As ImageCodecInfo
        For Each codec In codecs
            If codec.FormatID = format.Guid Then
                Return codec
            End If
        Next codec
        Return Nothing
  End Function
0