daily pastebin goal
39%
SHARE
TWEET

Bitmap Fast

ShadowTzu Nov 22nd, 2014 (edited) 192 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
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top