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
SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc [TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier
Suite à la session que j'ai présenté sur WebMatrix 2, vous pouvez trouver les slides ici, ainsi que les démos en packages nuget : démos1 et démos2 J'en profite pour remercier chaleureusement tous ceux qui sont venus très nombreux à cette sess...
Cliquez pour lire la suite de l'article par gpommier [SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE !MISHRA READER : UN LECTEUR RSS TRèS ZUNE STYLE EN OPEN SOURCE ! par Vko
Hier durant une session dédiée aux Techdays 2012, j'ai eu le plaisir d'annoncer la sortie de la Béta 2 de Mishra Reader. C'est quoi ? Pour les utilisateurs, c'est une vraie expérience de lecture de flux RSS sur Windows. Rien à voir avec les produit...
Cliquez pour lire la suite de l'article par Vko
Logiciels
Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning
|