Image to a Graphical Html Code

Public Class Form1
    Dim file1 As String
#Region "Controls : "
    Dim prog As New ProgressBar
    Dim pic As New PictureBox
    Dim WithEvents but1 As New Button
    Dim WithEvents but2 As New Button
#End Region
    Public Sub Bitmap_To_Htmlcode(ByVal pic As Bitmap)
        Dim sw As New IO.StreamWriter(file1)
        sw.WriteLine("<style type=" & Chr(34) & "text/css" & Chr(34) & ">pa {font-size:5px;}" & Environment.NewLine & "</style><pa>")
        Dim bmp As New RoBitmap(pic)
        For y = 0 To bmp.Height - 1
            Dim ste As String = ""
            For x = 0 To bmp.Width - 1
                Dim col As Color = bmp.GetPixel(x, y)
                sw.Write("<font color=" & Chr(34) & "rgb(" & col.R.ToString & "," & col.G.ToString & "," & col.B.ToString & ")" & Chr(34) & ">@</font>")
            Next
            Me.Invoke(Sub() prog.Value += bmp.Width)
            sw.Write("</br>")
        Next
        sw.Write("</pa>")
        sw.Close()
    End Sub
    Public Sub lol()
        Dim bmp As Bitmap = CType(pic.Image, Bitmap)
        Me.Invoke(Sub() prog.Maximum = bmp.Width * bmp.Height)
        Bitmap_To_Htmlcode(bmp)
        MessageBox.Show("Finish")
    End Sub
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles but2.Click
        Dim fr As New SaveFileDialog
        fr.Filter = " HTML |*.html"
        fr.ShowDialog()
        file1 = fr.FileName
        Dim th As New Threading.Thread(AddressOf lol)
        th.Start()
    End Sub
    Private Sub but1_Click(sender As System.Object, e As System.EventArgs) Handles but1.Click
        Dim fr As New OpenFileDialog
        fr.Filter = "Image|*.jepg;*.jpg;*.bmp;*.png;*.gif"
        fr.ShowDialog()
        If IO.File.Exists(fr.FileName) = True Then
            pic.Image = New Bitmap(fr.FileName)
        End If
    End Sub
    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        prog.Size = New Size(400, 21)
        prog.Location = New Point(12, 287)
        Me.Controls.Add(prog)
        pic.Size = New Size(483, 244)
        pic.Location = New Point(12, 37)
        Me.Controls.Add(pic)
        but1.Size = New Size(71, 19)
        but1.Location = New Point(12, 12)
        but1.Text = "load"
        Me.Controls.Add(but1)
        but2.Size = New Size(77, 21)
        but2.Location = New Point(418, 287)
        but2.Text = "save"
        Me.Controls.Add(but2)
        Me.Size = New Size(521, 352)
        Me.Text = "Picture to html"
    End Sub
