Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Imports System.IO
- Imports System.Drawing.Imaging
- Public Class GalleryGenerator
- Dim stylesheetfile As String
- Dim stylesheetname As String
- Public Function RotateImg(ByVal sImageFilePath As String) As Boolean
- Dim rft As RotateFlipType = RotateFlipType.RotateNoneFlipNone
- Dim img As Bitmap = Image.FromFile(sImageFilePath)
- Dim properties As PropertyItem() = img.PropertyItems
- Dim bReturn As Boolean = False
- For Each p As PropertyItem In properties
- If p.Id = 274 Then
- Dim orientation As Short = BitConverter.ToInt16(p.Value, 0)
- Select Case orientation
- Case 1
- rft = RotateFlipType.RotateNoneFlipNone
- Case 3
- rft = RotateFlipType.Rotate180FlipNone
- Case 6
- rft = RotateFlipType.Rotate90FlipNone
- Case 8
- rft = RotateFlipType.Rotate270FlipNone
- End Select
- End If
- Next
- If rft <> RotateFlipType.RotateNoneFlipNone Then
- img.RotateFlip(rft)
- System.IO.File.Delete(sImageFilePath)
- img.Save(sImageFilePath, System.Drawing.Imaging.ImageFormat.Jpeg)
- bReturn = True
- End If
- Return bReturn
- End Function
- Public Class AlphanumComparator
- Implements IComparer
- Public Function Compare(ByVal x As Object,
- ByVal y As Object) As Integer Implements IComparer.Compare
- ' [1] Validate the arguments.
- Dim s1 As String = x
- If s1 = Nothing Then
- Return 0
- End If
- Dim s2 As String = y
- If s2 = Nothing Then
- Return 0
- End If
- Dim len1 As Integer = s1.Length
- Dim len2 As Integer = s2.Length
- Dim marker1 As Integer = 0
- Dim marker2 As Integer = 0
- ' [2] Loop over both Strings.
- While marker1 < len1 And marker2 < len2
- ' [3] Get Chars.
- Dim ch1 As Char = s1(marker1)
- Dim ch2 As Char = s2(marker2)
- Dim space1(len1) As Char
- Dim loc1 As Integer = 0
- Dim space2(len2) As Char
- Dim loc2 As Integer = 0
- ' [4] Collect digits for String one.
- Do
- space1(loc1) = ch1
- loc1 += 1
- marker1 += 1
- If marker1 < len1 Then
- ch1 = s1(marker1)
- Else
- Exit Do
- End If
- Loop While Char.IsDigit(ch1) = Char.IsDigit(space1(0))
- ' [5] Collect digits for String two.
- Do
- space2(loc2) = ch2
- loc2 += 1
- marker2 += 1
- If marker2 < len2 Then
- ch2 = s2(marker2)
- Else
- Exit Do
- End If
- Loop While Char.IsDigit(ch2) = Char.IsDigit(space2(0))
- ' [6] Convert to Strings.
- Dim str1 = New String(space1)
- Dim str2 = New String(space2)
- ' [7] Parse Strings into Integers.
- Dim result As Integer
- If Char.IsDigit(space1(0)) And Char.IsDigit(space2(0)) Then
- Dim thisNumericChunk = Integer.Parse(str1)
- Dim thatNumericChunk = Integer.Parse(str2)
- result = thisNumericChunk.CompareTo(thatNumericChunk)
- Else
- result = str1.CompareTo(str2)
- End If
- ' [8] Return result if not equal.
- If Not result = 0 Then
- Return result
- End If
- End While
- ' [9] Compare lengths.
- Return len1 - len2
- End Function
- End Class
- Private Sub GenGalleryButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GenGalleryButton.Click
- Dim indir As New IO.DirectoryInfo(InDirFolderBrowserDialog.SelectedPath)
- Dim outdir As New IO.DirectoryInfo(OutDirFolderBrowserDialog.SelectedPath)
- Dim newdirs As Array = {"scaled", "thumbs", "fullsize", "html"}
- For Each newdir In newdirs
- If Not Directory.Exists(newdir) Then
- MkDir(newdir)
- End If
- Next
- Dim files As IO.FileInfo() = indir.GetFiles()
- Dim file As IO.FileInfo
- Dim imgnamenoext As New List(Of String)
- Dim imgname As New List(Of String)
- 'list the names of all files in the specified directory
- Dim scaledsize As New Single
- Dim thumbsize As New Single
- If ImgMaxSizeTextBox.Text > "850" Then
- MsgBox("Size exceeds limit. Using maximum.")
- scaledsize = "850"
- ElseIf ImgMaxSizeTextBox.Text < "300" Then
- MsgBox("Size is below the limit. Using minimum.")
- scaledsize = "300"
- Else
- scaledsize = ImgMaxSizeTextBox.Text
- End If
- If ThumbMaxSizeTextBox.Text > "250" Then
- MsgBox("Size exceeds limit. Using maximum.")
- thumbsize = "250"
- ElseIf ThumbMaxSizeTextBox.Text < "50" Then
- MsgBox("Size is below the limit. Using minimum.")
- thumbsize = "50"
- Else
- thumbsize = ThumbMaxSizeTextBox.Text
- End If
- For Each file In files
- If (file IsNot Nothing) And (file.Extension.ToUpper = (FormatInDDB.Text.ToUpper)) Then
- imgname.Add(file.FullName)
- imgnamenoext.Add(Path.GetFileNameWithoutExtension(file.FullName))
- RotateImg(file.FullName)
- Dim bm_source As New Bitmap(Image.FromFile(file.FullName))
- Select Case FormatOutDDB.Text
- Case ".JPG"
- bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".JPG", System.Drawing.Imaging.ImageFormat.Jpeg) ''STACK-TRACE FUEHRT HIER HIN
- Case ".PNG"
- bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".PNG", System.Drawing.Imaging.ImageFormat.Png)
- Case ".GIF"
- bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".GIF", System.Drawing.Imaging.ImageFormat.Gif)
- Case ".TIFF"
- bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".TIFF", System.Drawing.Imaging.ImageFormat.Tiff)
- Case ".BMP"
- bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".BMP", System.Drawing.Imaging.ImageFormat.Bmp)
- End Select
- Dim scale_factor_sc As New Single
- If bm_source.Height > bm_source.Width Then
- scale_factor_sc = scaledsize / bm_source.Height
- Else
- scale_factor_sc = scaledsize / bm_source.Width
- End If
- Dim bm_dest_sc As New Bitmap( _
- CInt(bm_source.Width * scale_factor_sc), _
- CInt(bm_source.Height * scale_factor_sc))
- Dim gr_dest_sc As Graphics = Graphics.FromImage(bm_dest_sc)
- gr_dest_sc.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
- gr_dest_sc.DrawImage(bm_source, 0, 0, _
- bm_dest_sc.Width, _
- bm_dest_sc.Height)
- Select Case FormatOutDDB.Text
- Case ".JPG"
- bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".JPG", System.Drawing.Imaging.ImageFormat.Jpeg)
- Case ".PNG"
- bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".PNG", System.Drawing.Imaging.ImageFormat.Png)
- Case ".GIF"
- bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".GIF", System.Drawing.Imaging.ImageFormat.Gif)
- Case ".TIFF"
- bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".TIFF", System.Drawing.Imaging.ImageFormat.Tiff)
- Case ".BMP"
- bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".BMP", System.Drawing.Imaging.ImageFormat.Bmp)
- End Select
- Dim scale_factor_th As New Single
- If bm_source.Height > bm_source.Width Then
- scale_factor_th = thumbsize / bm_source.Height
- Else
- scale_factor_th = thumbsize / bm_source.Width
- End If
- Dim bm_dest_th As New Bitmap( _
- CInt(bm_source.Width * scale_factor_th), _
- CInt(bm_source.Height * scale_factor_th))
- Dim gr_dest_th As Graphics = Graphics.FromImage(bm_dest_th)
- gr_dest_th.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
- gr_dest_th.DrawImage(bm_source, 0, 0, _
- bm_dest_th.Width, _
- bm_dest_th.Height)
- Select Case FormatOutDDB.Text
- Case ".JPG"
- bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".JPG", System.Drawing.Imaging.ImageFormat.Jpeg)
- Case ".PNG"
- bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".PNG", System.Drawing.Imaging.ImageFormat.Png)
- Case ".GIF"
- bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".GIF", System.Drawing.Imaging.ImageFormat.Gif)
- Case ".TIFF"
- bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".TIFF", System.Drawing.Imaging.ImageFormat.Tiff)
- Case ".BMP"
- bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".BMP", System.Drawing.Imaging.ImageFormat.Bmp)
- End Select
- End If
- Next
- Dim imgnamenoextsort As Array
- imgnamenoextsort = imgnamenoext.ToArray
- Array.Sort(imgnamenoextsort, New AlphanumComparator())
- My.Computer.FileSystem.WriteAllText("index.html", "<!DOCTYPE html " & vbCrLf & " PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN""" & vbCrLf & " ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">" & vbCrLf & "<html xmlns=""http://www.w3.org/1999/xhtml"">" & vbCrLf & "<head>" & vbCrLf & " <title>" & PageTitleTextBox.Text & vbCrLf & " </title>" & vbCrLf & " <meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"" />" & vbCrLf & " <link rel=""stylesheet"" type=""text/css"" href=""./" & stylesheetname & """ />" & vbCrLf & " <style type=""text/css"">" & vbCrLf & " a {width: ""$maxpx_th""px; display:inline-block; text-align:center; margin:0px; padding:0px;}" & vbCrLf & " </style>" & vbCrLf & "</head>" & vbCrLf & "<body>", True)
- Dim imgpg As String
- For Each img In imgnamenoextsort
- imgpg = img & ".html"
- My.Computer.FileSystem.WriteAllText("index.html", " <a href=""html/ht_" & imgpg & """>" & vbCrLf & " <img src=""thumbs/th_" & img & FormatOutDDB.Text & """ alt=""" & img & FormatOutDDB.Text & """ />" & vbCrLf & " </a>", True)
- Next
- My.Computer.FileSystem.WriteAllText("index.html", "</body>" & vbCrLf & "</html>", True)
- If MagScriptCheckBox.Checked = True Then
- Dim sc As Object = CreateObject("Shell.Application")
- My.Computer.Network.DownloadFile("http://www.nihilogic.dk/labs/mojomagnify/mojomagnify.zip", CurDir() & "\mojomagnify.zip")
- Dim input As Shell32.Folder = sc.NameSpace(CurDir() & "\mojomagnify.zip")
- Dim output As Shell32.Folder = sc.NameSpace(CurDir)
- output.CopyHere(input.Items, 4)
- End If
- ChDir("html")
- Dim prevpage As String
- Dim nextpage As String
- For Each img In imgnamenoextsort
- imgpg = "ht_" & img & ".html"
- My.Computer.FileSystem.WriteAllText(imgpg, "<!DOCTYPE html " & vbCrLf & " ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">" & vbCrLf & "<html xmlns=""http://www.w3.org/1999/xhtml"" xml:lang=""de_DE"" lang=""de_DE"">" & vbCrLf & "<head>" & vbCrLf & " <title>" & PageTitleTextBox.Text & vbCrLf & " </title>" & vbCrLf & " <meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8"" />" & vbCrLf & " <link type=""text/css"" href=""../" & stylesheetname & """ rel=""stylesheet"" />" & vbCrLf, True)
- If MagScriptCheckBox.Checked = True Then
- My.Computer.FileSystem.WriteAllText(imgpg, "<link type=""text/css"" href=""../mojomagnify.css"" rel=""stylesheet"" />" & vbCrLf & " <script type=""text/javascript"" src=""../mojomagnify.js""></script>", True)
- End If
- My.Computer.FileSystem.WriteAllText(imgpg, vbCrLf & "</head>" & vbCrLf & "<body>" & vbCrLf & " <div>" & vbCrLf & " <p onclick=""return false;"">" & vbCrLf & " <img src=""../scaled/sc_" & img & FormatOutDDB.Text & """ alt=""" & img & FormatOutDDB.Text & """", True)
- If MagScriptCheckBox.Checked = True Then
- My.Computer.FileSystem.WriteAllText(imgpg, " data-magnifysrc=""../fullsize/" & img & FormatOutDDB.Text & """", True)
- End If
- If Array.IndexOf(imgnamenoextsort, img) = "0" Then
- prevpage = "ht_" & imgnamenoextsort(UBound(imgnamenoextsort)) & ".html"
- Else
- prevpage = "ht_" & imgnamenoextsort(Array.IndexOf(imgnamenoextsort, img) - 1) & ".html"
- End If
- If Array.IndexOf(imgnamenoextsort, img) = UBound(imgnamenoextsort) Then
- nextpage = "ht_" & imgnamenoextsort(0) & ".html"
- Else
- nextpage = "ht_" & imgnamenoextsort(Array.IndexOf(imgnamenoextsort, img) + 1) & ".html"
- End If
- My.Computer.FileSystem.WriteAllText(imgpg, " />" & vbCrLf & " </p>" & vbCrLf & " </div> " & vbCrLf & " <div>" & vbCrLf & " <table>" & vbCrLf & " <tr>" & vbCrLf & " <td align=""left"">" & vbCrLf & " <a href=""" & prevpage & """>" & vbCrLf & " ◀ previous" & vbCrLf & " </a>" & vbCrLf & " </td>" & vbCrLf & " <td>" & vbCrLf & " <p>Entry " & Array.IndexOf(imgnamenoextsort, img) & " of " & UBound(imgnamenoextsort) & "</p>" & vbCrLf & " </td>" & vbCrLf & " <td align=""right"">" & vbCrLf & " <a href=""" & nextpage & """>" & vbCrLf & " ▶ next" & vbCrLf & " </a>" & vbCrLf & " </td>" & vbCrLf & " <td align=""right"">" & vbCrLf & " <a href=""../index.html"">" & vbCrLf & " ▲ index" & vbCrLf & " </a>" & vbCrLf & " </td>" & vbCrLf & " </tr>" & vbCrLf & " </table>", True)
- If MagScriptCheckBox.Checked = True Then
- My.Computer.FileSystem.WriteAllText(imgpg, vbCrLf & " <noscript><h4>Allow JavaScript for zooming!</h3></noscript>", True)
- End If
- My.Computer.FileSystem.WriteAllText(imgpg, vbCrLf & " </div>" & vbCrLf & "</body>" & vbCrLf & "</html>", True)
- Next
- FileCopy(stylesheetfile, "C:\" & stylesheetname) ''PROBLEMVERURSACHER... ABER WIE???
- End Sub
- Private Sub InitInFolderDialogueButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles InitInFolderDialogueButton.Click
- If InDirFolderBrowserDialog.ShowDialog() = DialogResult.OK Then
- Dim indir As New IO.DirectoryInfo(InDirFolderBrowserDialog.SelectedPath)
- InDirToolTip.SetToolTip(InitInFolderDialogueButton, "Input Directory: " & indir.FullName)
- End If
- End Sub
- Private Sub InitOutFolderDialogueButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles InitOutFolderDialogueButton.Click
- If OutDirFolderBrowserDialog.ShowDialog() = DialogResult.OK Then
- Dim outdir As New IO.DirectoryInfo(OutDirFolderBrowserDialog.SelectedPath)
- OutDirToolTip.SetToolTip(InitOutFolderDialogueButton, "Output Directory: " & outdir.FullName)
- FileSystem.ChDir(outdir.FullName)
- End If
- End Sub
- Private Sub GalleryGenerator_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
- Dim indir As New IO.DirectoryInfo(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments))
- InDirFolderBrowserDialog.SelectedPath = indir.FullName
- FormatInDDB.SelectedIndex = 0
- InDirToolTip.SetToolTip(InitInFolderDialogueButton, "Input Directory: " & indir.FullName & " (default)")
- Dim outdir As New IO.DirectoryInfo(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments))
- OutDirFolderBrowserDialog.SelectedPath = outdir.FullName
- FormatOutDDB.SelectedIndex = 0
- FileSystem.ChDir(outdir.FullName)
- OutDirToolTip.SetToolTip(InitOutFolderDialogueButton, "Output Directory: " & outdir.FullName & " (default)")
- ImgMaxSizeTextBox.MaxLength = 3
- ThumbMaxSizeTextBox.MaxLength = 3
- End Sub
- Private Sub ImgMaxSizeTextBox_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles ImgMaxSizeTextBox.KeyPress
- If Not Char.IsDigit(e.KeyChar) And Not Char.IsControl(e.KeyChar) Then
- e.Handled = True
- End If
- End Sub
- Private Sub ThumbMaxSizeTextBox_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles ThumbMaxSizeTextBox.KeyPress
- If Not Char.IsDigit(e.KeyChar) And Not Char.IsControl(e.KeyChar) Then
- e.Handled = True
- End If
- End Sub
- Private Sub CSSBrowseButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CSSBrowseButton.Click
- Using CSSBrowseDialog As New OpenFileDialog ''GELOEST DURCH USING-STATEMENT
- CSSBrowseDialog.ShowDialog()
- stylesheetfile = CSSBrowseDialog.FileName
- stylesheetname = CSSBrowseDialog.SafeFileName
- End Using
- End Sub
- End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement