Imports System.Drawing
Imports System.IO
Imports System.Drawing.Drawing2D
Imports System.Drawing.Imaging
Imports System.Windows.Forms
'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)
Try
preparaVariabili()
'Dim g As System.Drawing.Image = System.Drawing.Image.FromFile(Path.Combine(SourceDir.FullName, NomeFileChild))
Using g As Image = Image.FromFile(WorkFile.FullName)
'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)
End Using
'g.Dispose()
GC.Collect()
'PicSettings.mainForm.stepProgressBar()
Catch ex As Exception
Dim e = ex.Demystify()
Console.WriteLine(e)
Console.WriteLine(e.Message)
Console.WriteLine(e.StackTrace)
'MessageBox.Show(ex.Message)
End Try
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
'''
''' Aggiunge Orario, tempo gara e altri
'''
''' Image
'''
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
'''
''' Prepara diverse variabili azzerandole, elaborandole e prendendole dalle impostazioni
'''
'''
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
'''
''' Calculate the Size of the New image
'''
''' Larghezza
''' Altezza
'''
'''
'''
'''
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