begin process at 2012 05 27 07:24:59
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Multimedia

 > REDIMENSIONNEMENT DE PHOTOS PAR LOTS EN MULTITÂCHES

REDIMENSIONNEMENT DE PHOTOS PAR LOTS EN MULTITÂCHES


 Information sur la source

Note :
10 / 10 - par 1 personne
10,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Multimedia Source .NET ( DotNet ) Classé sous :multitâches, photos, redimentionnement Niveau :Initié Date de création :19/05/2007 Date de mise à jour :30/05/2007 20:36:33 Vu / téléchargé :5 974 / 646

Auteur : slyderkiller

Ecrire un message privé
Site perso
Commentaire sur cette source (0)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
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

  • 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
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


 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Historique

30 mai 2007 20:36:33 :
Correction du bug de la fenêtre de destination, la boite de dialogue s'affiche deux fois et la prise en compte du chemin est effective seulement au deuxieme affichage. Par ptit_tof57

 Sources de la même categorie

CLASS BASS par Duke49
Source .NET (Dotnet) CLASS AUDIO (MCI WAV MMIO) par Duke49
Source avec Zip Source .NET (Dotnet) SYNTHÈSE VOCALE SAPI5 par a1l2i3z4e5e
Source avec Zip Source .NET (Dotnet) MON LECTEUR MP3 par kentharold
Source avec Zip Source avec une capture LECTEUR MULTIMÉDIA par lartiguef

 Sources en rapport avec celle ci

Source avec Zip GESTION DES PHOTOS EN UTILISANT UNE BASE ACCESS par 310
Source avec Zip Source avec une capture BOULOMANCIE par Softmama
Source avec Zip ALBUM PHOTOS par ayoube2009
Source avec Zip Source avec une capture RENOMMER SÉRIE D'IMAGE DIRECTEMENT AVEC VBA EXCEL (CLASSEMEN... par davidparison
Source avec Zip Source avec une capture DIAPAUTO COMPRESSION DE PHOTOS/FICHIERS AUTOEXTRACTIBLE par candyraton

Commentaires et avis

Aucun commentaire pour le moment.

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Photos [ par Diego ] Existe-t-il un controle permettant de faire un fondu sur une photo ? photos dans une base access [ par TallBoy ] Bonjour,Avec une application en VB, j'aimerais prendre une photo.BMP et la mettre dans une base ACCESS. Merci Ya un prob dans l'upload des photos sur le site...(pour nix) [ par blackwizzard ] Salut nix!C BlackWizzard (he oui! encore moi!)j'ai essayé de mettre une photo dans la fiche auteur mais elle ne veut pas s'afficher apres l'upload...j Les photos de présentation [ par Lightness1024! ] j'ai mis une fausse source qui donne accès au 2 phtos que j'ai faites, mais elle sont encore évolutive bien sur.au moins, c'est du pur fait équpie c'e Quoi prendre pour créer un état avec des photos dynamiques? [ par vince ] Salut à tous,Je voudrais réaliser un état avec des photos dont le nom est enregistré dans une bdd access. A ce que j'ai compris ce n'est pas possible Problème pour réaliser une édition VB avec des photos [ par BPascal ] J'ai une base access avec des articles d'un catalogue que je dois éditer sous VB6. Dans cette base, j'ai aussi le nom d'image à éditer. Est-ce que le Urgent SVP - Publipostage sous Wordpartir d'une base excel et d'un répertoire contenant des photos, avec insertion automatique de la photo de la personne concernée sur le courrier [ par boubou79 ] Boubou79Boubou79, voila mon soucis, je dois effectuer un courrier de publipostage à partir de données (nom, prénom, adresse...) contenu dans un fichie Publipostage sous word avec insertion de photos situées dans un répertoire [ par boubou79 ] Boubou79Je poste ce second message pour relancer une nouvelle demande d'aide je dois effectuer un publipostage sous word et pour chaque courrier génér Publipostage Word-Excel-Répertoire de photos [ par boubou79 ] Boubou79Je poste ce second message pour relancer une nouvelle demande d'aide je dois effectuer un publipostage sous word et pour chaque courrier génér ToolBar et redimentionnement [ par SyDaze ] salut, comment peut on redimentionner les boutons d'une toolbar, ca ne marche pas avec les parametres de personnalisation.Merci


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Mai 2012
LMMJVSD
 123456
78910111213
14151617181920
21222324252627
28293031   

Consulter la suite du CalendriCode

A découvrir



 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,452 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales