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)
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
- Messages postés
-
7351
- Date d'inscription
- jeudi 13 septembre 2007
- Statut
- Contributeur
- Dernière intervention
- 23 avril 2021
122Voir ce cours sur la PictureBox:
https://plasserre.developpez.com/cours/vb-net/?page=ui-winforms4#LVIII-O-1
@+ Le Pivert
Je vais uploader mon code (même s'il n'est pas tout-à-fait 'codiquement correct' ;-)