Conversione a c# + threads

This commit is contained in:
Maddo Scientisto 2021-02-25 11:14:44 +01:00
commit d133917283
24 changed files with 2649 additions and 642 deletions

View file

@ -1,5 +1,7 @@
Imports System.IO
Imports System.Collections.Concurrent
Imports System.IO
Imports System.Collections.Generic
Imports MaddoShared
Public Class FileHelper
'Private dirSourceDest As Dictionary(Of FileInfo, DirectoryInfo)
@ -28,7 +30,7 @@ Public Class FileHelper
Me.filesPerFolder = filesPerFolder
Me.suffix = suffix
Me.counterSize = counterSize
me.numerationType = numerationType
Me.numerationType = numerationType
Me.separateFiles = True
End Sub
@ -37,7 +39,7 @@ Public Class FileHelper
''' </summary>
''' <remarks></remarks>
Public Sub New()
me.separateFiles = False
Me.separateFiles = False
End Sub
@ -77,13 +79,71 @@ Public Class FileHelper
Next
Catch ex As Exception
Dim e As Exception = ex.Demystify()
Console.WriteLine(e)
Console.WriteLine(e.Message)
Console.WriteLine(e.StackTrace)
End Try
Loop
Return dirSourceDest
End Function
'Public Class FileData
' Public File As FileInfo
' Public Directory As DirectoryInfo
' Public Sub New(newFile As FileInfo, newDirectory As DirectoryInfo)
' File = newFile
' Directory = newDirectory
' End Sub
'End Class
'Public Function GetFilesRecursiveParallel(ByVal root As DirectoryInfo, ByVal destRoot As DirectoryInfo, ByVal filter As String) As List(Of FileData)
' Dim dirSourceDest As New ConcurrentDictionary(Of FileInfo, DirectoryInfo)
' Dim result As New List(Of FileInfo)
' 'Dim stack As New Stack(Of DirectoryInfo)
' Dim stack As New Stack(Of KeyValuePair(Of DirectoryInfo, DirectoryInfo))
' Me.filter = filter
' Dim pair As New KeyValuePair(Of DirectoryInfo, DirectoryInfo)
' 'stack.Push(root)
' stack.Push(New KeyValuePair(Of DirectoryInfo, DirectoryInfo)(root, destRoot))
' Do While (stack.Count > 0)
' Dim curDirKV As KeyValuePair(Of DirectoryInfo, DirectoryInfo) = stack.Pop
' 'curDirKP = stack.Pop()
' Dim dir As DirectoryInfo = curDirKV.Key
' Dim dDir As DirectoryInfo = curDirKV.Value
' Try
' 'result.AddRange(dir.GetFiles(filter, SearchOption.TopDirectoryOnly))
' ' dividere file qui
' If filesPerFolder > 0 And separateFiles Then
' AppendDictionaryConcurrent(dirSourceDest, DividiFilesInDirConcurrent(dir, dDir))
' Else
' AppendDictionaryConcurrent(dirSourceDest, DividiFilesInDirConcurrent(dir, dDir))
' End If
' For Each subDirectory As DirectoryInfo In dir.GetDirectories
' stack.Push(New KeyValuePair(Of DirectoryInfo, DirectoryInfo)(subDirectory, New DirectoryInfo(Path.Combine(dDir.FullName, subDirectory.Name))))
' Next
' Catch ex As Exception
' ' TODO: FARE QUALCOSA
' End Try
' Loop
' Dim resultData As New List(Of FileData)
' resultData.AddRange(From p In dirSourceDest Select New FileData(p.Key, p.Value))
' Return resultData
' 'Return dirSourceDest
'End Function
Public Function appendDictionary(ByVal dictA As Dictionary(Of FileInfo, DirectoryInfo), ByVal dictB As Dictionary(Of FileInfo, DirectoryInfo)) As Dictionary(Of FileInfo, DirectoryInfo)
For Each pair As KeyValuePair(Of FileInfo, DirectoryInfo) In dictB
dictA.Add(pair.Key, pair.Value)
@ -91,6 +151,14 @@ Public Class FileHelper
Return dictA
End Function
'Public Function AppendDictionaryConcurrent(ByVal dictA As ConcurrentDictionary(Of FileInfo, DirectoryInfo), ByVal dictB As ConcurrentDictionary(Of FileInfo, DirectoryInfo)) As ConcurrentDictionary(Of FileInfo, DirectoryInfo)
' For Each pair As KeyValuePair(Of FileInfo, DirectoryInfo) In dictB
' dictA.TryAdd(pair.Key, pair.Value)
' 'dictA.Add(pair.Key, pair.Value)
' Next
' Return dictA
'End Function
Public Function getAllFilesInDir(dir As DirectoryInfo, dirDest As DirectoryInfo) As Dictionary(Of FileInfo, DirectoryInfo)
Dim dict As New Dictionary(Of FileInfo, DirectoryInfo)
For Each File As FileInfo In dir.GetFiles(filter)
@ -140,4 +208,45 @@ Public Class FileHelper
Return foldersDict
End Function
Private Function DividiFilesInDirConcurrent(dir As DirectoryInfo, dirDest As DirectoryInfo) As ConcurrentDictionary(Of FileInfo, DirectoryInfo)
Dim filesCount As Integer = dir.GetFiles(filter).Count
Dim contaFilePerDir As Integer = 0
Dim contaDirPerDir As Integer = 0
Dim tempText As String = String.Empty
Dim foldersDict As New ConcurrentDictionary(Of FileInfo, DirectoryInfo)
Dim destDir As DirectoryInfo
destDir = New DirectoryInfo(Path.Combine(dirDest.FullName))
For Each file As FileInfo In dir.GetFiles(filter)
contaFilePerDir += 1
If contaFilePerDir = (contaDirPerDir * filesPerFolder) + 1 Then
contaDirPerDir += 1
If numerationType = numerazione.Progressiva Then
tempText = contaDirPerDir.ToString
Else
tempText = (contaDirPerDir * filesPerFolder).ToString
End If
Dim i As Integer
For i = 1 To (counterSize - tempText.Length)
tempText = "0" & tempText
Next
destDir = New DirectoryInfo(Path.Combine(dirDest.FullName, suffix + tempText))
End If
If Not destDir.Exists Then
destDir.Create()
End If
foldersDict.TryAdd(file, destDir)
Next
Return foldersDict
End Function
End Class

View file

@ -3,6 +3,7 @@ Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.Threading
Imports System.Collections.Generic
Imports CatalogVbLib
Public Delegate Sub XyThreadAddold(ByVal Info As String)

View file

