Redimensionnement de photos par lots en multitâches

Télécharger le projet
Commenter

Description

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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (slyderkiller)