Option Strict On
Option Explicit On
Imports System.IO
Imports System.Drawing
Imports System.ComponentModel
Imports System.Drawing.Imaging


'Beim Abspeichern auf die Hardware, zeigt JGP ihre komprimierungsstärke

'Nutze für dieses Beispiel ein Bildle mit DEINBILD.png und lege die
'gleich neben deiner exe-Datei. Variable Filename ohne Dateiendung.

'Für die Umwandlung von Byte() zu Bitmap nutze die Funktion 'ToBitmap'
'Sofern die Byte() vercryptet ist, natürlich vorher entcrypten.


Public Module Module2
   Private ReadOnly Filename As String = "DEINBILD" 'Ohne Dateiendung
   Public Sub Main()
      Dim img1 = New Bitmap(Filename & ".png")
      'ODER: Manchmal ist es sinnvoll gleich ein Clone zu machen
      'Dim img1 = DirectCast(New Bitmap(Filename & ".png").Clone, Bitmap)

      Save(img1, Filename & ".jpg")

      'Konvertierung zuerst z.B. in JPG, dann zu Byte()
      'Rudimentärer Formatwechsel, der noch sehr 
      'gute Ergebnisse liefert
      Dim var1 = ToByteVariante1(img1, ImageFormat.Gif)

      'Konvertierung zuerst in PNG, dann zu Byte()
      'Über MemoryStream/EncoderParameters/Kompressionsrate
      'Interessanterweise wenn jpg-Format genommen wird ist 
      'das Resultat um einiges Gösse als in 'ToByteVariante1'
      Dim var2 = ToByteVariante2(img1, ImageFormat.Gif)

      ' >>  Interessanterweise, ist
      '     var1(jpeg) <  var2(jpeg)
      '     var1(jpeg) >  var2(png)
      '     var1(png)  <  var2(jpeg)
      '     var1(png)  <  var2(png)
      '     var1(gif)  =  var2(gif) '     Ideal für das vercrypten
      '     var1(tiff) =  var2(tiff)



      Stop

   End Sub
   Private Function ToByteVariante1(ByVal img1 As Bitmap,
                                    format As ImageFormat) As Int32
      Dim img2 = New Bitmap(Filename & ".jpg")
      'ODER: Manchmal ist es sinnvoll gleich ein Clone zu machen
      'Dim img1 = DirectCast(New Bitmap(Filename & ".jpg").Clone, Bitmap)

      'Grundsätzlich wird Jpg-Format gewählt
      'Rudimentärer Formatwechsler, der noch sehr 
      'gute Ergebnisse liefert
      Dim img1jpg = ChanceFormat(img1, format)
      Dim img2jpg = ChanceFormat(img2, format)

      'Convertierung zu Byte()
      '- ImageConverter
      '- TypeConverter
      '- MemoryStream
      Dim img1jpgic = ToByteArrIC(img1jpg)
      Dim img1jpgtc = ToByteArrTC(img1jpg)
      Dim img1jpgms = ToByteArrMS(img1jpg)

      Dim img2jpgic = ToByteArrIC(img2jpg)
      Dim img2jpgtc = ToByteArrTC(img2jpg)
      Dim img2jpgms = ToByteArrMS(img2jpg)

      ' *********** *********** *********** *********** 
      ' *********** *********** *********** *********** 
      ' *********** *********** *********** *********** 
      'Ab hier könnte man VERCRYPTEN. Z.b. AES
      ' *********** *********** *********** *********** 
      ' *********** *********** *********** *********** 
      ' *********** *********** *********** *********** 

      'Auf Byte-Gleichheit prüfen
      'Extra so gemacht, um zu schauen, ob die immer 
      'das gleiche Ergebnis liefern
      If img1jpgic.SequenceEqual(img1jpgtc) Then
         If img1jpgic.SequenceEqual(img1jpgms) Then
            If img2jpgic.SequenceEqual(img2jpgtc) Then
               If img2jpgic.SequenceEqual(img2jpgms) Then
                  If img1jpgic.SequenceEqual(img2jpgic) Then
                     Return img1jpgic.Length
                  End If
               End If
            End If
         End If
      End If
      Return -1
   End Function
   Private Function ToByteVariante2(ByVal img1 As Bitmap,
                                    format As ImageFormat) As Int32
      Dim img2 = New Bitmap(Filename & ".jpg")
      'ODER: Manchmal ist es sinnvoll gleich ein Clone zu machen
      'Dim img1 = DirectCast(New Bitmap(Filename & ".jpg").Clone, Bitmap)

      'Über MemoryStream/EncoderParameters/Kompressionsrate
      Dim img3jpg = ChanceFormatBm(img1, format, Nothing)
      Dim img4jpg = ChanceFormatBm(img2, format, Nothing)

      'Convertierung zu Byte()
      '- ImageConverter
      '- TypeConverter
      '- MemoryStream
      Dim img3jpgic = ToByteArrIC(img3jpg)
      Dim img3jpgtc = ToByteArrTC(img3jpg)
      Dim img3jpgms = ToByteArrMS(img3jpg)

      Dim img4jpgic = ToByteArrIC(img4jpg)
      Dim img4jpgtc = ToByteArrTC(img4jpg)
      Dim img4jpgms = ToByteArrMS(img4jpg)

      ' *********** *********** *********** *********** 
      ' *********** *********** *********** *********** 
      ' *********** *********** *********** *********** 
      'Ab hier könnte man VERCRYPTEN. Z.b. AES
      ' *********** *********** *********** *********** 
      ' *********** *********** *********** *********** 
      ' *********** *********** *********** *********** 

      'Auf Byte-Gleichheit prüfen
      'Extra so gemacht, um zu schauen, ob die immer 
      'das gleiche Ergebnis liefern
      If img3jpgic.SequenceEqual(img3jpgtc) Then
         If img3jpgic.SequenceEqual(img3jpgms) Then
            If img4jpgic.SequenceEqual(img4jpgtc) Then
               If img4jpgic.SequenceEqual(img4jpgms) Then
                  If img3jpgic.SequenceEqual(img4jpgic) Then
                     Return img3jpgic.Length
                  End If
               End If
            End If
         End If
      End If
      Return -1
   End Function
   Private Function ToBitmap(ByVal bimg() As Byte) As Bitmap
      If bimg IsNot Nothing AndAlso bimg.Length > 0 Then
         Dim ic As New ImageConverter
         Return CType(ic.ConvertFrom(bimg), Bitmap)
      End If
      Return Nothing
   End Function
   Private Function ChanceFormat(ByVal img As Bitmap, format As ImageFormat) As Bitmap
      'Rudimentärer Formatwechsel, der noch sehr gute Ergebnisse liefert
      If img.RawFormat.Equals(format) Then Return img
      Dim res As Bitmap, b() As Byte
      Using ms As New MemoryStream
         img.Save(ms, format)
         ms.Flush() 'Muss hier sein, sonst gibt es einen Fehler bei mir
         b = ms.ToArray
         ms.Flush()
      End Using
      Using ms As New MemoryStream(b)
         Using tmp = Image.FromStream(ms)
            'Vorteil übernimmt gleich das entsprechende Format
            res = DirectCast(New Bitmap(tmp).Clone, Bitmap)
            'Jetzt noch die PropertiesInformationen einsetzen
            For Each p As PropertyItem In tmp.PropertyItems
               res.SetPropertyItem(p)
            Next
         End Using
      End Using
      Return res
   End Function
   Private Function ToByteArrIC(ByVal img As Bitmap) As Byte()
      If img.PropertyItems IsNot Nothing AndAlso Not img.PropertyItems.Length = 0 Then
         If img.PropertyIdList IsNot Nothing AndAlso Not img.PropertyIdList.Length = 0 Then
            Dim ic As New ImageConverter
            Return DirectCast(ic.ConvertTo(img, GetType(Byte())), Byte())
         End If
      End If
      Return Nothing
   End Function
   Private Function ToByteArrTC(ByVal img As Bitmap) As Byte()
      If img.PropertyItems IsNot Nothing AndAlso Not img.PropertyItems.Length = 0 Then
         If img.PropertyIdList IsNot Nothing AndAlso Not img.PropertyIdList.Length = 0 Then
            Dim tc = TypeDescriptor.GetConverter(GetType(Image))
            Return DirectCast(tc.ConvertTo(img, GetType(Byte())), Byte())
         End If
      End If
      Return Nothing
   End Function
   Private Function ToByteArrMS(ByVal img As Bitmap) As Byte()
      'png-Format ist neutral
      Using ms As New MemoryStream
         img.Save(ms, ImageFormat.Png)
         ms.Flush()
         Return ms.ToArray
      End Using
   End Function
   Private Function ChanceFormatByte(ByVal img As Bitmap, format As ImageFormat,
                                     Optional ev As EncoderValue = Nothing) As Byte()
      ev = If(IsNothing(ev), EncoderValue.CompressionNone, ev)
      Using ms As New MemoryStream
         Using ep = New EncoderParameters(1)
            Dim QualityLevel = EncoderValue.CompressionNone
            Using myEncoderParameters As New EncoderParameters(1)
               Using myEncoderParameter As New EncoderParameter(Encoder.Quality, QualityLevel)
                  myEncoderParameters.Param(0) = myEncoderParameter
                  img.Save(ms, GetEncoderInfo(format), myEncoderParameters)
                  ms.Flush()
                  Return ms.ToArray
               End Using
            End Using
         End Using
      End Using
      Return Nothing
   End Function
   Private Function ChanceFormatBm(ByVal img As Bitmap, format As ImageFormat,
                                     Optional ev As EncoderValue = Nothing) As Bitmap
      Dim res As Bitmap
      ev = If(IsNothing(ev), EncoderValue.CompressionNone, ev)
      Using ms As New MemoryStream(ChanceFormatByte(img, format))
         Dim tmp = Image.FromStream(ms)
         res = DirectCast(New Bitmap(tmp).Clone, Bitmap)
         For Each p As PropertyItem In tmp.PropertyItems
            res.SetPropertyItem(p)
         Next
      End Using
      Return res
   End Function
   Private Function GetEncoderInfo(ByVal format As ImageFormat) As ImageCodecInfo
      Dim codecs = ImageCodecInfo.GetImageDecoders
      For Each codec As ImageCodecInfo In codecs
         If codec.FormatID = format.Guid Then
            Return codec
         End If
      Next
      Return Nothing
   End Function
   Private Function GetEncoderInfo(mimeType As String) As ImageCodecInfo
      'mimeType z.B. "Image/Png" siehe
      'https://referencesource.microsoft.com/System.Web.DataVisualization/a.html#50b0fd2ab80e3a33
      Dim encoders = ImageCodecInfo.GetImageEncoders
      For j As Int32 = 0 To encoders.Length - 1
         If encoders(j).MimeType = mimeType Then
            Return encoders(j)
         End If
      Next
      Return Nothing
   End Function
   Private Sub Save(ByVal img As Bitmap, filename As String)
      Using ep = New EncoderParameters(1)
         Dim QualityLevel = EncoderValue.CompressionNone
         Using myEncoderParameters As New EncoderParameters(1)
            Using myEncoderParameter As New EncoderParameter(Encoder.Quality, QualityLevel)
               myEncoderParameters.Param(0) = myEncoderParameter
               img.Save(filename, GetEncoderInfo(img.RawFormat), myEncoderParameters)
            End Using
         End Using
      End Using
   End Sub
End Module