Advertisement
Guest User

Problem mit GDI+

a guest
Jul 2nd, 2014
258
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VB.NET 18.51 KB | None | 0 0
  1. Imports System.IO
  2. Imports System.Drawing.Imaging
  3. Public Class GalleryGenerator
  4.     Dim stylesheetin As String
  5.     Dim stylesheetout As String
  6.     Public Function RotateImg(ByVal sImageFilePath As String) As Boolean
  7.         Dim rft As RotateFlipType = RotateFlipType.RotateNoneFlipNone
  8.         Dim img As Bitmap = Image.FromFile(sImageFilePath)
  9.         Dim properties As PropertyItem() = img.PropertyItems
  10.         Dim bReturn As Boolean = False
  11.         For Each p As PropertyItem In properties
  12.             If p.Id = 274 Then
  13.                 Dim orientation As Short = BitConverter.ToInt16(p.Value, 0)
  14.                 Select Case orientation
  15.                     Case 1
  16.                         rft = RotateFlipType.RotateNoneFlipNone
  17.                     Case 3
  18.                         rft = RotateFlipType.Rotate180FlipNone
  19.                     Case 6
  20.                         rft = RotateFlipType.Rotate90FlipNone
  21.                     Case 8
  22.                         rft = RotateFlipType.Rotate270FlipNone
  23.                 End Select
  24.             End If
  25.         Next
  26.         If rft <> RotateFlipType.RotateNoneFlipNone Then
  27.             img.RotateFlip(rft)
  28.             System.IO.File.Delete(sImageFilePath)
  29.             img.Save(sImageFilePath, System.Drawing.Imaging.ImageFormat.Jpeg)
  30.             bReturn = True
  31.         End If
  32.         Return bReturn
  33.  
  34.     End Function
  35.     Public Class AlphanumComparator
  36.         Implements IComparer
  37.  
  38.         Public Function Compare(ByVal x As Object,
  39.            ByVal y As Object) As Integer Implements IComparer.Compare
  40.  
  41.             ' [1] Validate the arguments.
  42.             Dim s1 As String = x
  43.             If s1 = Nothing Then
  44.                 Return 0
  45.             End If
  46.  
  47.             Dim s2 As String = y
  48.             If s2 = Nothing Then
  49.                 Return 0
  50.             End If
  51.  
  52.             Dim len1 As Integer = s1.Length
  53.             Dim len2 As Integer = s2.Length
  54.             Dim marker1 As Integer = 0
  55.             Dim marker2 As Integer = 0
  56.  
  57.             ' [2] Loop over both Strings.
  58.             While marker1 < len1 And marker2 < len2
  59.  
  60.                 ' [3] Get Chars.
  61.                 Dim ch1 As Char = s1(marker1)
  62.                 Dim ch2 As Char = s2(marker2)
  63.  
  64.                 Dim space1(len1) As Char
  65.                 Dim loc1 As Integer = 0
  66.                 Dim space2(len2) As Char
  67.                 Dim loc2 As Integer = 0
  68.  
  69.                 ' [4] Collect digits for String one.
  70.                 Do
  71.                     space1(loc1) = ch1
  72.                     loc1 += 1
  73.                     marker1 += 1
  74.  
  75.                     If marker1 < len1 Then
  76.                         ch1 = s1(marker1)
  77.                     Else
  78.                         Exit Do
  79.                     End If
  80.                 Loop While Char.IsDigit(ch1) = Char.IsDigit(space1(0))
  81.  
  82.                 ' [5] Collect digits for String two.
  83.                 Do
  84.                     space2(loc2) = ch2
  85.                     loc2 += 1
  86.                     marker2 += 1
  87.  
  88.                     If marker2 < len2 Then
  89.                         ch2 = s2(marker2)
  90.                     Else
  91.                         Exit Do
  92.                     End If
  93.                 Loop While Char.IsDigit(ch2) = Char.IsDigit(space2(0))
  94.  
  95.                 ' [6] Convert to Strings.
  96.                 Dim str1 = New String(space1)
  97.                 Dim str2 = New String(space2)
  98.  
  99.                 ' [7] Parse Strings into Integers.
  100.                 Dim result As Integer
  101.                 If Char.IsDigit(space1(0)) And Char.IsDigit(space2(0)) Then
  102.                     Dim thisNumericChunk = Integer.Parse(str1)
  103.                     Dim thatNumericChunk = Integer.Parse(str2)
  104.                     result = thisNumericChunk.CompareTo(thatNumericChunk)
  105.                 Else
  106.                     result = str1.CompareTo(str2)
  107.                 End If
  108.  
  109.                 ' [8] Return result if not equal.
  110.                 If Not result = 0 Then
  111.                     Return result
  112.                 End If
  113.             End While
  114.  
  115.             ' [9] Compare lengths.
  116.             Return len1 - len2
  117.         End Function
  118.     End Class
  119.     Private Sub GenGalleryButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles GenGalleryButton.Click
  120.         Dim indir As New IO.DirectoryInfo(InDirFolderBrowserDialog.SelectedPath)
  121.         Dim outdir As New IO.DirectoryInfo(OutDirFolderBrowserDialog.SelectedPath)
  122.         Dim newdirs As Array = {"scaled", "thumbs", "fullsize", "html"}
  123.         For Each newdir In newdirs
  124.             If Not Directory.Exists(newdir) Then
  125.                 MkDir(newdir)
  126.             End If
  127.         Next
  128.         Dim files As IO.FileInfo() = indir.GetFiles()
  129.         Dim file As IO.FileInfo
  130.         Dim imgnamenoext As New List(Of String)
  131.         Dim imgname As New List(Of String)
  132.         'list the names of all files in the specified directory
  133.         Dim scaledsize As New Single
  134.         Dim thumbsize As New Single
  135.  
  136.         Dim cssoutwithdir As String
  137.         cssoutwithdir = outdir.FullName.ToString & "\" & stylesheetout
  138.         FileCopy(stylesheetin, cssoutwithdir)
  139.  
  140.         If ImgMaxSizeTextBox.Text > "850" Then
  141.             MsgBox("Size exceeds limit. Using maximum.")
  142.             scaledsize = "850"
  143.         ElseIf ImgMaxSizeTextBox.Text < "300" Then
  144.             MsgBox("Size is below the limit. Using minimum.")
  145.             scaledsize = "300"
  146.         Else
  147.             scaledsize = ImgMaxSizeTextBox.Text
  148.         End If
  149.  
  150.         For Each file In files
  151.             If (file IsNot Nothing) And (file.Extension.ToUpper = (FormatInDDB.Text.ToUpper)) Then
  152.  
  153.                 imgnamenoext.Add("x")
  154.  
  155.                 RotateImg(file.FullName)
  156.  
  157.                 Dim bm_source As New Bitmap(Image.FromFile(file.FullName))
  158.  
  159.                 Select Case FormatOutDDB.Text
  160.                     Case ".JPG"
  161.                         '' Stack-Trace fuehrt hierhin (Fehler)
  162.                         bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".JPG", System.Drawing.Imaging.ImageFormat.Jpeg)
  163.                     Case ".PNG"
  164.                         bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".PNG", System.Drawing.Imaging.ImageFormat.Png)
  165.                     Case ".GIF"
  166.                         bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".GIF", System.Drawing.Imaging.ImageFormat.Gif)
  167.                     Case ".TIFF"
  168.                         bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".TIFF", System.Drawing.Imaging.ImageFormat.Tiff)
  169.                     Case ".BMP"
  170.                         bm_source.Save(outdir.FullName & "\fullsize\" & Path.GetFileNameWithoutExtension(file.FullName) & ".BMP", System.Drawing.Imaging.ImageFormat.Bmp)
  171.                 End Select
  172.  
  173.                 Dim scale_factor_sc As New Single
  174.  
  175.                 If bm_source.Height > bm_source.Width Then
  176.                     scale_factor_sc = scaledsize / bm_source.Height
  177.                 Else
  178.                     scale_factor_sc = scaledsize / bm_source.Width
  179.                 End If
  180.  
  181.                 Dim bm_dest_sc As New Bitmap( _
  182.                     CInt(bm_source.Width * scale_factor_sc), _
  183.                     CInt(bm_source.Height * scale_factor_sc))
  184.  
  185.                 Dim gr_dest_sc As Graphics = Graphics.FromImage(bm_dest_sc)
  186.                 gr_dest_sc.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
  187.  
  188.                 gr_dest_sc.DrawImage(bm_source, 0, 0, _
  189.                     bm_dest_sc.Width, _
  190.                     bm_dest_sc.Height)
  191.  
  192.                 Select Case FormatOutDDB.Text
  193.                     Case ".JPG"
  194.                         bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".JPG", System.Drawing.Imaging.ImageFormat.Jpeg)
  195.                     Case ".PNG"
  196.                         bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".PNG", System.Drawing.Imaging.ImageFormat.Png)
  197.                     Case ".GIF"
  198.                         bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".GIF", System.Drawing.Imaging.ImageFormat.Gif)
  199.                     Case ".TIFF"
  200.                         bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".TIFF", System.Drawing.Imaging.ImageFormat.Tiff)
  201.                     Case ".BMP"
  202.                         bm_dest_sc.Save(outdir.FullName & "\scaled\sc_" & Path.GetFileNameWithoutExtension(file.FullName) & ".BMP", System.Drawing.Imaging.ImageFormat.Bmp)
  203.                 End Select
  204.  
  205.                 Dim scale_factor_th As New Single
  206.  
  207.                 If bm_source.Height > bm_source.Width Then
  208.                     scale_factor_th = thumbsize / bm_source.Height
  209.                 Else
  210.                     scale_factor_th = thumbsize / bm_source.Width
  211.                 End If
  212.  
  213.                 Dim bm_dest_th As New Bitmap( _
  214.                     CInt(bm_source.Width * scale_factor_th), _
  215.                     CInt(bm_source.Height * scale_factor_th))
  216.  
  217.                 Dim gr_dest_th As Graphics = Graphics.FromImage(bm_dest_th)
  218.                 gr_dest_th.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
  219.  
  220.                 gr_dest_th.DrawImage(bm_source, 0, 0, _
  221.                     bm_dest_th.Width, _
  222.                     bm_dest_th.Height)
  223.                 Select Case FormatOutDDB.Text
  224.                     Case ".JPG"
  225.                         bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".JPG", System.Drawing.Imaging.ImageFormat.Jpeg)
  226.                     Case ".PNG"
  227.                         bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".PNG", System.Drawing.Imaging.ImageFormat.Png)
  228.                     Case ".GIF"
  229.                         bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".GIF", System.Drawing.Imaging.ImageFormat.Gif)
  230.                     Case ".TIFF"
  231.                         bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".TIFF", System.Drawing.Imaging.ImageFormat.Tiff)
  232.                     Case ".BMP"
  233.                         bm_dest_th.Save(outdir.FullName & "\thumbs\th_" & Path.GetFileNameWithoutExtension(file.FullName) & ".BMP", System.Drawing.Imaging.ImageFormat.Bmp)
  234.                 End Select
  235.             End If
  236.         Next
  237.  
  238.         Dim imgnamenoextsort As Array
  239.         imgnamenoextsort = imgnamenoext.ToArray
  240.         Array.Sort(imgnamenoextsort, New AlphanumComparator())
  241.         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=""./" & stylesheetout & """ />" & 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)
  242.         Dim imgpg As String
  243.         For Each img In imgnamenoextsort
  244.             imgpg = img & ".html"
  245.             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)
  246.         Next
  247.         My.Computer.FileSystem.WriteAllText("index.html", "</body>" & vbCrLf & "</html>", True)
  248.  
  249.         If MagScriptCheckBox.Checked = True Then
  250.             Dim sc As Object = CreateObject("Shell.Application")
  251.             My.Computer.Network.DownloadFile("http://www.nihilogic.dk/labs/mojomagnify/mojomagnify.zip", CurDir() & "\mojomagnify.zip")
  252.             Dim input As Shell32.Folder = sc.NameSpace("mojomagnify.zip")
  253.             Dim output As Shell32.Folder = sc.NameSpace(CurDir)
  254.             output.CopyHere(input.Items, 4)
  255.         End If
  256.  
  257.         ChDir("html")
  258.         Dim prevpage As String
  259.         Dim nextpage As String
  260.         For Each img In imgnamenoextsort
  261.             imgpg = "ht_" & img & ".html"
  262.             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=""../" & stylesheetout & """ rel=""stylesheet"" />" & vbCrLf, True)
  263.             If MagScriptCheckBox.Checked = True Then
  264.                 My.Computer.FileSystem.WriteAllText(imgpg, "<link type=""text/css"" href=""../mojomagnify.css"" rel=""stylesheet"" />" & vbCrLf & "  <script type=""text/javascript"" src=""../mojomagnify.js""></script>", True)
  265.             End If
  266.             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)
  267.             If MagScriptCheckBox.Checked = True Then
  268.                 My.Computer.FileSystem.WriteAllText(imgpg, " data-magnifysrc=""../fullsize/" & img & FormatOutDDB.Text & """", True)
  269.             End If
  270.  
  271.             If Array.IndexOf(imgnamenoextsort, img) = "0" Then
  272.                 prevpage = "ht_" & imgnamenoextsort(UBound(imgnamenoextsort)) & ".html"
  273.             Else
  274.                 prevpage = "ht_" & imgnamenoextsort(Array.IndexOf(imgnamenoextsort, img) - 1) & ".html"
  275.             End If
  276.  
  277.             If Array.IndexOf(imgnamenoextsort, img) = UBound(imgnamenoextsort) Then
  278.                 nextpage = "ht_" & imgnamenoextsort(0) & ".html"
  279.             Else
  280.                 nextpage = "ht_" & imgnamenoextsort(Array.IndexOf(imgnamenoextsort, img) + 1) & ".html"
  281.             End If
  282.  
  283.             My.Computer.FileSystem.WriteAllText(imgpg, " />" & vbCrLf & "    </p>" & vbCrLf & "  </div>     " & vbCrLf & "  <div>" & vbCrLf & "    <table>" & vbCrLf & "      <tr>" & vbCrLf & "        <td align=""left"">" & vbCrLf & "          <a href=""" & prevpage & """>" & vbCrLf & "            &#9664; 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 & "            &#9654; next" & vbCrLf & "          </a>" & vbCrLf & "        </td>" & vbCrLf & "        <td align=""right"">" & vbCrLf & "          <a href=""../index.html"">" & vbCrLf & "            &#9650; index" & vbCrLf & "          </a>" & vbCrLf & "        </td>" & vbCrLf & "      </tr>" & vbCrLf & "    </table>", True)
  284.  
  285.             If MagScriptCheckBox.Checked = True Then
  286.                 My.Computer.FileSystem.WriteAllText(imgpg, vbCrLf & "    <noscript><h4>Allow JavaScript for zooming!</h3></noscript>", True)
  287.             End If
  288.  
  289.             My.Computer.FileSystem.WriteAllText(imgpg, vbCrLf & "  </div>" & vbCrLf & "</body>" & vbCrLf & "</html>", True)
  290.         Next
  291.     End Sub
  292.  
  293.     Private Sub InitInFolderDialogueButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles InitInFolderDialogueButton.Click
  294.         If InDirFolderBrowserDialog.ShowDialog() = DialogResult.OK Then
  295.             Dim indir As New IO.DirectoryInfo(InDirFolderBrowserDialog.SelectedPath)
  296.             InDirToolTip.SetToolTip(InitInFolderDialogueButton, "Input Directory: " & indir.FullName)
  297.         End If
  298.     End Sub
  299.  
  300.     Private Sub InitOutFolderDialogueButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles InitOutFolderDialogueButton.Click
  301.         If OutDirFolderBrowserDialog.ShowDialog() = DialogResult.OK Then
  302.             Dim outdir As New IO.DirectoryInfo(OutDirFolderBrowserDialog.SelectedPath)
  303.             OutDirToolTip.SetToolTip(InitOutFolderDialogueButton, "Output Directory: " & outdir.FullName)
  304.             FileSystem.ChDir(outdir.FullName)
  305.         End If
  306.     End Sub
  307.  
  308.     Private Sub GalleryGenerator_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
  309.         Dim indir As New IO.DirectoryInfo(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments))
  310.         InDirFolderBrowserDialog.SelectedPath = indir.FullName
  311.         FormatInDDB.SelectedIndex = 0
  312.         InDirToolTip.SetToolTip(InitInFolderDialogueButton, "Input Directory: " & indir.FullName & " (default)")
  313.         Dim outdir As New IO.DirectoryInfo(Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments))
  314.         OutDirFolderBrowserDialog.SelectedPath = outdir.FullName
  315.         FormatOutDDB.SelectedIndex = 0
  316.         FileSystem.ChDir(outdir.FullName)
  317.         OutDirToolTip.SetToolTip(InitOutFolderDialogueButton, "Output Directory: " & outdir.FullName & " (default)")
  318.         ImgMaxSizeTextBox.MaxLength = 3
  319.         ThumbMaxSizeTextBox.MaxLength = 3
  320.     End Sub
  321.  
  322.     Private Sub ImgMaxSizeTextBox_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles ImgMaxSizeTextBox.KeyPress
  323.         If Not Char.IsDigit(e.KeyChar) And Not Char.IsControl(e.KeyChar) Then
  324.             e.Handled = True
  325.         End If
  326.     End Sub
  327.  
  328.     Private Sub ThumbMaxSizeTextBox_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles ThumbMaxSizeTextBox.KeyPress
  329.         If Not Char.IsDigit(e.KeyChar) And Not Char.IsControl(e.KeyChar) Then
  330.             e.Handled = True
  331.         End If
  332.     End Sub
  333.  
  334.     Private Sub CSSBrowseButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CSSBrowseButton.Click
  335.         CSSBrowseDialog.ShowDialog()
  336.         stylesheetin = CSSBrowseDialog.FileName
  337.         stylesheetout = Path.GetFileName(stylesheetin)
  338.         CSSToolTip.SetToolTip(CSSBrowseButton, "Stylesheet: " & stylesheetin)
  339.     End Sub
  340. End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement