Accueil > > > REDIMENSIONNEMENT DE PHOTOS PAR LOTS EN MULTITÂCHES
REDIMENSIONNEMENT DE PHOTOS PAR LOTS EN MULTITÂCHES
Information sur la source
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
- 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
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
Commentaires et avis
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
|
Derniers Blogs
IMAGINE CUP 2012, MAKE A SIGN EN FINALEIMAGINE CUP 2012, MAKE A SIGN EN FINALE par junarnoalg
Voilà qui est fait, la nouvelle est officielle ! L'équipe belge "Make a Sign" va au pays des kangourous défendre son projet dans la catégorie Software Design. http://www.imaginecup.com/CompetitionsContent/Competition/WorldwideFinalists.aspx V...
Cliquez pour lire la suite de l'article par junarnoalg KINECT 1.5 IS OUT !KINECT 1.5 IS OUT ! par Vko
La version 1.5 du Kinect For Microsoft vient tout juste de sortir ! Plein de nouveautés: Tracking de squelette en Near Mode Détection en position assise Détection faciale avec un SDK dédié Documentation et des guideline (enfin) Un out...
Cliquez pour lire la suite de l'article par Vko LES ACTUALITéS DE LA SEMAINE SUR C2I.FR (14 MAI - 20 MAI) LES ACTUALITéS DE LA SEMAINE SUR C2I.FR (14 MAI - 20 MAI) par richardc
Mise à jour des Web API du 14 Mai
Réservez dès maintenant votre journée du 20 juin pour le Windows Azure Dev Camp 2012 à Paris
Mise à jour de Team Foundation Service
MechCommander 2 sur Windows 8
Entity Framework 5 Release Candidate e...
Cliquez pour lire la suite de l'article par richardc REACTIVE EXTENSIONS : CONSOMMER DES SERVICES AVEC RX PARTIE 3, LES PIèGES à éVITERREACTIVE EXTENSIONS : CONSOMMER DES SERVICES AVEC RX PARTIE 3, LES PIèGES à éVITER par Groc
Une mauvaise utilisation de rx lors de l'écriture d'une couche d'accès à des services peut conduire à des cas embarassants avec des erreurs mal gérées, des appels qui ne partent lorsqu'ils le devraient, et même des résultats incorrects . le tout nuis...
Cliquez pour lire la suite de l'article par Groc SHAREPOINT BLOG SITE, PROBLèME D'ARCHIVESSHAREPOINT BLOG SITE, PROBLèME D'ARCHIVES par junarnoalg
Dernièrement, nous avons migré le site
myTIC
vers un nouveau serveur SharePoint 2010. Dans les contenus que nous vouloins récupérer, nous avions un certain nombre de blogs.
Nous avons utilisé les commandes Power...
Cliquez pour lire la suite de l'article par junarnoalg
Logiciels
sDEVIS-FACTURES vlPRO (8.1.0.3)SDEVIS-FACTURES VLPRO (8.1.0.3)sDEVIS-FACTURES vlPRO a été mis au point pour les particuliers, créateurs, entrepreneurs, artisa... Cliquez pour télécharger sDEVIS-FACTURES vlPRO 974 Application Server (12.2.4.6)974 APPLICATION SERVER (12.2.4.6)Développez de puissantes applications dans un environnement de 'cloud computing', clusterisé, séc... Cliquez pour télécharger 974 Application Server vPicture (1.4.2.1)VPICTURE (1.4.2.1)Avec vPicture, hébergez vos images facilement et rapidement.
vPicture est un utilitaire simple, ... Cliquez pour télécharger vPicture Easy-Planning (2.2.1.6)EASY-PLANNING (2.2.1.6)Easy-Planning permet de créer des plannings sous la représentation de diagrammes et est adapté au... Cliquez pour télécharger Easy-Planning COM-BACKUP (2.0)COM-BACKUP (2.0)
COM-BACKUP est un logiciel de sauvegarde qui permet de planifier les sauvegardes de vos dossiers ...
Cliquez pour télécharger COM-BACKUP
|