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
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.
Voir 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' ;-)