Viewing source for recipe2216vb.aspx

<%@ Page Language="vb" %>
<%@ Import Namespace="System.Drawing" %>
<%@ Import Namespace="System.Drawing.Drawing2D" %>
<%@ Import Namespace="System.Drawing.Imaging" %>
<%@ Import Namespace="System.Runtime.InteropServices" %>
<script language="vb" runat="server">
Private Function GetColorPalette() As ColorPalette
   Dim bitmap As New Bitmap(1, 1, PixelFormat.Format8bppIndexed)
   Dim palette As ColorPalette = bitmap.Palette
   bitmap.Dispose()
   
   Return palette
End Function


Private Function ReColorGif(image As System.Drawing.Image) As Bitmap
   Dim colors As Integer = 255
   Dim width As Integer = image.Width
   Dim height As Integer = image.Height
   
   Dim bitmap As New Bitmap(width, height, PixelFormat.Format8bppIndexed)
   Dim palette As ColorPalette = GetColorPalette()
   
   Dim oleColors As New SortedList()
   Dim safeColors() As Integer = {0, 51, 102, 153, 204, 255}
   
   Dim count As Integer = 0
   Dim r As Integer
   For r = 0 To safeColors.Length - 1
      Dim g As Integer
      For g = 0 To safeColors.Length - 1
         Dim b As Integer
         For b = 0 To safeColors.Length - 1
            palette.Entries(count) = Color.FromArgb(255, safeColors(r), safeColors(g), safeColors(b))
            oleColors(ColorTranslator.ToOle(palette.Entries(count))) = count
            count += 1
         Next b
      Next g
   Next r
   palette.Entries((colors - 1)) = Color.FromArgb(0, 255, 255, 255)
   
   bitmap.Palette = palette
   Dim bmpCopy As New Bitmap(width, height, PixelFormat.Format32bppArgb)
   If (True) Then
      Dim g As Graphics = Graphics.FromImage(bmpCopy)
      g.PageUnit = GraphicsUnit.Pixel
      g.DrawImage(image, 0, 0, width, height)
      g.Dispose()
   End If
   
   Dim bitmapData As BitmapData
   Dim rect As New Rectangle(0, 0, width, height)
   bitmapData = bitmap.LockBits(rect, ImageLockMode.WriteOnly, PixelFormat.Format8bppIndexed)
   
    Dim pixels As IntPtr = bitmapData.Scan0
    Dim bits As Byte()
    Dim pBits As Int32

    If (bitmapData.Stride > 0) Then
        pBits = pixels.ToInt32()
    Else
        pBits = pixels.ToInt32() + bitmapData.Stride * (Height - 1)
    End If

    Dim stride As Integer = Math.Abs(bitmapData.Stride)
    ReDim bits(Height * stride)
   
    Dim row As Integer
    Dim col As Integer

    For row = 0 To Height - 1
        For col = 0 To Width - 1

            Dim pixel As Color
            Dim i8BppPixel As Integer = row * stride + col

            pixel = BmpCopy.GetPixel(col, row)

            Dim index As Double

            Dim entry As Integer = 0
            If ColorTranslator.ToHtml(pixel) = "#ffffff" Then
                index = (colors - 1)
            ElseIf oleColors.ContainsKey(ColorTranslator.ToOle(pixel)) Then
                index = oleColors(ColorTranslator.ToOle(pixel))
            Else
                Dim red As Integer
                Do While safeColors(entry) < pixel.R
                    entry += 1
                Loop
                red = safeColors(entry)
                entry = 0

                Dim green As Integer
                Do While safeColors(entry) < pixel.G
                    entry += 1
                Loop
                green = safeColors(entry)
                entry = 0

                Dim blue As Integer
                Do While safeColors(entry) < pixel.B
                    entry += 1
                Loop
                blue = safeColors(entry)
                entry = 0

                index = oleColors(ColorTranslator.ToOle(Color.FromArgb(red, green, blue)))

            End If

            bits(i8BppPixel) = CByte(index)

        Next col
    Next row
   
   CopyArrayTo(pBits, bits, bits.Length)
   bitmap.UnlockBits(bitmapData)
   
   Return bitmap
   
   bitmap.Dispose()
   bmpCopy.Dispose()   
End Function

<DllImport("KERNEL32.DLL", EntryPoint:="RtlMoveMemory", _
    SetLastError:=True, CharSet:=CharSet.Auto, _
    ExactSpelling:=True, _
    CallingConvention:=CallingConvention.StdCall)> _
Public Shared Sub CopyArrayTo(<[In](), MarshalAs(UnmanagedType.I4)> ByVal hpvDest As Int32, <[In](), Out()> ByVal hpvSource() As Byte, ByVal cbCopy As Integer)
End Sub

Private Sub Page_Load(sender As Object, e As System.EventArgs)
   Dim outputBitmap As New Bitmap(200, 200, PixelFormat.Format24bppRgb)
   
   Dim blackPen As New Pen(Color.Black, 2)
   Dim bluePen As New Pen(Color.Blue, 5)
   Dim greenPen As New Pen(Color.Green, 10)
   Dim redBrush As New SolidBrush(Color.Red)
   Dim g As Graphics = Graphics.FromImage(outputBitmap)
   
   g.Clear(Color.White)
   g.SmoothingMode = SmoothingMode.AntiAlias
   g.DrawString("Aqua", New Font("Arial", 24, FontStyle.Bold), redBrush, New PointF(50, 60))
   g.DrawEllipse(greenPen, 40, 40, 110, 80)
   g.DrawEllipse(bluePen, 30, 30, 130, 100)
   g.DrawEllipse(blackPen, 23, 23, 144, 113)
   
   outputBitmap = ReColorGif(outputBitmap)
   
   Response.ContentType = "image/gif"
   outputBitmap.Save(Response.OutputStream, ImageFormat.Gif)
   
   outputBitmap.Dispose()
End Sub
</script>