VB.net Tutorial How to create a PaintControl
' if you would like to jsut skip to the example: Download Here
Imports System.Text
Imports System.Drawing.Drawing2D
Public Class PaintControl : Inherits Windows.Forms.Control
Private cSlide As BitSlide
Private cIsMouseDown As Boolean = False
Private cLastPoint As Point = Nothing
Public copacity As Integer = 255
Protected Overrides Sub OnMouseDown(e As MouseEventArgs)
cIsMouseDown = True
If e.Location.X + CInt(Me.Tag) < Me.Size.Width - 2 AndAlso e.Location.Y + CInt(Me.Tag) < Me.Size.Height - 2 Then
cSlide.AddPoint(e.Location, Me.ForeColor, Me.Tag, copacity)
cLastPoint = e.Location
End If
Me.Refresh()
End Sub
Public Sub Clear()
cSlide = New BitSlide(Me.Size)
Me.Refresh()
End Sub
Public Enum ExportType
AsString = 0
AsByteArray = 1
End Enum
Public Sub Save(ByVal FileLocation As String, ByVal SaveType As ExportType)
Select Case SaveType
Case ExportType.AsByteArray
IO.File.WriteAllBytes(FileLocation, cSlide.SaveAsByteArray())
Case ExportType.AsString
IO.File.WriteAllText(FileLocation, cSlide.SaveAsString)
End Select
End Sub
Public Sub Load(ByVal Byte1() As Byte)
cSlide = New BitSlide
cSlide.load(Byte1)
Me.Refresh()
End Sub
Public Sub Load(ByVal string1 As String)
cSlide = New BitSlide
cSlide.load(string1)
Me.Refresh()
End Sub
Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
If cIsMouseDown AndAlso e.Location.X > 0 AndAlso e.Location.Y > 0 AndAlso e.Location.X + CInt(Me.Tag) < Me.Size.Width - 2 AndAlso e.Location.Y + CInt(Me.Tag) < Me.Size.Height - 2 Then
If cLastPoint = Nothing Then
cLastPoint = e.Location
End If
cSlide.AddPoint(e.Location, Me.ForeColor, Me.Tag, copacity, cLastPoint)
cLastPoint = e.Location
Me.Refresh()
Else
cLastPoint = Nothing
End If
End Sub
Protected Overrides Sub OnMouseUp(e As MouseEventArgs)
cIsMouseDown = False
cLastPoint = Nothing
End Sub
Public Sub undo()
cSlide.undo()
Me.Refresh()
End Sub
Sub New()
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
Me.SetStyle(ControlStyles.DoubleBuffer, True)
Me.SetStyle(ControlStyles.UserPaint, True)
Me.SetStyle(ControlStyles.FixedHeight, True)
Me.SetStyle(ControlStyles.FixedWidth, True)
Me.BackgroundImageLayout = ImageLayout.None
Me.Tag = 1
End Sub
Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs)
Me.BackgroundImage = cSlide.Paint(Me.Size.Width, Me.Size.Height)
MyBase.OnPaintBackground(pevent)
End Sub
Protected Overrides Sub Finalize()
MyBase.Finalize()
cSlide = New BitSlide(Me.Size)
End Sub
Protected Overrides Sub OnResize(e As EventArgs)
cSlide.SetNewSize(Me.Size)
MyBase.OnResize(e)
End Sub
Private Structure BitSlide
Public BitmapSlide As Bitmap
Public X1() As Integer
Public Y1() As Integer
Public X2() As Integer
Public Y2() As Integer
Public c1() As Color
Public T1() As Integer
Public O1() As Integer
Private z As Integer
Private l As Integer ' last to draw...
Public Function SaveAsByteArray() As Byte()
' x1,y2
' if setpixel = -1,-1 else x2,y2
', color.r bg
Dim pstring As New StringBuilder
pstring.AppendLine(BitmapSlide.Width & "," & BitmapSlide.Height)
For i = 0 To z - 1
If X1(i) = X2(i) And Y1(i) = Y2(i) Then
pstring.AppendLine(X1(i) & "," & Y1(i) & ",-1,-1," & c1(i).R & "," & c1(i).G & "," & c1(i).B & "," & T1(i) & "," & O1(i))
Else
pstring.AppendLine(X1(i) & "," & Y1(i) & "," & X2(i) & "," & Y2(i) & "," & c1(i).R & "," & c1(i).G & "," & c1(i).B & "," & T1(i) & "," & O1(i))
End If
Next
Return System.Text.Encoding.Default.GetBytes(pstring.ToString)
End Function
Public Function SaveAsString() As String
' x1,y2
' if setpixel = -1,-1 else x2,y2
', color.r bg
Dim pstring As New StringBuilder
pstring.AppendLine(BitmapSlide.Width & "," & BitmapSlide.Height)
For i = 0 To z - 1
If X1(i) = X2(i) And Y1(i) = Y2(i) Then
pstring.AppendLine(X1(i) & "," & Y1(i) & ",-1,-1," & c1(i).R & "," & c1(i).G & "," & c1(i).B & "," & T1(i) & "," & O1(i))
Else
pstring.AppendLine(X1(i) & "," & Y1(i) & "," & X2(i) & "," & Y2(i) & "," & c1(i).R & "," & c1(i).G & "," & c1(i).B & "," & T1(i) & "," & O1(i))
End If
Next
Return pstring.ToString
End Function
Public Sub load(ByVal byte1() As Byte)
Dim pstring() As String = Split(System.Text.Encoding.Default.GetChars(byte1), vbCrLf)
Dim X As Integer = pstring.Length - 1
ReDim Preserve X1(X)
ReDim Preserve Y1(X)
ReDim Preserve X2(X)
ReDim Preserve Y2(X)
ReDim Preserve c1(X)
ReDim Preserve T1(X)
ReDim Preserve O1(X)
BitmapSlide = Nothing
BitmapSlide = New Bitmap(CInt(Split(pstring(0), ",")(0)), CInt(Split(pstring(0), ",")(1)))
z = X + 1
l = 0
For i = 1 To pstring.Length - 2
Dim Columns() As String = Split(pstring(i), ",")
If Columns(2) = "-1" Then
X1(i) = Columns(0)
Y1(i) = Columns(1)
X2(i) = Columns(0)
Y2(i) = Columns(1)
c1(i) = Color.FromArgb(Columns(4), Columns(5), Columns(6))
T1(i) = Columns(7)
O1(i) = Columns(8)
Else
X1(i) = Columns(0)
Y1(i) = Columns(1)
X2(i) = Columns(2)
Y2(i) = Columns(3)
c1(i) = Color.FromArgb(Columns(4), Columns(5), Columns(6))
T1(i) = Columns(7)
O1(i) = Columns(8)
End If
Next
End Sub
Public Sub load(ByVal pfile As String)
Dim pstring() As String = Split(pfile, vbCrLf)
Dim X As Integer = pstring.Length - 1
ReDim Preserve X1(X)
ReDim Preserve Y1(X)
ReDim Preserve X2(X)
ReDim Preserve Y2(X)
ReDim Preserve c1(X)
ReDim Preserve T1(X)
ReDim Preserve O1(X)
BitmapSlide = Nothing
BitmapSlide = New Bitmap(CInt(Split(pstring(0), ",")(0)), CInt(Split(pstring(0), ",")(1)))
z = X + 1
l = 0
For i = 1 To pstring.Length - 2
Dim Columns() As String = Split(pstring(i), ",")
If Columns(2) = "-1" Then
X1(i) = Columns(0)
Y1(i) = Columns(1)
X2(i) = Columns(0)
Y2(i) = Columns(1)
c1(i) = Color.FromArgb(Columns(4), Columns(5), Columns(6))
T1(i) = Columns(7)
O1(i) = Columns(8)
Else
X1(i) = Columns(0)
Y1(i) = Columns(1)
X2(i) = Columns(2)
Y2(i) = Columns(3)
c1(i) = Color.FromArgb(Columns(4), Columns(5), Columns(6))
T1(i) = Columns(7)
O1(i) = Columns(8)
End If
Next
End Sub
Public Sub undo()
If z - (2 + 5) > 0 Then
Dim x As Integer = z - (2 + 5)
ReDim Preserve X1(x)
ReDim Preserve Y1(x)
ReDim Preserve X2(x)
ReDim Preserve Y2(x)
ReDim Preserve c1(x)
ReDim Preserve T1(x)
ReDim Preserve O1(x)
BitmapSlide = Nothing
z -= 6
l = 0
ElseIf z > 0 Then
Dim x As Integer = z - 2
ReDim Preserve X1(x)
ReDim Preserve Y1(x)
ReDim Preserve X2(x)
ReDim Preserve Y2(x)
ReDim Preserve c1(x)
ReDim Preserve T1(x)
ReDim Preserve O1(x)
BitmapSlide = Nothing
z -= 1
l = 0
End If
End Sub
Public Sub AddPoint(ByVal point1 As Point, ByVal color1 As Color, ByVal Thinkness As Integer, ByVal opacity As Integer, Optional ByVal point2 As Point = Nothing)
If point2 = Nothing Then
ReDim Preserve X1(z) : X1(z) = point1.X
ReDim Preserve Y1(z) : Y1(z) = point1.Y
ReDim Preserve X2(z) : X2(z) = point1.X
ReDim Preserve Y2(z) : Y2(z) = point1.Y
Else
If point1 = point2 Then
ReDim Preserve X1(z) : X1(z) = point1.X
ReDim Preserve Y1(z) : Y1(z) = point1.Y
ReDim Preserve X2(z) : X2(z) = point1.X
ReDim Preserve Y2(z) : Y2(z) = point1.Y
Else
ReDim Preserve X1(z) : X1(z) = point1.X
ReDim Preserve Y1(z) : Y1(z) = point1.Y
ReDim Preserve X2(z) : X2(z) = point2.X
ReDim Preserve Y2(z) : Y2(z) = point2.Y
End If
End If
ReDim Preserve T1(z) : T1(z) = Thinkness
ReDim Preserve c1(z) : c1(z) = color1
ReDim Preserve O1(z) : O1(z) = opacity
z += 1
End Sub
Sub New(ByVal sizeOfCanvas As Point)
BitmapSlide = New Bitmap(sizeOfCanvas.X, sizeOfCanvas.Y)
z = 0
End Sub
Public Function Paint(ByVal x As Integer, ByVal y As Integer) As Bitmap
If BitmapSlide Is Nothing Then
BitmapSlide = New Bitmap(x, y)
End If
Dim g As Graphics = Graphics.FromImage(BitmapSlide)
g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
g.CompositingQuality = Drawing2D.CompositingQuality.GammaCorrected
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.SmoothingMode = SmoothingMode.HighQuality
For i = l To z - 1
If X1(i) = X2(i) And Y1(i) = Y2(i) Then
For y = 0 To T1(i) - 1
For p = 0 To T1(i) - 1
BitmapSlide.SetPixel(X1(i) + y, Y1(i) + p, Color.FromArgb(O1(i), c1(i).R, c1(i).G, c1(i).B))
Next
Next
Else
g.DrawLine(New Pen(Color.FromArgb(O1(i), c1(i).R, c1(i).G, c1(i).B), T1(i)), X1(i), Y1(i), X2(i), Y2(i))
End If
Next
l = z
Return BitmapSlide
End Function
Public Sub SetNewSize(ByVal nSize As Size)
If BitmapSlide IsNot Nothing Then
If nSize <> BitmapSlide.Size Then
Dim tempBitmap As New Bitmap(nSize.Width, nSize.Height)
For i = z - 1 To 0 Step -1
If X1(i) = X2(i) And Y1(i) = Y2(i) Then
Dim HasChanged As Boolean = False
FixPoint(X1(i), Y1(i), nSize, HasChanged)
If HasChanged Then
X2(i) = X1(i)
Y2(i) = Y1(i)
End If
Else
FixPoint(X1(i), Y1(i), nSize, False)
FixPoint(X2(i), Y2(i), nSize, False)
End If
Next
BitmapSlide = tempBitmap
l = 0
End If
End If
End Sub
Private Sub FixPoint(ByRef x As Integer, ByRef y As Integer, ByRef size As Size, ByRef hasChanged As Boolean)
If x > size.Width - 1 Then
x = size.Width - 1
hasChanged = True
End If
If y > size.Height - 1 Then
y = size.Height - 1
hasChanged = True
End If
End Sub
End Structure
End Class
No comments:
Post a Comment