perspective
熱2已有 4082 次閱讀 2017-10-02 10:07Imports System
Imports System.Drawing
Imports System.Drawing.Drawing2D
Namespace YLScsDrawing.Imaging.Filters
Public Class FreeTransform
Private vertex As PointF() = New PointF(3) {}
Private AB As YLScsDrawing.Geometry.Vector, _
BC As YLScsDrawing.Geometry.Vector, _
CD As YLScsDrawing.Geometry.Vector, _
DA As YLScsDrawing.Geometry.Vector
Private rect As New Rectangle()
Private srcCB As YLScsDrawing.Imaging.ImageData = New ImageData()
Private srcW As Integer = 0
Private srcH As Integer = 0
Public Property Bitmap() As Bitmap
Get
Return getTransformedBitmap()
End Get
Set(ByVal value As Bitmap)
Try
srcCB.FromBitmap(value)
srcH = value.Height
srcW = value.Width
Catch
srcW = 0
srcH = 0
End Try
End Set
End Property
Public Property ImageLocation() As Point
Get
Return rect.Location
End Get
Set(ByVal value As Point)
rect.Location = value
End Set
End Property
Private isBilinear As Boolean = False
Public Property IsBilinearInterpolation() As Boolean
Get
Return isBilinear
End Get
Set(ByVal value As Boolean)
isBilinear = value
End Set
End Property
Public ReadOnly Property ImageWidth() As Integer
Get
Return rect.Width
End Get
End Property
Public ReadOnly Property ImageHeight() As Integer
Get
Return rect.Height
End Get
End Property
Public Property VertexLeftTop() As PointF
Get
Return vertex(0)
End Get
Set(ByVal value As PointF)
vertex(0) = value
setVertex()
End Set
End Property
Public Property VertexTopRight() As PointF
Get
Return vertex(1)
End Get
Set(ByVal value As PointF)
vertex(1) = value
setVertex()
End Set
End Property
Public Property VertexRightBottom() As PointF
Get
Return vertex(2)
End Get
Set(ByVal value As PointF)
vertex(2) = value
setVertex()
End Set
End Property
Public Property VertexBottomLeft() As PointF
Get
Return vertex(3)
End Get
Set(ByVal value As PointF)
vertex(3) = value
setVertex()
End Set
End Property
Public Property FourCorners() As PointF()
Get
Return vertex
End Get
Set(ByVal value As PointF())
vertex = value
setVertex()
End Set
End Property
Private Sub setVertex()
Dim xmin As Single = Single.MaxValue
Dim ymin As Single = Single.MaxValue
Dim xmax As Single = Single.MinValue
Dim ymax As Single = Single.MinValue
For i As Integer = 0 To 3
xmax = Math.Max(xmax, vertex(i).X)
ymax = Math.Max(ymax, vertex(i).Y)
xmin = Math.Min(xmin, vertex(i).X)
ymin = Math.Min(ymin, vertex(i).Y)
Next
rect = New Rectangle(CInt(xmin), CInt(ymin), CInt((xmax - xmin)), CInt((ymax - ymin)))
AB = New YLScsDrawing.Geometry.Vector(vertex(0), vertex(1))
BC = New YLScsDrawing.Geometry.Vector(vertex(1), vertex(2))
CD = New YLScsDrawing.Geometry.Vector(vertex(2), vertex(3))
DA = New YLScsDrawing.Geometry.Vector(vertex(3), vertex(0))
' get unit vector
AB /= AB.Magnitude
BC /= BC.Magnitude
CD /= CD.Magnitude
DA /= DA.Magnitude
End Sub
Private Function isOnPlaneABCD(ByVal pt As PointF) As Boolean
' including point on border
If Not YLScsDrawing.Geometry.Vector.IsCCW(pt, vertex(0), vertex(1)) Then
If Not YLScsDrawing.Geometry.Vector.IsCCW(pt, vertex(1), vertex(2)) Then
If Not YLScsDrawing.Geometry.Vector.IsCCW(pt, vertex(2), vertex(3)) Then
If Not YLScsDrawing.Geometry.Vector.IsCCW(pt, vertex(3), vertex(0)) Then
Return True
End If
End If
End If
End If
Return False
End Function
Private Function getTransformedBitmap() As Bitmap
If srcH = 0 OrElse srcW = 0 Then Return Nothing
Dim destCB As New ImageData()
destCB.A = New Byte(rect.Width - 1, rect.Height - 1) {}
destCB.B = New Byte(rect.Width - 1, rect.Height - 1) {}
destCB.G = New Byte(rect.Width - 1, rect.Height - 1) {}
destCB.R = New Byte(rect.Width - 1, rect.Height - 1) {}
Dim ptInPlane As New PointF()
Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer
Dim dab As Double, dbc As Double, dcd As Double, dda As Double
Dim dx1 As Single, dx2 As Single, dy1 As Single, dy2 As Single, _
dx1y1 As Single, dx1y2 As Single, _
dx2y1 As Single, dx2y2 As Single, nbyte As Single
For y As Integer = 0 To rect.Height - 1
For x As Integer = 0 To rect.Width - 1
Dim srcPt As New Point(x, y)
srcPt.Offset(Me.rect.Location)
If isOnPlaneABCD(srcPt) Then
dab = Math.Abs( _
(New YLScsDrawing.Geometry.Vector(vertex(0), srcPt)).CrossProduct(AB))
dbc = Math.Abs( _
(New YLScsDrawing.Geometry.Vector(vertex(1), srcPt)).CrossProduct(BC))
dcd = Math.Abs( _
(New YLScsDrawing.Geometry.Vector(vertex(2), srcPt)).CrossProduct(CD))
dda = Math.Abs( _
(New YLScsDrawing.Geometry.Vector(vertex(3), srcPt)).CrossProduct(DA))
ptInPlane.X = CSng((srcW * (dda / (dda + dbc))))
ptInPlane.Y = CSng((srcH * (dab / (dab + dcd))))
x1 = CInt(ptInPlane.X)
y1 = CInt(ptInPlane.Y)
If x1 >= 0 AndAlso x1 < srcW AndAlso y1 >= 0 AndAlso y1 < srcH Then
If isBilinear Then
x2 = IIf((x1 = srcW - 1), x1, x1 + 1)
y2 = IIf((y1 = srcH - 1), y1, y1 + 1)
dx1 = ptInPlane.X - CSng(x1)
If dx1 < 0 Then dx1 = 0
dx1 = 1.0F - dx1
dx2 = 1.0F - dx1 dy1 = ptInPlane.Y - CSng(y1)
If dy1 < 0 Then dy1 = 0
dy1 = 1.0F - dy1
dy2 = 1.0F - dy1
dx1y1 = dx1 * dy1
dx1y2 = dx1 * dy2
dx2y1 = dx2 * dy1
dx2y2 = dx2 * dy2
nbyte = srcCB.A(x1, y1) * dx1y1 + srcCB.A(x2, y1) _
* dx2y1 + srcCB.A(x1, y2) * dx1y2 + srcCB.A(x2, y2) * dx2y2
destCB.A(x, y) = CByte(nbyte)
nbyte = srcCB.B(x1, y1) * dx1y1 + srcCB.B(x2, y1) _
* dx2y1 + srcCB.B(x1, y2) * dx1y2 + srcCB.B(x2, y2) * dx2y2
destCB.B(x, y) = CByte(nbyte)
nbyte = srcCB.G(x1, y1) * dx1y1 + srcCB.G(x2, y1) _
* dx2y1 + srcCB.G(x1, y2) * dx1y2 + srcCB.G(x2, y2) * dx2y2
destCB.G(x, y) = CByte(nbyte)
nbyte = srcCB.R(x1, y1) * dx1y1 + srcCB.R(x2, y1) _
* dx2y1 + srcCB.R(x1, y2) * dx1y2 + srcCB.R(x2, y2) * dx2y2
destCB.R(x, y) = CByte(nbyte)
Else
destCB.A(x, y) = srcCB.A(x1, y1)
destCB.B(x, y) = srcCB.B(x1, y1)
destCB.G(x, y) = srcCB.G(x1, y1)
destCB.R(x, y) = srcCB.R(x1, y1)
End If
End If
End If
Next
Next
Return destCB.ToBitmap()
End Function
End Class
End Namespace
Imports System.Drawing.Drawing2D
Namespace YLScsDrawing.Imaging.Filters
Public Class FreeTransform
Private vertex As PointF() = New PointF(3) {}
Private AB As YLScsDrawing.Geometry.Vector, _
BC As YLScsDrawing.Geometry.Vector, _
CD As YLScsDrawing.Geometry.Vector, _
DA As YLScsDrawing.Geometry.Vector
Private rect As New Rectangle()
Private srcCB As YLScsDrawing.Imaging.ImageData = New ImageData()
Private srcW As Integer = 0
Private srcH As Integer = 0
Public Property Bitmap() As Bitmap
Get
Return getTransformedBitmap()
End Get
Set(ByVal value As Bitmap)
Try
srcCB.FromBitmap(value)
srcH = value.Height
srcW = value.Width
Catch
srcW = 0
srcH = 0
End Try
End Set
End Property
Public Property ImageLocation() As Point
Get
Return rect.Location
End Get
Set(ByVal value As Point)
rect.Location = value
End Set
End Property
Private isBilinear As Boolean = False
Public Property IsBilinearInterpolation() As Boolean
Get
Return isBilinear
End Get
Set(ByVal value As Boolean)
isBilinear = value
End Set
End Property
Public ReadOnly Property ImageWidth() As Integer
Get
Return rect.Width
End Get
End Property
Public ReadOnly Property ImageHeight() As Integer
Get
Return rect.Height
End Get
End Property
Public Property VertexLeftTop() As PointF
Get
Return vertex(0)
End Get
Set(ByVal value As PointF)
vertex(0) = value
setVertex()
End Set
End Property
Public Property VertexTopRight() As PointF
Get
Return vertex(1)
End Get
Set(ByVal value As PointF)
vertex(1) = value
setVertex()
End Set
End Property
Public Property VertexRightBottom() As PointF
Get
Return vertex(2)
End Get
Set(ByVal value As PointF)
vertex(2) = value
setVertex()
End Set
End Property
Public Property VertexBottomLeft() As PointF
Get
Return vertex(3)
End Get
Set(ByVal value As PointF)
vertex(3) = value
setVertex()
End Set
End Property
Public Property FourCorners() As PointF()
Get
Return vertex
End Get
Set(ByVal value As PointF())
vertex = value
setVertex()
End Set
End Property
Private Sub setVertex()
Dim xmin As Single = Single.MaxValue
Dim ymin As Single = Single.MaxValue
Dim xmax As Single = Single.MinValue
Dim ymax As Single = Single.MinValue
For i As Integer = 0 To 3
xmax = Math.Max(xmax, vertex(i).X)
ymax = Math.Max(ymax, vertex(i).Y)
xmin = Math.Min(xmin, vertex(i).X)
ymin = Math.Min(ymin, vertex(i).Y)
Next
rect = New Rectangle(CInt(xmin), CInt(ymin), CInt((xmax - xmin)), CInt((ymax - ymin)))
AB = New YLScsDrawing.Geometry.Vector(vertex(0), vertex(1))
BC = New YLScsDrawing.Geometry.Vector(vertex(1), vertex(2))
CD = New YLScsDrawing.Geometry.Vector(vertex(2), vertex(3))
DA = New YLScsDrawing.Geometry.Vector(vertex(3), vertex(0))
' get unit vector
AB /= AB.Magnitude
BC /= BC.Magnitude
CD /= CD.Magnitude
DA /= DA.Magnitude
End Sub
Private Function isOnPlaneABCD(ByVal pt As PointF) As Boolean
' including point on border
If Not YLScsDrawing.Geometry.Vector.IsCCW(pt, vertex(0), vertex(1)) Then
If Not YLScsDrawing.Geometry.Vector.IsCCW(pt, vertex(1), vertex(2)) Then
If Not YLScsDrawing.Geometry.Vector.IsCCW(pt, vertex(2), vertex(3)) Then
If Not YLScsDrawing.Geometry.Vector.IsCCW(pt, vertex(3), vertex(0)) Then
Return True
End If
End If
End If
End If
Return False
End Function
Private Function getTransformedBitmap() As Bitmap
If srcH = 0 OrElse srcW = 0 Then Return Nothing
Dim destCB As New ImageData()
destCB.A = New Byte(rect.Width - 1, rect.Height - 1) {}
destCB.B = New Byte(rect.Width - 1, rect.Height - 1) {}
destCB.G = New Byte(rect.Width - 1, rect.Height - 1) {}
destCB.R = New Byte(rect.Width - 1, rect.Height - 1) {}
Dim ptInPlane As New PointF()
Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer
Dim dab As Double, dbc As Double, dcd As Double, dda As Double
Dim dx1 As Single, dx2 As Single, dy1 As Single, dy2 As Single, _
dx1y1 As Single, dx1y2 As Single, _
dx2y1 As Single, dx2y2 As Single, nbyte As Single
For y As Integer = 0 To rect.Height - 1
For x As Integer = 0 To rect.Width - 1
Dim srcPt As New Point(x, y)
srcPt.Offset(Me.rect.Location)
If isOnPlaneABCD(srcPt) Then
dab = Math.Abs( _
(New YLScsDrawing.Geometry.Vector(vertex(0), srcPt)).CrossProduct(AB))
dbc = Math.Abs( _
(New YLScsDrawing.Geometry.Vector(vertex(1), srcPt)).CrossProduct(BC))
dcd = Math.Abs( _
(New YLScsDrawing.Geometry.Vector(vertex(2), srcPt)).CrossProduct(CD))
dda = Math.Abs( _
(New YLScsDrawing.Geometry.Vector(vertex(3), srcPt)).CrossProduct(DA))
ptInPlane.X = CSng((srcW * (dda / (dda + dbc))))
ptInPlane.Y = CSng((srcH * (dab / (dab + dcd))))
x1 = CInt(ptInPlane.X)
y1 = CInt(ptInPlane.Y)
If x1 >= 0 AndAlso x1 < srcW AndAlso y1 >= 0 AndAlso y1 < srcH Then
If isBilinear Then
x2 = IIf((x1 = srcW - 1), x1, x1 + 1)
y2 = IIf((y1 = srcH - 1), y1, y1 + 1)
dx1 = ptInPlane.X - CSng(x1)
If dx1 < 0 Then dx1 = 0
dx1 = 1.0F - dx1
dx2 = 1.0F - dx1 dy1 = ptInPlane.Y - CSng(y1)
If dy1 < 0 Then dy1 = 0
dy1 = 1.0F - dy1
dy2 = 1.0F - dy1
dx1y1 = dx1 * dy1
dx1y2 = dx1 * dy2
dx2y1 = dx2 * dy1
dx2y2 = dx2 * dy2
nbyte = srcCB.A(x1, y1) * dx1y1 + srcCB.A(x2, y1) _
* dx2y1 + srcCB.A(x1, y2) * dx1y2 + srcCB.A(x2, y2) * dx2y2
destCB.A(x, y) = CByte(nbyte)
nbyte = srcCB.B(x1, y1) * dx1y1 + srcCB.B(x2, y1) _
* dx2y1 + srcCB.B(x1, y2) * dx1y2 + srcCB.B(x2, y2) * dx2y2
destCB.B(x, y) = CByte(nbyte)
nbyte = srcCB.G(x1, y1) * dx1y1 + srcCB.G(x2, y1) _
* dx2y1 + srcCB.G(x1, y2) * dx1y2 + srcCB.G(x2, y2) * dx2y2
destCB.G(x, y) = CByte(nbyte)
nbyte = srcCB.R(x1, y1) * dx1y1 + srcCB.R(x2, y1) _
* dx2y1 + srcCB.R(x1, y2) * dx1y2 + srcCB.R(x2, y2) * dx2y2
destCB.R(x, y) = CByte(nbyte)
Else
destCB.A(x, y) = srcCB.A(x1, y1)
destCB.B(x, y) = srcCB.B(x1, y1)
destCB.G(x, y) = srcCB.G(x1, y1)
destCB.R(x, y) = srcCB.R(x1, y1)
End If
End If
End If
Next
Next
Return destCB.ToBitmap()
End Function
End Class
End Namespace
Imports System
Imports System.Collections.Generic
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Namespace YLScsDrawing.Imaging
''' <summary>
''' Using InteropServices.Marshal methods to get image channels (R,G,B,A) byte
''' </summary>
Public Class ImageData
Implements IDisposable
Private _red As Byte(,), _green As Byte(,), _blue As Byte(,), _alpha As Byte(,)
Private _disposed As Boolean = False
Public Property A() As Byte(,)
Get
Return _alpha
End Get
Set(ByVal value As Byte(,))
_alpha = value
End Set
End Property
Public Property B() As Byte(,)
Get
Return _blue
End Get
Set(ByVal value As Byte(,))
_blue = value
End Set
End Property
Public Property G() As Byte(,)
Get
Return _green
End Get
Set(ByVal value As Byte(,))
_green = value
End Set
End Property
Public Property R() As Byte(,)
Get
Return _red
End Get
Set(ByVal value As Byte(,))
_red = value
End Set
End Property
Public Function Clone() As ImageData
Dim cb As New ImageData()
cb.A = DirectCast(_alpha.Clone(), Byte(,))
cb.B = DirectCast(_blue.Clone(), Byte(,))
cb.G = DirectCast(_green.Clone(), Byte(,))
cb.R = DirectCast(_red.Clone(), Byte(,))
Return cb
End Function
#Region "InteropServices.Marshal methods"
Public Sub FromBitmap(ByVal srcBmp As Bitmap)
Dim w As Integer = srcBmp.Width
Dim h As Integer = srcBmp.Height
_alpha = New Byte(w - 1, h - 1) {}
_blue = New Byte(w - 1, h - 1) {}
_green = New Byte(w - 1, h - 1) {}
_red = New Byte(w - 1, h - 1) {}
' Lock the bitmap's bits.
Dim bmpData As BitmapData = srcBmp.LockBits(New Rectangle(0, 0, w, h), _
ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
' Get the address of the first line.
Dim ptr As IntPtr = bmpData.Scan0
' Declare an array to hold the bytes of the bitmap.
Dim bytes As Integer = bmpData.Stride * srcBmp.Height
Dim rgbValues As Byte() = New Byte(bytes - 1) {}
' Copy the RGB values
Marshal.Copy(ptr, rgbValues, 0, bytes)
Dim offset As Integer = bmpData.Stride - w * 4
Dim index As Integer = 0
For y As Integer = 0 To h - 1
For x As Integer = 0 To w - 1
_blue(x, y) = rgbValues(index)
_green(x, y) = rgbValues(index + 1)
_red(x, y) = rgbValues(index + 2)
_alpha(x, y) = rgbValues(index + 3)
index += 4
Next
index += offset
Next
' Unlock the bits.
srcBmp.UnlockBits(bmpData)
End Sub
Public Function ToBitmap() As Bitmap
Dim width As Integer = 0, height As Integer = 0
If _alpha IsNot Nothing Then
width = Math.Max(width, _alpha.GetLength(0))
height = Math.Max(height, _alpha.GetLength(1))
End If
If _blue IsNot Nothing Then
width = Math.Max(width, _blue.GetLength(0))
height = Math.Max(height, _blue.GetLength(1))
End If
If _green IsNot Nothing Then
width = Math.Max(width, _green.GetLength(0))
height = Math.Max(height, _green.GetLength(1))
End If
If _red IsNot Nothing Then
width = Math.Max(width, _red.GetLength(0))
height = Math.Max(height, _red.GetLength(1))
End If
Dim bmp As New Bitmap(width, height, PixelFormat.Format32bppArgb)
Dim bmpData As BitmapData = bmp.LockBits(New Rectangle(0, 0, width, height), _
ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
' Get the address of the first line.
Dim ptr As IntPtr = bmpData.Scan0
' Declare an array to hold the bytes of the bitmap.
Dim bytes As Integer = bmpData.Stride * bmp.Height
Dim rgbValues As Byte() = New Byte(bytes - 1) {}
' set rgbValues
Dim offset As Integer = bmpData.Stride - width * 4
Dim i As Integer = 0
For y As Integer = 0 To height - 1
For x As Integer = 0 To width - 1
rgbValues(i) = IIf(checkArray(_blue, x, y), _blue(x, y), CByte(0))
rgbValues(i + 1) = IIf(checkArray(_green, x, y), _green(x, y), CByte(0))
rgbValues(i + 2) = IIf(checkArray(_red, x, y), _red(x, y), CByte(0))
rgbValues(i + 3) = IIf(checkArray(_alpha, x, y), _alpha(x, y), CByte(255))
i += 4
Next
i += offset
Next
' Copy the RGB values back to the bitmap
Marshal.Copy(rgbValues, 0, ptr, bytes)
' Unlock the bits.
bmp.UnlockBits(bmpData)
Return bmp
End Function
#End Region
Private Shared Function checkArray(ByVal array As Byte(,), _
ByVal x As Integer, ByVal y As Integer) As Boolean
If array Is Nothing Then
Return False
End If
If x < array.GetLength(0) AndAlso y < array.GetLength(1) Then
Return True
Else
Return False
End If
End Function
Public Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
' Use SupressFinalize in case a subclass
' of this type implements a finalizer.
GC.SuppressFinalize(Me)
End Sub
Protected Overloads Sub Dispose(ByVal disposing As Boolean)
' If you need thread safety, use a lock around these
' operations, as well as in your methods that use the resource.
If Not _disposed Then
If disposing Then
_alpha = Nothing
_blue = Nothing
_green = Nothing
_red = Nothing
End If
' Indicate that the instance has been disposed.
_disposed = True
End If
End Sub
End Class
End Namespace
Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Namespace YLScsDrawing.Imaging
''' <summary>
''' Using InteropServices.Marshal methods to get image channels (R,G,B,A) byte
''' </summary>
Public Class ImageData
Implements IDisposable
Private _red As Byte(,), _green As Byte(,), _blue As Byte(,), _alpha As Byte(,)
Private _disposed As Boolean = False
Public Property A() As Byte(,)
Get
Return _alpha
End Get
Set(ByVal value As Byte(,))
_alpha = value
End Set
End Property
Public Property B() As Byte(,)
Get
Return _blue
End Get
Set(ByVal value As Byte(,))
_blue = value
End Set
End Property
Public Property G() As Byte(,)
Get
Return _green
End Get
Set(ByVal value As Byte(,))
_green = value
End Set
End Property
Public Property R() As Byte(,)
Get
Return _red
End Get
Set(ByVal value As Byte(,))
_red = value
End Set
End Property
Public Function Clone() As ImageData
Dim cb As New ImageData()
cb.A = DirectCast(_alpha.Clone(), Byte(,))
cb.B = DirectCast(_blue.Clone(), Byte(,))
cb.G = DirectCast(_green.Clone(), Byte(,))
cb.R = DirectCast(_red.Clone(), Byte(,))
Return cb
End Function
#Region "InteropServices.Marshal methods"
Public Sub FromBitmap(ByVal srcBmp As Bitmap)
Dim w As Integer = srcBmp.Width
Dim h As Integer = srcBmp.Height
_alpha = New Byte(w - 1, h - 1) {}
_blue = New Byte(w - 1, h - 1) {}
_green = New Byte(w - 1, h - 1) {}
_red = New Byte(w - 1, h - 1) {}
' Lock the bitmap's bits.
Dim bmpData As BitmapData = srcBmp.LockBits(New Rectangle(0, 0, w, h), _
ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
' Get the address of the first line.
Dim ptr As IntPtr = bmpData.Scan0
' Declare an array to hold the bytes of the bitmap.
Dim bytes As Integer = bmpData.Stride * srcBmp.Height
Dim rgbValues As Byte() = New Byte(bytes - 1) {}
' Copy the RGB values
Marshal.Copy(ptr, rgbValues, 0, bytes)
Dim offset As Integer = bmpData.Stride - w * 4
Dim index As Integer = 0
For y As Integer = 0 To h - 1
For x As Integer = 0 To w - 1
_blue(x, y) = rgbValues(index)
_green(x, y) = rgbValues(index + 1)
_red(x, y) = rgbValues(index + 2)
_alpha(x, y) = rgbValues(index + 3)
index += 4
Next
index += offset
Next
' Unlock the bits.
srcBmp.UnlockBits(bmpData)
End Sub
Public Function ToBitmap() As Bitmap
Dim width As Integer = 0, height As Integer = 0
If _alpha IsNot Nothing Then
width = Math.Max(width, _alpha.GetLength(0))
height = Math.Max(height, _alpha.GetLength(1))
End If
If _blue IsNot Nothing Then
width = Math.Max(width, _blue.GetLength(0))
height = Math.Max(height, _blue.GetLength(1))
End If
If _green IsNot Nothing Then
width = Math.Max(width, _green.GetLength(0))
height = Math.Max(height, _green.GetLength(1))
End If
If _red IsNot Nothing Then
width = Math.Max(width, _red.GetLength(0))
height = Math.Max(height, _red.GetLength(1))
End If
Dim bmp As New Bitmap(width, height, PixelFormat.Format32bppArgb)
Dim bmpData As BitmapData = bmp.LockBits(New Rectangle(0, 0, width, height), _
ImageLockMode.ReadWrite, PixelFormat.Format32bppArgb)
' Get the address of the first line.
Dim ptr As IntPtr = bmpData.Scan0
' Declare an array to hold the bytes of the bitmap.
Dim bytes As Integer = bmpData.Stride * bmp.Height
Dim rgbValues As Byte() = New Byte(bytes - 1) {}
' set rgbValues
Dim offset As Integer = bmpData.Stride - width * 4
Dim i As Integer = 0
For y As Integer = 0 To height - 1
For x As Integer = 0 To width - 1
rgbValues(i) = IIf(checkArray(_blue, x, y), _blue(x, y), CByte(0))
rgbValues(i + 1) = IIf(checkArray(_green, x, y), _green(x, y), CByte(0))
rgbValues(i + 2) = IIf(checkArray(_red, x, y), _red(x, y), CByte(0))
rgbValues(i + 3) = IIf(checkArray(_alpha, x, y), _alpha(x, y), CByte(255))
i += 4
Next
i += offset
Next
' Copy the RGB values back to the bitmap
Marshal.Copy(rgbValues, 0, ptr, bytes)
' Unlock the bits.
bmp.UnlockBits(bmpData)
Return bmp
End Function
#End Region
Private Shared Function checkArray(ByVal array As Byte(,), _
ByVal x As Integer, ByVal y As Integer) As Boolean
If array Is Nothing Then
Return False
End If
If x < array.GetLength(0) AndAlso y < array.GetLength(1) Then
Return True
Else
Return False
End If
End Function
Public Overloads Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
' Use SupressFinalize in case a subclass
' of this type implements a finalizer.
GC.SuppressFinalize(Me)
End Sub
Protected Overloads Sub Dispose(ByVal disposing As Boolean)
' If you need thread safety, use a lock around these
' operations, as well as in your methods that use the resource.
If Not _disposed Then
If disposing Then
_alpha = Nothing
_blue = Nothing
_green = Nothing
_red = Nothing
End If
' Indicate that the instance has been disposed.
_disposed = True
End If
End Sub
End Class
End Namespace
Imports System
Imports System.Drawing
Namespace YLScsDrawing.Geometry
Public Structure Vector
Private _x As Double, _y As Double
Public Sub New(ByVal x As Double, ByVal y As Double)
_x = x
_y = y
End Sub
Public Sub New(ByVal pt As PointF)
_x = pt.X
_y = pt.Y
End Sub
Public Sub New(ByVal st As PointF, ByVal [end] As PointF)
_x = [end].X - st.X
_y = [end].Y - st.Y
End Sub
Public Property X() As Double
Get
Return _x
End Get
Set(ByVal value As Double)
_x = value
End Set
End Property
Public Property Y() As Double
Get
Return _y
End Get
Set(ByVal value As Double)
_y = value
End Set
End Property
Public ReadOnly Property Magnitude() As Double
Get
Return Math.Sqrt(X * X + Y * Y)
End Get
End Property
Public Shared Operator +(ByVal v1 As Vector, ByVal v2 As Vector) As Vector
Return New Vector(v1.X + v2.X, v1.Y + v2.Y)
End Operator
Public Shared Operator -(ByVal v1 As Vector, ByVal v2 As Vector) As Vector
Return New Vector(v1.X - v2.X, v1.Y - v2.Y)
End Operator
Public Shared Operator -(ByVal v As Vector) As Vector
Return New Vector(-v.X, -v.Y)
End Operator
Public Shared Operator *(ByVal c As Double, ByVal v As Vector) As Vector
Return New Vector(c * v.X, c * v.Y)
End Operator
Public Shared Operator *(ByVal v As Vector, ByVal c As Double) As Vector
Return New Vector(c * v.X, c * v.Y)
End Operator
Public Shared Operator /(ByVal v As Vector, ByVal c As Double) As Vector
Return New Vector(v.X / c, v.Y / c)
End Operator
' A * B =|A|.|B|.sin(angle AOB)
Public Function CrossProduct(ByVal v As Vector) As Double
Return _x * v.Y - v.X * _y
End Function
' A. B=|A|.|B|.cos(angle AOB)
Public Function DotProduct(ByVal v As Vector) As Double
Return _x * v.X + _y * v.Y
End Function
Public Shared Function IsClockwise(ByVal pt1 As PointF, _
ByVal pt2 As PointF, ByVal pt3 As PointF) As Boolean
Dim V21 As New Vector(pt2, pt1)
Dim v23 As New Vector(pt2, pt3)
' sin(angle pt1 pt2 pt3) > 0, 0<angle pt1 pt2 pt3 <180
Return V21.CrossProduct(v23) < 0
End Function
Public Shared Function IsCCW(ByVal pt1 As PointF, _
ByVal pt2 As PointF, ByVal pt3 As PointF) As Boolean
Dim V21 As New Vector(pt2, pt1)
Dim v23 As New Vector(pt2, pt3)
' sin(angle pt2 pt1 pt3) < 0, 180<angle pt2 pt1 pt3 <360
Return V21.CrossProduct(v23) > 0
End Function
Public Shared Function DistancePointLine(ByVal pt As PointF, _
ByVal lnA As PointF, ByVal lnB As PointF) As Double
Dim v1 As New Vector(lnA, lnB)
Dim v2 As New Vector(lnA, pt)
v1 /= v1.Magnitude
Return Math.Abs(v2.CrossProduct(v1))
End Function
Public Sub Rotate(ByVal Degree As Integer)
Dim radian As Double = Degree * Math.PI / 180.0R
Dim sin As Double = Math.Sin(radian)
Dim cos As Double = Math.Cos(radian)
Dim nx As Double = _x * cos - _y * sin
Dim ny As Double = _x * sin + _y * cos
_x = nx
_y = ny
End Sub
Public Function ToPointF() As PointF
Return New PointF(CSng(_x), CSng(_y))
End Function
End Structure
End Namespace
Namespace YLScsDrawing.Geometry
Public Structure Vector
Private _x As Double, _y As Double
Public Sub New(ByVal x As Double, ByVal y As Double)
_x = x
_y = y
End Sub
Public Sub New(ByVal pt As PointF)
_x = pt.X
_y = pt.Y
End Sub
Public Sub New(ByVal st As PointF, ByVal [end] As PointF)
_x = [end].X - st.X
_y = [end].Y - st.Y
End Sub
Public Property X() As Double
Get
Return _x
End Get
Set(ByVal value As Double)
_x = value
End Set
End Property
Public Property Y() As Double
Get
Return _y
End Get
Set(ByVal value As Double)
_y = value
End Set
End Property
Public ReadOnly Property Magnitude() As Double
Get
Return Math.Sqrt(X * X + Y * Y)
End Get
End Property
Public Shared Operator +(ByVal v1 As Vector, ByVal v2 As Vector) As Vector
Return New Vector(v1.X + v2.X, v1.Y + v2.Y)
End Operator
Public Shared Operator -(ByVal v1 As Vector, ByVal v2 As Vector) As Vector
Return New Vector(v1.X - v2.X, v1.Y - v2.Y)
End Operator
Public Shared Operator -(ByVal v As Vector) As Vector
Return New Vector(-v.X, -v.Y)
End Operator
Public Shared Operator *(ByVal c As Double, ByVal v As Vector) As Vector
Return New Vector(c * v.X, c * v.Y)
End Operator
Public Shared Operator *(ByVal v As Vector, ByVal c As Double) As Vector
Return New Vector(c * v.X, c * v.Y)
End Operator
Public Shared Operator /(ByVal v As Vector, ByVal c As Double) As Vector
Return New Vector(v.X / c, v.Y / c)
End Operator
' A * B =|A|.|B|.sin(angle AOB)
Public Function CrossProduct(ByVal v As Vector) As Double
Return _x * v.Y - v.X * _y
End Function
' A. B=|A|.|B|.cos(angle AOB)
Public Function DotProduct(ByVal v As Vector) As Double
Return _x * v.X + _y * v.Y
End Function
Public Shared Function IsClockwise(ByVal pt1 As PointF, _
ByVal pt2 As PointF, ByVal pt3 As PointF) As Boolean
Dim V21 As New Vector(pt2, pt1)
Dim v23 As New Vector(pt2, pt3)
' sin(angle pt1 pt2 pt3) > 0, 0<angle pt1 pt2 pt3 <180
Return V21.CrossProduct(v23) < 0
End Function
Public Shared Function IsCCW(ByVal pt1 As PointF, _
ByVal pt2 As PointF, ByVal pt3 As PointF) As Boolean
Dim V21 As New Vector(pt2, pt1)
Dim v23 As New Vector(pt2, pt3)
' sin(angle pt2 pt1 pt3) < 0, 180<angle pt2 pt1 pt3 <360
Return V21.CrossProduct(v23) > 0
End Function
Public Shared Function DistancePointLine(ByVal pt As PointF, _
ByVal lnA As PointF, ByVal lnB As PointF) As Double
Dim v1 As New Vector(lnA, lnB)
Dim v2 As New Vector(lnA, pt)
v1 /= v1.Magnitude
Return Math.Abs(v2.CrossProduct(v1))
End Function
Public Sub Rotate(ByVal Degree As Integer)
Dim radian As Double = Degree * Math.PI / 180.0R
Dim sin As Double = Math.Sin(radian)
Dim cos As Double = Math.Cos(radian)
Dim nx As Double = _x * cos - _y * sin
Dim ny As Double = _x * sin + _y * cos
_x = nx
_y = ny
End Sub
Public Function ToPointF() As PointF
Return New PointF(CSng(_x), CSng(_y))
End Function
End Structure
End Namespace
發表評論 評論 (0 個評論)