@ -40,6 +40,8 @@
<SccLocalPath>SAK</SccLocalPath>
<SccAuxPath>SAK</SccAuxPath>
<SccProvider>SAK</SccProvider>
<NuGetPackageImportStamp>
</NuGetPackageImportStamp>
<PublishUrl>http://localhost/ImageCatalog/</PublishUrl>
<Install>true</Install>
<InstallFrom>Web</InstallFrom>
@ -54,8 +56,6 @@
<ApplicationVersion>1.8.0.%2a</ApplicationVersion>
<UseApplicationTrust>false</UseApplicationTrust>
<BootstrapperEnabled>true</BootstrapperEnabled>
<NuGetPackageImportStamp>
</NuGetPackageImportStamp>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\</OutputPath>
@ -169,10 +169,19 @@
<Prefer32Bit>false</Prefer32Bit>
</PropertyGroup>
<ItemGroup>
<Reference Include="Ben.Demystifier, Version=0.3.0.0, Culture=neutral, PublicKeyToken=a6d206e05440431a, processorArchitecture=MSIL">
<HintPath>..\packages\Ben.Demystifier.0.3.0\lib\net45\Ben.Demystifier.dll</HintPath>
</Reference>
<Reference Include="Microsoft.VisualBasic.PowerPacks.Vs, Version=10.0.0.0" />
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.Buffers, Version=4.0.3.0, Culture=neutral, PublicKeyToken=cc7b13ffcd2ddd51, processorArchitecture=MSIL">
<HintPath>..\packages\System.Buffers.4.5.1\lib\net461\System.Buffers.dll</HintPath>
</Reference>
<Reference Include="System.Collections.Immutable, Version=5.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL">
<HintPath>..\packages\System.Collections.Immutable.5.0.0\lib\net461\System.Collections.Immutable.dll</HintPath>
</Reference>
<Reference Include="System.Core">
<RequiredTargetFramework>3.5</RequiredTargetFramework>
<Private>True</Private>
@ -185,6 +194,22 @@
<Name>System.Drawing</Name>
<Private>True</Private>
</Reference>
<Reference Include="System.Memory, Version=4.0.1.1, Culture=neutral, PublicKeyToken=cc7b13ffcd2ddd51, processorArchitecture=MSIL">
<HintPath>..\packages\System.Memory.4.5.4\lib\net461\System.Memory.dll</HintPath>
</Reference>
<Reference Include="System.Numerics" />
<Reference Include="System.Numerics.Vectors, Version=4.1.4.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL">
<HintPath>..\packages\System.Numerics.Vectors.4.5.0\lib\net46\System.Numerics.Vectors.dll</HintPath>
</Reference>
<Reference Include="System.Reflection.Metadata, Version=5.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL">
<HintPath>..\packages\System.Reflection.Metadata.5.0.0\lib\net461\System.Reflection.Metadata.dll</HintPath>
</Reference>
<Reference Include="System.Runtime.CompilerServices.Unsafe, Version=4.0.4.1, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL">
<HintPath>..\packages\System.Runtime.CompilerServices.Unsafe.4.5.3\lib\net461\System.Runtime.CompilerServices.Unsafe.dll</HintPath>
</Reference>
<Reference Include="System.Threading.Tasks.Extensions, Version=4.2.0.1, Culture=neutral, PublicKeyToken=cc7b13ffcd2ddd51, processorArchitecture=MSIL">
<HintPath>..\packages\System.Threading.Tasks.Extensions.4.5.4\lib\net461\System.Threading.Tasks.Extensions.dll</HintPath>
</Reference>
<Reference Include="System.Windows.Forms">
<Name>System.Windows.Forms</Name>
</Reference>
@ -207,7 +232,6 @@
<SubType>Code</SubType>
</Compile>
<Compile Include="FileHelper.vb" />
<Compile Include="ImageCreator.vb" />
<Compile Include="CreaImmagineSeparateMultiCore.vb" />
<Compile Include="CreaImmagineSeparateThread.vb" />
<Compile Include="ExifReader.vb">
@ -260,6 +284,7 @@
<Generator>SettingsSingleFileGenerator</Generator>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
<None Include="packages.config" />
</ItemGroup>
<ItemGroup>
<BootstrapperPackage Include="Microsoft.Net.Client.3.5">
@ -296,6 +321,16 @@
<ItemGroup>
<Folder Include="Sorgenti\" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\CatalogVbLib\CatalogVbLib.vbproj">
<Project>{44465926-240d-473f-90b8-786ba4384406}</Project>
<Name>CatalogVbLib</Name>
</ProjectReference>
<ProjectReference Include="..\MaddoShared\MaddoShared.csproj">
<Project>{aebfe9e3-277c-4a7b-8448-145d1b11998b}</Project>
<Name>MaddoShared</Name>
</ProjectReference>
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />
<PropertyGroup>
<PreBuildEvent>

View file

