Redimensionnement de photos par lots en multitâches
On choisi le pourcentage de compression, on peut effacer les blanc des titres, renommer les titres , choisir le dossier de destination?
Source / Exemple :
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System
Imports System.ComponentModel
Imports System.Threading
Imports System.Windows.Forms
Public Class Form1
' Initialisation des fonctions inter thread
Delegate Sub SetTextCallback(ByVal [text] As String)
Delegate Sub SetBarGeneCallback(ByVal [Gene] As Integer)
Delegate Sub SetBarRedimCallback(ByVal [Redim] As Integer)
Delegate Sub SetFinishCallback(ByVal [Etat] As Boolean)
'Déclaration du thread
Public ThreadRedim As New Threading.Thread(AddressOf CalculRedimPhotos)
Dim nPhotos As Integer 'obtien le nombres de photos sélectionées
Dim W1, H1, W2, H2, W3, H3, Wpct As Integer 'Parametre de redimentionnement
Dim NomTemp As String 'Renvoi le nom du fichier source
Dim n As Integer
'Fonctions inter thread
Private Sub SetText(ByVal [text] As String)
If Me.lbFichier.InvokeRequired Then
Dim d As New SetTextCallback(AddressOf SetText)
Me.Invoke(d, New Object() {[text]})
Else
Me.lbFichier.Text = [text]
End If
End Sub
Private Sub SetBarGene(ByVal [Gene] As Integer)
If Me.pbGenerale.InvokeRequired Then
Dim d As New SetBarGeneCallback(AddressOf SetBarGene)
Me.Invoke(d, New Object() {[Gene]})
Else
Me.pbGenerale.Value = [Gene]
End If
End Sub
Private Sub SetBarRedim(ByVal [Redim] As Integer)
If Me.pbFichier.InvokeRequired Then
Dim d As New SetBarRedimCallback(AddressOf SetBarRedim)
Me.Invoke(d, New Object() {[Redim]})
Else
Me.pbFichier.Value = [Redim]
End If
End Sub
Private Sub FinishThread(ByVal [Etat] As Boolean)
If Me.cbSupp.InvokeRequired Then
Dim d As New SetFinishCallback(AddressOf FinishThread)
Me.Invoke(d, New Object() {[Etat]})
Else
Me.initialisation()
End If
End Sub
'Initialisation
Private Sub initialisation()
' Pause du thread
Me.ThreadRedim.Suspend()
Me.cbSupp.Enabled = True
Me.cbRenam.Enabled = True
Me.txbRenam.Enabled = True
Me.nudPct.Enabled = True
Me.bntGo.Enabled = False
Me.bntDestination.Enabled = False
Me.bntOuvrir.Enabled = True
Me.pbFichier.Value = 0
Me.pbGenerale.Value = 0
Me.lbFichier.Text = ""
Me.lbDestination.Text = ""
Me.lbOuvrir.Items.Clear()
MessageBox.Show("Redimensionnement terminé")
End Sub
Public Sub CalculRedimPhotos()
Dim imageSource As Image
Dim imageReduite As Image
pbGenerale.Value = 0
Wpct = Me.nudPct.Value 'Valeur du % de redimentionnement
'Boucle sur le thread si il est en run
While ThreadRedim.ThreadState = ThreadState.Running
For n = 0 To Me.nPhotos
SetBarRedim(0)
SetText("Traitement de " + NomTemp + " en cour ...")
If Me.cbRenam.Checked = True Then
'Si on renome les photos
NomTemp = Me.txbRenam.Text + "0" + CStr(n) + ".jpg"
Else
'Si elle porte le même nom
NomTemp = Split(Me.Ouvrir.FileNames(n), "\")(UBound(Split(Me.Ouvrir.FileNames(n), "\")))
End If
If Me.cbSupp.Checked = True Then
'On efface les espaces et on remplace
NomTemp = Replace(NomTemp, " ", "_")
End If
SetBarRedim(20)
'Ouverture de limage source
imageSource = System.Drawing.Image.FromFile(Me.Ouvrir.FileNames(n))
'get W1 and H1 pour calculer le ratio
'Exctraction des dimentions
W1 = imageSource.Width
H1 = imageSource.Height
SetBarRedim(40)
'calcul des nouvelles dimentions
If W1 >= H1 Then ' Paysage
W2 = W1 * Wpct / 100
H2 = W2 * H1 / W1
Else ' Portrait
H2 = H1 * Wpct / 100
W2 = H2 * W1 / H1
End If
SetBarRedim(60)
' Get the source bitmap.
Dim bm_source As New Bitmap(imageSource)
SetBarRedim(80)
' bitmap pour le resultat.
Dim bm_dest As New Bitmap(W2, H2)
SetBarRedim(85)
' Creer un GraphicsOject pour le resultat du Bitmap.
Dim gr_dest As Graphics = Graphics.FromImage(bm_dest)
SetBarRedim(90)
' Copy l'image source dans le bitmap.
gr_dest.DrawImage(bm_source, 0, 0, W2, H2)
imageReduite = bm_dest
SetBarRedim(95)
' sauvegarder l'image en jpg dans le repertoire de destination
imageReduite.Save(Me.Destination.SelectedPath + "\" + NomTemp, System.Drawing.Imaging.ImageFormat.Jpeg)
SetBarRedim(100)
If nPhotos <> 0 Then
SetBarGene(n * 100 / nPhotos)
Else
SetBarGene(100)
End If
ThreadRedim.Sleep(300) ' Pause du thread en ms
Next
SetText("Traitement Terminé")
FinishThread(True)
End While
End Sub
Private Sub CountOuvrir()
'Renvoi les photos sélectionnées
lbOuvrir.Items.Clear()
nPhotos = Ouvrir.FileNames.GetUpperBound(0)
Dim i As Integer
For i = 0 To nPhotos
'Affiche les photos sélectionnées
lbOuvrir.Items.Add(Ouvrir.FileNames(i))
Next
End Sub
Private Sub bntOuvrir_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bntOuvrir.Click
Ouvrir.ShowDialog()
If (Ouvrir.FileName <> "") Then
CountOuvrir()
bntDestination.Enabled = True
Else
lbOuvrir.Text = "Sélectionné un fichier"
bntDestination.Enabled = False
End If
End Sub
Private Sub bntDestination_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bntDestination.Click
If Destination.ShowDialog() = Windows.Forms.DialogResult.OK Then
lbDestination.Text = Destination.SelectedPath
bntGo.Enabled = True
Else
lbDestination.Text = " Aucun dossier n'a été sélectionné"
End If
End Sub
Private Sub bntGo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bntGo.Click
cbSupp.Enabled = False
cbRenam.Enabled = False
txbRenam.Enabled = False
nudPct.Enabled = False
bntGo.Enabled = False
bntDestination.Enabled = False
bntOuvrir.Enabled = False
If ThreadRedim.ThreadState = ThreadState.Unstarted Then
' démarrage du thread
ThreadRedim.Start()
Else
' reprise du thread
ThreadRedim.Resume()
End If
End Sub
Private Sub QuiterToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles QuiterToolStripMenuItem.Click
Me.Close()
End Sub
Private Sub AideToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AideToolStripMenuItem.Click
Aide.Show()
End Sub
Private Sub APropoDeToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles APropoDeToolStripMenuItem.Click
AboutBox1.Show()
End Sub
End Class
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
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.