T
tommytwotrain
Guest
Here is something new using gradient fills. Note the size and location of the shapes are definable.
What shapes can you do? Do you have another method of shading (other than gradient fill) or other improvents?
Option Strict On
Imports System.Drawing.Drawing2D
Public Class Form2
Private Sub Form2_Load(sender As Object, e As EventArgs) Handles Me.Load
Me.DoubleBuffered = True this is for resizing the form
End Sub
Private Sub Form2_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
With e.Graphics
setup a scale XX units across the width of the form
Dim theScale As Single = 35
Dim scaleratio As Single = Me.ClientSize.Width / theScale
.ScaleTransform(scaleratio, scaleratio)
.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
.Clear(Color.Black)
DrawGrid(e.Graphics, theScale)
DrawCube(e.Graphics, 8, 12, 10, New Point(14, 27))
DrawSphere(e.Graphics, 9, 15, 6)
DrawCone(e.Graphics, New Point(26, 21), 6)
DrawCylinder(e.Graphics, New Point(17, 17), 10, 4)
End With
End Sub
Private Sub DrawGrid(g As Graphics, theScale As Single)
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim textheight As Single = theScale / 25
Using f As New Font("Arial", textheight), _
p As Pen = New Pen(Color.SkyBlue, theScale / 500), _
br As SolidBrush = New SolidBrush(Color.LightGray)
Dim y1 As Single = CSng(yoffset - (1.5 * textheight))
Dim y2 As Single
For x = 0 To theScale Step 5
x axis
g.DrawLine(p, x, yoffset - 0, x, yoffset - theScale)
g.DrawString(x.ToString, f, br, x, y1)
y axis
y2 = CSng(yoffset - (1.5 * textheight + x))
g.DrawLine(p, 0, yoffset - x, theScale, yoffset - x)
g.DrawString(x.ToString, f, br, 0, y2)
Next
End Using
End Sub
Private Sub DrawCylinder(g As Graphics, xy1 As Point, h As Integer, r As Single)
xy1 is the location of the cylinder top center, ul = upperleft, lr = lower right etc.
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim rectf As RectangleF = New RectangleF(xy1.X - r, CSng(yoffset - (xy1.Y + (r / 1.9) - h)), 2 * r, r)
Dim path1 As New GraphicsPath()
path1.AddArc(rectf, 180, -180)
Using lgbr As New LinearGradientBrush(rectf, Color.Gray, Color.WhiteSmoke, 180)
g.FillPath(lgbr, path1)
path1.Reset()
Dim ul As Point = xy1
ul.Offset(CInt(-r), 0)
Dim ll As Point = ul
ll.Offset(0, -h)
Dim ur As Point = xy1
ur.Offset(CInt(r), 0)
Dim lr As Point = ur
lr.Offset(0, -h)
Dim thePolygon() As PointF = {ll, ul, ur, lr}
ReverseY(thePolygon, yoffset)
create a path from the coordinate polygon and fill with gradient color
path1.AddLines(thePolygon)
g.FillPath(lgbr, path1)
End Using
path1.Reset()
rectf.Offset(0, -h)
path1.AddEllipse(rectf)
Using pgbr As New Drawing2D.PathGradientBrush(path1)
pgbr.CenterPoint = New PointF(xy1.X + r, yoffset - r)
pgbr.CenterColor = Color.Gray
g.FillPath(pgbr, path1)
End Using
End Sub
Private Sub DrawCone(g As Graphics, xy1 As Point, r As Single)
xy1 is the location of the cone apex, ul = upperleft, lr = lower right etc.
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim rectf As RectangleF = New RectangleF(xy1.X - r, CSng(yoffset - (xy1.Y - (1.49 * r))), 2 * r, r)
Dim path1 As New GraphicsPath()
path1.AddArc(rectf, 180, -180)
Using lgbr As New LinearGradientBrush(rectf, Color.Gray, Color.WhiteSmoke, 190)
g.FillPath(lgbr, path1)
path1.Reset()
Dim ll As Point = xy1
ll.Offset(CInt(-r), CInt(-2 * r))
Dim lr As Point = xy1
lr.Offset(CInt(r), CInt(-2 * r))
Dim thePolygon() As PointF = {ll, xy1, lr}
ReverseY(thePolygon, yoffset)
create a path from the coordinate polygon and fill with gradient color
path1.AddLines(thePolygon)
g.FillPath(lgbr, path1)
End Using
End Sub
Private Sub DrawCube(g As Graphics, w As Single, h As Single, d As Single, xy1 As Point)
xy1 is the location of the upper left front side, ul = upperleft, lr = lower right etc.
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim path1 As New Drawing2D.GraphicsPath
d *= 0.7F force the perspective
With g
draw front
Using br As SolidBrush = New SolidBrush(Color.LightGray)
.FillRectangle(br, xy1.X, yoffset - xy1.Y, w, h)
End Using
top coordinates
Dim ul1 As Point
ul1.X = CInt(xy1.X + (d * Math.Cos(30 / 57.3)))
ul1.Y = CInt(xy1.Y + (d * Math.Sin(30 / 57.3)))
Dim ur1 As Point = ul1
ur1.Offset(CInt(w), 0)
Dim lr1 As Point = xy1
lr1.Offset(CInt(w), 0)
Dim thePolygon() As PointF = {xy1, ul1, ur1, lr1}
ReverseY(thePolygon, yoffset)
create a path from the coordinate polygon and fill with gradient color
path1.AddLines(thePolygon)
Using pgbr As New Drawing2D.PathGradientBrush(path1)
pgbr.CenterPoint = New PointF(2 * w, yoffset)
pgbr.CenterColor = Color.SteelBlue
.FillPath(pgbr, path1)
End Using
side
ul1 = lr1
lr1 = ur1
lr1.Offset(0, CInt(-h))
Dim ll1 As Point = ul1
ll1.Offset(0, CInt(-h))
thePolygon = {ul1, ur1, lr1, ll1}
ReverseY(thePolygon, yoffset)
path1.Reset()
path1.AddLines(thePolygon)
Using pgbr As New Drawing2D.PathGradientBrush(path1)
pgbr.CenterPoint = New PointF(2 * w, yoffset)
pgbr.CenterColor = Color.SlateGray
.FillPath(pgbr, path1)
End Using
End With
End Sub
Private Sub DrawSphere(g As Graphics, x As Single, y As Single, r As Single)
x, y is the location of the sphere center
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim rectf As RectangleF = New RectangleF(x - r, yoffset - (y + r), 2 * r, 2 * r)
Dim path As New GraphicsPath()
path.AddEllipse(rectf)
rectf.X += r / 50
rectf.Y += r / 50
g.DrawEllipse(New Pen(Color.LightGray, r / 16), rectf)
Using pthGrBrush As New PathGradientBrush(path)
pthGrBrush.CenterPoint = New PointF(x + r, yoffset - 10)
pthGrBrush.CenterColor = Color.Gray
Dim colors As Color() = {Color.WhiteSmoke}
pthGrBrush.SurroundColors = colors
g.FillPath(pthGrBrush, path)
pthGrBrush.CenterColor = Color.LightGray
rectf.Width *= 0.2F
rectf.Height *= 0.2F
rectf.Offset(r / 3, r / 2)
g.FillEllipse(pthGrBrush, rectf)
End Using
End Sub
Private Sub ReverseY(ByRef thePolygon() As PointF, ByVal yoffset As Single)
translate the y coords of the polygon for positive y axis
For i = 0 To thePolygon.Length - 1
thePolygon(i).Y = yoffset - thePolygon(i).Y
Next
End Sub
Private Sub Form2_Resize(sender As Object, e As EventArgs) Handles Me.Resize
Me.Invalidate()
End Sub
End Class
PS note the yaxis coordinates increase going upward.
Continue reading...
What shapes can you do? Do you have another method of shading (other than gradient fill) or other improvents?
Option Strict On
Imports System.Drawing.Drawing2D
Public Class Form2
Private Sub Form2_Load(sender As Object, e As EventArgs) Handles Me.Load
Me.DoubleBuffered = True this is for resizing the form
End Sub
Private Sub Form2_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
With e.Graphics
setup a scale XX units across the width of the form
Dim theScale As Single = 35
Dim scaleratio As Single = Me.ClientSize.Width / theScale
.ScaleTransform(scaleratio, scaleratio)
.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
.Clear(Color.Black)
DrawGrid(e.Graphics, theScale)
DrawCube(e.Graphics, 8, 12, 10, New Point(14, 27))
DrawSphere(e.Graphics, 9, 15, 6)
DrawCone(e.Graphics, New Point(26, 21), 6)
DrawCylinder(e.Graphics, New Point(17, 17), 10, 4)
End With
End Sub
Private Sub DrawGrid(g As Graphics, theScale As Single)
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim textheight As Single = theScale / 25
Using f As New Font("Arial", textheight), _
p As Pen = New Pen(Color.SkyBlue, theScale / 500), _
br As SolidBrush = New SolidBrush(Color.LightGray)
Dim y1 As Single = CSng(yoffset - (1.5 * textheight))
Dim y2 As Single
For x = 0 To theScale Step 5
x axis
g.DrawLine(p, x, yoffset - 0, x, yoffset - theScale)
g.DrawString(x.ToString, f, br, x, y1)
y axis
y2 = CSng(yoffset - (1.5 * textheight + x))
g.DrawLine(p, 0, yoffset - x, theScale, yoffset - x)
g.DrawString(x.ToString, f, br, 0, y2)
Next
End Using
End Sub
Private Sub DrawCylinder(g As Graphics, xy1 As Point, h As Integer, r As Single)
xy1 is the location of the cylinder top center, ul = upperleft, lr = lower right etc.
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim rectf As RectangleF = New RectangleF(xy1.X - r, CSng(yoffset - (xy1.Y + (r / 1.9) - h)), 2 * r, r)
Dim path1 As New GraphicsPath()
path1.AddArc(rectf, 180, -180)
Using lgbr As New LinearGradientBrush(rectf, Color.Gray, Color.WhiteSmoke, 180)
g.FillPath(lgbr, path1)
path1.Reset()
Dim ul As Point = xy1
ul.Offset(CInt(-r), 0)
Dim ll As Point = ul
ll.Offset(0, -h)
Dim ur As Point = xy1
ur.Offset(CInt(r), 0)
Dim lr As Point = ur
lr.Offset(0, -h)
Dim thePolygon() As PointF = {ll, ul, ur, lr}
ReverseY(thePolygon, yoffset)
create a path from the coordinate polygon and fill with gradient color
path1.AddLines(thePolygon)
g.FillPath(lgbr, path1)
End Using
path1.Reset()
rectf.Offset(0, -h)
path1.AddEllipse(rectf)
Using pgbr As New Drawing2D.PathGradientBrush(path1)
pgbr.CenterPoint = New PointF(xy1.X + r, yoffset - r)
pgbr.CenterColor = Color.Gray
g.FillPath(pgbr, path1)
End Using
End Sub
Private Sub DrawCone(g As Graphics, xy1 As Point, r As Single)
xy1 is the location of the cone apex, ul = upperleft, lr = lower right etc.
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim rectf As RectangleF = New RectangleF(xy1.X - r, CSng(yoffset - (xy1.Y - (1.49 * r))), 2 * r, r)
Dim path1 As New GraphicsPath()
path1.AddArc(rectf, 180, -180)
Using lgbr As New LinearGradientBrush(rectf, Color.Gray, Color.WhiteSmoke, 190)
g.FillPath(lgbr, path1)
path1.Reset()
Dim ll As Point = xy1
ll.Offset(CInt(-r), CInt(-2 * r))
Dim lr As Point = xy1
lr.Offset(CInt(r), CInt(-2 * r))
Dim thePolygon() As PointF = {ll, xy1, lr}
ReverseY(thePolygon, yoffset)
create a path from the coordinate polygon and fill with gradient color
path1.AddLines(thePolygon)
g.FillPath(lgbr, path1)
End Using
End Sub
Private Sub DrawCube(g As Graphics, w As Single, h As Single, d As Single, xy1 As Point)
xy1 is the location of the upper left front side, ul = upperleft, lr = lower right etc.
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim path1 As New Drawing2D.GraphicsPath
d *= 0.7F force the perspective
With g
draw front
Using br As SolidBrush = New SolidBrush(Color.LightGray)
.FillRectangle(br, xy1.X, yoffset - xy1.Y, w, h)
End Using
top coordinates
Dim ul1 As Point
ul1.X = CInt(xy1.X + (d * Math.Cos(30 / 57.3)))
ul1.Y = CInt(xy1.Y + (d * Math.Sin(30 / 57.3)))
Dim ur1 As Point = ul1
ur1.Offset(CInt(w), 0)
Dim lr1 As Point = xy1
lr1.Offset(CInt(w), 0)
Dim thePolygon() As PointF = {xy1, ul1, ur1, lr1}
ReverseY(thePolygon, yoffset)
create a path from the coordinate polygon and fill with gradient color
path1.AddLines(thePolygon)
Using pgbr As New Drawing2D.PathGradientBrush(path1)
pgbr.CenterPoint = New PointF(2 * w, yoffset)
pgbr.CenterColor = Color.SteelBlue
.FillPath(pgbr, path1)
End Using
side
ul1 = lr1
lr1 = ur1
lr1.Offset(0, CInt(-h))
Dim ll1 As Point = ul1
ll1.Offset(0, CInt(-h))
thePolygon = {ul1, ur1, lr1, ll1}
ReverseY(thePolygon, yoffset)
path1.Reset()
path1.AddLines(thePolygon)
Using pgbr As New Drawing2D.PathGradientBrush(path1)
pgbr.CenterPoint = New PointF(2 * w, yoffset)
pgbr.CenterColor = Color.SlateGray
.FillPath(pgbr, path1)
End Using
End With
End Sub
Private Sub DrawSphere(g As Graphics, x As Single, y As Single, r As Single)
x, y is the location of the sphere center
Dim yoffset As Single = g.VisibleClipBounds.Height
Dim rectf As RectangleF = New RectangleF(x - r, yoffset - (y + r), 2 * r, 2 * r)
Dim path As New GraphicsPath()
path.AddEllipse(rectf)
rectf.X += r / 50
rectf.Y += r / 50
g.DrawEllipse(New Pen(Color.LightGray, r / 16), rectf)
Using pthGrBrush As New PathGradientBrush(path)
pthGrBrush.CenterPoint = New PointF(x + r, yoffset - 10)
pthGrBrush.CenterColor = Color.Gray
Dim colors As Color() = {Color.WhiteSmoke}
pthGrBrush.SurroundColors = colors
g.FillPath(pthGrBrush, path)
pthGrBrush.CenterColor = Color.LightGray
rectf.Width *= 0.2F
rectf.Height *= 0.2F
rectf.Offset(r / 3, r / 2)
g.FillEllipse(pthGrBrush, rectf)
End Using
End Sub
Private Sub ReverseY(ByRef thePolygon() As PointF, ByVal yoffset As Single)
translate the y coords of the polygon for positive y axis
For i = 0 To thePolygon.Length - 1
thePolygon(i).Y = yoffset - thePolygon(i).Y
Next
End Sub
Private Sub Form2_Resize(sender As Object, e As EventArgs) Handles Me.Resize
Me.Invalidate()
End Sub
End Class
PS note the yaxis coordinates increase going upward.
Continue reading...