@ -1,835 +0,0 @@
Imports System.IO
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
'Imports System.Threading
Public Class ImageCreator
#Region "dichiarazioni"
Private FotoRuotaADestra As Boolean = False
Private FotoRuotaASinistra As Boolean = False
Private TempMinText As String = ""
'Private crFont1 As Font
Private _NomeFileChild As String
Private _SourceDir As DirectoryInfo
Private _DestDirStart As DirectoryInfo
Private _DestDir As DirectoryInfo
Private _workFile As FileInfo
Private testoFirma As String
Private testoFirmaV As String
Private alphaScelta As Integer
Private DimensioneStandard As Integer
Private DimensioneStandardMiniatura As Integer
Private dataFoto As DateTime
Private dataPartenzaI As DateTime
Private testoOrario As String
Private testoFirmaPiccola As String
Private thumbSizeSmall As Size
Private thumbSizeBig As Size
Private nomeFileSmall As String
Private nomeFileBig As String
Private nomeFileBig2 As String
Private yPosFromBottom As Single
Private yPosFromBottom1 As Single
Private yPosFromBottom2 As Single
Private yPosFromBottom3 As Single
Private yPosFromBottom4 As Single
#End Region
Public Sub New()
End Sub
Public Sub New(ByVal nomeFileChild As String, ByVal sourceDir As DirectoryInfo, ByVal destDir As DirectoryInfo, ByVal destDirStart As DirectoryInfo)
Me.NomeFileChild = nomeFileChild
Me.SourceDir = sourceDir
Me.DestDir = destDir
Me.DestDirStart = destDirStart
Me.WorkFile = New FileInfo(nomeFileChild)
End Sub
Public Sub New(ByVal nomeFileChild As String, ByVal sourceDir As DirectoryInfo, ByVal destDir As DirectoryInfo)
Me.NomeFileChild = nomeFileChild
Me.DestDir = destDir
End Sub
Public Sub New(ByVal file As FileInfo, ByVal destination As DirectoryInfo)
Me.WorkFile = file
me.DestDir = destination
End Sub
Public Sub CreaImmagineThread(ByVal Info As String)
#If Not Debug Then
Try
#End If
preparaVariabili()
'Dim g As System.Drawing.Image = System.Drawing.Image.FromFile(Path.Combine(SourceDir.FullName, NomeFileChild))
Dim g As System.Drawing.Image = System.Drawing.Image.FromFile(WorkFile.FullName)
' Imposta testo extra
impostaTestoExtra(g)
' Ruota l'immagine in base ai dati EXIF
Rotation(g)
' Forza jpeg se è selezionata l'opzione
Dim thisFormat As System.Drawing.Imaging.ImageFormat = g.RawFormat
If PicSettings.UsaForzaJpg = True Then thisFormat = System.Drawing.Imaging.ImageFormat.Jpeg
prepareThumbnailSize(g)
Dim imgOutputBig As New Bitmap(g, thumbSizeBig.Width, thumbSizeBig.Height)
imgOutputBig.SetResolution(g.HorizontalResolution, g.VerticalResolution)
' Crea le miniature
creaMiniature(g, imgOutputBig, thisFormat)
aggiungiTesto(g, imgOutputBig)
aggiungiLogo(imgOutputBig)
salvaFoto(imgOutputBig, thumbSizeBig, nomeFileBig, nomeFileSmall, thumbSizeSmall, thisFormat)
g.Dispose()
GC.Collect()
PicSettings.mainForm.stepProgressBar()
#If Not Debug Then
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
#End If
End Sub
Private Sub Rotation(ByRef g As System.Drawing.Image)
FotoRuotaADestra = False
FotoRuotaASinistra = False
If PicSettings.UsaRotazioneAutomatica = True Then
If g.PropertyIdList.Length > 0 Then ' ci sono dati exif
Dim DatiExif As New ExifReader(CType(g, Bitmap))
Select Case DatiExif.Orientation
Case ExifReader.Orientations.BottomLeft
Case ExifReader.Orientations.BottomRight
Case ExifReader.Orientations.LeftTop
Case ExifReader.Orientations.LftBottom
FotoRuotaASinistra = True
Case ExifReader.Orientations.RightBottom
Case ExifReader.Orientations.RightTop
Case ExifReader.Orientations.TopLeft
Case ExifReader.Orientations.TopRight
End Select
End If
End If
If FotoRuotaASinistra = True Then
g.RotateFlip(RotateFlipType.Rotate270FlipNone)
End If
If FotoRuotaADestra = True Then
g.RotateFlip(RotateFlipType.Rotate90FlipNone)
End If
End Sub
''' <summary>
''' Aggiunge Orario, tempo gara e altri
''' </summary>
''' <param name="g">Image</param>
''' <remarks></remarks>
Private Sub impostaTestoExtra(g As Image)
If PicSettings.UsaOrarioTestoApplicare Or
PicSettings.UsaTempoGaraTestoApplicare Or
PicSettings.UsaOrarioMiniatura Or
PicSettings.TestoMin Or
PicSettings.AggTempoGaraMin Or
PicSettings.AggNumTempMin Then
If g.PropertyIdList.Length > 0 Then ' ci sono dati exif
Dim DatiExif As New ExifReader(CType(g, Bitmap))
dataFoto = DatiExif.DateTimeOriginal
testoFirma = PicSettings.TestoFirmaStart
testoFirmaV = PicSettings.TestoFirmaStartV
If dataFoto.Year <> 1 Then
testoFirmaPiccola = dataFoto.ToShortTimeString
If PicSettings.UsaOrarioTestoApplicare = True Then
testoFirma &= " " & dataFoto.ToShortDateString & " " & dataFoto.ToLongTimeString
testoFirmaV &= " " & dataFoto.ToShortDateString & " " & dataFoto.ToLongTimeString
End If
If PicSettings.UsaTempoGaraTestoApplicare = True Then
Dim Orario As TimeSpan = New TimeSpan(DateDiff(DateInterval.Second, dataPartenzaI, dataFoto) * 10000000)
testoFirma &= " " & testoOrario & Orario.Hours.ToString("00") & ":" & Orario.Minutes.ToString("00") & ":" & Orario.Seconds.ToString("00")
testoFirmaV &= " " & testoOrario & Orario.Hours.ToString("00") & ":" & Orario.Minutes.ToString("00") & ":" & Orario.Seconds.ToString("00")
End If
End If
End If
Else
testoFirma = PicSettings.TestoFirmaStart
testoFirmaV = PicSettings.TestoFirmaStartV
End If
End Sub
''' <summary>
''' Prepara diverse variabili azzerandole, elaborandole e prendendole dalle impostazioni
''' </summary>
''' <remarks></remarks>
Private Sub preparaVariabili()
alphaScelta = CType((255 * (100 - PicSettings.Trasparenza) / 100), Integer)
testoFirma = ""
testoFirmaV = ""
dataPartenzaI = PicSettings.DataPartenza
testoOrario = PicSettings.TestoOrario
If testoOrario.Length > 0 Then testoOrario &= " "
testoFirmaPiccola = ""
thumbSizeSmall = New Size
thumbSizeBig = New Size
nomeFileSmall = ""
nomeFileBig2 = ""
nomeFileBig = ""
DimensioneStandard = PicSettings.DimStandard
DimensioneStandardMiniatura = PicSettings.DimStandardMiniatura
'nomeFileSmall = Suffisso & NomeFileChild
'nomeFileBig = NomeFileChild
nomeFileSmall = Suffisso & WorkFile.Name
nomeFileBig = WorkFile.Name
End Sub
Private Sub prepareThumbnailSize(g As Image)
If g.Width > g.Height Then
thumbSizeSmall = NewthumbSize(g.Width, g.Height, LarghezzaSmall, "Larghezza")
Dim SizeOrig As New Size(g.Width, g.Height)
thumbSizeBig = SizeOrig
Else
thumbSizeSmall = NewthumbSize(g.Width, g.Height, AltezzaSmall, "Altezza")
Dim SizeOrig As New Size(g.Width, g.Height)
thumbSizeBig = SizeOrig
End If
End Sub
Private Sub creaMiniature(g As Image, imgOutputBig As Bitmap, thisFormat As ImageFormat)
If PicSettings.TestoMin Then
testoFirmaPiccola = nomeFileBig
ElseIf PicSettings.AggNumTempMin Then
testoFirmaPiccola = nomeFileBig + " "
End If
'Dim yPosFromBottom4 As Single
Dim crFont1 As Font = Nothing
Dim crFont2 As Font = Nothing
Dim crSize1 As SizeF = New SizeF
Dim crSize2 As SizeF = New SizeF
If PicSettings.CreaMiniature = True Then
If PicSettings.AggiungiScritteMiniature = False Then
If PicSettings.DirectorySorgente.ToUpper = PicSettings.DirectoryDestinazione.ToUpper Then
nomeFileSmall = nomeFileSmall.Substring(0, nomeFileSmall.Length - 4) & Codice & nomeFileSmall.Substring(nomeFileSmall.Length - 4)
End If
If PicSettings.UsaOrarioMiniatura Or
PicSettings.TestoMin Or
PicSettings.AggTempoGaraMin Or
PicSettings.AggNumTempMin Then
If testoFirmaPiccola.Length > 0 Then
Dim imgOutputSmall As Bitmap
imgOutputSmall = CType(imgOutputBig.Clone, Bitmap)
Dim grPhoto1 As Graphics
grPhoto1 = Graphics.FromImage(imgOutputSmall)
grPhoto1.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Dim LarghezzaStandard1 As Integer
'quick fix
DimensioneStandardMiniatura = 50
If PicSettings.Grassetto = True Then
crFont1 = New Font(PicSettings.IlFont, DimensioneStandardMiniatura, FontStyle.Bold)
crFont2 = New Font(PicSettings.IlFont, DimensioneStandard, FontStyle.Bold)
Else
crFont1 = New Font(PicSettings.IlFont, DimensioneStandardMiniatura)
crFont2 = New Font(PicSettings.IlFont, DimensioneStandard)
End If
crSize1 = grPhoto1.MeasureString(testoFirmaPiccola, crFont1)
crSize2 = grPhoto1.MeasureString(testoFirma, crFont1)
LarghezzaStandard1 = CType(crSize1.Width, Integer)
If crSize1.Width > CType(g.Width, Single) Then
Dim Conta As Integer = DimensioneStandardMiniatura
Do
If Conta > 20 Then
Conta -= 5
Else
Conta -= 1
End If
If PicSettings.Grassetto = True Then
crFont1 = New Font(PicSettings.IlFont, Conta, FontStyle.Bold)
Else
crFont1 = New Font(PicSettings.IlFont, Conta)
End If
crSize1 = grPhoto1.MeasureString(testoFirmaPiccola, crFont1)
If crSize1.Width < CType(g.Width, Single) Then
LarghezzaStandard1 = CType(crSize1.Width, Integer)
Exit Do
End If
If Conta <= 5 Then Exit Do
Loop
DimensioneStandardMiniatura = Conta
End If
Select Case PicSettings.Posizione.ToUpper
Case "ALTO"
yPosFromBottom1 = (PicSettings.Margine)
yPosFromBottom4 = (PicSettings.MargVert)
Case "BASSO"
yPosFromBottom1 = CType((g.Height - crSize1.Height - (g.Height * PicSettings.Margine / 100)), Single)
yPosFromBottom4 = CType((g.Height - crSize1.Height - (g.Height * PicSettings.MargVert / 100)), Single)
End Select
Dim xCenterOfImg1 As Single
Dim StrFormat1 As StringFormat = New StringFormat
Select Case PicSettings.Allineamento.ToUpper
Case "SINISTRA"
xCenterOfImg1 = CType((PicSettings.Margine + (LarghezzaStandard1 / 2)), Single)
If (LarghezzaStandard1 / 2) > (g.Width / 2) - PicSettings.Margine Then
xCenterOfImg1 = CType((g.Width / 2), Single)
End If
Case "CENTRO"
xCenterOfImg1 = CType((g.Width / 2), Single)
Case "DESTRA"
xCenterOfImg1 = CType((g.Width - PicSettings.Margine - (LarghezzaStandard1 / 2)), Single)
If (LarghezzaStandard1 / 2) > (g.Width / 2) - PicSettings.Margine Then
xCenterOfImg1 = CType((g.Width / 2), Single)
End If
End Select
StrFormat1.Alignment = StringAlignment.Center
Dim semiTransBrush21 As SolidBrush = New SolidBrush(Color.FromArgb(alphaScelta, 0, 0, 0))
Dim semiTransBrush1 As SolidBrush = New SolidBrush(Color.FromArgb(alphaScelta, PicSettings.fontColoreRGB))
'quick fix
DimensioneStandardMiniatura = PicSettings.DimMin
If PicSettings.Grassetto = True Then
crFont1 = New Font(PicSettings.IlFont, DimensioneStandardMiniatura, FontStyle.Bold)
Else
crFont1 = New Font(PicSettings.IlFont, DimensioneStandardMiniatura)
End If
'asdgadfhdfhjgfsjgfjygfdhsdafa
If PicSettings.TestoMin Then
grPhoto1.DrawString(nomeFileBig, crFont1, semiTransBrush21, New PointF(xCenterOfImg1 + 1, yPosFromBottom1 + 1), StrFormat1)
grPhoto1.DrawString(nomeFileBig, crFont1, semiTransBrush1, New PointF(xCenterOfImg1, yPosFromBottom1), StrFormat1)
ElseIf PicSettings.AggTempoGaraMin And PicSettings.UsaTempoGaraTestoApplicare Then
Dim Orario As TimeSpan = New TimeSpan(DateDiff(DateInterval.Second, dataPartenzaI, dataFoto) * 10000000)
Dim tempstr As String = ""
tempstr &= ControlChars.CrLf & testoOrario & Orario.Hours.ToString("00") & ":" & Orario.Minutes.ToString("00") & ":" & Orario.Seconds.ToString("00")
grPhoto1.DrawString(tempstr, crFont1, semiTransBrush21, New PointF(xCenterOfImg1 + 1, yPosFromBottom1 + 1), StrFormat1)
grPhoto1.DrawString(tempstr, crFont1, semiTransBrush1, New PointF(xCenterOfImg1, yPosFromBottom1), StrFormat1)
ElseIf PicSettings.AggNumTempMin Then
Dim Orario As TimeSpan = New TimeSpan(DateDiff(DateInterval.Second, dataPartenzaI, dataFoto) * 10000000)
Dim tempstr As String = ""
tempstr &= nomeFileBig
tempstr &= ControlChars.CrLf & testoOrario & Orario.Hours.ToString("00") & ":" & Orario.Minutes.ToString("00") & ":" & Orario.Seconds.ToString("00")
grPhoto1.DrawString(tempstr, crFont1, semiTransBrush21, New PointF(xCenterOfImg1 + 1, yPosFromBottom1 + 1), StrFormat1)
grPhoto1.DrawString(tempstr, crFont1, semiTransBrush1, New PointF(xCenterOfImg1, yPosFromBottom1), StrFormat1)
Else
grPhoto1.DrawString(testoFirmaPiccola, crFont1, semiTransBrush21, New PointF(xCenterOfImg1 + 1, yPosFromBottom1 + 1), StrFormat1)
grPhoto1.DrawString(testoFirmaPiccola, crFont1, semiTransBrush1, New PointF(xCenterOfImg1, yPosFromBottom1), StrFormat1)
End If
' Salva la miniatura
imgOutputSmall.Save(Path.Combine(DestDir.FullName, "Temp_" & nomeFileSmall), thisFormat)
Dim g2 As System.Drawing.Image = System.Drawing.Image.FromFile(Path.Combine(DestDir.FullName, "Temp_" & nomeFileSmall))
Dim imgOutputSmall2 As New Bitmap(g2, thumbSizeSmall.Width, thumbSizeSmall.Height)
imgOutputSmall2.Save(Path.Combine(DestDir.FullName, nomeFileSmall), thisFormat)
imgOutputSmall2.Dispose()
imgOutputSmall.Dispose()
g2.Dispose()
Kill(Path.Combine(DestDir.FullName, "Temp_" & nomeFileSmall))
Else
Dim imgOutputSmall As New Bitmap(g, thumbSizeSmall.Width, thumbSizeSmall.Height)
imgOutputSmall.Save(Path.Combine(DestDir.FullName, nomeFileSmall), thisFormat)
imgOutputSmall.Dispose()
End If
Else
Dim imgOutputSmall As New Bitmap(g, thumbSizeSmall.Width, thumbSizeSmall.Height)
imgOutputSmall.Save(Path.Combine(DestDir.FullName, nomeFileSmall), thisFormat)
imgOutputSmall.Dispose()
End If
End If
End If
End Sub
Private Sub aggiungiTesto(g As Image, imgOutputBig As Bitmap)
Dim grPhoto As Graphics
grPhoto = Graphics.FromImage(imgOutputBig)
grPhoto.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
Dim crFont As Font = Nothing
Dim crSize As SizeF = New SizeF
Dim LarghezzaStandard As Integer
If PicSettings.Grassetto = True Then
crFont = New Font(PicSettings.IlFont, DimensioneStandard, FontStyle.Bold)
Else
crFont = New Font(PicSettings.IlFont, DimensioneStandard)
End If
crSize = grPhoto.MeasureString(testoFirma, crFont)
LarghezzaStandard = CType(crSize.Width, Integer)
If crSize.Width > CType(g.Width, Single) Then
Dim Conta As Integer = DimensioneStandard
Do
If Conta > 20 Then
Conta -= 5
Else
Conta -= 1
End If
If PicSettings.Grassetto = True Then
crFont = New Font(PicSettings.IlFont, Conta, FontStyle.Bold)
Else
crFont = New Font(PicSettings.IlFont, Conta)
End If
crSize = grPhoto.MeasureString(testoFirma, crFont)
If crSize.Width < CType(g.Width, Single) Then
LarghezzaStandard = CType(crSize.Width, Integer)
Exit Do
End If
If Conta <= 5 Then Exit Do
Loop
DimensioneStandard = Conta
End If
Select Case PicSettings.Posizione.ToUpper
Case "ALTO"
yPosFromBottom = (PicSettings.Margine)
yPosFromBottom3 = (PicSettings.MargVert)
Case "BASSO"
yPosFromBottom = CType((g.Height - crSize.Height - (g.Height * PicSettings.Margine / 100)), Single)
yPosFromBottom3 = CType((g.Height - crSize.Height - (g.Height * PicSettings.MargVert / 100)), Single)
End Select
Dim xCenterOfImg As Single
Dim xCenterOfImg3 As Single
Dim StrFormat As StringFormat = New StringFormat
Select Case PicSettings.Allineamento.ToUpper
Case "SINISTRA"
xCenterOfImg = CType((PicSettings.Margine + (LarghezzaStandard / 2)), Single)
xCenterOfImg3 = CType((PicSettings.MargVert + (LarghezzaStandard / 2)), Single)
If (LarghezzaStandard / 2) > (g.Width / 2) - PicSettings.Margine Then
xCenterOfImg = CType((g.Width / 2), Single)
End If
If (LarghezzaStandard / 2) > (g.Width / 2) - PicSettings.MargVert Then
xCenterOfImg3 = CType((g.Width / 2), Single)
End If
Case "CENTRO"
xCenterOfImg = CType((g.Width / 2), Single)
Case "DESTRA"
xCenterOfImg = CType((g.Width - PicSettings.Margine - (LarghezzaStandard / 2)), Single)
xCenterOfImg3 = CType((g.Width - PicSettings.MargVert - (LarghezzaStandard / 2)), Single)
If (LarghezzaStandard / 2) > (g.Width / 2) - PicSettings.Margine Then
xCenterOfImg = CType((g.Width / 2), Single)
End If
If (LarghezzaStandard / 2) > (g.Width / 2) - PicSettings.MargVert Then
xCenterOfImg3 = CType((g.Width / 2), Single)
End If
End Select
StrFormat.Alignment = StringAlignment.Center
Dim semiTransBrush2 As SolidBrush = New SolidBrush(Color.FromArgb(alphaScelta, 0, 0, 0))
'Dim semiTransBrush As SolidBrush = New SolidBrush(Color.FromArgb(AlphaScelta, _FontColoreR, _FontColoreG, _FontColoreB))
Dim semiTransBrush As SolidBrush = New SolidBrush(Color.FromArgb(alphaScelta, PicSettings.fontColoreRGB))
If FotoRuotaADestra Or FotoRuotaASinistra Then
If PicSettings.Grassetto = True Then
crFont = New Font(PicSettings.IlFont, DimVert, FontStyle.Bold)
Else
crFont = New Font(PicSettings.IlFont, DimVert)
End If
Else
If PicSettings.Grassetto = True Then
crFont = New Font(PicSettings.IlFont, DimensioneStandard, FontStyle.Bold)
Else
crFont = New Font(PicSettings.IlFont, DimensioneStandard)
End If
End If
'qui scrive il testo (nomefilebig)
If PicSettings.TestoNome Then
If NomeData And g.PropertyIdList.Length > 0 Then
Dim DatiExif As New ExifReader(CType(g, Bitmap))
dataFoto = DatiExif.DateTimeOriginal
grPhoto.DrawString((nomeFileBig & " " & dataFoto.ToShortDateString), crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromBottom + 1), StrFormat)
grPhoto.DrawString((nomeFileBig & " " & dataFoto.ToShortDateString), crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromBottom), StrFormat)
Else
grPhoto.DrawString(nomeFileBig, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromBottom + 1), StrFormat)
grPhoto.DrawString(nomeFileBig, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromBottom), StrFormat)
End If
End If
If PicSettings.TestoNome = False Then
If FotoRuotaADestra Or FotoRuotaASinistra Then
If PicSettings.TestoMin = False Then
grPhoto.DrawString(testoFirmaV, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromBottom3 + 1), StrFormat)
grPhoto.DrawString(testoFirmaV, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromBottom3), StrFormat)
End If
If PicSettings.TestoMin = True Then
grPhoto.DrawString(testoFirmaV, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromBottom4 + 1), StrFormat)
grPhoto.DrawString(testoFirmaV, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromBottom4), StrFormat)
End If
Else
grPhoto.DrawString(testoFirma, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromBottom + 1), StrFormat)
grPhoto.DrawString(testoFirma, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromBottom), StrFormat)
End If
End If
If PicSettings.DirectorySorgente.ToUpper = PicSettings.DirectoryDestinazione.ToUpper Then
nomeFileBig2 = nomeFileBig
nomeFileBig = nomeFileBig.Substring(0, nomeFileBig.Length - 4) & Codice & nomeFileBig.Substring(nomeFileBig.Length - 4)
End If
grPhoto.Dispose()
End Sub
Private Sub aggiungiLogo(imgOutputBig As Bitmap)
'imgOutputBig
If PicSettings.LogoAggiungi = True And File.Exists(PicSettings.LogoNomeFile) Then
Dim ImmagineLogo As Image = Image.FromFile(PicSettings.LogoNomeFile)
Dim LogoColoreTrasparente As Color = Color.White
'Dim bmWatermark As Bitmap
'* Create a Bitmap based on the previously modified photograph Bitmap
'bmWatermark = New Bitmap(imgOutputBig)
'bmWatermark.SetResolution(imgOutputBig.HorizontalResolution, imgOutputBig.VerticalResolution)
'* Load this Bitmap into a new Graphic Object
Dim grWatermark As Graphics = Graphics.FromImage(imgOutputBig)
'* To achieve a translucent watermark we will apply (2) color manipulations
Dim imageAttributes As Imaging.ImageAttributes = New Imaging.ImageAttributes
'* The first step replace the background color with one that is transparent (Alpha=0, R=0, G=0, B=0)
Dim colorMap As Imaging.ColorMap = New Imaging.ColorMap
'* background this will be the color we search for and replace with transparency
colorMap.OldColor = LogoColoreTrasparente
colorMap.NewColor = Color.FromArgb(0, 0, 0, 0)
Dim remapTable As Imaging.ColorMap() = {colorMap}
imageAttributes.SetRemapTable(remapTable, Imaging.ColorAdjustType.Bitmap)
'* The second color manipulation is used to change the opacity by setting the 3rd row and 3rd column to 0.3f
Dim colorMatrixElements As Single()() = {New Single() {1.0F, 0.0F, 0.0F, 0.0F, 0.0F}, New Single() {0.0F, 1.0F, 0.0F, 0.0F, 0.0F}, New Single() {0.0F, 0.0F, 1.0F, 0.0F, 0.0F}, New Single() {0.0F, 0.0F, 0.0F, CType(PicSettings.LogoTrasparenza, Single) / 100, 0.0F}, New Single() {0.0F, 0.0F, 0.0F, 0.0F, 1.0F}}
Dim wmColorMatrix As Imaging.ColorMatrix = New Imaging.ColorMatrix(colorMatrixElements)
imageAttributes.SetColorMatrix(wmColorMatrix, Imaging.ColorMatrixFlag.Default, Imaging.ColorAdjustType.Bitmap)
Dim FotoLogoH As Integer = PicSettings.LogoAltezza
Dim FotoLogoW As Integer = PicSettings.LogoLarghezza
Dim FattoreAlt As Double = ImmagineLogo.Height / FotoLogoH
Dim FattoreLarg As Double = ImmagineLogo.Width / FotoLogoW
Dim NuovaSize As Size
If FattoreLarg > FattoreAlt Then
NuovaSize = NewthumbSize(ImmagineLogo.Width, ImmagineLogo.Height, FotoLogoW, "Larghezza")
Else
NuovaSize = NewthumbSize(ImmagineLogo.Width, ImmagineLogo.Height, FotoLogoH, "Altezza")
End If
Dim MargineUsato As Integer
Dim MargineL As Integer
Dim InPercentualeL As Boolean
If PicSettings.LogoMargine.EndsWith("%") = True Then
InPercentualeL = True
Else
InPercentualeL = False
End If
MargineL = CType(Val(PicSettings.LogoMargine), Integer)
If InPercentualeL = True Then
MargineUsato = CType(imgOutputBig.Height * MargineL / 100, Integer)
Else
MargineUsato = MargineL
End If
Dim xPosOfWm As Integer
Dim yPosOfWm As Integer
Select Case PicSettings.LogoPosizioneH.ToUpper
Case "SINISTRA", "NESSUNA"
xPosOfWm = MargineUsato
Case "CENTRO"
xPosOfWm = CType((imgOutputBig.Width - NuovaSize.Width) / 2, Integer)
Case "DESTRA"
xPosOfWm = ((imgOutputBig.Width - NuovaSize.Width) - MargineUsato)
End Select
Select Case PicSettings.LogoPosizioneV.ToUpper
Case "ALTO", "NESSUNA"
yPosOfWm = MargineUsato
Case "CENTRO"
yPosOfWm = CType((imgOutputBig.Height - NuovaSize.Height) / 2, Integer)
Case "BASSO"
yPosOfWm = ((imgOutputBig.Height - NuovaSize.Height) - MargineUsato)
End Select
grWatermark.DrawImage(ImmagineLogo, New Rectangle(xPosOfWm, yPosOfWm, NuovaSize.Width, NuovaSize.Height), 0, 0, ImmagineLogo.Width, ImmagineLogo.Height, GraphicsUnit.Pixel, imageAttributes)
grWatermark.Dispose()
End If
End Sub
Private Sub salvaFoto(imgOutputBig As Bitmap, thumbSizeBig As Size, NomeFileBig As String, NomeFileSmall As String, thumbSizeSmall As Size, thisFormat As ImageFormat)
If PicSettings.FotoGrandeDimOrigina = False Then
'attenzione non controlla se è png
'imgOutputBig.Save(Path.Combine(_DestDir.FullName, "Temp_" & NomeFileBig), thisFormat)
If thisFormat.Equals(ImageFormat.Jpeg) Then
salvaImmagineCustomQuality(imgOutputBig, Path.Combine(DestDir.FullName, "Temp_" & NomeFileBig), jpegQuality)
Else
imgOutputBig.Save(Path.Combine(_DestDir.FullName, "Temp_" & NomeFileBig), thisFormat)
End If
Dim g2 As System.Drawing.Image = System.Drawing.Image.FromFile(Path.Combine(DestDir.FullName, "Temp_" & NomeFileBig))
If g2.Width > g2.Height Then
thumbSizeBig = NewthumbSize(g2.Width, g2.Height, PicSettings.LarghezzaBig, "Larghezza")
Else
thumbSizeBig = NewthumbSize(g2.Width, g2.Height, PicSettings.AltezzaBig, "Altezza")
End If
Dim imgOutputBig2 As New Bitmap(g2, thumbSizeBig.Width, thumbSizeBig.Height)
'
If thisFormat.Equals(ImageFormat.Jpeg) Then
salvaImmagineCustomQuality(imgOutputBig2, Path.Combine(DestDir.FullName, NomeFileBig), jpegQuality)
Else
imgOutputBig2.Save(Path.Combine(_DestDir.FullName, NomeFileBig), thisFormat)
End If
imgOutputBig2.Dispose()
imgOutputBig.Dispose()
g2.Dispose()
Else
'
If thisFormat.Equals(ImageFormat.Jpeg) Then
salvaImmagineCustomQuality(imgOutputBig, Path.Combine(DestDir.FullName, NomeFileBig), jpegQuality)
Else
imgOutputBig.Save(Path.Combine(_DestDir.FullName, NomeFileBig), thisFormat)
End If
imgOutputBig.Dispose()
End If
If PicSettings.CreaMiniature Then
If PicSettings.AggiungiScritteMiniature = True Then
Dim g1 As System.Drawing.Image
If PicSettings.FotoGrandeDimOrigina = False Then
g1 = System.Drawing.Image.FromFile(Path.Combine(DestDir.FullName, "Temp_" & NomeFileBig))
Else
g1 = System.Drawing.Image.FromFile(Path.Combine(DestDir.FullName, NomeFileBig))
End If
Dim imgOutputSmall As New Bitmap(g1, thumbSizeSmall.Width, thumbSizeSmall.Height)
If PicSettings.DirectorySorgente.ToUpper = PicSettings.DirectoryDestinazione.ToUpper Then
NomeFileSmall = NomeFileSmall.Substring(0, NomeFileSmall.Length - 4) & Codice & NomeFileSmall.Substring(NomeFileSmall.Length - 4)
End If
'
If thisFormat.Equals(ImageFormat.Jpeg) Then
salvaImmagineCustomQuality(imgOutputSmall, Path.Combine(DestDir.FullName, NomeFileSmall), jpegQualityMin)
Else
imgOutputSmall.Save(Path.Combine(_DestDir.FullName, NomeFileSmall), thisFormat)
End If
imgOutputSmall.Dispose()
g1.Dispose()
End If
End If
If File.Exists(Path.Combine(DestDir.FullName, "Temp_" & NomeFileBig)) = True Then
Kill(Path.Combine(DestDir.FullName, "Temp_" & NomeFileBig))
End If
End Sub
Private Sub salvaImmagineCustomQuality(imageToSave As Bitmap, nomeFileFinale As String, quality As Long)
Dim JgpEncoder As ImageCodecInfo = GetEncoder(ImageFormat.Jpeg)
Dim MyEncoder As Encoder = Encoder.Quality
Dim MyEncoderParameters As New EncoderParameters(1)
Dim MyEncoderParameter As New EncoderParameter(MyEncoder, jpegQuality)
MyEncoderParameters.Param(0) = MyEncoderParameter
imageToSave.Save(nomeFileFinale, JgpEncoder, MyEncoderParameters)
imageToSave.Dispose()
End Sub
Private Function GetEncoder(ByVal format As ImageFormat) As ImageCodecInfo
Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageDecoders()
Dim codec As ImageCodecInfo
For Each codec In codecs
If codec.FormatID = format.Guid Then
Return codec
End If
Next codec
Return Nothing
End Function
''' <summary>
''' Calculate the Size of the New image
''' </summary>
''' <param name="currentwidth">Larghezza</param>
''' <param name="currentheight">Altezza</param>
''' <param name="MaxPixel"></param>
''' <param name="TipoSize"></param>
''' <returns></returns>
''' <remarks></remarks>
Private Function NewthumbSize(ByVal currentwidth As Integer, ByVal currentheight As Integer, ByVal MaxPixel As Integer, ByVal TipoSize As String) As Size
' e
'*** 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
Public Property WorkFile() As FileInfo
Get
Return _workFile
End Get
Set(value As FileInfo)
_workFile = value
End Set
End Property
Public Property DestDir() As DirectoryInfo
Get
Return _DestDir
End Get
Set(ByVal value As DirectoryInfo)
_DestDir = value
End Set
End Property
Public Property SourceDir() As DirectoryInfo
Get
Return _SourceDir
End Get
Set(ByVal value As DirectoryInfo)
_SourceDir = value
End Set
End Property
Public Property DestDirStart() As DirectoryInfo
Get
Return _DestDirStart
End Get
Set(ByVal value As DirectoryInfo)
_DestDirStart = value
End Set
End Property
Public Property NomeFileChild() As String
Get
Return _NomeFileChild
End Get
Set(ByVal value As String)
_NomeFileChild = value
End Set
End Property
End Class

