This commit is contained in:
Maddo 2016-07-04 16:45:45 +02:00
commit 3b1afdf2c0
92 changed files with 23248 additions and 0 deletions

View file

@ -0,0 +1,31 @@
Imports System.Reflection
Imports System.Runtime.InteropServices
' General Information about an assembly is controlled through the following
' set of attributes. Change these attribute values to modify the information
' associated with an assembly.
' Review the values of the assembly attributes
<Assembly: AssemblyTitle("Image Catalog")>
<Assembly: AssemblyDescription("")>
<Assembly: AssemblyCompany("FornaSoft")>
<Assembly: AssemblyProduct("")>
<Assembly: AssemblyCopyright("(C) 2002-08")>
<Assembly: AssemblyTrademark("")>
<Assembly: CLSCompliant(True)>
'The following GUID is for the ID of the typelib if this project is exposed to COM
<Assembly: Guid("948AA2AA-5BED-4DD5-9C67-3126EE9109C6")>
' Version information for an assembly consists of the following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion("1.74.*")>

View file

@ -0,0 +1 @@

View file

@ -0,0 +1,943 @@
Imports System.IO
'Imports System.Drawing.Drawing2D
'Imports System.Drawing.Imaging
'Imports System.Threading
Public Class CreaImmagineSeparateMultiCore
Private _DirectorySorgente As String
Private _DirectoryDestinazione As String
Private _SourceDir As DirectoryInfo
Private _DestDirStart As DirectoryInfo
Private _DimStandard As Integer
Private _DimStandardMiniatura As Integer
Private _UsaOrarioMiniatura As Boolean
Private _UsaOrarioTestoApplicare As Boolean
Private _UsaTempoGaraTestoApplicare As Boolean
Private _TestoFirmaStart As String
Private _TestoFirmaStartV As String
Private _DataPartenza As DateTime
Private _TestoOrario As String
Private _UsaRotazioneAutomatica As Boolean
Private _UsaForzaJpg As Boolean
Private _LarghezzaSmall As Integer
Private _AltezzaSmall As Integer
Private _CreaMiniature As Boolean
Private _AggiungiScritteMiniature As Boolean
Private _NomeFileChild As String
Private _Suffisso As String
Private _Codice As String
Private _Trasparenza As Integer
Private _IlFont As String
Private _Grassetto As Boolean
Private _Posizione As String
Private _Allineamento As String
Private _Margine As Integer
Private _LogoAltezza As Integer
Private _LogoLarghezza As Integer
Private _FontColoreR As Integer
Private _FontColoreG As Integer
Private _FontColoreB As Integer
Private _LogoAggiungi As Boolean
Private _LogoNomeFile As String
Private _LogoTrasparenza As String
Private _LogoMargine As String
Private _LogoPosizioneH As String
Private _LogoPosizioneV As String
Private _FotoGrandeDimOrigina As Boolean
Private _AltezzaBig As Integer
Private _LarghezzaBig As Integer
Private _DestDir As DirectoryInfo
Public Sub CreaImmagine(ByVal InfoImg As PicInfo)
Dim TestoFirma As String = ""
_DestDir = InfoImg.DirDest
_SourceDir = InfoImg.DirSource
_DestDirStart = InfoImg.DirDestStart
_NomeFileChild = InfoImg.NomeImmagine
Dim AlphaScelta As Integer = CType((255 * (100 - _Trasparenza) / 100), Integer)
Dim DimensioneStandard As Integer
Dim DimensioneStandardMiniatura As Integer
Dim DataFoto As DateTime
Dim DataPartenzaI As DateTime = _DataPartenza
If _TestoOrario.Length > 0 Then
_TestoOrario &= " "
End If
Dim TestoFirmaPiccola As String = ""
Dim FileConta As Integer = 0
Dim ContaFileXDir As Integer = 0
Dim ContaDirXDir As Integer = 0
Dim TestoTemp As String = ""
Dim ContaTemp As Integer = 0
DimensioneStandard = _DimStandard
DimensioneStandardMiniatura = _DimStandardMiniatura
Dim g As System.Drawing.Image = System.Drawing.Image.FromFile(Path.Combine(_SourceDir.FullName, _NomeFileChild))
If _UsaOrarioTestoApplicare = True Or _UsaTempoGaraTestoApplicare = True Or _UsaOrarioMiniatura = True Then
If g.PropertyIdList.Length > 0 Then ' ci sono dati exif
Dim DatiExif As New ExifReader(CType(g, Bitmap))
DataFoto = DatiExif.DateTimeOriginal
TestoFirma = _TestoFirmaStart
If DataFoto.Year <> 1 Then
TestoFirmaPiccola = DataFoto.ToShortTimeString
If _UsaOrarioTestoApplicare = True Then
TestoFirma &= " - " & DataFoto.ToShortDateString & " " & DataFoto.ToLongTimeString
End If
If _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")
End If
End If
End If
Else
TestoFirma = _TestoFirmaStart
End If
Dim FotoRuotaADestra As Boolean = False
Dim FotoRuotaASinistra As Boolean = False
If _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
'rotazione
If FotoRuotaASinistra = True Then
g.RotateFlip(RotateFlipType.Rotate270FlipNone)
End If
If FotoRuotaADestra = True Then
g.RotateFlip(RotateFlipType.Rotate90FlipNone)
End If
Dim thisFormat As System.Drawing.Imaging.ImageFormat = g.RawFormat
If _UsaForzaJpg = True Then
thisFormat = System.Drawing.Imaging.ImageFormat.Jpeg
End If
Dim thumbSizeSmall As New Size
Dim thumbSizeBig As New Size
Dim NomeFileSmall As String = ""
Dim NomeFileBig As String = ""
Dim NomeFileBig2 As String = ""
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
NomeFileSmall = Suffisso & _NomeFileChild
NomeFileBig = _NomeFileChild
Dim imgOutputBig As New Bitmap(g, thumbSizeBig.Width, thumbSizeBig.Height)
imgOutputBig.SetResolution(g.HorizontalResolution, g.VerticalResolution)
If _CreaMiniature = True Then
If _AggiungiScritteMiniature = False Then
If _DirectorySorgente.ToUpper = _DirectoryDestinazione.ToUpper Then
NomeFileSmall = NomeFileSmall.Substring(0, NomeFileSmall.Length - 4) & Codice & NomeFileSmall.Substring(NomeFileSmall.Length - 4)
End If
If _UsaOrarioMiniatura = True 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 crFont1 As Font = Nothing
Dim crSize1 As SizeF = New SizeF
Dim LarghezzaStandard1 As Integer
If _Grassetto = True Then
crFont1 = New Font(IlFont, DimensioneStandardMiniatura, FontStyle.Bold)
Else
crFont1 = New Font(_IlFont, DimensioneStandardMiniatura)
End If
crSize1 = grPhoto1.MeasureString(TestoFirmaPiccola, 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 _Grassetto = True Then
crFont1 = New Font(_IlFont, Conta, FontStyle.Bold)
Else
crFont1 = New Font(_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
Dim yPosFromBottom1 As Single
Select Case _Posizione.ToUpper
Case "ALTO"
yPosFromBottom1 = (_Margine)
Case "BASSO"
'yPosFromBottom = (g.Height - _Margine - DimensioneStandard)
'yPosFromBottom1 = CType((g.Height - crFont1.Height - (g.Height * _Margine / 100) - (crFont1.Height * 0.3)), Single)
yPosFromBottom1 = CType((g.Height - crSize1.Height - (g.Height * _Margine / 100)), Single)
End Select
Dim xCenterOfImg1 As Single
Dim StrFormat1 As StringFormat = New StringFormat
Select Case _Allineamento.ToUpper
Case "SINISTRA"
xCenterOfImg1 = CType((_Margine + (LarghezzaStandard1 / 2)), Single)
If (LarghezzaStandard1 / 2) > (g.Width / 2) - _Margine Then
xCenterOfImg1 = CType((g.Width / 2), Single)
End If
Case "CENTRO"
xCenterOfImg1 = CType((g.Width / 2), Single)
Case "DESTRA"
xCenterOfImg1 = CType((g.Width - _Margine - (LarghezzaStandard1 / 2)), Single)
If (LarghezzaStandard1 / 2) > (g.Width / 2) - _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, _FontColoreR, _FontColoreG, _FontColoreB))
If _Grassetto = True Then
crFont1 = New Font(_IlFont, DimensioneStandardMiniatura, FontStyle.Bold)
Else
crFont1 = New Font(_IlFont, DimensioneStandardMiniatura)
End If
grPhoto1.DrawString(TestoFirmaPiccola, crFont1, semiTransBrush21, New PointF(xCenterOfImg1 + 1, yPosFromBottom1 + 1), StrFormat1)
grPhoto1.DrawString(TestoFirmaPiccola, crFont1, semiTransBrush1, New PointF(xCenterOfImg1, yPosFromBottom1), StrFormat1)
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
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 _Grassetto = True Then
crFont = New Font(_IlFont, DimensioneStandard, FontStyle.Bold)
Else
crFont = New Font(_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 _Grassetto = True Then
crFont = New Font(_IlFont, Conta, FontStyle.Bold)
Else
crFont = New Font(_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
Dim yPosFromBottom As Single
Select Case _Posizione.ToUpper
Case "ALTO"
yPosFromBottom = (_Margine)
Case "BASSO"
'yPosFromBottom = (g.Height - _Margine - DimensioneStandard)
'yPosFromBottom = CType((g.Height - DimensioneStandard - (g.Height * _Margine / 100) - (DimensioneStandard * 0.3)), Single)
yPosFromBottom = CType((g.Height - crSize.Height - (g.Height * _Margine / 100)), Single)
End Select
Dim xCenterOfImg As Single
Dim StrFormat As StringFormat = New StringFormat
Select Case _Allineamento.ToUpper
Case "SINISTRA"
xCenterOfImg = CType((_Margine + (LarghezzaStandard / 2)), Single)
If (LarghezzaStandard / 2) > (g.Width / 2) - _Margine Then
xCenterOfImg = CType((g.Width / 2), Single)
End If
Case "CENTRO"
xCenterOfImg = CType((g.Width / 2), Single)
Case "DESTRA"
xCenterOfImg = CType((g.Width - _Margine - (LarghezzaStandard / 2)), Single)
If (LarghezzaStandard / 2) > (g.Width / 2) - _Margine Then
xCenterOfImg = 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))
If _Grassetto = True Then
crFont = New Font(_IlFont, DimensioneStandard, FontStyle.Bold)
Else
crFont = New Font(_IlFont, DimensioneStandard)
End If
grPhoto.DrawString(TestoFirma, crFont, semiTransBrush2, New PointF(xCenterOfImg + 1, yPosFromBottom + 1), StrFormat)
grPhoto.DrawString(TestoFirma, crFont, semiTransBrush, New PointF(xCenterOfImg, yPosFromBottom), StrFormat)
If _DirectorySorgente.ToUpper = _DirectoryDestinazione.ToUpper Then
NomeFileBig2 = NomeFileBig
NomeFileBig = NomeFileBig.Substring(0, NomeFileBig.Length - 4) & Codice & NomeFileBig.Substring(NomeFileBig.Length - 4)
End If
'imgOutputBig
If _LogoAggiungi = True And File.Exists(_LogoNomeFile) Then
Dim ImmagineLogo As Image = Image.FromFile(_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 transulcent 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 trasparent (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(_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 = _LogoAltezza
Dim FotoLogoW As Integer = _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 _LogoMargine.EndsWith("%") = True Then
InPercentualeL = True
Else
InPercentualeL = False
End If
MargineL = CType(Val(_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 _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 _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
If _FotoGrandeDimOrigina = False Then
imgOutputBig.Save(Path.Combine(_DestDir.FullName, "Temp_" & NomeFileBig), thisFormat)
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, _LarghezzaBig, "Larghezza")
Else
thumbSizeBig = NewthumbSize(g2.Width, g2.Height, _AltezzaBig, "Altezza")
End If
Dim imgOutputBig2 As New Bitmap(g2, thumbSizeBig.Width, thumbSizeBig.Height)
imgOutputBig2.Save(Path.Combine(_DestDir.FullName, NomeFileBig), thisFormat)
imgOutputBig2.Dispose()
imgOutputBig.Dispose()
g2.Dispose()
Else
imgOutputBig.Save(Path.Combine(_DestDir.FullName, NomeFileBig), thisFormat)
imgOutputBig.Dispose()
End If
If _CreaMiniature = True Then
If _AggiungiScritteMiniature = True Then
Dim g1 As System.Drawing.Image
If _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 _DirectorySorgente.ToUpper = _DirectoryDestinazione.ToUpper Then
NomeFileSmall = NomeFileSmall.Substring(0, NomeFileSmall.Length - 4) & Codice & NomeFileSmall.Substring(NomeFileSmall.Length - 4)
End If
imgOutputSmall.Save(Path.Combine(_DestDir.FullName, NomeFileSmall), thisFormat)
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
g.Dispose()
grPhoto.Dispose()
If _DirectorySorgente.ToUpper = _DirectoryDestinazione.ToUpper Then
Kill(Path.Combine(_SourceDir.FullName, NomeFileBig2))
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
Public Property DirectorySorgente() As String
Get
Return _DirectorySorgente
End Get
Set(ByVal value As String)
_DirectorySorgente = value
End Set
End Property
Public Property DirectoryDestinazione() As String
Get
Return _DirectoryDestinazione
End Get
Set(ByVal value As String)
_DirectoryDestinazione = 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 TestoFirmaStart() As String
Get
Return _TestoFirmaStart
End Get
Set(ByVal value As String)
_TestoFirmaStart = value
End Set
End Property
Public Property TestoFirmaStartV() As String
Get
Return _TestoFirmaStartV
End Get
Set(ByVal value As String)
_TestoFirmaStartV = value
End Set
End Property
Public Property DataPartenza() As DateTime
Get
Return _DataPartenza
End Get
Set(ByVal value As DateTime)
_DataPartenza = value
End Set
End Property
Public Property TestoOrario() As String
Get
Return _TestoOrario
End Get
Set(ByVal value As String)
_TestoOrario = value
End Set
End Property
Public Property DimStandard() As Integer
Get
Return _DimStandard
End Get
Set(ByVal value As Integer)
_DimStandard = value
End Set
End Property
Public Property DimStandardMiniatura() As Integer
Get
Return _DimStandardMiniatura
End Get
Set(ByVal value As Integer)
_DimStandardMiniatura = value
End Set
End Property
Public Property UsaOrarioMiniatura() As Boolean
Get
Return _UsaOrarioMiniatura
End Get
Set(ByVal value As Boolean)
_UsaOrarioMiniatura = value
End Set
End Property
Public Property UsaOrarioTestoApplicare() As Boolean
Get
Return _UsaOrarioTestoApplicare
End Get
Set(ByVal value As Boolean)
_UsaOrarioTestoApplicare = value
End Set
End Property
Public Property UsaTempoGaraTestoApplicare() As Boolean
Get
Return _UsaTempoGaraTestoApplicare
End Get
Set(ByVal value As Boolean)
_UsaTempoGaraTestoApplicare = value
End Set
End Property
Public Property UsaRotazioneAutomatica() As Boolean
Get
Return _UsaRotazioneAutomatica
End Get
Set(ByVal value As Boolean)
_UsaRotazioneAutomatica = value
End Set
End Property
Public Property UsaForzaJpg() As Boolean
Get
Return _UsaForzaJpg
End Get
Set(ByVal value As Boolean)
_UsaForzaJpg = value
End Set
End Property
Public Property LarghezzaSmall() As Integer
Get
Return _LarghezzaSmall
End Get
Set(ByVal value As Integer)
_LarghezzaSmall = value
End Set
End Property
Public Property AltezzaSmall() As Integer
Get
Return _AltezzaSmall
End Get
Set(ByVal value As Integer)
_AltezzaSmall = value
End Set
End Property
Public Property CreaMiniature() As Boolean
Get
Return _CreaMiniature
End Get
Set(ByVal value As Boolean)
_CreaMiniature = value
End Set
End Property
Public Property AggiungiScritteMiniature() As Boolean
Get
Return _AggiungiScritteMiniature
End Get
Set(ByVal value As Boolean)
_AggiungiScritteMiniature = 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
Public Property Suffisso() As String
Get
Return _Suffisso
End Get
Set(ByVal value As String)
_Suffisso = value
End Set
End Property
Public Property Codice() As String
Get
Return _Codice
End Get
Set(ByVal value As String)
_Codice = value
End Set
End Property
Public Property Trasparenza() As Integer
Get
Return _Trasparenza
End Get
Set(ByVal value As Integer)
_Trasparenza = value
End Set
End Property
Public Property IlFont() As String
Get
Return _IlFont
End Get
Set(ByVal value As String)
_IlFont = value
End Set
End Property
Public Property Grassetto() As Boolean
Get
Return _Grassetto
End Get
Set(ByVal value As Boolean)
_Grassetto = value
End Set
End Property
Public Property Posizione() As String
Get
Return _Posizione
End Get
Set(ByVal value As String)
_Posizione = value
End Set
End Property
Public Property Allineamento() As String
Get
Return _Allineamento
End Get
Set(ByVal value As String)
_Allineamento = value
End Set
End Property
Public Property Margine() As Integer
Get
Return _Margine
End Get
Set(ByVal value As Integer)
_Margine = value
End Set
End Property
Public Property LogoAltezza() As Integer
Get
Return _LogoAltezza
End Get
Set(ByVal value As Integer)
_LogoAltezza = value
End Set
End Property
Public Property LogoLarghezza() As Integer
Get
Return _LogoLarghezza
End Get
Set(ByVal value As Integer)
_LogoLarghezza = value
End Set
End Property
Public Property FontColoreR() As Integer
Get
Return _FontColoreR
End Get
Set(ByVal value As Integer)
_FontColoreR = value
End Set
End Property
Public Property FontColoreG() As Integer
Get
Return _FontColoreG
End Get
Set(ByVal value As Integer)
_FontColoreG = value
End Set
End Property
Public Property FontColoreB() As Integer
Get
Return _FontColoreB
End Get
Set(ByVal value As Integer)
_FontColoreB = value
End Set
End Property
Public Property LogoAggiungi() As Boolean
Get
Return _LogoAggiungi
End Get
Set(ByVal value As Boolean)
_LogoAggiungi = value
End Set
End Property
Public Property LogoNomeFile() As String
Get
Return _LogoNomeFile
End Get
Set(ByVal value As String)
_LogoNomeFile = value
End Set
End Property
Public Property LogoTrasparenza() As String
Get
Return _LogoTrasparenza
End Get
Set(ByVal value As String)
_LogoTrasparenza = value
End Set
End Property
Public Property LogoMargine() As String
Get
Return _LogoMargine
End Get
Set(ByVal value As String)
_LogoMargine = value
End Set
End Property
Public Property LogoPosizioneH() As String
Get
Return _LogoPosizioneH
End Get
Set(ByVal value As String)
_LogoPosizioneH = value
End Set
End Property
Public Property LogoPosizioneV() As String
Get
Return _LogoPosizioneV
End Get
Set(ByVal value As String)
_LogoPosizioneV = value
End Set
End Property
Public Property FotoGrandeDimOrigina() As Boolean
Get
Return _FotoGrandeDimOrigina
End Get
Set(ByVal value As Boolean)
_FotoGrandeDimOrigina = value
End Set
End Property
Public Property AltezzaBig() As Integer
Get
Return _AltezzaBig
End Get
Set(ByVal value As Integer)
_AltezzaBig = value
End Set
End Property
Public Property LarghezzaBig() As Integer
Get
Return _LarghezzaBig
End Get
Set(ByVal value As Integer)
_LarghezzaBig = 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
End Class

File diff suppressed because it is too large Load diff

1068
imagecatalog/ExifReader.vb Normal file

File diff suppressed because it is too large Load diff

143
imagecatalog/FileHelper.vb Normal file
View file

@ -0,0 +1,143 @@
Imports System.IO
Imports System.Collections.Generic
Public Class FileHelper
'Private dirSourceDest As Dictionary(Of FileInfo, DirectoryInfo)
Private filesPerFolder As Integer
Private suffix As String
Private counterSize As Integer
Private numerationType As Integer
Private filter As String
Private separateFiles As Boolean
Private extensions As String = "*.jpg,*.png,*.gif"
Public Enum numerazione
Progressiva
Files
End Enum
''' <summary>
''' Preparazione per la separazione
''' </summary>
''' <param name="filesPerFolder"></param>
''' <param name="suffix"></param>
''' <param name="counterSize"></param>
''' <param name="numerationType"></param>
''' <remarks></remarks>
Public Sub New(ByVal filesPerFolder As Integer, ByVal suffix As String, ByVal counterSize As Integer, ByVal numerationType As Integer)
Me.filesPerFolder = filesPerFolder
Me.suffix = suffix
Me.counterSize = counterSize
me.numerationType = numerationType
Me.separateFiles = True
End Sub
''' <summary>
''' nessuna separazione
''' </summary>
''' <remarks></remarks>
Public Sub New()
me.separateFiles = False
End Sub
Public Function GetFilesRecursive(ByVal root As DirectoryInfo, ByVal destRoot As DirectoryInfo, ByVal filter As String) As Dictionary(Of FileInfo, DirectoryInfo)
Dim dirSourceDest As New Dictionary(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
appendDictionary(dirSourceDest, dividiFilesInDir(dir, dDir))
Else
appendDictionary(dirSourceDest, getAllFilesInDir(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
End Try
Loop
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)
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)
dict.Add(File, New DirectoryInfo(Path.Combine(dirDest.FullName, File.Name)))
Next
Return dict
End Function
Private Function dividiFilesInDir(dir As DirectoryInfo, dirDest As DirectoryInfo) As Dictionary(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 Dictionary(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.Add(file, destDir)
Next
Return foldersDict
End Function
End Class

120
imagecatalog/Form1.resx Normal file
View file

@ -0,0 +1,120 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

2945
imagecatalog/Form1.vb Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,297 @@
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectType>Local</ProjectType>
<ProductVersion>9.0.30729</ProductVersion>
<SchemaVersion>2.0</SchemaVersion>
<ProjectGuid>{8D3AA2B0-8F06-4A61-9CAD-B920EB1A8E9C}</ProjectGuid>
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<ApplicationIcon>
</ApplicationIcon>
<AssemblyKeyContainerName>
</AssemblyKeyContainerName>
<AssemblyName>ImageCatalog</AssemblyName>
<AssemblyOriginatorKeyFile>
</AssemblyOriginatorKeyFile>
<AssemblyOriginatorKeyMode>None</AssemblyOriginatorKeyMode>
<DefaultClientScript>JScript</DefaultClientScript>
<DefaultHTMLPageLayout>Grid</DefaultHTMLPageLayout>
<DefaultTargetSchema>IE50</DefaultTargetSchema>
<DelaySign>false</DelaySign>
<OutputType>WinExe</OutputType>
<OptionCompare>Binary</OptionCompare>
<OptionExplicit>On</OptionExplicit>
<OptionStrict>On</OptionStrict>
<RootNamespace>ImageCatalog</RootNamespace>
<StartupObject>ImageCatalog.My.MyApplication</StartupObject>
<FileUpgradeFlags>
</FileUpgradeFlags>
<MyType>WindowsForms</MyType>
<OldToolsVersion>3.5</OldToolsVersion>
<UpgradeBackupLocation>
</UpgradeBackupLocation>
<TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
<IsWebBootstrapper>true</IsWebBootstrapper>
<ApplicationManifest>My Project\app.manifest</ApplicationManifest>
<TargetFrameworkProfile>Client</TargetFrameworkProfile>
<PublishUrl>http://localhost/ImageCatalog/</PublishUrl>
<Install>true</Install>
<InstallFrom>Web</InstallFrom>
<UpdateEnabled>true</UpdateEnabled>
<UpdateMode>Foreground</UpdateMode>
<UpdateInterval>7</UpdateInterval>
<UpdateIntervalUnits>Days</UpdateIntervalUnits>
<UpdatePeriodically>false</UpdatePeriodically>
<UpdateRequired>false</UpdateRequired>
<MapFileExtensions>true</MapFileExtensions>
<ApplicationRevision>0</ApplicationRevision>
<ApplicationVersion>1.8.0.%2a</ApplicationVersion>
<UseApplicationTrust>false</UseApplicationTrust>
<BootstrapperEnabled>true</BootstrapperEnabled>
<SccProjectName>SAK</SccProjectName>
<SccLocalPath>SAK</SccLocalPath>
<SccAuxPath>SAK</SccAuxPath>
<SccProvider>SAK</SccProvider>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<OutputPath>bin\</OutputPath>
<DocumentationFile>ImageCatalog.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>true</DebugSymbols>
<Optimize>false</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032,42353,42354,42355</NoWarn>
<DebugType>full</DebugType>
<PlatformTarget>AnyCPU</PlatformTarget>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<OutputPath>bin\</OutputPath>
<DocumentationFile>ImageCatalog.xml</DocumentationFile>
<BaseAddress>285212672</BaseAddress>
<ConfigurationOverrideFile>
</ConfigurationOverrideFile>
<DefineConstants>
</DefineConstants>
<DefineDebug>false</DefineDebug>
<DefineTrace>true</DefineTrace>
<DebugSymbols>false</DebugSymbols>
<Optimize>true</Optimize>
<RegisterForComInterop>false</RegisterForComInterop>
<RemoveIntegerChecks>false</RemoveIntegerChecks>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032,42353,42354,42355</NoWarn>
<DebugType>none</DebugType>
<PlatformTarget>AnyCPU</PlatformTarget>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|x64' ">
<DebugSymbols>true</DebugSymbols>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x64\Debug\</OutputPath>
<BaseAddress>285212672</BaseAddress>
<DocumentationFile>ImageCatalog.xml</DocumentationFile>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032,42353,42354,42355</NoWarn>
<DebugType>full</DebugType>
<PlatformTarget>x64</PlatformTarget>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|x64' ">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x64\Release\</OutputPath>
<BaseAddress>285212672</BaseAddress>
<DocumentationFile>ImageCatalog.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032,42353,42354,42355</NoWarn>
<PlatformTarget>x64</PlatformTarget>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Debug|x86'">
<DebugSymbols>true</DebugSymbols>
<DefineDebug>true</DefineDebug>
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x86\Debug\</OutputPath>
<BaseAddress>285212672</BaseAddress>
<DocumentationFile>ImageCatalog.xml</DocumentationFile>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032,42353,42354,42355</NoWarn>
<DebugType>full</DebugType>
<PlatformTarget>x86</PlatformTarget>
<CodeAnalysisLogFile>bin\ImageCatalog.exe.CodeAnalysisLog.xml</CodeAnalysisLogFile>
<CodeAnalysisUseTypeNameInSuppression>true</CodeAnalysisUseTypeNameInSuppression>
<CodeAnalysisModuleSuppressionsFile>GlobalSuppressions.vb</CodeAnalysisModuleSuppressionsFile>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
<CodeAnalysisRuleSetDirectories>;F:\Program Files (x86)\Microsoft Visual Studio 10.0\Team Tools\Static Analysis Tools\\Rule Sets</CodeAnalysisRuleSetDirectories>
<CodeAnalysisIgnoreBuiltInRuleSets>true</CodeAnalysisIgnoreBuiltInRuleSets>
<CodeAnalysisRuleDirectories>;F:\Program Files (x86)\Microsoft Visual Studio 10.0\Team Tools\Static Analysis Tools\FxCop\\Rules</CodeAnalysisRuleDirectories>
<CodeAnalysisIgnoreBuiltInRules>true</CodeAnalysisIgnoreBuiltInRules>
<CodeAnalysisFailOnMissingRules>false</CodeAnalysisFailOnMissingRules>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(Platform)' == 'Release|x86'">
<DefineTrace>true</DefineTrace>
<OutputPath>bin\x86\Release\</OutputPath>
<BaseAddress>285212672</BaseAddress>
<DocumentationFile>ImageCatalog.xml</DocumentationFile>
<Optimize>true</Optimize>
<WarningLevel>1</WarningLevel>
<NoWarn>42016,42017,42018,42019,42032,42353,42354,42355</NoWarn>
<PlatformTarget>x86</PlatformTarget>
<CodeAnalysisLogFile>bin\ImageCatalog.exe.CodeAnalysisLog.xml</CodeAnalysisLogFile>
<CodeAnalysisUseTypeNameInSuppression>true</CodeAnalysisUseTypeNameInSuppression>
<CodeAnalysisModuleSuppressionsFile>GlobalSuppressions.vb</CodeAnalysisModuleSuppressionsFile>
<CodeAnalysisRuleSet>AllRules.ruleset</CodeAnalysisRuleSet>
<CodeAnalysisRuleSetDirectories>;F:\Program Files (x86)\Microsoft Visual Studio 10.0\Team Tools\Static Analysis Tools\\Rule Sets</CodeAnalysisRuleSetDirectories>
<CodeAnalysisIgnoreBuiltInRuleSets>true</CodeAnalysisIgnoreBuiltInRuleSets>
<CodeAnalysisRuleDirectories>;F:\Program Files (x86)\Microsoft Visual Studio 10.0\Team Tools\Static Analysis Tools\FxCop\\Rules</CodeAnalysisRuleDirectories>
<CodeAnalysisIgnoreBuiltInRules>true</CodeAnalysisIgnoreBuiltInRules>
</PropertyGroup>
<ItemGroup>
<Reference Include="Microsoft.VisualBasic.PowerPacks.Vs, Version=10.0.0.0" />
<Reference Include="System">
<Name>System</Name>
</Reference>
<Reference Include="System.Core">
<RequiredTargetFramework>3.5</RequiredTargetFramework>
<Private>True</Private>
</Reference>
<Reference Include="System.Data">
<Name>System.Data</Name>
<Private>True</Private>
</Reference>
<Reference Include="System.Drawing">
<Name>System.Drawing</Name>
<Private>True</Private>
</Reference>
<Reference Include="System.Windows.Forms">
<Name>System.Windows.Forms</Name>
</Reference>
<Reference Include="System.Xml">
<Name>System.XML</Name>
</Reference>
</ItemGroup>
<ItemGroup>
<Import Include="Microsoft.VisualBasic" />
<Import Include="System" />
<Import Include="System.Collections" />
<Import Include="System.Data" />
<Import Include="System.Diagnostics" />
<Import Include="System.Drawing" />
<Import Include="System.Linq" />
<Import Include="System.Windows.Forms" />
</ItemGroup>
<ItemGroup>
<Compile Include="AssemblyInfo.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="FileHelper.vb" />
<Compile Include="ImageCreator.vb" />
<Compile Include="CreaImmagineSeparateMultiCore.vb" />
<Compile Include="CreaImmagineSeparateThread.vb" />
<Compile Include="ExifReader.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="Form1.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="LoadBuffer.vb" />
<Compile Include="MainForm.Designer.vb">
<DependentUpon>MainForm.vb</DependentUpon>
</Compile>
<Compile Include="MainForm.vb">
<SubType>Form</SubType>
</Compile>
<Compile Include="Module2.vb" />
<Compile Include="My Project\Application.Designer.vb">
<AutoGen>True</AutoGen>
<DependentUpon>Application.myapp</DependentUpon>
</Compile>
<Compile Include="My Project\Settings.Designer.vb">
<AutoGen>True</AutoGen>
<DesignTimeSharedInput>True</DesignTimeSharedInput>
<DependentUpon>Settings.settings</DependentUpon>
</Compile>
<Compile Include="PicSettings.vb" />
<Compile Include="XYThreadPool.vb" />
<Compile Include="Module1.vb">
<SubType>Code</SubType>
</Compile>
<Compile Include="ParametriSetup.vb">
<SubType>Code</SubType>
</Compile>
<EmbeddedResource Include="Form1.resx">
<DependentUpon>Form1.vb</DependentUpon>
<SubType>Designer</SubType>
</EmbeddedResource>
<EmbeddedResource Include="MainForm.resx">
<DependentUpon>MainForm.vb</DependentUpon>
</EmbeddedResource>
<None Include="My Project\Application.myapp">
<Generator>MyApplicationCodeGenerator</Generator>
<LastGenOutput>Application.Designer.vb</LastGenOutput>
</None>
<None Include="app.config" />
<None Include="ClassDiagram1.cd" />
<None Include="My Project\app.manifest" />
<None Include="My Project\Settings.settings">
<CustomToolNamespace>My</CustomToolNamespace>
<Generator>SettingsSingleFileGenerator</Generator>
<LastGenOutput>Settings.Designer.vb</LastGenOutput>
</None>
</ItemGroup>
<ItemGroup>
<BootstrapperPackage Include="Microsoft.Net.Client.3.5">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5 SP1 Client Profile</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.2.0">
<Visible>False</Visible>
<ProductName>.NET Framework 2.0 %28x86%29</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.0">
<Visible>False</Visible>
<ProductName>.NET Framework 3.0 %28x86%29</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.5">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5</ProductName>
<Install>true</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Net.Framework.3.5.SP1">
<Visible>False</Visible>
<ProductName>.NET Framework 3.5 SP1</ProductName>
<Install>false</Install>
</BootstrapperPackage>
<BootstrapperPackage Include="Microsoft.Windows.Installer.3.1">
<Visible>False</Visible>
<ProductName>Windows Installer 3.1</ProductName>
<Install>true</Install>
</BootstrapperPackage>
</ItemGroup>
<ItemGroup>
<Folder Include="Sorgenti\" />
</ItemGroup>
<Import Project="$(MSBuildBinPath)\Microsoft.VisualBasic.targets" />
<PropertyGroup>
<PreBuildEvent>
</PreBuildEvent>
<PostBuildEvent>
</PostBuildEvent>
</PropertyGroup>
</Project>

View file

@ -0,0 +1,835 @@
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

@ -0,0 +1,9 @@
Imports System.Collections.Generic
Imports System.IO
Public Class LoadBuffer
Public imageList As New List(Of System.Drawing.Image)
Public picSourceList As New List(Of FileInfo)
Public dirSourceList As New List(Of List(Of FileInfo))
End Class

1786
imagecatalog/MainForm.Designer.vb generated Normal file

File diff suppressed because it is too large Load diff

120
imagecatalog/MainForm.resx Normal file
View file

@ -0,0 +1,120 @@
<?xml version="1.0" encoding="utf-8"?>
<root>
<!--
Microsoft ResX Schema
Version 2.0
The primary goals of this format is to allow a simple XML format
that is mostly human readable. The generation and parsing of the
various data types are done through the TypeConverter classes
associated with the data types.
Example:
... ado.net/XML headers & schema ...
<resheader name="resmimetype">text/microsoft-resx</resheader>
<resheader name="version">2.0</resheader>
<resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader>
<resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader>
<data name="Name1"><value>this is my long string</value><comment>this is a comment</comment></data>
<data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data>
<data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64">
<value>[base64 mime encoded serialized .NET Framework object]</value>
</data>
<data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64">
<value>[base64 mime encoded string representing a byte array form of the .NET Framework object]</value>
<comment>This is a comment</comment>
</data>
There are any number of "resheader" rows that contain simple
name/value pairs.
Each data row contains a name, and value. The row also contains a
type or mimetype. Type corresponds to a .NET class that support
text/value conversion through the TypeConverter architecture.
Classes that don't support this are serialized and stored with the
mimetype set.
The mimetype is used for serialized objects, and tells the
ResXResourceReader how to depersist the object. This is currently not
extensible. For a given mimetype the value must be set accordingly:
Note - application/x-microsoft.net.object.binary.base64 is the format
that the ResXResourceWriter will generate, however the reader can
read any of the formats listed below.
mimetype: application/x-microsoft.net.object.binary.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.soap.base64
value : The object must be serialized with
: System.Runtime.Serialization.Formatters.Soap.SoapFormatter
: and then encoded with base64 encoding.
mimetype: application/x-microsoft.net.object.bytearray.base64
value : The object must be serialized into a byte array
: using a System.ComponentModel.TypeConverter
: and then encoded with base64 encoding.
-->
<xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xsd:import namespace="http://www.w3.org/XML/1998/namespace" />
<xsd:element name="root" msdata:IsDataSet="true">
<xsd:complexType>
<xsd:choice maxOccurs="unbounded">
<xsd:element name="metadata">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" />
</xsd:sequence>
<xsd:attribute name="name" use="required" type="xsd:string" />
<xsd:attribute name="type" type="xsd:string" />
<xsd:attribute name="mimetype" type="xsd:string" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="assembly">
<xsd:complexType>
<xsd:attribute name="alias" type="xsd:string" />
<xsd:attribute name="name" type="xsd:string" />
</xsd:complexType>
</xsd:element>
<xsd:element name="data">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
<xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" msdata:Ordinal="1" />
<xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" />
<xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" />
<xsd:attribute ref="xml:space" />
</xsd:complexType>
</xsd:element>
<xsd:element name="resheader">
<xsd:complexType>
<xsd:sequence>
<xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" />
</xsd:sequence>
<xsd:attribute name="name" type="xsd:string" use="required" />
</xsd:complexType>
</xsd:element>
</xsd:choice>
</xsd:complexType>
</xsd:element>
</xsd:schema>
<resheader name="resmimetype">
<value>text/microsoft-resx</value>
</resheader>
<resheader name="version">
<value>2.0</value>
</resheader>
<resheader name="reader">
<value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
</root>

1328
imagecatalog/MainForm.vb Normal file

File diff suppressed because it is too large Load diff

155
imagecatalog/Module1.vb Normal file
View file

@ -0,0 +1,155 @@
Module Module1
'Sub CaricaIni()
' Dim Parola As String
' Dim i As Integer
' Dim p As Integer
' If Dir$(NomeIni) <> "" Then
' Open NomeIni For Input As #1
' Input #1, NumeroMacchine
' For i = 1 To NumeroMacchine
' Input #1, NomeMacchina(i)
' Input #1, CodiceMacchina(i)
' Input #1, TempoMacchinaFerma(i)
' Input #1, LunghezzaImpulso(i)
' Input #1, TempoRegistrazioneDati(i)
' Input #1, RangoVelocita(i)
' Input #1, MaxVelocita(i)
' Input #1, NumeroRulli(i)
' Input #1, NumeroFili(i)
' Input #1, IndirizzoMacchina(i)
' Input #1, StampaAutoMacchina(i)
' Next i
' Input #1, SettimanaInizio
' Input #1, SettimanaFine
' Input #1, Chiusura
' Input #1, OrarioStampa
' Input #1, OrarioStampaSecondi
' Input #1, OrarioAccendiProg
' Input #1, OrarioSpengiProg
' Input #1, NomeDitta
' Input #1, StampaAutoGiorno
' Input #1, StampaAutoWeek
' Input #1, StampaGiornoRiepilogo
' Input #1, StampaGiornoGrafTMFA
' Input #1, StampaGiornoGrafVel
' Input #1, StampaWeekRiepilogo
' Input #1, StampaWeekGrafTMFA
' Input #1, StampaWeekGrafVel
' Input #1, StampanteManuale
' Input #1, StampanteAutomatica
' Input #1, StampanteNomeAghi
' Input #1, StampanteNomeLaser
' Input #1, NomePortaComm
' Input #1, TurniTotali
' For p = 1 To TurniTotali
' Input #1, TurnoNumero(p)
' Input #1, TurnoInizioMinuti(p)
' Input #1, TurnoFineMinuti(p)
' Input #1, TurnoInizioSecondi(p)
' Input #1, TurnoFineSecondi(p)
' Next p
' Input #1, Parola
' Close #1
' PassWordAmm = Trim$(Cripta(Parola, ChiaveCriDecri))
' End If
'End Sub
'Sub SalvaIni()
' Dim Conto As Single
' Dim Nomefile As String
' Dim NomeDir As String
' Dim Testo As String
' Dim TestoA As String
' Dim i As Integer
' Dim k As Integer
' Dim p As Integer
' Dim Lungo As Integer
' Dim Resto As Integer
' Dim Primo(3) As String
' For i = 1 To NumeroMacchine
' If Right$(DirectoryProgramma, 1) = "\" Then
' NomeDir = DirectoryProgramma + NomeMacchina(i)
' Else
' NomeDir = DirectoryProgramma + "\" + NomeMacchina(i)
' End If
' Nomefile = NomeDir + "\" + NomeMacchina(i) + ".SYS"
' If Dir$(Nomefile) = "" Then MkDir(NomeDir)
' Next i
'Open NomeIni For Output As #3
' Print #3, NumeroMacchine
' For i = 1 To NumeroMacchine
' If Right$(DirectoryProgramma, 1) = "\" Then
' Nomefile = DirectoryProgramma + NomeMacchina(i) + "\" + NomeMacchina(i) + ".SYS"
' Else
' Nomefile = DirectoryProgramma + "\" + NomeMacchina(i) + "\" + NomeMacchina(i) + ".SYS"
' End If
' Open Nomefile For Output As #4
' Write #4, NomeMacchina(i)
' Write #4, CodiceMacchina(i)
' Print #4, TempoMacchinaFerma(i)
' Print #4, LunghezzaImpulso(i)
' Print #4, TempoRegistrazioneDati(i)
' Print #4, RangoVelocita(i)
' Print #4, MaxVelocita(i)
' Print #4, NumeroRulli(i)
' Print #4, NumeroFili(i)
' Print #4, IndirizzoMacchina(i)
' Write #4, StampaAutoMacchina(i)
' Close #4
' Write #3, NomeMacchina(i)
' Write #3, CodiceMacchina(i)
' Print #3, TempoMacchinaFerma(i)
' Print #3, LunghezzaImpulso(i)
' Print #3, TempoRegistrazioneDati(i)
' Print #3, RangoVelocita(i)
' Print #3, MaxVelocita(i)
' Print #3, NumeroRulli(i)
' Print #3, NumeroFili(i)
' Print #3, IndirizzoMacchina(i)
' Write #3, StampaAutoMacchina(i)
' Next i
' Print #3, SettimanaInizio
' Print #3, SettimanaFine
' Write #3, Chiusura
' Write #3, OrarioStampa
' Print #3, OrarioStampaSecondi
' Write #3, OrarioAccendiProg
' Write #3, OrarioSpengiProg
' Write #3, NomeDitta
' Write #3, StampaAutoGiorno
' Write #3, StampaAutoWeek
' Write #3, StampaGiornoRiepilogo
' Write #3, StampaGiornoGrafTMFA
' Write #3, StampaGiornoGrafVel
' Write #3, StampaWeekRiepilogo
' Write #3, StampaWeekGrafTMFA
' Write #3, StampaWeekGrafVel
' Write #3, StampanteManuale
' Write #3, StampanteAutomatica
' Write #3, StampanteNomeAghi
' Write #3, StampanteNomeLaser
' Write #3, NomePortaComm
' Print #3, TurniTotali
' For p = 1 To TurniTotali
' Print #3, TurnoNumero(p)
' Print #3, TurnoInizioMinuti(p)
' Print #3, TurnoFineMinuti(p)
' Print #3, TurnoInizioSecondi(p)
' Print #3, TurnoFineSecondi(p)
' Next p
' Testo = Cripta(PassWordAmm, ChiaveCriDecri)
' Write #3, Testo
'Close #3
'End Sub
Public SetupIni As New ParametriSetup
End Module

3
imagecatalog/Module2.vb Normal file
View file

@ -0,0 +1,3 @@
Module Module2
End Module

View file

@ -0,0 +1,38 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.18033
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
'NOTE: This file is auto-generated; do not modify it directly. To make changes,
' or if you encounter build errors in this file, go to the Project Designer
' (go to Project Properties or double-click the My Project node in
' Solution Explorer), and make changes on the Application tab.
'
Partial Friend Class MyApplication
<Global.System.Diagnostics.DebuggerStepThroughAttribute()> _
Public Sub New()
MyBase.New(Global.Microsoft.VisualBasic.ApplicationServices.AuthenticationMode.Windows)
Me.IsSingleInstance = false
Me.EnableVisualStyles = true
Me.SaveMySettingsOnExit = true
Me.ShutDownStyle = Global.Microsoft.VisualBasic.ApplicationServices.ShutdownMode.AfterMainFormCloses
End Sub
<Global.System.Diagnostics.DebuggerStepThroughAttribute()> _
Protected Overrides Sub OnCreateMainForm()
Me.MainForm = Global.ImageCatalog.MainForm
End Sub
End Class
End Namespace

View file

@ -0,0 +1,10 @@
<?xml version="1.0" encoding="utf-8"?>
<MyApplicationData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<MySubMain>true</MySubMain>
<MainForm>MainForm</MainForm>
<SingleInstance>false</SingleInstance>
<ShutdownMode>0</ShutdownMode>
<EnableVisualStyles>true</EnableVisualStyles>
<AuthenticationMode>0</AuthenticationMode>
<SaveMySettingsOnExit>true</SaveMySettingsOnExit>
</MyApplicationData>

View file

@ -0,0 +1,73 @@
'------------------------------------------------------------------------------
' <auto-generated>
' This code was generated by a tool.
' Runtime Version:4.0.30319.18033
'
' Changes to this file may cause incorrect behavior and will be lost if
' the code is regenerated.
' </auto-generated>
'------------------------------------------------------------------------------
Option Strict On
Option Explicit On
Namespace My
<Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute(), _
Global.System.CodeDom.Compiler.GeneratedCodeAttribute("Microsoft.VisualStudio.Editors.SettingsDesigner.SettingsSingleFileGenerator", "11.0.0.0"), _
Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Partial Friend NotInheritable Class MySettings
Inherits Global.System.Configuration.ApplicationSettingsBase
Private Shared defaultInstance As MySettings = CType(Global.System.Configuration.ApplicationSettingsBase.Synchronized(New MySettings()),MySettings)
#Region "My.Settings Auto-Save Functionality"
#If _MyType = "WindowsForms" Then
Private Shared addedHandler As Boolean
Private Shared addedHandlerLockObject As New Object
<Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), Global.System.ComponentModel.EditorBrowsableAttribute(Global.System.ComponentModel.EditorBrowsableState.Advanced)> _
Private Shared Sub AutoSaveSettings(ByVal sender As Global.System.Object, ByVal e As Global.System.EventArgs)
If My.Application.SaveMySettingsOnExit Then
My.Settings.Save()
End If
End Sub
#End If
#End Region
Public Shared ReadOnly Property [Default]() As MySettings
Get
#If _MyType = "WindowsForms" Then
If Not addedHandler Then
SyncLock addedHandlerLockObject
If Not addedHandler Then
AddHandler My.Application.Shutdown, AddressOf AutoSaveSettings
addedHandler = True
End If
End SyncLock
End If
#End If
Return defaultInstance
End Get
End Property
End Class
End Namespace
Namespace My
<Global.Microsoft.VisualBasic.HideModuleNameAttribute(), _
Global.System.Diagnostics.DebuggerNonUserCodeAttribute(), _
Global.System.Runtime.CompilerServices.CompilerGeneratedAttribute()> _
Friend Module MySettingsProperty
<Global.System.ComponentModel.Design.HelpKeywordAttribute("My.Settings")> _
Friend ReadOnly Property Settings() As Global.ImageCatalog.My.MySettings
Get
Return Global.ImageCatalog.My.MySettings.Default
End Get
End Property
End Module
End Namespace

View file

@ -0,0 +1,6 @@
<?xml version='1.0' encoding='utf-8'?>
<SettingsFile xmlns="http://schemas.microsoft.com/VisualStudio/2004/01/settings" CurrentProfile="(Default)" UseMySettingsClassName="true">
<Profiles>
<Profile Name="(Default)" />
</Profiles>
</SettingsFile>

View file

@ -0,0 +1,22 @@
<?xml version="1.0" encoding="utf-8"?>
<asmv1:assembly manifestVersion="1.0" xmlns="urn:schemas-microsoft-com:asm.v1" xmlns:asmv1="urn:schemas-microsoft-com:asm.v1" xmlns:asmv2="urn:schemas-microsoft-com:asm.v2" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
<assemblyIdentity version="1.0.0.0" name="MyApplication.app"/>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
<security>
<requestedPrivileges xmlns="urn:schemas-microsoft-com:asm.v3">
<!-- UAC Manifest Options
If you want to change the Windows User Account Control level replace the
requestedExecutionLevel node with one of the following.
<requestedExecutionLevel level="asInvoker" uiAccess="false" />
<requestedExecutionLevel level="requireAdministrator" uiAccess="false" />
<requestedExecutionLevel level="highestAvailable" uiAccess="false" />
If you want to utilize File and Registry Virtualization for backward
compatibility then delete the requestedExecutionLevel node.
-->
<requestedExecutionLevel level="asInvoker" uiAccess="false" />
</requestedPrivileges>
</security>
</trustInfo>
</asmv1:assembly>

View file

@ -0,0 +1,148 @@
Public Class ParametriSetup
Private _ElencoParametri As DataSet
Private _NomeFileSetup As String
Public Sub New(ByVal FileSetup As String)
_ElencoParametri = New DataSet
_NomeFileSetup = FileSetup
If FileSetup <> "" Then
CaricaParametriSetup()
End If
End Sub
Public Sub New()
_ElencoParametri = New DataSet
_NomeFileSetup = ""
End Sub
Public Sub CaricaParametriSetup()
_ElencoParametri = LeggiXmlDataSet("Setup", _NomeFileSetup, "Nome")
End Sub
Public Sub SalvaParametriSetup()
If System.IO.File.Exists(_NomeFileSetup) = True Then
Kill(_NomeFileSetup)
End If
_ElencoParametri.WriteXml(_NomeFileSetup)
End Sub
Public Function LeggiParametroString(ByVal NomeParametro As String) As String
Dim Risposta As String = ""
Try
Dim LElenco As DataRow() = _ElencoParametri.Tables("Setup").Select("Nome='" & NomeParametro & "'")
Dim LaRiga As DataRow
For Each LaRiga In LElenco
Risposta = LaRiga("Valore").ToString
Next
Catch
Risposta = ""
End Try
Return Risposta
End Function
Public Function LeggiParametroBoolean(ByVal NomeParametro As String) As Boolean
Dim Risposta As String = ""
Try
Dim LElenco As DataRow() = _ElencoParametri.Tables("Setup").Select("Nome='" & NomeParametro & "'")
Dim LaRiga As DataRow
For Each LaRiga In LElenco
Risposta = LaRiga("Valore").ToString
Next
Catch
Risposta = ""
End Try
Select Case Risposta.ToUpper
Case "TRUE", "OK", "SI", "1", "YES", "VERO"
Return True
Case Else
Return False
End Select
End Function
Public Sub AggiornaParametro(ByVal NomeParametro As String, ByVal ValoreParametro As Object)
Try
If _ElencoParametri.Tables("Setup") Is Nothing Then
Dim TabellaTmp As New DataTable("Setup")
Dim RigaTmp As DataRow
Dim LaColonna As DataColumn
LaColonna = TabellaTmp.Columns.Add("Nome", System.Type.GetType("System.String"))
LaColonna = TabellaTmp.Columns.Add("Valore", System.Type.GetType("System.String"))
'* Aggiunge alla tabella tutte le righe
RigaTmp = TabellaTmp.NewRow
RigaTmp("Nome") = NomeParametro
RigaTmp("Valore") = ValoreParametro
TabellaTmp.Rows.Add(RigaTmp)
_ElencoParametri.Tables.Add(TabellaTmp)
Else
Dim LElenco As DataRow() = _ElencoParametri.Tables("Setup").Select("Nome='" & NomeParametro & "'")
If LElenco.Length = 0 Then
Dim LaRiga As DataRow
LaRiga = _ElencoParametri.Tables("Setup").NewRow
LaRiga("Nome") = NomeParametro
LaRiga("Valore") = ValoreParametro
_ElencoParametri.Tables("Setup").Rows.Add(LaRiga)
Else
LElenco(0).Item("Valore") = ValoreParametro
End If
End If
Catch
End Try
End Sub
Private Function LeggiXmlDataTable(ByVal NomeTabella As String, ByVal NomeFileXml As String, Optional ByVal NomeColonnaChiave As String = "") As DataTable
'* Crea e Legge il dataset dal file xml
Dim DataSetXml As New System.Data.DataSet
DataSetXml.ReadXml(NomeFileXml)
'* Aggiunge il campo chiave
If NomeColonnaChiave <> "" Then
DataSetXml.Tables(NomeTabella).Constraints.Add(NomeColonnaChiave, DataSetXml.Tables(NomeTabella).Columns(NomeColonnaChiave), True)
End If
'* Restituisce la risposta
Return DataSetXml.Tables(NomeTabella)
End Function
Private Shared Function LeggiXmlDataSet(ByVal NomeTabella As String, ByVal NomeFileXml As String, Optional ByVal NomeColonnaChiave As String = "") As DataSet
'* Crea e Legge il dataset dal file xml
Dim DataSetXml As New System.Data.DataSet
DataSetXml.ReadXml(NomeFileXml)
'* Aggiunge il campo chiave
If NomeColonnaChiave <> "" Then
DataSetXml.Tables(NomeTabella).Constraints.Add(NomeColonnaChiave, DataSetXml.Tables(NomeTabella).Columns(NomeColonnaChiave), True)
End If
'* Restituisce la risposta
Return DataSetXml
End Function
Public Property NomeFileSetup() As String
Get
Return _NomeFileSetup
End Get
Set(ByVal Value As String)
_NomeFileSetup = Value
End Set
End Property
End Class

604
imagecatalog/PicSettings.vb Normal file
View file

@ -0,0 +1,604 @@
Imports System.IO
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Module PicSettings
Private _DirectorySorgente As String
Private _DirectoryDestinazione As String
Private _DimVert As Integer
Private _MargVert As Integer
Private _DimStandard As Integer
Private _DimStandardMiniatura As Integer
Private _NomeData As Boolean
Private _TestoNome As Boolean
Private _UsaOrarioMiniatura As Boolean
Private _UsaOrarioTestoApplicare As Boolean
Private _UsaTempoGaraTestoApplicare As Boolean
Private _TestoFirmaStart As String
Private _TestoFirmaStartV As String
Private _DataPartenza As DateTime
Private _TestoOrario As String
Private _UsaRotazioneAutomatica As Boolean
Private _UsaForzaJpg As Boolean
Private _LarghezzaSmall As Integer
Private _AltezzaSmall As Integer
Private _CreaMiniature As Boolean
Private _AggiungiScritteMiniature As Boolean
Private _AggTempoGaraMin As Boolean
Private _AggNumTempMin As Boolean
Private _Suffisso As String
Private _Codice As String
Private _Trasparenza As Integer
Private _IlFont As String
Private _Grassetto As Boolean
Private _Posizione As String
Private _Allineamento As String
Private _Margine As Integer
Private _LogoAltezza As Integer
Private _LogoLarghezza As Integer
Private _fontColoreRGB As Color
Private _LogoAggiungi As Boolean
Private _LogoNomeFile As String
Private _LogoTrasparenza As String
Private _LogoMargine As String
Private _LogoPosizioneH As String
Private _LogoPosizioneV As String
Private _FotoGrandeDimOrigina As Boolean
Private _AltezzaBig As Integer
Private _LarghezzaBig As Integer
Private _DestDir As DirectoryInfo
Private _DimMin As Integer
Private _TestoMin As Boolean
Private _SecretDefault As Boolean
Private _SecretBig As Boolean
Private _SecretSmall As Boolean
Private _SecretPathSmall As String
Private _SecretPathBig As String
Private _jpegQuality As Long
Private _jpegQualityMin As Long
Private FotoRuotaADestra As Boolean = False
Private FotoRuotaASinistra As Boolean = False
Private TempMinText As String = ""
Private _mainForm As MainForm
'Private progressBar As System.Windows.Forms.ProgressBar
Public Property mainForm() As MainForm
Get
Return _mainForm
End Get
Set(ByVal value As MainForm)
_mainForm = value
End Set
End Property
Public Property DirectorySorgente() As String
Get
Return _DirectorySorgente
End Get
Set(ByVal value As String)
_DirectorySorgente = value
End Set
End Property
Public Property DirectoryDestinazione() As String
Get
Return _DirectoryDestinazione
End Get
Set(ByVal value As String)
_DirectoryDestinazione = value
End Set
End Property
Public Property TestoFirmaStart() As String
Get
Return _TestoFirmaStart
End Get
Set(ByVal value As String)
_TestoFirmaStart = value
End Set
End Property
Public Property TestoFirmaStartV() As String
Get
Return _TestoFirmaStartV
End Get
Set(ByVal value As String)
_TestoFirmaStartV = value
End Set
End Property
Public Property DataPartenza() As DateTime
Get
Return _DataPartenza
End Get
Set(ByVal value As DateTime)
_DataPartenza = value
End Set
End Property
Public Property TestoOrario() As String
Get
Return _TestoOrario
End Get
Set(ByVal value As String)
_TestoOrario = value
End Set
End Property
Public Property DimStandard() As Integer
Get
Return _DimStandard
End Get
Set(ByVal value As Integer)
_DimStandard = value
End Set
End Property
Public Property DimStandardMiniatura() As Integer
Get
Return _DimStandardMiniatura
End Get
Set(ByVal value As Integer)
_DimStandardMiniatura = value
End Set
End Property
Public Property NomeData() As Boolean
Get
Return _NomeData
End Get
Set(ByVal value As Boolean)
_NomeData = value
End Set
End Property
Public Property TestoNome() As Boolean
Get
Return _TestoNome
End Get
Set(ByVal value As Boolean)
_TestoNome = value
End Set
End Property
Public Property UsaOrarioMiniatura() As Boolean
Get
Return _UsaOrarioMiniatura
End Get
Set(ByVal value As Boolean)
_UsaOrarioMiniatura = value
End Set
End Property
Public Property UsaOrarioTestoApplicare() As Boolean
Get
Return _UsaOrarioTestoApplicare
End Get
Set(ByVal value As Boolean)
_UsaOrarioTestoApplicare = value
End Set
End Property
Public Property UsaTempoGaraTestoApplicare() As Boolean
Get
Return _UsaTempoGaraTestoApplicare
End Get
Set(ByVal value As Boolean)
_UsaTempoGaraTestoApplicare = value
End Set
End Property
Public Property UsaRotazioneAutomatica() As Boolean
Get
Return _UsaRotazioneAutomatica
End Get
Set(ByVal value As Boolean)
_UsaRotazioneAutomatica = value
End Set
End Property
Public Property UsaForzaJpg() As Boolean
Get
Return _UsaForzaJpg
End Get
Set(ByVal value As Boolean)
_UsaForzaJpg = value
End Set
End Property
Public Property LarghezzaSmall() As Integer
Get
Return _LarghezzaSmall
End Get
Set(ByVal value As Integer)
_LarghezzaSmall = value
End Set
End Property
Public Property AltezzaSmall() As Integer
Get
Return _AltezzaSmall
End Get
Set(ByVal value As Integer)
_AltezzaSmall = value
End Set
End Property
Public Property CreaMiniature() As Boolean
Get
Return _CreaMiniature
End Get
Set(ByVal value As Boolean)
_CreaMiniature = value
End Set
End Property
Public Property AggiungiScritteMiniature() As Boolean
Get
Return _AggiungiScritteMiniature
End Get
Set(ByVal value As Boolean)
_AggiungiScritteMiniature = value
End Set
End Property
Public Property Suffisso() As String
Get
Return _Suffisso
End Get
Set(ByVal value As String)
_Suffisso = value
End Set
End Property
Public Property Codice() As String
Get
Return _Codice
End Get
Set(ByVal value As String)
_Codice = value
End Set
End Property
Public Property Trasparenza() As Integer
Get
Return _Trasparenza
End Get
Set(ByVal value As Integer)
_Trasparenza = value
End Set
End Property
Public Property IlFont() As String
Get
Return _IlFont
End Get
Set(ByVal value As String)
_IlFont = value
End Set
End Property
Public Property Grassetto() As Boolean
Get
Return _Grassetto
End Get
Set(ByVal value As Boolean)
_Grassetto = value
End Set
End Property
Public Property Posizione() As String
Get
Return _Posizione
End Get
Set(ByVal value As String)
_Posizione = value
End Set
End Property
Public Property Allineamento() As String
Get
Return _Allineamento
End Get
Set(ByVal value As String)
_Allineamento = value
End Set
End Property
Public Property Margine() As Integer
Get
Return _Margine
End Get
Set(ByVal value As Integer)
_Margine = value
End Set
End Property
Public Property LogoAltezza() As Integer
Get
Return _LogoAltezza
End Get
Set(ByVal value As Integer)
_LogoAltezza = value
End Set
End Property
Public Property LogoLarghezza() As Integer
Get
Return _LogoLarghezza
End Get
Set(ByVal value As Integer)
_LogoLarghezza = value
End Set
End Property
Public Property fontColoreRGB() As Color
Get
Return _fontColoreRGB
End Get
Set(ByVal value As Color)
_fontColoreRGB = value
End Set
End Property
Public Property LogoAggiungi() As Boolean
Get
Return _LogoAggiungi
End Get
Set(ByVal value As Boolean)
_LogoAggiungi = value
End Set
End Property
Public Property LogoNomeFile() As String
Get
Return _LogoNomeFile
End Get
Set(ByVal value As String)
_LogoNomeFile = value
End Set
End Property
Public Property LogoTrasparenza() As String
Get
Return _LogoTrasparenza
End Get
Set(ByVal value As String)
_LogoTrasparenza = value
End Set
End Property
Public Property LogoMargine() As String
Get
Return _LogoMargine
End Get
Set(ByVal value As String)
_LogoMargine = value
End Set
End Property
Public Property LogoPosizioneH() As String
Get
Return _LogoPosizioneH
End Get
Set(ByVal value As String)
_LogoPosizioneH = value
End Set
End Property
Public Property LogoPosizioneV() As String
Get
Return _LogoPosizioneV
End Get
Set(ByVal value As String)
_LogoPosizioneV = value
End Set
End Property
Public Property FotoGrandeDimOrigina() As Boolean
Get
Return _FotoGrandeDimOrigina
End Get
Set(ByVal value As Boolean)
_FotoGrandeDimOrigina = value
End Set
End Property
Public Property AltezzaBig() As Integer
Get
Return _AltezzaBig
End Get
Set(ByVal value As Integer)
_AltezzaBig = value
End Set
End Property
Public Property LarghezzaBig() As Integer
Get
Return _LarghezzaBig
End Get
Set(ByVal value As Integer)
_LarghezzaBig = 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 DimVert() As Integer
Get
Return _DimVert
End Get
Set(ByVal value As Integer)
_DimVert = value
End Set
End Property
Public Property MargVert() As Integer
Get
Return _MargVert
End Get
Set(ByVal value As Integer)
_MargVert = value
End Set
End Property
Public Property TestoMin() As Boolean
Get
Return _TestoMin
End Get
Set(ByVal value As Boolean)
_TestoMin = value
End Set
End Property
Public Property DimMin() As Integer
Get
Return _DimMin
End Get
Set(ByVal value As Integer)
_DimMin = value
End Set
End Property
Public Property SecretDefault() As Boolean
Get
Return _SecretDefault
End Get
Set(ByVal value As Boolean)
_SecretDefault = value
End Set
End Property
Public Property SecretBig() As Boolean
Get
Return _SecretBig
End Get
Set(ByVal value As Boolean)
_SecretBig = value
End Set
End Property
Public Property SecretSmall() As Boolean
Get
Return _SecretSmall
End Get
Set(ByVal value As Boolean)
_SecretSmall = value
End Set
End Property
Public Property SecretPathSmall() As String
Get
Return _SecretPathSmall
End Get
Set(ByVal value As String)
_SecretPathSmall = value
End Set
End Property
Public Property SecretPathBig() As String
Get
Return _SecretPathBig
End Get
Set(ByVal value As String)
_SecretPathBig = value
End Set
End Property
Public Property AggTempoGaraMin() As Boolean
Get
Return _AggTempoGaraMin
End Get
Set(ByVal value As Boolean)
_AggTempoGaraMin = value
End Set
End Property
Public Property AggNumTempMin() As Boolean
Get
Return _AggNumTempMin
End Get
Set(ByVal value As Boolean)
_AggNumTempMin = value
End Set
End Property
Public Property jpegQuality() As Long
Get
Return _jpegQuality
End Get
Set(ByVal value As Long)
_jpegQuality = value
End Set
End Property
Public Property jpegQualityMin() As Long
Get
Return _jpegQualityMin
End Get
Set(ByVal value As Long)
_jpegQualityMin = value
End Set
End Property
End Module

View file

@ -0,0 +1,185 @@
Option Explicit On
Option Strict On
Imports System.Threading
Imports System.Collections
Public Delegate Sub ThreadErrorHandlerDelegate(ByVal oWorkItem As ThreadPoolWorkItem, ByVal oError As Exception)
Public Class ThreadPoolWorkItem
Public m_bStoreOutput As Boolean = False
Public m_sName As String = ""
Public m_pMethod As [Delegate] = Nothing
Public m_pInput As Object() = Nothing
Public m_oOutput As Object = Nothing
Public m_oException As Exception = Nothing
Public Sub New()
End Sub
Public Sub New(ByVal sName As String, ByVal pMethod As [Delegate], ByVal pInput As Object(), ByVal bStoreOutput As Boolean)
m_sName = sName
m_pMethod = pMethod
m_pInput = pInput
m_bStoreOutput = bStoreOutput
End Sub
End Class
Public Class XYThreadPool
Private m_htThreads As Hashtable = New Hashtable(256)
Private m_nMinThreadCount As Integer = 5
Private m_nMaxThreadCount As Integer = 10
Private m_nShutdownPause As Integer = 200
Private m_nServerPause As Integer = 25
Private m_bContinue As Boolean = False
Private m_oException As Exception = Nothing
Private m_qInput As Queue = New Queue(1024)
Private m_qOutput As Queue = New Queue(1024)
Private m_delegateThreadErrorHandler As [Delegate] = New ThreadErrorHandlerDelegate(AddressOf OnThreadError)
Private Sub ThreadProc()
While m_bContinue
Dim obj As Object = Nothing
Monitor.Enter(Me)
If m_qInput.Count > 0 Then obj = m_qInput.Dequeue()
Monitor.Exit(Me)
If obj Is Nothing Then
Dim bQuit As Boolean = False
Monitor.Enter(Me)
If m_htThreads.Count > m_nMinThreadCount Then
m_htThreads.Remove(Thread.CurrentThread.Name)
bQuit = True
End If
Monitor.Exit(Me)
If bQuit Then Return
Thread.Sleep(10 * m_nServerPause)
Else
Dim oWorkItem As ThreadPoolWorkItem = CType(obj, ThreadPoolWorkItem)
'oWorkItem.m_oOutput = oWorkItem.m_pMethod.DynamicInvoke(oWorkItem.m_pInput)
Try
oWorkItem.m_oOutput = oWorkItem.m_pMethod.DynamicInvoke(oWorkItem.m_pInput)
Catch oBug As Exception
If Not m_delegateThreadErrorHandler Is Nothing Then
Try
Dim pInput As Object() = {oWorkItem, oBug}
m_delegateThreadErrorHandler.DynamicInvoke(pInput)
Catch
End Try
End If
End Try
If oWorkItem.m_bStoreOutput Then
Monitor.Enter(m_qOutput)
m_qOutput.Enqueue(oWorkItem)
Monitor.Exit(m_qOutput)
End If
Thread.Sleep(m_nServerPause)
End If
End While
End Sub
Private Sub OnThreadError(ByVal oWorkItem As ThreadPoolWorkItem, ByVal oError As Exception)
If oWorkItem Is Nothing Then
m_oException = oError
Else
oWorkItem.m_oException = oError
End If
End Sub
Public Sub SetThreadErrorHandler(ByVal pMethod As ThreadErrorHandlerDelegate)
Monitor.Enter(Me)
m_delegateThreadErrorHandler = pMethod
Monitor.Exit(Me)
End Sub
Public Sub SetServerPause(ByVal nMilliseconds As Integer)
Monitor.Enter(Me)
If nMilliseconds > 9 And nMilliseconds < 101 Then m_nServerPause = nMilliseconds
Monitor.Exit(Me)
End Sub
Public Sub SetShutdownPause(ByVal nMilliseconds As Integer)
Monitor.Enter(Me)
m_nShutdownPause = nMilliseconds
Monitor.Exit(Me)
End Sub
Public Function GetException() As Exception
Return m_oException
End Function
Public Sub InsertWorkItem(ByVal oWorkItem As ThreadPoolWorkItem)
Try
Monitor.Enter(Me)
m_qInput.Enqueue(oWorkItem)
If m_bContinue AndAlso m_qInput.Count > m_htThreads.Count AndAlso m_htThreads.Count < m_nMaxThreadCount Then
Dim th As Thread = New Thread(AddressOf ThreadProc)
th.Name = Guid.NewGuid.ToString()
m_htThreads.Add(th.Name, th)
th.Start()
End If
Catch oBug As Exception
m_oException = oBug
Finally
Monitor.Exit(Me)
End Try
End Sub
Public Sub InsertWorkItem(ByVal sName As String, ByVal pMethod As [Delegate], ByVal pArgs As Object(), ByVal bStoreOutput As Boolean)
InsertWorkItem(New ThreadPoolWorkItem(sName, pMethod, pArgs, bStoreOutput))
End Sub
Public Function ExtractWorkItem() As ThreadPoolWorkItem
Dim oWorkItem As Object = Nothing
Monitor.Enter(m_qOutput)
If m_qOutput.Count > 0 Then oWorkItem = m_qOutput.Dequeue()
Monitor.Exit(m_qOutput)
If oWorkItem Is Nothing Then Return Nothing
Return CType(oWorkItem, ThreadPoolWorkItem)
End Function
Public Function StartThreadPool(Optional ByVal nMinThreadCount As Integer = 5, Optional ByVal nMaxThreadCount As Integer = 10) As Boolean
Try
Monitor.Enter(Me)
If m_bContinue = False Then
m_bContinue = True
If nMinThreadCount > 0 Then
m_nMinThreadCount = nMinThreadCount
End If
If nMaxThreadCount > m_nMinThreadCount Then
m_nMaxThreadCount = nMaxThreadCount
Else
m_nMaxThreadCount = 2 * m_nMinThreadCount
End If
Dim i As Integer
For i = 1 To m_nMinThreadCount
Dim th As Thread = New Thread(AddressOf ThreadProc)
th.Name = Guid.NewGuid.ToString()
m_htThreads.Add(th.Name, th)
th.Start()
Next i
End If
Return True
Catch oBug As Exception
m_bContinue = False
m_oException = oBug
Return False
Finally
Monitor.Exit(Me)
End Try
End Function
Public Sub StopThreadPool()
Monitor.Enter(Me)
m_bContinue = False
Thread.Sleep(Math.Max(200, m_nShutdownPause))
If (m_nShutdownPause > 0) Then
Dim dict As IDictionaryEnumerator = m_htThreads.GetEnumerator()
While dict.MoveNext()
Dim th As Thread = CType(dict.Value(), Thread)
If th.IsAlive Then
Try
th.Abort()
Catch
End Try
End If
End While
End If
m_htThreads.Clear()
m_qInput.Clear()
' m_qOutput.Clear()
Monitor.Exit(Me)
End Sub
Public Function GetThreadCount() As Integer
Monitor.Enter(Me)
Dim nCount As Integer = m_htThreads.Count
Monitor.Exit(Me)
Return nCount
End Function
End Class

23
imagecatalog/app.config Normal file
View file

@ -0,0 +1,23 @@
<?xml version="1.0"?>
<configuration>
<system.diagnostics>
<sources>
<!-- Questa sezione definisce la configurazione di registrazione per My.Application.Log -->
<source name="DefaultSource" switchName="DefaultSwitch">
<listeners>
<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"/>
</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"/>
<!-- 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.0,Profile=Client"/></startup></configuration>