Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionImports System.IO Imports System.Drawing.Imaging Public Class Form1 #Region "Déclarations" Dim x, y, diff, dify, i As Int32 Dim path As String Dim w, h, r, vignette As Integer Dim rapport As Double Dim img As Image Dim paysage As Boolean #End Region #Region "Ouverture" Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) System.IO.File.Delete(Application.StartupPath & "\redim.jpg") 'supprime image redimensionnée End Sub Private Sub Form1_Load_1(sender As System.Object, e As System.EventArgs) Handles MyBase.Load Button1.Text = "Ouvrir image" Me.MaximizeBox = False End Sub Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click Dim chemin As String = Application.StartupPath & "\redim.jpg" 'chemin image redimensionnée Dim j As Integer vignette = 100 Dim ofd As New OpenFileDialog With ofd .Multiselect = True .Title = "Choisissez une image" .Filter = "jpeg (*.jpg)|*.jpg|gif (*.gif)|*.gif|tiff (*.tif)|*.tif|bmp (*.bmp)|*.bmp|png (*.png)|*.png" .FilterIndex = 1 .RestoreDirectory = False If .ShowDialog() = Windows.Forms.DialogResult.OK Then path = .FileName 'chemin image source img = Image.FromFile(path) r = CInt(img.HorizontalResolution) 'résolution image w = img.Width 'largeur image h = img.Height ' hauteur image If w < h Then paysage = False rapport = h / w RedimensionnerImage(path, chemin, CInt(400 / rapport), 400, r) 'portrait Else paysage = True rapport = (w / h) RedimensionnerImage(path, chemin, 400, CInt(400 / rapport), r) 'paysage End If dimension() 'dimension Panel 'On découpe et dresse une liste des images 100x100 For j = 0 To 11 Step 1 'création pictureBox Dim pic As New PictureBox i += 1 pic.Name = "Image " & i pic.BorderStyle = BorderStyle.Fixed3D If w < h Then pic.Image = ImagePart_haut(chemin, x, y, vignette, vignette) 'portrait Else pic.Image = ImagePart(chemin, x, y, vignette, vignette) 'paysage End If pic.SetBounds(x, y, vignette, vignette) x += vignette 'vérifier s'il ya suffisamment d'espace dans l'axe x pour ajouter une image If x >= Panel1.Width Or (x + vignette) > Panel1.Width Then diff = Panel1.Width - x 'S'il n'y a pas assez d'espace, commencer une nouvelle ligne ci-dessous y += vignette x = 0 End If If ((y + vignette) > Panel1.Height) Then dify = Panel1.Height - y End If 'controle PictureBox AddHandler pic.MouseDown, AddressOf PictureBox_MouseDown AddHandler pic.MouseMove, AddressOf PictureBox_MouseMove AddHandler pic.DoubleClick, AddressOf PictureBox_DoubleClick 'ajouter une image Panel1.Controls.Add(pic) Next Else MessageBox.Show("Opération annulée par l'utilisateur!", "Ouverture image", MessageBoxButtons.OK, MessageBoxIcon.Information) Exit Sub End If .Dispose() End With Button1.Enabled = False End Sub #End Region #Region "Fonctions" ' Fonction qui retourne une image redimensionnée ' path: Chemin de l'image (Ex: C:\images\pic.jpg) ' width: largeur souhaitée ' height: hauteur souhaitée Private Function ResizedImage(ByVal path As String, ByVal width As Integer, ByVal height As Integer) As Image Try Return Bitmap.FromFile(path).GetThumbnailImage(width, height, Nothing, Nothing) Catch Return Nothing End Try End Function ' Fonction qui retourne une partie d'image ' path: Chemin de l'image (Ex: C:\images\pic.jpg) ' width: largeur souhaitée ' height: hauteur souhaitée ' x: position de départ (x) ' y: position de départ (y) Private Function ImagePart(ByVal path As String, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer) As Image 'paysage Dim ImaSource = ResizedImage(path, 400, 300) Dim nouvImage As New Bitmap(width, height) Dim graph As Graphics = Graphics.FromImage(nouvImage) Dim rect As New Rectangle(0, 0, width, height) graph.DrawImage(ImaSource, rect, x, y, width, height, GraphicsUnit.Pixel) nouvImage.SetResolution(r, r) Return nouvImage End Function Private Function ImagePart_haut(ByVal path As String, ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer) As Image 'portrait Dim ImaSource = ResizedImage(path, 300, 400) Dim nouvImage As New Bitmap(width, height) Dim graph As Graphics = Graphics.FromImage(nouvImage) Dim rect As New Rectangle(0, 0, width, height) graph.DrawImage(ImaSource, rect, x, y, width, height, GraphicsUnit.Pixel) nouvImage.SetResolution(r, r) Return nouvImage End Function Private Sub RedimensionnerImage(ByRef cheminOrigine As String, ByRef cheminDestination As String, ByVal largeur As Integer, ByVal hauteur As Integer, ByVal resolution As Integer) 'crée un Bitmap à partir de l'image d'origine Dim imageSource As New Bitmap(cheminOrigine) 'crée un Bitmap avec la nouvelle taille (il est possible de spécifier un facteur de redimensionnement à la place d'une taille) Dim bp As New Bitmap(largeur, hauteur) Dim gr As Graphics = Graphics.FromImage(bp) 'copie l'image source dans la nouvelle image gr.DrawImage(imageSource, 0, 0, bp.Width + 1, bp.Height + 1) bp.SetResolution(resolution, resolution) 'résolution de l'image originale 'sauvegarde le tout (ici en jpeg) bp.Save(cheminDestination, ImageFormat.Jpeg) End Sub Private Sub dimension() 'dimension Panel If paysage = True Then Panel1.Width = 419 Panel1.Height = 319 Me.Width = 470 Me.Height = 450 Else paysage = False Panel1.Width = 319 Panel1.Height = 419 Me.Width = 370 Me.Height = 550 End If End Sub #End Region #Region "PictureBox" Private Sub PictureBox_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then x = e.X y = e.Y End If End Sub Private Sub PictureBox_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) If e.Button = Windows.Forms.MouseButtons.Left Then sender.Left += (e.X - x) sender.Top += (e.Y - y) End If End Sub Private Sub PictureBox_DoubleClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) ' On récupère le contrôle cliqué ... Dim pictTmp As PictureBox = DirectCast(sender, PictureBox) MsgBox(pictTmp.Name) End Sub #End Region End Class
PaintEventArgsconduisent à des erreurs, alors que le remplacement de
e.Graphicspar le
CreateGraphicsdu support de dessin suffit. Mais je dois encore mettre cela en ordre. D'autre part, je voudrais savoir si le Vb 2008 possède un explorateur d'objets.
Imports System.Drawing
Public Class Accueil
Private Chm As String, ImgO As Image
Private Sub bOuv_Click(ByVal sender As Object, ByVal e As EventArgs) Handles bOuv.Click
'Acquisition de l'image d'origine ImgO dans le PictureBox pBox.
'DlgOuvrir est un contrôle OpenDialog (filtre Bmp, jpg, gif).
'L'image ImgO est stockée dans l'ordinateur à l'état de fichier.
Dim Ok As Boolean
With DlgOuvrir
.ShowDialog()
Ok = (.ShowDialog = DialogResult.OK)
If Ok Then
Chm = .FileName : ImgO = Image.FromFile(Chm)
pBox.Image = Image.FromFile(Chm)
End If
End With
'Code de Graphics.DrawImage, méthode (Image, Int32, Int32, Rectangle, GraphicsUnit)
Dim x As Integer = 100
Dim y As Integer = 100
Dim srcRect As New Rectangle(50, 50, 150, 150)
Dim units As GraphicsUnit = GraphicsUnit.Pixel
pBox.CreateGraphics.DrawImage(ImgO, x, y, srcRect, units)
'L'exécution de ce code est censée produire une image extraite de l'image d'origine ImgO.
'Mais dans l'état actuel le test n'est pas possible, car l'image potentiellement extraite
'est alors devant l'image d'origine.
'Bon courage mes amis!
End Sub
29 févr. 2016 à 11:06