Imports System.Collections.Concurrent Imports System.IO Imports System.Drawing.Drawing2D Imports System.Drawing.Imaging Imports System.Threading Imports System.Collections.Generic Imports System.Drawing.Text Imports System.Runtime.InteropServices Imports System.Threading.Tasks Imports CatalogVbLib Imports MaddoShared Public Delegate Sub XyThreadAdd(ByVal Info As String) Public Class MainForm #Const MULTI_THREADED_UI = True Private StopAttivo As Boolean Private WaterSelectColor As Boolean = False 'Private ContaFotoCuori As Integer 'Private TaskCuori() As PicInfo Private MyPool As XYThreadPool = New XYThreadPool Private ContaImmaginiThread As Integer Private maxThreads As Integer = 15 Private minThreads As Integer = 5 Private Sub setDefaults() txtSorgente.Text = "" txtDestinazione.Text = "" TextBox3.Text = "tn_" TextBox4.Text = "" TextBox5.Text = "350" TextBox6.Text = "350" TextBox27.Text = "2240" TextBox28.Text = "2240" TextBox9.Text = "0" TextBox11.Text = "20" TextBox12.Text = "8" 'TextBox13.Text = "" TextBox10.Text = "" TextBox14.Text = "430" TextBox15.Text = "430" TextBox16.Text = "290" txtFilePerCartella.Text = "99" TextBox19.Text = "100" txtSuffissoCartelle.Text = "" txtCifreContatore.Text = "2" TextBox25.Text = "50" TextBox26.Text = "" TextBox7.Text = CStr(4) TextBox8.Text = CStr(4) TextBox34.Text = "Yellow" TextBox30.Text = "20" TextBox31.Text = "6" TextBox32.Text = "85" TextBox33.Text = "30" ComboBox1.Items.Add("Alto") ComboBox1.Items.Add("Basso") ComboBox1.SelectedIndex = 1 ComboBox2.Items.Add("Sinistra") ComboBox2.Items.Add("Centro") ComboBox2.Items.Add("Destra") ComboBox2.SelectedIndex = 1 ' Create a obejct of InstalledFontCollection Dim InstalledFonts As New InstalledFontCollection ' Gets the array of FontFamily objects associated with this FontCollection. Dim fontfamilies() As FontFamily = InstalledFonts.Families() ' Populates font combobox with the font name For Each fontFamily As FontFamily In fontfamilies ComboBox3.Items.Add(fontFamily.Name) Next ComboBox3.Text = ComboBox3.Items(0).ToString 'ComboBox3.Items.Add("Arial") 'ComboBox3.Items.Add("Arial Black") 'ComboBox3.Items.Add("Arial Narrow") 'ComboBox3.Items.Add("Comic Sans MS") 'ComboBox3.Items.Add("Courier New") 'ComboBox3.Items.Add("System") 'ComboBox3.Items.Add("Times New Roman") 'ComboBox3.Items.Add("Verdana") 'ComboBox3.Items.Add("Wingdings") 'ComboBox3.SelectedIndex = 7 ComboBox4.Items.Add("Sinistra") ComboBox4.Items.Add("Centro") ComboBox4.Items.Add("Destra") ComboBox4.SelectedIndex = 2 ComboBox5.Items.Add("Alto") ComboBox5.Items.Add("Centro") ComboBox5.Items.Add("Basso") ComboBox5.SelectedIndex = 2 End Sub Private Shared Function AllocConsole() As Boolean End Function Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Application.EnableVisualStyles() setDefaults() #If Not DEBUG Then AllocConsole() #End If Console.WriteLine("Programma avviato") End Sub Private Sub FixPaths() If txtSorgente.Text.EndsWith("\") = False Then txtSorgente.Text &= "\" End If If txtDestinazione.Text.EndsWith("\") = False Then txtDestinazione.Text &= "\" End If End Sub Private Sub lockUI() TabControl1.Enabled = False Button5.Enabled = False Button6.Enabled = False btnCreaCatalogo.Enabled = False End Sub Private Sub unlockUI() TabControl1.Enabled = True Button5.Enabled = True Button6.Enabled = True btnCreaCatalogo.Enabled = True End Sub Private Sub btnCreaCatalogo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCreaCatalogo.Click lockUI() Dim timeStart As Date Dim timeStop As Date timeStart = TimeOfDay FixPaths() Label10.Text = "" lblFotoTotaliNum.Text = "0" Label18.Text = "0" Label43.Text = "-s" maxThreads = CInt(TextBox7.Text) minThreads = CInt(TextBox8.Text) If rdbNuovoMetodo.Checked Then setPicSettings(txtSorgente.Text, txtDestinazione.Text) ProgressBar1.Minimum = 0 ProgressBar1.Step = 1 ProgressBar1.Value = 0 Dim t1 As New Threading.Thread(AddressOf creaCatalogoThread) t1.IsBackground = False t1.Start() ElseIf rdbVecchioMetodo.Checked Then creaCatalogo(timeStart, timeStop) unlockUI() End If End Sub Private Sub creaCatalogoThread() Dim timeStart As Date = TimeOfDay MyPool.StopThreadPool() MyPool.StartThreadPool(minThreads, maxThreads) ContaImmaginiThread = 0 'creaImmaginiWithThreadMod(txtSorgente.Text, txtDestinazione.Text) creaimmaginiWithThreadDict(txtSorgente.Text, txtDestinazione.Text) Dim ThAttivo As ThreadPoolWorkItem = Nothing Dim i As Integer = 0 #Const asfd = 1 #If asfd = 1 Then Do Until i = ContaImmaginiThread Thread.Sleep(100) ThAttivo = MyPool.ExtractWorkItem() If ThAttivo IsNot Nothing Then i += 1 'stepProgressBar() Dim threads As Integer = MyPool.GetThreadCount() setLabel10Text("File: " & ThAttivo.m_sName & " Threads: " & CStr(threads)) 'setLabel18Text(ContaImmaginiThread.ToString) 'setLabel18Text(i.ToString) 'Label10.Text = "File: " & ThAttivo.m_sName 'Label18.Text = ContaImmaginiThread.ToString End If Loop MyPool.StopThreadPool() Dim timeStop As Date = TimeOfDay setLabel10Text("Finito") setLabel43Text(CalcTime(timeStart, timeStop, ContaImmaginiThread)) #End If End Sub Private Sub creaCatalogo(timeStart As Date, timeStop As Date) 'asdfg MyPool.StopThreadPool() MyPool.StartThreadPool(minThreads, maxThreads) ContaImmaginiThread = 0 CreaImmaginiWithThread(txtSorgente.Text, txtDestinazione.Text) Dim ThAttivo As ThreadPoolWorkItem = Nothing Dim i As Integer = 0 Do Until i = ContaImmaginiThread Thread.Sleep(100) ThAttivo = MyPool.ExtractWorkItem() If ThAttivo IsNot Nothing Then i += 1 Label10.Text = "File: " & ThAttivo.m_sName Label18.Text = ContaImmaginiThread.ToString End If Loop MyPool.StopThreadPool() timeStop = TimeOfDay CalcTime(timeStart, timeStop, ContaImmaginiThread) Label10.Text = "Finito" If CheckBox22.Checked = True Then Shell("%windir%\System32\shutdown.exe") End If End Sub Private Function CalcTime(ByVal timeStart As Date, ByVal timeStop As Date, ByVal numFoto As Integer) As String Dim timediffH, timediffS As Long Dim timediffM As Long timediffM = DateAndTime.DateDiff(DateInterval.Minute, timeStart, timeStop) timediffS = DateAndTime.DateDiff(DateInterval.Second, timeStart, timeStop) timediffH = DateAndTime.DateDiff(DateInterval.Hour, timeStart, timeStop) 'dim s As String = "H:" + timediffH.ToString + " M:" + timediffM.ToString + " S:" + timediffS.ToString 'Label43.Text = "H:" + timediffH.ToString + " M:" + timediffM.ToString + " S:" + timediffS.ToString Dim fotoSec As Double = numFoto / CDbl(timediffS) Dim fotoMin As Double = numFoto / CDbl(timediffM) Dim fotoOra As Double = numFoto / CDbl(timediffH) Dim s As String = "S: " + timediffS.ToString + "; F/s: " + fotoSec.ToString("0.000") '+ " F/m: " + fotoMin.ToString("0.00") + " F/h: " + fotoOra.ToString("0.00") Return s End Function Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Dim DirSearch As FolderBrowserDialog = New FolderBrowserDialog DirSearch.SelectedPath = txtSorgente.Text If DialogResult.OK = DirSearch.ShowDialog() Then Dim DirectoryScelta As String = DirSearch.SelectedPath If DirectoryScelta.EndsWith("\") = False Then DirectoryScelta &= "\" End If txtSorgente.Text = DirectoryScelta End If End Sub Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click Dim DirSearch As FolderBrowserDialog = New FolderBrowserDialog DirSearch.SelectedPath = txtDestinazione.Text If DialogResult.OK = DirSearch.ShowDialog() Then Dim DirectoryScelta As String = DirSearch.SelectedPath If DirectoryScelta.EndsWith("\") = False Then DirectoryScelta &= "\" End If txtDestinazione.Text = DirectoryScelta End If 'Dim openFileDialog As OpenFileDialog = New OpenFileDialog 'Dim openFileDialog As OpenFileDialog = New OpenFileDialog 'openFileDialog.InitialDirectory = TextBox1.Text 'openFileDialog.Filter = "Bitmap files (*.bmp)|*.bmp|Jpeg files (*.jpg)|*.jpg|All valid files (*.*)|*.*" 'openFileDialog.FilterIndex = 2 'openFileDialog.RestoreDirectory = True 'If DialogResult.OK = openFileDialog.ShowDialog() Then ' Dim IlNome As String = openFileDialog.FileName ' Dim NomeFine As String = "" ' Dim i As Integer ' Dim Elenco As String() ' Elenco = IlNome.Split(New Char() {"\"c}) ' For i = 0 To Elenco.Length - 1 ' NomeFine &= Elenco(i) & "\" ' Next ' TextBox1.Text = NomeFine 'End If End Sub Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click Dim SaveFileDlg As SaveFileDialog = New SaveFileDialog 'SaveFileDlg.InitialDirectory = "c:\" SaveFileDlg.Filter = "Setup (*.xml)|*.xml|All valid files (*.*)|*.*" SaveFileDlg.FilterIndex = 0 SaveFileDlg.RestoreDirectory = True If DialogResult.OK = SaveFileDlg.ShowDialog Then Dim IlNome As String = SaveFileDlg.FileName SetupIni.NomeFileSetup = IlNome SetupIni.AggiornaParametro("DirSorgente", txtSorgente.Text) SetupIni.AggiornaParametro("DirDestinazione", txtDestinazione.Text) SetupIni.AggiornaParametro("DirSottoDirectory", chkAggiornaSottodirectory.Checked) SetupIni.AggiornaParametro("DirDividiDestinazione", chkCreaSottocartelle.Checked) SetupIni.AggiornaParametro("DirDividiNumFile", txtFilePerCartella.Text) SetupIni.AggiornaParametro("DirDividiSuffisso", txtSuffissoCartelle.Text) SetupIni.AggiornaParametro("DirDividiNumCifre", txtCifreContatore.Text) If rdbNumProgressiva.Checked = True Then SetupIni.AggiornaParametro("DirDividiTipoNumerazione", "Progressiva") Else SetupIni.AggiornaParametro("DirDividiTipoNumerazione", "Files") End If SetupIni.AggiornaParametro("MiniatureCrea", CheckBox1.Checked) SetupIni.AggiornaParametro("MiniatureSuffisso", TextBox3.Text) SetupIni.AggiornaParametro("MiniatureAltezza", TextBox5.Text) SetupIni.AggiornaParametro("MiniatureLarghezza", TextBox6.Text) SetupIni.AggiornaParametro("MiniatureAddScritta", RadioButton3.Checked) SetupIni.AggiornaParametro("MiniatureAddOrario", RadioButton4.Checked) SetupIni.AggiornaParametro("FotoAltezza", TextBox27.Text) SetupIni.AggiornaParametro("FotoLarghezza", TextBox28.Text) 'SetupIni.AggiornaParametro("FotoCodice", TextBox13.Text) 'SetupIni.AggiornaParametro("FotoDimOriginali", CheckBox2.Checked) SetupIni.AggiornaParametro("FontDimensione", TextBox11.Text) SetupIni.AggiornaParametro("FontDimensioneMiniatura", TextBox25.Text) SetupIni.AggiornaParametro("FontBold", CheckBox3.Checked) SetupIni.AggiornaParametro("FontNome", ComboBox3.Text) SetupIni.AggiornaParametro("TestoTesto", TextBox4.Text) SetupIni.AggiornaParametro("TestoTrasparente", TextBox9.Text) SetupIni.AggiornaParametro("TestoMargine", TextBox12.Text) SetupIni.AggiornaParametro("TestoPosizione", ComboBox1.Text) SetupIni.AggiornaParametro("TestoAllineamento", ComboBox2.Text) SetupIni.AggiornaParametro("MarchioFile", TextBox10.Text) SetupIni.AggiornaParametro("MarchioAltezza", TextBox14.Text) SetupIni.AggiornaParametro("MarchioLarghezza", TextBox15.Text) SetupIni.AggiornaParametro("MarchioMargine", TextBox16.Text) SetupIni.AggiornaParametro("MarchioAllOrizzontale", ComboBox4.Text) SetupIni.AggiornaParametro("MarchioAllVerticale", ComboBox5.Text) SetupIni.AggiornaParametro("MarchioTrasparenza", TextBox19.Text) SetupIni.AggiornaParametro("MarchioAggiungi", CheckBox5.Checked) SetupIni.AggiornaParametro("TempoGara", CheckBox7.Checked) SetupIni.AggiornaParametro("Orario", CheckBox8.Checked) SetupIni.AggiornaParametro("EtichettaOrario", TextBox18.Text) SetupIni.AggiornaParametro("GeneraleForzaJpg", chkForzaJpg.Checked) SetupIni.AggiornaParametro("GeneraleRotazioneAutomatica", chkRotazioneAutomatica.Checked) SetupIni.AggiornaParametro("GrandezzaVerticale", TextBox30.Text) SetupIni.AggiornaParametro("MargineVerticale", TextBox31.Text) SetupIni.AggiornaParametro("DimensioniOriginali", CheckBox15.Checked) SetupIni.AggiornaParametro("TestoVerticale", TextBox29.Text) SetupIni.AggiornaParametro("NomeMiniatura", RadioButton6.Checked) SetupIni.AggiornaParametro("DataFoto", CheckBox16.Checked) SetupIni.AggiornaParametro("NumeroFoto", CheckBox17.Checked) SetupIni.AggiornaParametro("ColoreTestoRGB", TextBox34.Text) SetupIni.AggiornaParametro("TempoSmall", RadioButton5.Checked) SetupIni.AggiornaParametro("NumTempoSmall", RadioButton7.Checked) SetupIni.AggiornaParametro("CompressioneJpeg", TextBox32.Text) SetupIni.AggiornaParametro("CompressioneJpegMiniatura", TextBox33.Text) SetupIni.SalvaParametriSetup() Me.Text = "Image Catalog - " & LeggiSoloNomeFile(IlNome) End If End Sub Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click Dim openFileDialog As OpenFileDialog = New OpenFileDialog 'openFileDialog.InitialDirectory = TextBox1.Text openFileDialog.Filter = "Setup (*.xml)|*.xml|All valid files (*.*)|*.*" openFileDialog.FilterIndex = 0 openFileDialog.RestoreDirectory = True If DialogResult.OK = openFileDialog.ShowDialog() Then Dim IlNome As String = openFileDialog.FileName SetupIni.NomeFileSetup = IlNome SetupIni.CaricaParametriSetup() txtSorgente.Text = SetupIni.LeggiParametroString("DirSorgente") txtDestinazione.Text = SetupIni.LeggiParametroString("DirDestinazione") chkAggiornaSottodirectory.Checked = SetupIni.LeggiParametroBoolean("DirSottoDirectory") chkCreaSottocartelle.Checked = SetupIni.LeggiParametroBoolean("DirDividiDestinazione") txtFilePerCartella.Text = SetupIni.LeggiParametroString("DirDividiNumFile") txtSuffissoCartelle.Text = SetupIni.LeggiParametroString("DirDividiSuffisso") txtCifreContatore.Text = SetupIni.LeggiParametroString("DirDividiNumCifre") Dim TestoTemp As String = SetupIni.LeggiParametroString("DirDividiTipoNumerazione") If TestoTemp.ToUpper = "PROGRESSIVA" Then rdbNumProgressiva.Checked = True Else rdbNumFiles.Checked = True End If CheckBox1.Checked = SetupIni.LeggiParametroBoolean("MiniatureCrea") TextBox3.Text = SetupIni.LeggiParametroString("MiniatureSuffisso") TextBox5.Text = SetupIni.LeggiParametroString("MiniatureAltezza") TextBox6.Text = SetupIni.LeggiParametroString("MiniatureLarghezza") RadioButton3.Checked = SetupIni.LeggiParametroBoolean("MiniatureAddScritta") RadioButton4.Checked = SetupIni.LeggiParametroBoolean("MiniatureAddOrario") TextBox27.Text = SetupIni.LeggiParametroString("FotoAltezza") TextBox28.Text = SetupIni.LeggiParametroString("FotoLarghezza") 'TextBox13.Text = SetupIni.LeggiParametroString("FotoCodice") 'CheckBox2.Checked = SetupIni.LeggiParametroBoolean("FotoDimOriginali") TextBox11.Text = SetupIni.LeggiParametroString("FontDimensione") TextBox25.Text = SetupIni.LeggiParametroString("FontDimensioneMiniatura") CheckBox3.Checked = SetupIni.LeggiParametroBoolean("FontBold") ComboBox3.Text = SetupIni.LeggiParametroString("FontNome") If TextBox25.Text = "" Then TextBox25.Text = "0" End If TextBox4.Text = SetupIni.LeggiParametroString("TestoTesto") TextBox9.Text = SetupIni.LeggiParametroString("TestoTrasparente") TextBox12.Text = SetupIni.LeggiParametroString("TestoMargine") ComboBox1.Text = SetupIni.LeggiParametroString("TestoPosizione") ComboBox2.Text = SetupIni.LeggiParametroString("TestoAllineamento") TextBox10.Text = SetupIni.LeggiParametroString("MarchioFile") TextBox14.Text = SetupIni.LeggiParametroString("MarchioAltezza") TextBox15.Text = SetupIni.LeggiParametroString("MarchioLarghezza") TextBox16.Text = SetupIni.LeggiParametroString("MarchioMargine") ComboBox4.Text = SetupIni.LeggiParametroString("MarchioAllOrizzontale") ComboBox5.Text = SetupIni.LeggiParametroString("MarchioAllVerticale") TextBox19.Text = SetupIni.LeggiParametroString("MarchioTrasparenza") CheckBox5.Checked = SetupIni.LeggiParametroBoolean("MarchioAggiungi") CheckBox7.Checked = SetupIni.LeggiParametroBoolean("TempoGara") CheckBox8.Checked = SetupIni.LeggiParametroBoolean("Orario") TextBox18.Text = SetupIni.LeggiParametroString("EtichettaOrario") chkForzaJpg.Checked = SetupIni.LeggiParametroBoolean("GeneraleForzaJpg") chkRotazioneAutomatica.Checked = SetupIni.LeggiParametroBoolean("GeneraleRotazioneAutomatica") TextBox30.Text = SetupIni.LeggiParametroString("GrandezzaVerticale") TextBox31.Text = SetupIni.LeggiParametroString("MargineVerticale") CheckBox15.Checked = SetupIni.LeggiParametroBoolean("DimensioniOriginali") TextBox29.Text = SetupIni.LeggiParametroString("TestoVerticale") RadioButton6.Checked = SetupIni.LeggiParametroBoolean("NomeMiniatura") CheckBox16.Checked = SetupIni.LeggiParametroBoolean("DataFoto") CheckBox17.Checked = SetupIni.LeggiParametroBoolean("NumeroFoto") RadioButton5.Checked = SetupIni.LeggiParametroBoolean("TempoSmall") RadioButton7.Checked = SetupIni.LeggiParametroBoolean("NumTempoSmall") TextBox32.Text = SetupIni.LeggiParametroString("CompressioneJpeg") TextBox33.Text = SetupIni.LeggiParametroString("CompressioneJpegMiniatura") TextBox34.Text = SetupIni.LeggiParametroString("ColoreTestoRGB") If File.Exists(TextBox10.Text) Then PictureBox1.Image = Image.FromFile(TextBox10.Text) If PictureBox1.Image.Height >= PictureBox1.Image.Width Then PictureBox1.Height = 160 PictureBox1.Width = CType(160 * PictureBox1.Image.Width / PictureBox1.Image.Height, Integer) Else PictureBox1.Width = 224 PictureBox1.Height = CType(224 * PictureBox1.Image.Height / PictureBox1.Image.Width, Integer) End If End If Me.Text = "Image Catalog - " & LeggiSoloNomeFile(IlNome) End If End Sub Private Sub setPicSettings(ByVal SourcePath As String, ByVal DestPath As String) Dim SourceDir As DirectoryInfo = New DirectoryInfo(SourcePath) Dim DestDirStart As DirectoryInfo = New DirectoryInfo(DestPath) Dim DestDir As DirectoryInfo = Nothing PicSettings.DirectorySorgente = txtSorgente.Text PicSettings.DirectoryDestinazione = txtDestinazione.Text 'PicSettings.DestDir = DestDir 'PicSettings.SourceDir = SourceDir 'PicSettings.DestDirStart = DestDirStart PicSettings.DimStandard = CType(TextBox11.Text, Integer) PicSettings.DimStandardMiniatura = CType(TextBox25.Text, Integer) PicSettings.UsaOrarioMiniatura = CheckBox12.Checked PicSettings.UsaOrarioTestoApplicare = CheckBox8.Checked PicSettings.UsaTempoGaraTestoApplicare = CheckBox7.Checked PicSettings.UsaRotazioneAutomatica = chkRotazioneAutomatica.Checked PicSettings.UsaForzaJpg = chkForzaJpg.Checked If CheckBox17.Checked Then PicSettings.TestoNome = True Else PicSettings.TestoNome = False End If If CheckBox16.Checked Then PicSettings.NomeData = True Else PicSettings.NomeData = False End If PicSettings.TestoFirmaStart = TextBox4.Text PicSettings.TestoFirmaStartV = TextBox29.Text PicSettings.DataPartenza = DateTimePicker1.Value PicSettings.TestoOrario = TextBox18.Text PicSettings.AltezzaSmall = CType(TextBox6.Text, Integer) PicSettings.LarghezzaSmall = CType(TextBox5.Text, Integer) PicSettings.CreaMiniature = CheckBox1.Checked PicSettings.AggiungiScritteMiniature = RadioButton3.Checked PicSettings.AggTempoGaraMin = RadioButton5.Checked PicSettings.AggNumTempMin = RadioButton7.Checked PicSettings.DimVert = CType(TextBox30.Text, Integer) PicSettings.MargVert = CType(TextBox31.Text, Integer) 'PicSettings.NomeFileChild = childFile.Name PicSettings.Suffisso = TextBox3.Text 'PicSettings.Codice = TextBox13.Text PicSettings.Trasparenza = CType(TextBox9.Text, Integer) PicSettings.IlFont = ComboBox3.SelectedItem.ToString PicSettings.Grassetto = CheckBox3.Checked PicSettings.Posizione = ComboBox1.SelectedItem.ToString PicSettings.Allineamento = ComboBox2.SelectedItem.ToString PicSettings.Margine = CType(TextBox12.Text, Integer) PicSettings.LogoAltezza = CType(TextBox14.Text, Integer) PicSettings.LogoLarghezza = CType(TextBox15.Text, Integer) PicSettings.fontColoreRGB = ColorTranslator.FromHtml(TextBox34.Text) PicSettings.LogoAggiungi = CheckBox5.Checked PicSettings.LogoNomeFile = TextBox10.Text PicSettings.LogoTrasparenza = TextBox19.Text PicSettings.LogoMargine = TextBox16.Text PicSettings.LogoPosizioneH = ComboBox4.Text PicSettings.LogoPosizioneV = ComboBox5.Text PicSettings.FotoGrandeDimOrigina = CheckBox15.Checked PicSettings.AltezzaBig = CType(TextBox27.Text, Integer) PicSettings.LarghezzaBig = CType(TextBox28.Text, Integer) PicSettings.DimMin = CType(TextBox25.Text, Integer) PicSettings.TestoMin = RadioButton6.Checked PicSettings.jpegQuality = CLng(TextBox32.Text) PicSettings.jpegQualityMin = CLng(TextBox33.Text) PicSettings.mainForm = Me End Sub Private Function makeFilesList(ByVal SourcePath As String) As List(Of List(Of FileInfo)) Dim SourceDir As DirectoryInfo = New DirectoryInfo(SourcePath) Dim DestDir As DirectoryInfo = Nothing Dim NumFileXDir As Integer = CType(txtFilePerCartella.Text, Integer) Dim SuffixDir As String = txtSuffissoCartelle.Text Dim NumCifreDir As Integer = CType(txtCifreContatore.Text, Integer) Dim DividiFile As Boolean = False StopAttivo = False Dim FileConta As Integer = 0 Dim ContaFileXDir As Integer = 0 Dim ContaDirXDir As Integer = 0 Dim TestoTemp As String = "" Dim ContaTemp As Integer = 0 Dim picList As New List(Of FileInfo) Dim dirList As New List(Of List(Of FileInfo)) 'controlla directory principale 'Dim childFile As FileInfo 'For Each childFile In SourceDir.GetFiles("*.jpg") ' picList.Add(childFile) 'Next 'picList = getFiles(SourceDir, SearchOption.AllDirectories) 'dirList.Add(picList) 'controlla sottodirectory If chkAggiornaSottodirectory.Checked = True Then Dim subDir As DirectoryInfo For Each subDir In SourceDir.GetDirectories() Dim filesList As New List(Of FileInfo) filesList = getFiles(subDir) dirList.Add(filesList) Next End If Return dirList End Function Private Function getFiles(sourceDir As DirectoryInfo) As List(Of FileInfo) Dim picList As New List(Of FileInfo) Dim childFile As FileInfo For Each childFile In sourceDir.GetFiles("*.jpg") picList.Add(childFile) Next Return picList End Function Private Function getDirsDict(SourcePath As String, DestPath As String) As Dictionary(Of FileInfo, DirectoryInfo) Dim SourceDir As DirectoryInfo = New DirectoryInfo(SourcePath) Dim DestDirStart As DirectoryInfo = New DirectoryInfo(DestPath) Dim DestDir As DirectoryInfo = Nothing Dim NumFileXDir As Integer = CType(txtFilePerCartella.Text, Integer) Dim SuffixDir As String = txtSuffissoCartelle.Text Dim NumCifreDir As Integer = CType(txtCifreContatore.Text, Integer) Dim DividiFile As Boolean = False StopAttivo = False Dim FileConta As Integer = 0 Dim ContaFileXDir As Integer = 0 Dim ContaDirXDir As Integer = 0 'Dim TestoTemp As String = "" 'Dim ContaTemp As Integer = 0 Dim dirSourceDest As Dictionary(Of FileInfo, DirectoryInfo) = New Dictionary(Of FileInfo, DirectoryInfo) If SourceDir.Exists Then If chkAggiornaSottodirectory.Checked Then FileConta = SourceDir.GetFiles("*.jpg", SearchOption.AllDirectories).GetLength(0) Else FileConta = SourceDir.GetFiles("*.jpg", SearchOption.TopDirectoryOnly).GetLength(0) End If Dim a As String = (CType(lblFotoTotaliNum.Text, Integer) + FileConta).ToString setLabel17Text(a) setProgressBarMaximum(CInt(a)) If chkAggiornaSottodirectory.Checked Then For Each directory As DirectoryInfo In SourceDir.GetDirectories For Each file As FileInfo In directory.GetFiles(".jpg") Next Next End If For Each file As FileInfo In SourceDir.GetFiles("*.jpg", SearchOption.AllDirectories) Next If NumFileXDir > 0 And chkCreaSottocartelle.Checked = True And FileConta > NumFileXDir Then DividiFile = True Else DestDir = DestDirStart If Not DestDir.Exists Then DestDir.Create() End If DividiFile = False End If Dim filesList As New List(Of FileInfo) If chkAggiornaSottodirectory.Checked Then filesList.AddRange(SourceDir.GetFiles("*.jpg", SearchOption.AllDirectories)) filesList.AddRange(SourceDir.GetFiles("*.png", SearchOption.AllDirectories)) Else filesList.AddRange(SourceDir.GetFiles("*.jpg", SearchOption.TopDirectoryOnly)) filesList.AddRange(SourceDir.GetFiles("*.png", SearchOption.TopDirectoryOnly)) End If For Each file As FileInfo In filesList ContaFileXDir += 1 If DividiFile = True Then If ContaFileXDir = (ContaDirXDir * NumFileXDir) + 1 Then ContaDirXDir += 1 Dim TestoTemp As String If rdbNumProgressiva.Checked = True Then TestoTemp = ContaDirXDir.ToString Else TestoTemp = (ContaDirXDir * NumFileXDir).ToString End If For ContaTemp As Integer = 1 To (NumCifreDir - TestoTemp.Length) TestoTemp = "0" & TestoTemp Next DestDir = New DirectoryInfo(Path.Combine(DestDirStart.FullName, SuffixDir, TestoTemp)) 'DestDir = New DirectoryInfo(DestDirStart.FullName & IIf(Not DestDirStart.FullName.EndsWith("\"), "\", String.Empty).ToString & SuffixDir & TestoTemp) dirSourceDest.Add(file, DestDir) If Not DestDir.Exists Then DestDir.Create() End If End If End If Next End If Return dirSourceDest End Function Private Sub setLabel17Text(ByVal text As String) If lblFotoTotaliNum.InvokeRequired Then lblFotoTotaliNum.Invoke(New Action(Of String)(AddressOf setLabel17Text), text) Else lblFotoTotaliNum.Text = text End If End Sub Private Sub setLabel10Text(ByVal text As String) If Label10.InvokeRequired Then Label10.Invoke(New Action(Of String)(AddressOf setLabel10Text), text) Else Label10.Text = text End If End Sub Public Sub stepProgressBar() If ProgressBar1.InvokeRequired Then ProgressBar1.Invoke(New MethodInvoker(AddressOf ProgressBar1.PerformStep)) Else ProgressBar1.PerformStep() End If setLabel18Text(ProgressBar1.Value.ToString) End Sub Private Sub setProgressBarMaximum(ByVal value As Integer) If ProgressBar1.InvokeRequired Then ProgressBar1.Invoke(New Action(Of Integer)(AddressOf setProgressBarMaximum), value) Else ProgressBar1.Maximum = value End If End Sub Private Sub setProgressBarValue(ByVal value As Integer) If ProgressBar1.InvokeRequired Then ProgressBar1.Invoke(New Action(Of Integer)(AddressOf setProgressBarValue), value) Else ProgressBar1.Value = value End If End Sub Private Sub setLabel18Text(ByVal text As String) If Label18.InvokeRequired Then Label18.Invoke(New Action(Of String)(AddressOf setLabel18Text), text) Else Label18.Text = text End If End Sub Private Sub setLabel43Text(ByVal text As String) If Label43.InvokeRequired Then Label43.Invoke(New Action(Of String)(AddressOf setLabel43Text), text) Else Label43.Text = text End If End Sub Private Sub creaImmaginiWithThreadMod(ByVal SourcePath As String, ByVal DestPath As String) Dim SourceDir As DirectoryInfo = New DirectoryInfo(SourcePath) Dim DestDirStart As DirectoryInfo = New DirectoryInfo(DestPath) Dim DestDir As DirectoryInfo = Nothing Dim NumFileXDir As Integer = CType(txtFilePerCartella.Text, Integer) Dim SuffixDir As String = txtSuffissoCartelle.Text Dim NumCifreDir As Integer = CType(txtCifreContatore.Text, Integer) Dim DividiFile As Boolean = False StopAttivo = False Dim FileConta As Integer = 0 Dim ContaFileXDir As Integer = 0 Dim ContaDirXDir As Integer = 0 Dim TestoTemp As String = "" Dim ContaTemp As Integer = 0 If SourceDir.Exists Then FileConta = SourceDir.GetFiles("*.jpg").GetLength(0) 'Label17.Text = (CType(Label17.Text, Integer) + FileConta).ToString Dim a As String = (CType(lblFotoTotaliNum.Text, Integer) + FileConta).ToString setLabel17Text(a) setProgressBarMaximum(CInt(a)) If NumFileXDir > 0 And chkCreaSottocartelle.Checked = True Then If FileConta > NumFileXDir Then DividiFile = True Else DestDir = DestDirStart If Not DestDir.Exists Then DestDir.Create() End If DividiFile = False End If Else DestDir = DestDirStart If Not DestDir.Exists Then DestDir.Create() End If DividiFile = False End If Dim childFile As FileInfo For Each childFile In SourceDir.GetFiles("*.jpg") If StopAttivo = True Then Exit For End If setLabel10Text("File: " & childFile.Name) Dim b As String = (CType(Label18.Text, Integer) + 1).ToString 'setLabel18Text(b) 'setProgressBarValue(CInt(b)) 'Label10.Text = "File: " & childFile.Name 'Label18.Text = (CType(Label18.Text, Integer) + 1).ToString 'Application.DoEvents() ContaFileXDir += 1 If DividiFile = True Then If ContaFileXDir = (ContaDirXDir * NumFileXDir) + 1 Then ContaDirXDir += 1 If rdbNumProgressiva.Checked = True Then TestoTemp = ContaDirXDir.ToString Else TestoTemp = (ContaDirXDir * NumFileXDir).ToString End If For ContaTemp = 1 To (NumCifreDir - TestoTemp.Length) TestoTemp = "0" & TestoTemp Next If DestDirStart.FullName.EndsWith("\") Then DestDir = New DirectoryInfo(DestDirStart.FullName & SuffixDir & TestoTemp) Else DestDir = New DirectoryInfo(DestDirStart.FullName & "\" & SuffixDir & TestoTemp) End If If Not DestDir.Exists Then DestDir.Create() End If End If End If 'Application.DoEvents() Dim ClsCreaImmagine As New ImageCreatorSharp(childFile.Name, SourceDir, DestDir, DestDirStart) ' ClsCreaImmagine.NomeFileChild = childFile.Name ' ClsCreaImmagine.DestDir = DestDir ' ClsCreaImmagine.SourceDir = SourceDir ' ClsCreaImmagine.DestDirStart = DestDirStart ContaImmaginiThread += 1 MyPool.InsertWorkItem(childFile.Name, New XyThreadAdd(AddressOf ClsCreaImmagine.CreaImmagineThread), New Object(0) {childFile.Name}, True) Next ' copy all the sub-directories by recursively calling this same routine If chkAggiornaSottodirectory.Checked = True Then Dim subDir As DirectoryInfo For Each subDir In SourceDir.GetDirectories() creaImmaginiWithThreadMod(subDir.FullName, Path.Combine(DestDir.FullName, subDir.Name)) Next End If End If End Sub Private Function getNumerazione() As Integer Dim numerazione As Integer If rdbNumProgressiva.Checked Then numerazione = FileHelper.numerazione.Progressiva Else numerazione = FileHelper.numerazione.Files End If Return numerazione End Function Private Function GetNumerazioneEnum() As NumerazioneType Dim numerazioneType As NumerazioneType If rdbNumProgressiva.Checked Then numerazioneType = NumerazioneType.Progressiva ' FileHelper.numerazione.Progressiva Else numerazioneType = NumerazioneType.Files ' FileHelper.numerazione.Files End If Return numerazioneType End Function Private Sub creaimmaginiWithThreadDict(ByVal SourcePath As String, ByVal DestPath As String) Dim dirSourceDest As Dictionary(Of FileInfo, DirectoryInfo) = New Dictionary(Of FileInfo, DirectoryInfo) If chkAggiornaSottodirectory.Checked And chkCreaSottocartelle.Checked Then Dim helper As New FileHelper(CInt(txtFilePerCartella.Text), txtSuffissoCartelle.Text, CInt(txtCifreContatore.Text), getNumerazione()) 'getfilesrecursive dirSourceDest = helper.GetFilesRecursive(New DirectoryInfo(SourcePath), New DirectoryInfo(DestPath), "*.jpg") ElseIf chkAggiornaSottodirectory.Checked And Not chkCreaSottocartelle.Checked Then End If '= getDirsDict(SourcePath, DestPath) Dim pair As KeyValuePair(Of FileInfo, DirectoryInfo) For Each pair In dirSourceDest setLabel10Text("File: " & pair.Key.Name) Dim b As String = (CType(Label18.Text, Integer) + 1).ToString Dim ClsCreaImmagine As New ImageCreatorSharp(pair.Key, pair.Value) ContaImmaginiThread += 1 MyPool.InsertWorkItem(pair.Key.Name, New XyThreadAdd(AddressOf ClsCreaImmagine.CreaImmagineThread), New Object(0) {pair.Key.Name}, True) Next End Sub 'il posto giusto dove fare modifiche Private Sub CreaImmaginiWithThread(ByVal SourcePath As String, ByVal DestPath As String) Dim SourceDir As DirectoryInfo = New DirectoryInfo(SourcePath) Dim DestDirStart As DirectoryInfo = New DirectoryInfo(DestPath) Dim DestDir As DirectoryInfo = Nothing Dim NumFileXDir As Integer = CType(txtFilePerCartella.Text, Integer) Dim SuffixDir As String = txtSuffissoCartelle.Text Dim NumCifreDir As Integer = CType(txtCifreContatore.Text, Integer) Dim DividiFile As Boolean = False StopAttivo = False Dim FileConta As Integer = 0 Dim ContaFileXDir As Integer = 0 Dim ContaDirXDir As Integer = 0 Dim TestoTemp As String = "" Dim ContaTemp As Integer = 0 If SourceDir.Exists Then FileConta = SourceDir.GetFiles("*.jpg").GetLength(0) lblFotoTotaliNum.Text = (CType(lblFotoTotaliNum.Text, Integer) + FileConta).ToString If NumFileXDir > 0 And chkCreaSottocartelle.Checked = True Then If FileConta > NumFileXDir Then DividiFile = True Else DestDir = DestDirStart If Not DestDir.Exists Then DestDir.Create() End If DividiFile = False End If Else DestDir = DestDirStart If Not DestDir.Exists Then DestDir.Create() End If DividiFile = False End If Dim childFile As FileInfo For Each childFile In SourceDir.GetFiles("*.jpg") If StopAttivo = True Then Exit For End If 'Label10.Text = "File: " & childFile.Name 'Label18.Text = (CType(Label18.Text, Integer) + 1).ToString 'Application.DoEvents() ContaFileXDir += 1 If DividiFile = True Then If ContaFileXDir = (ContaDirXDir * NumFileXDir) + 1 Then ContaDirXDir += 1 If rdbNumProgressiva.Checked = True Then TestoTemp = ContaDirXDir.ToString Else TestoTemp = (ContaDirXDir * NumFileXDir).ToString End If For ContaTemp = 1 To (NumCifreDir - TestoTemp.Length) TestoTemp = "0" & TestoTemp Next If DestDirStart.FullName.EndsWith("\") Then DestDir = New DirectoryInfo(DestDirStart.FullName & SuffixDir & TestoTemp) Else DestDir = New DirectoryInfo(DestDirStart.FullName & "\" & SuffixDir & TestoTemp) End If If Not DestDir.Exists Then DestDir.Create() End If End If End If Application.DoEvents() Dim ClsCreaImmagine As New CreaImmagineSeparateThread ClsCreaImmagine.DirectorySorgente = txtSorgente.Text ClsCreaImmagine.DirectoryDestinazione = txtDestinazione.Text ClsCreaImmagine.DestDir = DestDir ClsCreaImmagine.SourceDir = SourceDir ClsCreaImmagine.DestDirStart = DestDirStart ClsCreaImmagine.DimStandard = CType(TextBox11.Text, Integer) ClsCreaImmagine.DimStandardMiniatura = CType(TextBox25.Text, Integer) ClsCreaImmagine.UsaOrarioMiniatura = CheckBox12.Checked ClsCreaImmagine.UsaOrarioTestoApplicare = CheckBox8.Checked ClsCreaImmagine.UsaTempoGaraTestoApplicare = CheckBox7.Checked ClsCreaImmagine.UsaRotazioneAutomatica = chkRotazioneAutomatica.Checked ClsCreaImmagine.UsaForzaJpg = chkForzaJpg.Checked If CheckBox17.Checked Then ClsCreaImmagine.TestoNome = True Else ClsCreaImmagine.TestoNome = False End If If CheckBox16.Checked Then ClsCreaImmagine.NomeData = True Else ClsCreaImmagine.NomeData = False End If ClsCreaImmagine.TestoFirmaStart = TextBox4.Text ClsCreaImmagine.TestoFirmaStartV = TextBox29.Text ClsCreaImmagine.DataPartenza = DateTimePicker1.Value ClsCreaImmagine.TestoOrario = TextBox18.Text ClsCreaImmagine.AltezzaSmall = CType(TextBox5.Text, Integer) ClsCreaImmagine.LarghezzaSmall = CType(TextBox5.Text, Integer) ClsCreaImmagine.CreaMiniature = CheckBox1.Checked ClsCreaImmagine.AggiungiScritteMiniature = RadioButton3.Checked ClsCreaImmagine.AggTempoGaraMin = RadioButton5.Checked ClsCreaImmagine.AggNumTempMin = RadioButton7.Checked ClsCreaImmagine.DimVert = CType(TextBox30.Text, Integer) ClsCreaImmagine.MargVert = CType(TextBox31.Text, Integer) ClsCreaImmagine.NomeFileChild = childFile.Name ClsCreaImmagine.Suffisso = TextBox3.Text 'ClsCreaImmagine.Codice = TextBox13.Text ClsCreaImmagine.Trasparenza = CType(TextBox9.Text, Integer) ClsCreaImmagine.IlFont = ComboBox3.SelectedItem.ToString ClsCreaImmagine.Grassetto = CheckBox3.Checked ClsCreaImmagine.Posizione = ComboBox1.SelectedItem.ToString ClsCreaImmagine.Allineamento = ComboBox2.SelectedItem.ToString ClsCreaImmagine.Margine = CType(TextBox12.Text, Integer) ClsCreaImmagine.LogoAltezza = CType(TextBox14.Text, Integer) ClsCreaImmagine.LogoLarghezza = CType(TextBox15.Text, Integer) 'ClsCreaImmagine.FontColoreR = CType(TextBox22.Text, Integer) 'ClsCreaImmagine.FontColoreG = CType(TextBox23.Text, Integer) 'ClsCreaImmagine.FontColoreB = CType(TextBox24.Text, Integer) ClsCreaImmagine.fontColoreRGB = ColorTranslator.FromHtml(TextBox34.Text) ClsCreaImmagine.LogoAggiungi = CheckBox5.Checked ClsCreaImmagine.LogoNomeFile = TextBox10.Text ClsCreaImmagine.LogoTrasparenza = TextBox19.Text ClsCreaImmagine.LogoMargine = TextBox16.Text ClsCreaImmagine.LogoPosizioneH = ComboBox4.Text ClsCreaImmagine.LogoPosizioneV = ComboBox5.Text ClsCreaImmagine.FotoGrandeDimOrigina = CheckBox15.Checked ClsCreaImmagine.AltezzaBig = CType(TextBox27.Text, Integer) ClsCreaImmagine.LarghezzaBig = CType(TextBox28.Text, Integer) ClsCreaImmagine.DimMin = CType(TextBox25.Text, Integer) ClsCreaImmagine.TestoMin = RadioButton6.Checked ClsCreaImmagine.jpegQuality = CLng(TextBox32.Text) ClsCreaImmagine.jpegQualityMin = CLng(TextBox33.Text) ContaImmaginiThread += 1 MyPool.InsertWorkItem(childFile.Name, New XyThreadAdd(AddressOf ClsCreaImmagine.CreaImmagineThread), New Object(0) {childFile.Name}, True) Next ' copy all the sub-directories by recursively calling this same routine If chkAggiornaSottodirectory.Checked = True Then Dim subDir As DirectoryInfo For Each subDir In SourceDir.GetDirectories() CreaImmaginiWithThread(subDir.FullName, Path.Combine(DestDir.FullName, subDir.Name)) Next End If End If End Sub Private Sub CopyDirectoryFile(ByVal SourcePath As String, ByVal DestPath As String, Optional ByVal OverWrite As Boolean = False) Dim SourceDir As DirectoryInfo = New DirectoryInfo(SourcePath) Dim DestDir As DirectoryInfo = New DirectoryInfo(DestPath) If SourceDir.Exists Then If Not DestDir.Exists Then DestDir.Create() End If ' copy all the files of the current directory Dim childFile As FileInfo For Each childFile In SourceDir.GetFiles() If OverWrite Then childFile.CopyTo(Path.Combine(DestDir.FullName, childFile.Name), True) Else ' if overwrite = false, copy the file only if it does not exist ' this is done to avoid an IOException if a file already exists ' this way the other files can be copied anyway... If Not File.Exists(Path.Combine(DestDir.FullName, childFile.Name)) Then childFile.CopyTo(Path.Combine(DestDir.FullName, childFile.Name), False) End If End If Next ' copy all the sub-directories by recursively calling this same routine Dim subDir As DirectoryInfo For Each subDir In SourceDir.GetDirectories() CopyDirectoryFile(subDir.FullName, Path.Combine(DestDir.FullName, subDir.Name), OverWrite) Next End If End Sub Function NewthumbSize(ByVal currentwidth As Integer, ByVal currentheight As Integer, ByVal MaxPixel As Integer, ByVal TipoSize As String) As Size ' Calculate the Size of the New image '*** Larghezza, Altezza, Auto Dim tempMultiplier As Double If TipoSize.ToUpper = "Larghezza".ToUpper Then tempMultiplier = MaxPixel / currentwidth ElseIf TipoSize.ToUpper = "Altezza".ToUpper Then tempMultiplier = MaxPixel / currentheight Else If currentheight > currentwidth Then ' portrait tempMultiplier = MaxPixel / currentheight Else tempMultiplier = MaxPixel / currentwidth End If End If Dim NewSize As New Size(CInt(currentwidth * tempMultiplier), CInt(currentheight * tempMultiplier)) Return NewSize End Function Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click StopAttivo = True MyPool.StopThreadPool() unlockUI() End Sub Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click Dim openFileDialog As OpenFileDialog = New OpenFileDialog 'openFileDialog.InitialDirectory = TextBox1.Text openFileDialog.Filter = "Immagini jpg (*.jpg)|*.jpg|Immagini gif (*.gif)|*.gif|Tutti i file (*.*)|*.*" If TextBox10.Text.Length > 0 Then openFileDialog.FileName = TextBox10.Text End If openFileDialog.FilterIndex = 0 openFileDialog.RestoreDirectory = True If DialogResult.OK = openFileDialog.ShowDialog() Then TextBox10.Text = openFileDialog.FileName PictureBox1.Image = Image.FromFile(TextBox10.Text) If PictureBox1.Image.Height >= PictureBox1.Image.Width Then PictureBox1.Height = 160 PictureBox1.Width = CType(160 * PictureBox1.Image.Width / PictureBox1.Image.Height, Integer) Else PictureBox1.Width = 224 PictureBox1.Height = CType(224 * PictureBox1.Image.Height / PictureBox1.Image.Width, Integer) End If End If End Sub Private Function LeggiSoloNomeFile(ByVal FileName As String) As String Dim Testo As String = FileName Dim Risposta As String = "" Dim Nomi() As String = Testo.Split(New Char() {"\"c}) If Nomi.Length > 1 Then Risposta = Nomi(Nomi.Length - 1) End If Return Risposta End Function Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove 'GetColor() 'GetPixelColor(PictureBox1.PointToScreen(e.Location)).ToArgb.ToString("X8") End Sub Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp If e.Button = MouseButtons.Left Then WaterSelectColor = True Else WaterSelectColor = False End If End Sub 'Private Declare Function CreateDC Lib "gdi32.dll" (ByVal strDriver As String, ByVal strDevice As String, ByVal strOutput As String, ByVal pData As IntPtr) As IntPtr 'Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As IntPtr) As Boolean 'Private Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As IntPtr, ByVal x As Integer, ByVal y As Integer) As Integer 'Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As Point) As Boolean '''' '''' Get the color relative to mouse position '''' 'Private Sub GetColor() ' Dim hdcScreen As IntPtr = CreateDC("Display", Nothing, Nothing, IntPtr.Zero) ' Dim pt As Point = New Point ' GetCursorPos(pt) ' Dim cr As Integer = GetPixel(hdcScreen, pt.X, pt.Y) ' DeleteDC(hdcScreen) ' Dim clr As Color = Color.FromArgb((cr And &HFF), (cr And &HFF00) >> 8, (cr And &HFF0000) >> 16) ' PictureBox3.BackColor = clr ' If WaterSelectColor = True Then ' PictureBox2.BackColor = clr ' End If ' WaterSelectColor = False 'End Sub Private Function GetPixelColor(ByVal screenLocation As Point) As Color() 'Dim bm As New Bitmap(1, 1, Imaging.PixelFormat.Format24bppRgb) 'Dim g As Graphics = Graphics.FromImage(bm) 'g.CopyFromScreen(screenLocation, New Point(0, 0), New Size(1, 1)) 'Dim result As Color = bm.GetPixel(0, 0) 'g.Dispose() 'bm.Dispose() 'Return result Return Nothing End Function Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click Dim MyDialog As New ColorDialog MyDialog.AllowFullOpen = True 'If TextBox22.Text.Length > 0 And TextBox23.Text.Length > 0 And TextBox24.Text.Length > 0 Then ' If CType(TextBox22.Text, Integer) >= 0 And CType(TextBox23.Text, Integer) >= 0 And CType(TextBox24.Text, Integer) >= 0 Then ' MyDialog.Color = Color.FromArgb(0, CType(TextBox22.Text, Integer), CType(TextBox23.Text, Integer), CType(TextBox24.Text, Integer)) ' End If 'End If If (MyDialog.ShowDialog() = Windows.Forms.DialogResult.OK) Then 'TextBox22.Text = MyDialog.Color.R.ToString 'TextBox23.Text = MyDialog.Color.G.ToString 'TextBox24.Text = MyDialog.Color.B.ToString TextBox34.Text = ColorTranslator.ToHtml(MyDialog.Color) TextBox34.BackColor = MyDialog.Color End If End Sub Private Sub TextBox27_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) End Sub Private Sub CheckBox18_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox18.CheckedChanged CheckBox4.Checked = False CheckBox12.Checked = False End Sub Private Sub CheckBox4_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox4.CheckedChanged CheckBox18.Checked = False End Sub Private Sub CheckBox12_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CheckBox12.CheckedChanged CheckBox18.Checked = False End Sub Private Sub Label27_Click(sender As Object, e As EventArgs) Handles Label27.Click End Sub Private Async Sub Button1_Click(sender As Object, e As EventArgs) Handles btnCreaCatalogoAsync.Click lockUI() 'Dim timeStart As Date 'Dim timeStop As Date 'timeStart = TimeOfDay FixPaths() Label10.Text = "Elaborazione in corso..." lblFotoTotaliNum.Text = "0" Label18.Text = "0" Label43.Text = "-s" setPicSettings(txtSorgente.Text, txtDestinazione.Text) ProgressBar1.Minimum = 0 ProgressBar1.Step = 1 ProgressBar1.Value = 0 'Await CreaCatalogoParallel() Dim imgStf As ImageCreationStuff = New ImageCreationStuff() Dim imageCreationOptions As ImageCreationStuff.Options = New ImageCreationStuff.Options() With imageCreationOptions .AggiornaSottodirectory = chkAggiornaSottodirectory.Checked .CreaSottocartelle = chkCreaSottocartelle.Checked .FilePerCartella = CInt(txtFilePerCartella.Text) .SuffissoCartelle = txtSuffissoCartelle.Text .CifreContatore = CInt(txtCifreContatore.Text) .NumerazioneType = GetNumerazioneEnum() .SourcePath = txtSorgente.Text .DestinationPath = txtDestinazione.Text .MaxThreads = CInt(TextBox7.Text) .ChunksSize = CInt(TextBox8.Text) .LinearExecution = rdbVecchioMetodo.Checked End With Dim time As String = Await imgStf.CreaCatalogoParallel(imageCreationOptions) Label43.Text = time Label10.Text = "Finito" unlockUI() End Sub Private Sub UpdateCounter(text As String) Label10.Invoke(Sub() Label10.Text = text End Sub) End Sub Private Async Function CreaCatalogoParallel() As Task Dim timeStart As Date = TimeOfDay ContaImmaginiThread = 0 setLabel10Text("Elaborazione in corso...") Dim imgStf As ImageCreationStuff = New ImageCreationStuff() Dim imageCreationOptions As ImageCreationStuff.Options = New ImageCreationStuff.Options() With imageCreationOptions .AggiornaSottodirectory = chkAggiornaSottodirectory.Checked .CreaSottocartelle = chkCreaSottocartelle.Checked .FilePerCartella = CInt(txtFilePerCartella.Text) .SuffissoCartelle = txtSuffissoCartelle.Text .CifreContatore = CInt(txtCifreContatore.Text) .NumerazioneType = GetNumerazioneEnum() .SourcePath = txtSorgente.Text .DestinationPath = txtDestinazione.Text End With Await imgStf.CreaImmaginiParallel(imageCreationOptions) 'Await CreaImmaginiParallel(txtSorgente.Text, txtDestinazione.Text) setLabel10Text("Finito") Dim timeStop As Date = TimeOfDay setLabel43Text(CalcTime(timeStart, timeStop, ContaImmaginiThread)) End Function 'Private Async Function CreaImmaginiParallel(ByVal SourcePath As String, ByVal DestPath As String) As Task ' Dim dataToProcess As List(Of FileData) = New List(Of FileData) ' 'Dim dirSourceDest As Dictionary(Of FileInfo, DirectoryInfo) = New Dictionary(Of FileInfo, DirectoryInfo) ' If chkAggiornaSottodirectory.Checked And chkCreaSottocartelle.Checked Then ' Dim helperSharp As New FileHelperSharp() ' 'Dim helper As New FileHelper(CInt(txtFilePerCartella.Text), txtSuffissoCartelle.Text, CInt(txtCifreContatore.Text), getNumerazione()) ' 'getfilesrecursive ' Dim fileHelperOptions As FileHelperOptions = New FileHelperOptions() ' fileHelperOptions.FilesPerFolder = CInt(txtFilePerCartella.Text) ' fileHelperOptions.Suffix = txtSuffissoCartelle.Text ' fileHelperOptions.CounterSize = CInt(txtCifreContatore.Text) ' fileHelperOptions.NumerationType = GetNumerazioneEnum() ' dataToProcess = helperSharp.GetFilesRecursive(New DirectoryInfo(SourcePath), New DirectoryInfo(DestPath), "*.jpg", fileHelperOptions) ' 'dataToProcess = helper.GetFilesRecursiveParallel(New DirectoryInfo(SourcePath), New DirectoryInfo(DestPath), "*.jpg") ' ElseIf chkAggiornaSottodirectory.Checked And Not chkCreaSottocartelle.Checked Then ' ' TODO manca tutto?!?!?!? ' End If ' Dim scheduler As TaskScheduler = New ConcurrentExclusiveSchedulerPair(TaskScheduler.Default, Environment.ProcessorCount * 2).ConcurrentScheduler ' Dim test As IEnumerable(Of Task) = From d In dataToProcess Select Task.Factory.StartNew(Sub() ' 'setLabel10Text("File: " & p.File.Name) ' Dim b As String = (CType(Label18.Text, Integer) + 1).ToString ' Dim clsCreaImmagine As New ImageCreator(d.File, d.Directory) ' clsCreaImmagine.CreaImmagineThread(d.File.Name) ' ContaImmaginiThread += 1 ' UpdateCounter(ContaImmaginiThread & " " & d.File.Name) ' End Sub, CancellationToken.None, TaskCreationOptions.LongRunning, scheduler) 'TODO Cancellation Token ' 'ThreadingHelper.StartAndWaitAllThrottled(test, CType(TextBox7.Text, Integer)) ' Await Task.WhenAll(test) ' '= getDirsDict(SourcePath, DestPath) ' 'Parallel.ForEach(dataToProcess, ' ' Sub(p, state) ' ' 'setLabel10Text("File: " & p.File.Name) ' ' Dim b As String = (CType(Label18.Text, Integer) + 1).ToString ' ' Dim clsCreaImmagine As New ImageCreator(p.File, p.Directory) ' ' clsCreaImmagine.CreaImmagineThread(p.File.Name) ' ' ContaImmaginiThread += 1 ' ' UpdateCounter(ContaImmaginiThread & " " & p.File.Name) ' ' 'MyPool.InsertWorkItem(p.File.Name, New XyThreadAdd(AddressOf ClsCreaImmagine.CreaImmagineThread), New Object(0) {p.File.Name}, True) ' ' ' TODO: BREAK ON STOP state.stop() ' ' End Sub) ' 'Dim pair As KeyValuePair(Of FileInfo, DirectoryInfo) ' 'For Each pair In dirSourceDest ' ' setLabel10Text("File: " & pair.Key.Name) ' ' Dim b As String = (CType(Label18.Text, Integer) + 1).ToString ' ' Dim ClsCreaImmagine As New ImageCreator(pair.Key, pair.Value) ' ' ContaImmaginiThread += 1 ' ' MyPool.InsertWorkItem(pair.Key.Name, New XyThreadAdd(AddressOf ClsCreaImmagine.CreaImmagineThread), New Object(0) {pair.Key.Name}, True) ' 'Next 'End Function End Class Public Class PicInfo Public DirSource, DirDest, DirDestStart As DirectoryInfo Public NomeImmagine As String Public Sub New(ByVal Dir_Source As DirectoryInfo, ByVal Dir_Dest As DirectoryInfo, ByVal Dir_DestStart As DirectoryInfo, ByVal Nome_Immagine As String) DirSource = Dir_Source DirDest = Dir_Dest DirDestStart = Dir_DestStart NomeImmagine = Nome_Immagine End Sub End Class