Icon editing

System.ComponentModel.Win32Exception (0x80004005): Handlingen er gennemført
  ved System.Drawing.Icon.Initialize(Int32 width, Int32 height)
  ved System.Drawing.Icon..ctor(Stream stream, Int32 width, Int32 height)
  ved System.Drawing.Icon..ctor(Stream stream)
  ved WindowsApplication109.Form1.BitmapToIcon(Image bmp) i C:\Users\Mads Haupt\Documents\Visual Studio 2012\Projects\WindowsApplication109\WindowsApplication109\Form1.vb:linje 76
  ved WindowsApplication109.Form1.Form1_Load(Object sender, EventArgs e) i C:\Users\Mads Haupt\Documents\Visual Studio 2012\Projects\WindowsApplication109\WindowsApplication109\Form1.vb:linje 101
  ved System.EventHandler.Invoke(Object sender, EventArgs e)
  ved System.Windows.Forms.Form.OnLoad(EventArgs e)
  ved System.Windows.Forms.Form.OnCreateControl()
  ved System.Windows.Forms.Control.CreateControl(Boolean fIgnoreVisible)
  ved System.Windows.Forms.Control.CreateControl()
  ved System.Windows.Forms.Control.WmShowWindow(Message& m)
  ved System.Windows.Forms.Control.WndProc(Message& m)
  ved System.Windows.Forms.ScrollableControl.WndProc(Message& m)
  ved System.Windows.Forms.ContainerControl.WndProc(Message& m)
  ved System.Windows.Forms.Form.WmShowWindow(Message& m)
  ved System.Windows.Forms.Form.WndProc(Message& m)
  ved System.Windows.Forms.Control.ControlNativeWindow.OnMessage(Message& m)
  ved System.Windows.Forms.Control.ControlNativeWindow.WndProc(Message& m)
  ved System.Windows.Forms.NativeWindow.Callback(IntPtr hWnd, Int32 msg, IntPtr wparam, IntPtr lparam)

Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging

Public Class Form1

    Structure IconDir
        Public Reserved As Short
        Public Type As Short
        Public Count As Short
    End Structure

    Structure IconDirEntry
        Public Width As Byte
        Public Height As Byte
        Public ColorCount As Byte
        Public Reserved As Byte
        Public Planes As Short
        Public BitCount As Short
        Public BytesInRes As Integer
        Public ImageOffset As Integer
    End Structure

    Structure BitmapInfoHeader
        Public Size As UInteger
        Public Width As UInteger
        Public Height As UInteger
        Public Planes As UShort
        Public BitCount As UShort
        Public Compression As Integer
        Public SizeImage As UInteger
        Public XPelsPerMeter As Integer
        Public YPelsPerMeter As Integer
        Public ClrUsed As UInteger
        Public ClrImportant As UInteger
    End Structure

    Private Function BitmapToIcon(ByVal bmp As Image) As Icon
        ' Converting image
        Dim imagestream As New MemoryStream
        Dim bits As Byte
        Select Case bmp.PixelFormat
            Case Imaging.PixelFormat.Format1bppIndexed
                bits = 1
            Case Imaging.PixelFormat.Format4bppIndexed
                bits = 4
            Case Imaging.PixelFormat.Format8bppIndexed
                bits = 8
            Case Imaging.PixelFormat.Format16bppArgb1555, Imaging.PixelFormat.Format16bppGrayScale, Imaging.PixelFormat.Format16bppRgb555, Imaging.PixelFormat.Format16bppRgb565
                bits = 16
            Case Imaging.PixelFormat.Format24bppRgb
                bits = 24
            Case Imaging.PixelFormat.Format32bppArgb, Imaging.PixelFormat.Format32bppPArgb, Imaging.PixelFormat.Format32bppRgb
                bits = 32
            Case Imaging.PixelFormat.Format48bppRgb
                bits = 48
            Case Imaging.PixelFormat.Format64bppArgb, Imaging.PixelFormat.Format64bppPArgb
                bits = 64
        End Select
        WriteStructure(Of BitmapInfoHeader)(imagestream, New BitmapInfoHeader With {.BitCount = bits, .Width = bmp.Width, .Height = bmp.Height * 2, .Compression = 0, .ClrUsed = bmp.Width * bmp.Height, .ClrImportant = 0, .XPelsPerMeter = 0, .YPelsPerMeter = 0, .Planes = 1, .SizeImage = bmp.Width * bmp.Height * (bits / 8), .Size = Marshal.SizeOf(GetType(BitmapInfoHeader))})
        Dim img As Bitmap = bmp.Clone
        Dim data As BitmapData = img.LockBits(New Rectangle(0, 0, img.Width, img.Height), ImageLockMode.ReadOnly, img.PixelFormat)
        Dim bytes(data.Stride * data.Height - 1) As Byte
        Dim ptr As IntPtr = data.Scan0
        Marshal.Copy(ptr, bytes, 0, bytes.Length)
        img.UnlockBits(data)
        imagestream.Write(bytes, 0, bytes.Length)

        ' Creates icon
        Dim memory As New MemoryStream
        WriteStructure(Of IconDir)(memory, New IconDir With {.Count = 1, .Reserved = 0, .Type = 1})
        WriteStructure(Of IconDirEntry)(memory, New IconDirEntry With {.Width = If(bmp.Width < 256, bmp.Width, 0), .Height = If(bmp.Height < 256, bmp.Width, 0), .ImageOffset = Marshal.SizeOf(GetType(IconDir)) + Marshal.SizeOf(GetType(IconDirEntry)), .Reserved = 0, .ColorCount = 0, .Planes = 1, .BitCount = 32, .BytesInRes = imagestream.Length})
        memory.Write(imagestream.ToArray, 0, imagestream.Length)
        imagestream.Close()
        memory.Seek(0, SeekOrigin.Begin)
        Return New Icon(memory)
    End Function

    Private Function ReadStructure(Of T As Structure)(ByVal input As Stream) As T
        Dim size As Integer = Marshal.SizeOf(GetType(T))
        Dim bytes(size - 1) As Byte
        input.Read(bytes, 0, bytes.Length)
        Dim ptr As IntPtr = Marshal.AllocHGlobal(size)
        Marshal.Copy(bytes, 0, ptr, bytes.Length)
        ReadStructure = Marshal.PtrToStructure(ptr, GetType(T))
        Marshal.FreeHGlobal(ptr)
    End Function

    Private Sub WriteStructure(Of T As Structure)(ByVal output As Stream, ByVal [structure] As T)
        Dim size As Integer = Marshal.SizeOf(GetType(T))
        Dim bytes(size - 1) As Byte
        Dim ptr As IntPtr = Marshal.AllocHGlobal(size)
        Marshal.StructureToPtr([structure], ptr, True)
        Marshal.Copy(ptr, bytes, 0, bytes.Length)
        Marshal.FreeHGlobal(ptr)
        output.Write(bytes, 0, bytes.Length)
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim file As New FileStream(Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\.ico", FileMode.Create)
        Dim icon As Icon = BitmapToIcon(New Bitmap(256, 256))
        icon.Save(file)
        file.Close()
        End
    End Sub

End Class