View file

@ -160,6 +160,7 @@ Partial Class MainForm
Me.Label10 = New System.Windows.Forms.Label()
Me.btnCreaCatalogo = New System.Windows.Forms.Button()
Me.Button6 = New System.Windows.Forms.Button()
Me.btnCreaCatalogoAsync = New System.Windows.Forms.Button()
Me.TabControl1.SuspendLayout()
Me.TabPage5.SuspendLayout()
Me.GroupBox11.SuspendLayout()
@ -289,9 +290,9 @@ Partial Class MainForm
Me.Label8.AutoSize = True
Me.Label8.Location = New System.Drawing.Point(64, 26)
Me.Label8.Name = "Label8"
Me.Label8.Size = New System.Drawing.Size(61, 13)
Me.Label8.Size = New System.Drawing.Size(111, 13)
Me.Label8.TabIndex = 3
Me.Label8.Text = "Min Thread"
Me.Label8.Text = "Chunk Size (0 = MAX)"
'
'TextBox8
'
@ -299,16 +300,16 @@ Partial Class MainForm
Me.TextBox8.Name = "TextBox8"
Me.TextBox8.Size = New System.Drawing.Size(47, 20)
Me.TextBox8.TabIndex = 2
Me.TextBox8.Text = "4"
Me.TextBox8.Text = "0"
'
'Label7
'
Me.Label7.AutoSize = True
Me.Label7.Location = New System.Drawing.Point(61, 48)
Me.Label7.Name = "Label7"
Me.Label7.Size = New System.Drawing.Size(64, 13)
Me.Label7.Size = New System.Drawing.Size(108, 13)
Me.Label7.TabIndex = 1
Me.Label7.Text = "Max Thread"
Me.Label7.Text = "Threads (0 = CPU *2)"
'
'TextBox7
'
@ -316,7 +317,7 @@ Partial Class MainForm
Me.TextBox7.Name = "TextBox7"
Me.TextBox7.Size = New System.Drawing.Size(47, 20)
Me.TextBox7.TabIndex = 0
Me.TextBox7.Text = "4"
Me.TextBox7.Text = "0"
'
'GroupBox3
'
@ -1493,7 +1494,7 @@ Partial Class MainForm
Me.Label27.Name = "Label27"
Me.Label27.Size = New System.Drawing.Size(140, 20)
Me.Label27.TabIndex = 62
Me.Label27.Text = "Versione 2.1 2019"
Me.Label27.Text = "Versione 2.2 2021"
Me.Label27.TextAlign = System.Drawing.ContentAlignment.MiddleRight
'
'Button7
@ -1568,7 +1569,7 @@ Partial Class MainForm
Me.btnCreaCatalogo.Font = New System.Drawing.Font("Microsoft Sans Serif", 12.0!, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.btnCreaCatalogo.Location = New System.Drawing.Point(539, 77)
Me.btnCreaCatalogo.Name = "btnCreaCatalogo"
Me.btnCreaCatalogo.Size = New System.Drawing.Size(192, 39)
Me.btnCreaCatalogo.Size = New System.Drawing.Size(102, 39)
Me.btnCreaCatalogo.TabIndex = 53
Me.btnCreaCatalogo.Text = "crea catalogo"
'
@ -1581,11 +1582,21 @@ Partial Class MainForm
Me.Button6.TabIndex = 54
Me.Button6.Text = "Carica impostazioni"
'
'btnCreaCatalogoAsync
'
Me.btnCreaCatalogoAsync.Location = New System.Drawing.Point(647, 78)
Me.btnCreaCatalogoAsync.Name = "btnCreaCatalogoAsync"
Me.btnCreaCatalogoAsync.Size = New System.Drawing.Size(84, 38)
Me.btnCreaCatalogoAsync.TabIndex = 68
Me.btnCreaCatalogoAsync.Text = "Crea 2"
Me.btnCreaCatalogoAsync.UseVisualStyleBackColor = True
'
'MainForm
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
Me.ClientSize = New System.Drawing.Size(739, 401)
Me.Controls.Add(Me.btnCreaCatalogoAsync)
Me.Controls.Add(Me.ProgressBar1)
Me.Controls.Add(Me.CheckBox22)
Me.Controls.Add(Me.Label43)
@ -1783,4 +1794,5 @@ Partial Class MainForm
Friend WithEvents rdbVecchioMetodo As System.Windows.Forms.RadioButton
Friend WithEvents CheckBox2 As System.Windows.Forms.CheckBox
Friend WithEvents chkSovrascriviFile As System.Windows.Forms.CheckBox
Friend WithEvents btnCreaCatalogoAsync As Button
End Class

View file

@ -1,9 +1,14 @@
Imports System.IO
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)
@ -97,12 +102,20 @@ Public Class MainForm
ComboBox5.Items.Add("Basso")
ComboBox5.SelectedIndex = 2
End Sub
<DllImport("kernel32.dll", SetLastError:=True)>
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()
@ -160,6 +173,7 @@ Public Class MainForm
End If
End Sub
Private Sub creaCatalogoThread()
Dim timeStart As Date = TimeOfDay
MyPool.StopThreadPool()
@ -878,7 +892,7 @@ Public Class MainForm
Dim ClsCreaImmagine As New ImageCreator(childFile.Name, SourceDir, DestDir, DestDirStart)
Dim ClsCreaImmagine As New ImageCreatorSharp(childFile.Name, SourceDir, DestDir, DestDirStart)
' ClsCreaImmagine.NomeFileChild = childFile.Name
' ClsCreaImmagine.DestDir = DestDir
' ClsCreaImmagine.SourceDir = SourceDir
@ -898,7 +912,7 @@ Public Class MainForm
End Sub
Private Function getNumerazione() As Integer
dim numerazione As Integer
Dim numerazione As Integer
If rdbNumProgressiva.Checked Then
numerazione = FileHelper.numerazione.Progressiva
Else
@ -907,6 +921,16 @@ Public Class MainForm
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
@ -922,12 +946,12 @@ Public Class MainForm
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)
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
@ -1312,7 +1336,157 @@ Public Class MainForm
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

