SHARE
TWEET

Bitmap Fast

ShadowTzu Nov 22nd, 2014 (edited) 178 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. 'Coded by ShadowTzu
  2. 'Free to use
  3.  
  4. 'my 3D engine, Tzu3D: http://shadowtzu.free.fr
  5. 'Youtube: https://www.youtube.com/user/shadowtzu
  6. 'Facebook: https://www.facebook.com/Tzu3d
  7. 'Twitter: https://twitter.com/shadowtzu
  8. 'Twitch: http://www.twitch.tv/shadowtzu
  9. 'Website: http://tzu3d.weebly.com
  10.  
  11. Imports System.IO
  12.  
  13. Friend Class BitmapFast
  14.     Implements IDisposable
  15.  
  16. #Region "private"
  17.     Private b() As Byte
  18.     Private i_Width As Integer
  19.     Private i_Height As Integer
  20.     Private m_stride As Integer
  21.     Private mLoad_Failed As Boolean
  22. #End Region
  23.  
  24. #Region "New"
  25.     Sub New(Width As Integer, Height As Integer)
  26.         Me.i_Width = Width
  27.         Me.i_Height = Height
  28.         ReDim b(Height * Width * 4 - 1)
  29.     End Sub
  30.  
  31.     Sub New(ByVal filename As String)
  32.         Me.New(filename, False, 0)
  33.     End Sub
  34.  
  35.     Public Sub New(ByVal filename As String, Optional ByVal clamp As Boolean = False, Optional ByVal clamp_add As Integer = 0)
  36.         If (filename = "") Or (System.IO.File.Exists(filename) = False) Then
  37.             MsgBox("file '" & filename & "' not found!")
  38.             mLoad_Failed = True
  39.             Exit Sub
  40.         End If
  41.  
  42.         Dim pv_bitmap As System.Drawing.Bitmap = Nothing
  43.         Dim image_width, image_height As Integer
  44.  
  45.         Dim myimage As System.Drawing.Image = System.Drawing.Image.FromFile(filename)
  46.         image_height = myimage.Height
  47.  
  48.         If clamp = True Then
  49.             image_height = clamp_base_two(myimage.Height)
  50.             image_width = clamp_base_two(myimage.Width)
  51.             If clamp_add <> 0 Then
  52.                 image_height = CInt(myimage.Height / 2) * 2 + clamp_add
  53.                 image_width = CInt(myimage.Width / 2) * 2 + clamp_add
  54.             End If
  55.         Else
  56.             image_height = myimage.Height
  57.             image_width = myimage.Width          
  58.         End If
  59.         pv_bitmap = New System.Drawing.Bitmap(myimage, image_width, image_height)
  60.  
  61.         i_Width = pv_bitmap.Width
  62.         i_Height = pv_bitmap.Height
  63.  
  64.         Dim bounds As System.Drawing.Rectangle = New System.Drawing.Rectangle(0, 0, pv_bitmap.Width, pv_bitmap.Height)
  65.         Dim bitmapData As System.Drawing.Imaging.BitmapData = pv_bitmap.LockBits(bounds, Drawing.Imaging.ImageLockMode.ReadOnly, Drawing.Imaging.PixelFormat.Format32bppArgb)
  66.  
  67.         ReDim b(pv_bitmap.Height * bitmapData.Stride - 1)
  68.         m_stride = bitmapData.Stride
  69.         System.Runtime.InteropServices.Marshal.Copy(bitmapData.Scan0, b, 0, b.Length)
  70.  
  71.         bounds = Nothing
  72.         bitmapData = Nothing
  73.         pv_bitmap.Dispose()
  74.         pv_bitmap = Nothing
  75.     End Sub
  76.  
  77.     Private Function clamp_base_two(ByVal value As Integer) As Integer
  78.         Dim clamp_test(0) As Integer
  79.  
  80.         Dim inc_clamp As Integer = 16
  81.         Dim start_test As Integer = 32
  82.  
  83.         clamp_test(0) = start_test
  84.         Dim inc As Integer
  85.         Do While start_test < 4096
  86.             ReDim Preserve clamp_test(inc)
  87.             clamp_test(inc) = start_test + CInt(start_test / 2)
  88.             start_test += inc_clamp
  89.             inc += 1
  90.         Loop
  91.         For i As Integer = 0 To clamp_test.Length - 1
  92.             If value < clamp_test(i) Then
  93.                 value = clamp_test(i) - 16
  94.                 Erase clamp_test
  95.                 Return value
  96.             End If
  97.         Next
  98.         Erase clamp_test
  99.         Return 4096
  100.     End Function
  101.  
  102.  
  103. #End Region
  104.  
  105. #Region "Function Get/Set Pixel"
  106.     Public Function Getpixel(ByVal x As Integer, ByVal y As Integer) As System.Drawing.Color
  107.         Dim red, green, blue, Alpha As Byte
  108.         If x > Me.i_Width Then x = x Mod i_Width
  109.         If y > Me.i_Height Then y = y Mod i_Height
  110.         If x < 0 Then x = Me.i_Width - (Math.Abs(x) Mod i_Width)
  111.         If y < 0 Then y = Me.i_Height - (Math.Abs(y) Mod i_Height)
  112.  
  113.         red = b((x * 4) + y * m_stride)
  114.         green = b((x * 4 + 1) + y * m_stride)
  115.         blue = b((x * 4 + 2) + y * m_stride)
  116.         Alpha = b((x * 4 + 3) + y * m_stride)
  117.  
  118.         Return System.Drawing.Color.FromArgb(Alpha, red, green, blue)
  119.     End Function
  120.  
  121.     Public Sub Setpixel(ByVal x As Integer, ByVal y As Integer, ByVal color As System.Drawing.Color)
  122.         Dim red, green, blue, Alpha As Byte
  123.         red = color.R : green = color.G : blue = color.B : Alpha = color.A
  124.         b((x * 4) + y * m_stride) = blue
  125.         b((x * 4 + 1) + y * m_stride) = green
  126.         b((x * 4 + 2) + y * m_stride) = red
  127.         b((x * 4 + 3) + y * m_stride) = Alpha
  128.     End Sub
  129.  
  130.     Public Property Pixel(X As Integer, Y As Integer) As System.Drawing.Color
  131.         Get
  132.             Return Getpixel(X, Y)
  133.         End Get
  134.         Set(value As System.Drawing.Color)
  135.             Setpixel(X, Y, value)
  136.         End Set
  137.     End Property
  138.  
  139. #End Region
  140.  
  141. #Region "property"
  142.     Public ReadOnly Property Load_Failed As Boolean
  143.         Get
  144.             Return mLoad_Failed
  145.         End Get
  146.     End Property
  147.  
  148.     Public ReadOnly Property Width() As Integer
  149.         Get
  150.             Return i_Width
  151.         End Get
  152.     End Property
  153.  
  154.     Public ReadOnly Property Height() As Integer
  155.         Get
  156.             Return i_Height
  157.         End Get
  158.     End Property
  159.  
  160.     Public Function Get_Bitmap() As System.Drawing.Bitmap
  161.  
  162.         Get_Bitmap = New System.Drawing.Bitmap(i_Width, i_Height, Drawing.Imaging.PixelFormat.Format32bppArgb)
  163.  
  164.         Dim bounds As System.Drawing.Rectangle = New System.Drawing.Rectangle(0, 0, Get_Bitmap.Width, Get_Bitmap.Height)
  165.         Dim bitmapData As System.Drawing.Imaging.BitmapData = Get_Bitmap.LockBits(bounds, Drawing.Imaging.ImageLockMode.ReadOnly, Drawing.Imaging.PixelFormat.Format32bppArgb)
  166.  
  167.         System.Runtime.InteropServices.Marshal.Copy(b, 0, bitmapData.Scan0, b.Length)
  168.         Get_Bitmap.UnlockBits(bitmapData)
  169.  
  170.     End Function
  171. #End Region
  172.  
  173. #Region "save"
  174.     Public Sub Save(ByVal filename As String, ByVal format As System.Drawing.Imaging.ImageFormat)
  175.         Dim pv_bitmap As System.Drawing.Bitmap = Nothing
  176.         pv_bitmap = New System.Drawing.Bitmap(i_Width, i_Height, Drawing.Imaging.PixelFormat.Format32bppArgb)
  177.  
  178.  
  179.         Dim bounds As System.Drawing.Rectangle = New System.Drawing.Rectangle(0, 0, pv_bitmap.Width, pv_bitmap.Height)
  180.         Dim bitmapData As System.Drawing.Imaging.BitmapData = pv_bitmap.LockBits(bounds, Drawing.Imaging.ImageLockMode.ReadOnly, Drawing.Imaging.PixelFormat.Format32bppArgb)
  181.  
  182.         System.Runtime.InteropServices.Marshal.Copy(b, 0, bitmapData.Scan0, b.Length)
  183.  
  184.         pv_bitmap.Save(filename, format)
  185.         pv_bitmap.Dispose()
  186.         pv_bitmap = Nothing
  187.  
  188.     End Sub
  189. #End Region
  190.  
  191.  
  192.     Private disposedValue As Boolean = False
  193.  
  194.     Protected Friend Overridable Sub Dispose(ByVal disposing As Boolean)
  195.         If Not Me.disposedValue Then
  196.             If disposing Then
  197.  
  198.             End If
  199.  
  200.             Erase b
  201.             b = Nothing
  202.  
  203.         End If
  204.         Me.disposedValue = True
  205.     End Sub
  206.  
  207. #Region " IDisposable Support "
  208.     Friend Sub Dispose() Implements IDisposable.Dispose
  209.         Dispose(True)
  210.         GC.SuppressFinalize(Me)
  211.     End Sub
  212. #End Region
  213.  
  214. End Class
RAW Paste Data
Pastebin PRO Summer Special!
Get 40% OFF on Pastebin PRO accounts!
Top