End Class
Class RoBitmap
    Private bildDaten As Byte()
    Private colore As Color(,)
    Private m_width As Integer
    Private m_height As Integer
    Private Bild As Bitmap
    Private rect As Rectangle
    Private modified As Boolean
    Private bytes As Integer
    Private stride As Integer
    Private pixelFormat As System.Drawing.Imaging.PixelFormat
    Private colorPalette As System.Drawing.Imaging.ColorPalette
    Public Sub New(bld As Bitmap)
        Bild = bld
        SetzeWerte()
    End Sub
    Private Sub SetzeWerte()
        colorPalette = Bild.Palette
        pixelFormat = Bild.PixelFormat
        m_width = Bild.Width
        m_height = Bild.Height
        rect = New Rectangle(0, 0, m_width, m_height)
        Dim bmpData As System.Drawing.Imaging.BitmapData = Bild.LockBits(rect, System.Drawing.Imaging.ImageLockMode.[ReadOnly], Bild.PixelFormat)

        Dim ptr As IntPtr = bmpData.Scan0
        stride = bmpData.Stride
        bytes = stride * m_height
        bildDaten = New Byte(bytes - 1) {}
        System.Runtime.InteropServices.Marshal.Copy(ptr, bildDaten, 0, bytes)
        Bild.UnlockBits(bmpData)
        colore = New Color(m_width - 1, m_height - 1) {}
        Select Case pixelFormat
            Case System.Drawing.Imaging.PixelFormat.Format32bppArgb
                Format32BppArgb()
                Exit Select
            Case System.Drawing.Imaging.PixelFormat.Format24bppRgb
                Format24BppRgb()
                Exit Select
            Case System.Drawing.Imaging.PixelFormat.Format8bppIndexed
                Format8BppIndexed()
                Exit Select
            Case System.Drawing.Imaging.PixelFormat.Format4bppIndexed
                Format4BppIndexed()
                Exit Select
            Case System.Drawing.Imaging.PixelFormat.Format1bppIndexed
                Format1BppIndexed()
                Exit Select
        End Select
        modified = False
    End Sub
    Private Sub Format32BppArgb()
        For y As Integer = 0 To m_height - 1
            For x As Integer = 0 To m_width - 1
                colore(x, y) = Color.FromArgb(bildDaten(y * stride + x * 4 + 3), bildDaten(y * stride + x * 4 + 2), bildDaten(y * stride + x * 4 + 1), bildDaten(y * stride + x * 4))
            Next
        Next
    End Sub
    Private Sub Format24BppRgb()
        For y As Integer = 0 To m_height - 1
            For x As Integer = 0 To m_width - 1
                colore(x, y) = Color.FromArgb(bildDaten(y * stride + x * 3 + 2), bildDaten(y * stride + x * 3 + 1), bildDaten(y * stride + x * 3))
            Next
        Next
    End Sub
    Private Sub Format8BppIndexed()
        For y As Integer = 0 To m_height - 1
            For x As Integer = 0 To m_width - 1
                colore(x, y) = colorPalette.Entries(bildDaten(y * stride + x))
            Next
        Next
    End Sub
    Private Sub Format4BppIndexed()
        For y As Integer = 0 To m_height - 1
            For x As Integer = 0 To m_width - 1
                If x Mod 2 = 0 Then
                    colore(x, y) = colorPalette.Entries(LowByte(bildDaten(y * stride + x \ 2)))
                Else
                    colore(x, y) = colorPalette.Entries(HighByte(bildDaten(y * stride + x \ 2)))
                End If
            Next
        Next
    End Sub
    Private Sub Format1BppIndexed()
        Dim rest As Integer = m_width Mod 8
        Dim bits As Byte
        Dim x As Integer, y As Integer
        For y = 0 To m_height - 1
            For x = 0 To m_width - 9 Step 8
                bits = bildDaten(y * stride + x \ 8)
                colore(x, y) = colorPalette.Entries((bits And 128) \ 128)
                colore(x + 1, y) = colorPalette.Entries((bits And 64) \ 64)
                colore(x + 2, y) = colorPalette.Entries((bits And 32) \ 32)
                colore(x + 3, y) = colorPalette.Entries((bits And 16) \ 16)
                colore(x + 4, y) = colorPalette.Entries((bits And 8) \ 8)
                colore(x + 5, y) = colorPalette.Entries((bits And 4) \ 4)
                colore(x + 6, y) = colorPalette.Entries((bits And 2) \ 2)
                colore(x + 7, y) = colorPalette.Entries(bits And 1)
            Next
            bits = bildDaten(y * stride + x \ 8)
            Dim teiler As Integer = 128
            For i As Integer = 0 To rest - 1
                colore(x + i, y) = colorPalette.Entries((bits And teiler) \ teiler)
                teiler = CInt(teiler / 2)
            Next
        Next
    End Sub
    Private Function HighByte(zahl As Byte) As Integer
        Return zahl >> 4
    End Function
    Private Function LowByte(zahl As Byte) As Integer

        Return zahl And 15
    End Function
    Public Function GetPixel(x As Integer, y As Integer) As Color
        Return colore(x, y)
    End Function
    Public Sub SetPixel(x As Integer, y As Integer, col As Color)
        colore(x, y) = col
        modified = True
    End Sub
    Public ReadOnly Property Width() As Integer
        Get
            Return m_width
        End Get
    End Property
    Public ReadOnly Property Height() As Integer
        Get
            Return m_height
        End Get
    End Property
    Public Property Image() As Bitmap
        Get
            If Not modified Then
                Return Bild
            End If
            Select Case pixelFormat
                Case System.Drawing.Imaging.PixelFormat.Format32bppArgb
                    Return ReturnFormat32BppArgb()
                Case System.Drawing.Imaging.PixelFormat.Format24bppRgb
                    Return ReturnFormat24BppRgb()
                Case System.Drawing.Imaging.PixelFormat.Format8bppIndexed
                    'ReturnFormat8BppIndexed();
                    Exit Select
                Case System.Drawing.Imaging.PixelFormat.Format4bppIndexed
                    'ReturnFormat4BppIndexed();
                    Exit Select
                Case System.Drawing.Imaging.PixelFormat.Format1bppIndexed
                    'ReturnFormat1BppIndexed();
                    Exit Select
            End Select
            Return Nothing
        End Get
        Set(value As Bitmap)
            Bild = value
            SetzeWerte()
        End Set
    End Property
    Private Function ReturnFormat24BppRgb() As Bitmap
        For y As Integer = 0 To m_height - 1
            For x As Integer = 0 To m_width - 1
                bildDaten(y * stride + x * 3 + 2) = colore(x, y).R
                bildDaten(y * stride + x * 3 + 1) = colore(x, y).G
                bildDaten(y * stride + x * 3) = colore(x, y).B
            Next
        Next
        Dim bmpData As System.Drawing.Imaging.BitmapData = Bild.LockBits(rect, System.Drawing.Imaging.ImageLockMode.[WriteOnly], Bild.PixelFormat)
        Dim ptr As IntPtr = bmpData.Scan0
        System.Runtime.InteropServices.Marshal.Copy(bildDaten, 0, ptr, bytes)
        Bild.UnlockBits(bmpData)
        modified = False
        Return Bild
    End Function
    Private Function ReturnFormat32BppArgb() As Bitmap
        For y As Integer = 0 To m_height - 1
            For x As Integer = 0 To m_width - 1
                bildDaten(y * stride + x * 4 + 3) = colore(x, y).A
                bildDaten(y * stride + x * 4 + 2) = colore(x, y).R
                bildDaten(y * stride + x * 4 + 1) = colore(x, y).G
                bildDaten(y * stride + x * 4) = colore(x, y).B
            Next
        Next
        Dim bmpData As System.Drawing.Imaging.BitmapData = Bild.LockBits(rect, System.Drawing.Imaging.ImageLockMode.[WriteOnly], Bild.PixelFormat)
        Dim ptr As IntPtr = bmpData.Scan0
        System.Runtime.InteropServices.Marshal.Copy(bildDaten, 0, ptr, bytes)
        Bild.UnlockBits(bmpData)
        modified = False
        Return Bild
    End Function
End Class