drawing 3d objects in 2d
Hither is something new using slope fills. Notation the size and location of the shapes are definable.
What shapes can yous do? Do you take another method of shading (other than gradient fill) or other improvents?
Option Strict On Imports System.Cartoon.Drawing2D Public Class Form2 Individual Sub Form2_Load(sender Every bit Object, east As EventArgs) Handles Me.Load Me.DoubleBuffered = Truthful 'this is for resizing the form End Sub Individual Sub Form2_Paint(sender As Object, east Every bit PaintEventArgs) Handles Me.Pigment With east.Graphics 'setup a calibration XX units beyond the width of the class Dim theScale As Unmarried = 35 Dim scaleratio As Single = Me.ClientSize.Width / theScale .ScaleTransform(scaleratio, scaleratio) .SmoothingMode = Drawing2D.SmoothingMode.AntiAlias .Clear(Colour.Black) DrawGrid(e.Graphics, theScale) DrawCube(e.Graphics, 8, 12, ten, New Point(xiv, 27)) DrawSphere(due east.Graphics, 9, 15, 6) DrawCone(e.Graphics, New Point(26, 21), six) DrawCylinder(e.Graphics, New Betoken(17, 17), x, 4) End With End Sub Individual Sub DrawGrid(thousand Equally Graphics, theScale As Single) Dim yoffset Every bit Unmarried = g.VisibleClipBounds.Height Dim textheight As Single = theScale / 25 Using f Every bit New Font("Arial", textheight), _ p As Pen = New Pen(Color.SkyBlue, theScale / 500), _ br As SolidBrush = New SolidBrush(Colour.LightGray) Dim y1 Every bit Single = CSng(yoffset - (1.5 * textheight)) Dim y2 As Single For 10 = 0 To theScale Step 5 'x axis g.DrawLine(p, x, yoffset - 0, x, yoffset - theScale) g.DrawString(x.ToString, f, br, ten, y1) 'y axis y2 = CSng(yoffset - (one.5 * textheight + x)) m.DrawLine(p, 0, yoffset - 10, theScale, yoffset - ten) g.DrawString(x.ToString, f, br, 0, y2) Next Cease Using Finish Sub Individual Sub DrawCylinder(g Equally Graphics, xy1 Equally Point, h Equally Integer, r Equally Single) 'xy1 is the location of the cylinder tiptop center, ul = upperleft, lr = lower right etc. Dim yoffset As Single = thou.VisibleClipBounds.Pinnacle 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, Colour.Grayness, Color.WhiteSmoke, 180) yard.FillPath(lgbr, path1) path1.Reset() Dim ul Equally Point = xy1 ul.Offset(CInt(-r), 0) Dim ll Every bit Betoken = ul ll.Showtime(0, -h) Dim ur As Point = xy1 ur.Offset(CInt(r), 0) Dim lr As Point = ur lr.Offset(0, -h) Dim thePolygon() Every bit PointF = {ll, ul, ur, lr} ReverseY(thePolygon, yoffset) ' ''create a path from the coordinate polygon and fill with slope color path1.AddLines(thePolygon) g.FillPath(lgbr, path1) Stop Using path1.Reset() rectf.Offset(0, -h) path1.AddEllipse(rectf) Using pgbr Equally New Drawing2D.PathGradientBrush(path1) pgbr.CenterPoint = New PointF(xy1.X + r, yoffset - r) pgbr.CenterColor = Color.Grey g.FillPath(pgbr, path1) Finish Using Finish Sub Private Sub DrawCone(m Equally 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.Tiptop Dim rectf Equally RectangleF = New RectangleF(xy1.Ten - r, CSng(yoffset - (xy1.Y - (1.49 * r))), 2 * r, r) Dim path1 Equally New GraphicsPath() path1.AddArc(rectf, 180, -180) Using lgbr As New LinearGradientBrush(rectf, Color.Gray, Colour.WhiteSmoke, 190) chiliad.FillPath(lgbr, path1) path1.Reset() Dim ll As Signal = xy1 ll.Offset(CInt(-r), CInt(-2 * r)) Dim lr Every bit Indicate = xy1 lr.Offset(CInt(r), CInt(-2 * r)) Dim thePolygon() Every bit PointF = {ll, xy1, lr} ReverseY(thePolygon, yoffset) ' ''create a path from the coordinate polygon and fill up with slope colour path1.AddLines(thePolygon) g.FillPath(lgbr, path1) End Using End Sub Individual Sub DrawCube(g As Graphics, w As Single, h Equally Single, d As Unmarried, xy1 As Indicate) 'xy1 is the location of the upper left front side, ul = upperleft, lr = lower right etc. Dim yoffset Every bit Single = g.VisibleClipBounds.Elevation Dim path1 Equally New Drawing2D.GraphicsPath d *= 0.7F 'force the perspective With g 'draw front Using br As SolidBrush = New SolidBrush(Colour.LightGray) .FillRectangle(br, xy1.X, yoffset - xy1.Y, w, h) End Using 'top coordinates Dim ul1 As Point ul1.Ten = CInt(xy1.Ten + (d * Math.Cos(30 / 57.three))) ul1.Y = CInt(xy1.Y + (d * Math.Sin(thirty / 57.3))) Dim ur1 Equally Indicate = ul1 ur1.Offset(CInt(westward), 0) Dim lr1 As Betoken = xy1 lr1.Offset(CInt(westward), 0) Dim thePolygon() Every bit 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(two * w, yoffset) pgbr.CenterColor = Color.SteelBlue .FillPath(pgbr, path1) End Using 'side ul1 = lr1 lr1 = ur1 lr1.Offset(0, CInt(-h)) Dim ll1 Every bit Bespeak = 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(ii * due west, yoffset) pgbr.CenterColor = Colour.SlateGray .FillPath(pgbr, path1) Stop Using Cease With End Sub Private Sub DrawSphere(chiliad As Graphics, x Every bit Unmarried, y As Single, r Every bit Single) '10, y is the location of the sphere center Dim yoffset Equally Single = g.VisibleClipBounds.Height Dim rectf Equally RectangleF = New RectangleF(x - r, yoffset - (y + r), 2 * r, 2 * r) Dim path As New GraphicsPath() path.AddEllipse(rectf) rectf.X += r / l rectf.Y += r / 50 g.DrawEllipse(New Pen(Colour.LightGray, r / xvi), rectf) Using pthGrBrush Equally New PathGradientBrush(path) pthGrBrush.CenterPoint = New PointF(x + r, yoffset - x) pthGrBrush.CenterColor = Color.Gray Dim colors As Color() = {Color.WhiteSmoke} pthGrBrush.SurroundColors = colors m.FillPath(pthGrBrush, path) pthGrBrush.CenterColor = Color.LightGray rectf.Width *= 0.2F rectf.Height *= 0.2F rectf.Get-go(r / iii, r / 2) grand.FillEllipse(pthGrBrush, rectf) Stop Using End Sub Individual Sub ReverseY(ByRef thePolygon() As PointF, ByVal yoffset Equally Single) 'translate the y coords of the polygon for positive y axis For i = 0 To thePolygon.Length - i thePolygon(i).Y = yoffset - thePolygon(i).Y Next End Sub Private Sub Form2_Resize(sender As Object, east As EventArgs) Handles Me.Resize Me.Invalidate() End Sub Terminate Class PS notation the yaxis coordinates increase going up.
Source: https://social.msdn.microsoft.com/Forums/vstudio/en-US/811c3452-1f97-452f-8af4-22219b095dd7/drawing-3d-shapes-in-2d?forum=vbgeneral
0 Response to "drawing 3d objects in 2d"
แสดงความคิดเห็น