View file

@ -8,7 +8,7 @@
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Strict Off
Option Explicit On

View file

@ -8,7 +8,7 @@
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Strict Off
Option Explicit On

File diff suppressed because it is too large Load diff

View file

@ -1,5 +1,5 @@
Option Explicit On
Option Strict On
Option Strict Off
Imports System.Threading
Imports System.Collections

View file

@ -1,23 +1,36 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<system.diagnostics>
<sources>
<!-- Questa sezione definisce la configurazione di registrazione per My.Application.Log -->
<source name="DefaultSource" switchName="DefaultSwitch">
<listeners>
<add name="FileLog"/>
<add name="FileLog" />
<!-- Per scrivere nel log eventi dell'applicazione, rimuovere il commento dalla sezione sottostante -->
<!--<add name="EventLog"/>-->
</listeners>
</source>
</sources>
<switches>
<add name="DefaultSwitch" value="Information"/>
<add name="DefaultSwitch" value="Information" />
</switches>
<sharedListeners>
<add name="FileLog" type="Microsoft.VisualBasic.Logging.FileLogTraceListener, Microsoft.VisualBasic, Version=8.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL" initializeData="FileLogWriter"/>
<add name="FileLog" type="Microsoft.VisualBasic.Logging.FileLogTraceListener, Microsoft.VisualBasic, Version=8.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a, processorArchitecture=MSIL" initializeData="FileLogWriter" />
<!-- Per scrivere nel log eventi dell'applicazione, rimuovere il commento dalla sezione sottostante e sostituire APPLICATION_NAME con il nome dell'applicazione -->
<!--<add name="EventLog" type="System.Diagnostics.EventLogTraceListener" initializeData="APPLICATION_NAME"/> -->
</sharedListeners>
</system.diagnostics>
<startup><supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.7.2"/></startup></configuration>
<startup><supportedRuntime version="v4.0" sku=".NETFramework,Version=v4.7.2" /></startup>
<runtime>
<assemblyBinding xmlns="urn:schemas-microsoft-com:asm.v1">
<dependentAssembly>
<assemblyIdentity name="System.Threading.Tasks.Extensions" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-4.2.0.1" newVersion="4.2.0.1" />
</dependentAssembly>
<dependentAssembly>
<assemblyIdentity name="Microsoft.Bcl.AsyncInterfaces" publicKeyToken="cc7b13ffcd2ddd51" culture="neutral" />
<bindingRedirect oldVersion="0.0.0.0-5.0.0.0" newVersion="5.0.0.0" />
</dependentAssembly>
</assemblyBinding>
</runtime>
</configuration>

View file

@ -0,0 +1,11 @@
<?xml version="1.0" encoding="utf-8"?>
<packages>
<package id="Ben.Demystifier" version="0.3.0" targetFramework="net472" />
<package id="System.Buffers" version="4.5.1" targetFramework="net472" />
<package id="System.Collections.Immutable" version="5.0.0" targetFramework="net472" />
<package id="System.Memory" version="4.5.4" targetFramework="net472" />
<package id="System.Numerics.Vectors" version="4.5.0" targetFramework="net472" />
<package id="System.Reflection.Metadata" version="5.0.0" targetFramework="net472" />
<package id="System.Runtime.CompilerServices.Unsafe" version="4.5.3" targetFramework="net472" />
<package id="System.Threading.Tasks.Extensions" version="4.5.4" targetFramework="net472" />
</packages>