Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
' Работаем с пикселами 32-битового изображения (Format32bppArgb)
Public Class Pixxxelz
' na http://sontse.hmarka.net/ abo http://igorr.zx6.ru/ ye pizdata demo programa i kucha raznogo ohuyennogo koda!
Implements ICloneable
Implements IDisposable
Public Declare Ansi
Sub memcpy
Lib "kernel32"
Alias "RtlMoveMemory" _
 
ByVal Dst
As IntPtr,
ByVal Src
As IntPtr,
ByVal Length
As Integer)
Public Declare Ansi
Sub memcpy2
Lib "kernel32"
Alias "RtlMoveMemory" _
 
ByVal Dst
As Byte,
ByVal Src
As IntPtr,
ByVal Length
As Integer)
Public Declare Ansi
Sub memcpy3
Lib "kernel32"
Alias "RtlMoveMemory" _
 
ByVal Dst
As ARGB,
ByVal Src
As IntPtr,
ByVal Length
As Integer)
#Region " ARGB - структура работы с 32-битовым цветом (Drawing.Color - не годится)"
Public Structure ARGB
Dim b
As Byte
Dim g
As Byte
Dim r
As Byte
Dim a
As Byte
' Параметризированный конструктор
Public Sub New(
ByVal a
As Byte,
ByVal r
As Byte,
ByVal g
As Byte,
ByVal b
As Byte)
Me.a = a :
Me.r = r :
Me.g = g :
Me.b = b
End Sub
End Structure
#
End Region
Friend _width
As Integer
Friend _height
As Integer
Friend _ptr
As IntPtr
Friend _length
As Integer
Public Sub New(
ByVal img
As Bitmap)
MyBase.
New()
Dim tmp
As New Bitmap(img.Width, img.Height, PixelFormat.Format32bppArgb)
Dim g
As Graphics = Graphics.FromImage(tmp)
Call g.DrawImageUnscaled(img, 0, 0) : g.Dispose()
_length = img.Width * img.Height * 4
' Длина данных 32-битового изображения в памяти (4 байта на пиксел)
_ptr = Marshal.AllocHGlobal(_length)
' Выделяем отдельно память
' Блокируем данные изображения
Dim data
As BitmapData = tmp.LockBits(
New Rectangle(0, 0, tmp.Width, _
tmp.Height), ImageLockMode.
ReadOnly, PixelFormat.Format32bppArgb)
Call memcpy(_ptr, data.Scan0, _length)
Call tmp.UnlockBits(data) : tmp.Dispose()
_width = img.Width : _height = img.Height
End Sub
Public Sub SetPixel(
ByVal x
As Integer,
ByVal y
As Integer,
ByVal value
As ARGB)
Dim ofs
As Integer = ((y * Width) + x) * 4
Marshal.WriteByte(_ptr, ofs + 3, value.a)
Marshal.WriteByte(_ptr, ofs + 2, value.r)
Marshal.WriteByte(_ptr, ofs + 1, value.g)
Marshal.WriteByte(_ptr, ofs, value.b)
End Sub
Public Function GetPixel(
ByVal x
As Integer,
ByVal y
As Integer)
As ARGB
Dim ofs
As Integer = ((y * Width) + x) * 4
Return New ARGB(Marshal.ReadByte(_ptr, ofs + 3), Marshal.ReadByte(_ptr, ofs + 2), _
Marshal.ReadByte(_ptr, ofs + 1), Marshal.ReadByte(_ptr, ofs))
End Function
' Получить изображение
' (copy = false) - изображение на основе графической информации данного объекта
' (copy = true) - изображение на основе копии графической информации данного объекта
Public Function ToBitmap(
Optional ByVal copy
As Boolean =
False)
As Bitmap
If copy
Then
Dim p
As Pixxxelz = CType(Clone(), Pixxxelz)
Return p.ToBitmap(
False)
Else
Return New Bitmap(Width, Height, Width * 4, PixelFormat, Pointer)
End If
End Function
Public ReadOnly Property Width()
As Integer
Get
Return _width
End Get
End Property
Public ReadOnly Property Height()
As Integer
Get
Return _height
End Get
End Property
Public ReadOnly Property Length()
As Integer
Get
Return _length
End Get
End Property
Public ReadOnly Property Pointer()
As IntPtr
Get
Return _ptr
End Get
End Property
Public ReadOnly Property PixelFormat()
As PixelFormat
Get
Return Imaging.PixelFormat.Format32bppArgb
End Get
End Property
#Region " для общего развития"
Public Shared Operator =(
ByVal first
As Pixxxelz,
ByVal second
As Pixxxelz)
As Boolean
Return first._ptr.ToInt32 = second._ptr.ToInt32
End Operator
Public Shared Operator <>
ByVal first
As Pixxxelz,
ByVal second
As Pixxxelz)
As Boolean
Return Not first = second
End Operator
Public Function Clone()
As Object Implements System.ICloneable.Clone
Dim pxlz
As New Pixxxelz
With pxlz
._ptr = Marshal.AllocHGlobal(_length)
Call memcpy(._ptr, _ptr, _length)
._height = _height
._width = _width
._length = _length
End With
Return pxlz
End Function
Public Sub Dispose()
Implements IDisposable.Dispose
On Error GoTo nahuy
Call Marshal.FreeHGlobal(_ptr)
Finalize()
Return
nahuy:
End Sub
Friend Sub New()
MyBase.
New()
End Sub
#
End Region
Public Function ToByteArray()
As Byte()
Dim arr((Width * Height * 4) - 1)
As Byte
Call memcpy2(arr(0), Pointer, Length)
Return arr
End Function
Public Function ToArgb()
As ARGB()
Dim arr((Width * Height) - 1)
As ARGB
Call memcpy3(arr(0), Pointer, Length)
Return arr
End Function
End Class