首页 > 代码库 > VB.NET 章鱼哥 ——程序员也懂爱,动态绘制红心,很浪漫哦
VB.NET 章鱼哥 ——程序员也懂爱,动态绘制红心,很浪漫哦
先看看效果图吧:有动态绘制效果哦。
想不想知道怎么绘制的啊,别急,下面就直接给源码!
1界面设计。一个Form窗体,一个Panel控件,一个Button按钮。就这么简单。
代码:
'********************************************************************* '作者:章鱼哥,QQ:3107073263 群:309816713 '如有疑问或好的建议请联系我,大家一起进步 '********************************************************************* Imports Microsoft.VisualBasic.PowerPacks Public Class Form1 '定义一些全局变量 Dim A_1_R As Double Dim A_1_L As Double Dim x1R As Double Dim x1L As Double Dim y1R As Double Dim y1L As Double Dim x2R, x2L As Double Dim y2R, y2L As Double Dim ArrayS As New ArrayList Dim ArrayE As New ArrayList Dim ArrayL As New ArrayList Dim ArrayR As New ArrayList Dim ind As Integer Dim Rin As Integer Dim PD As Boolean = False Dim indx As Integer Dim Lin As Integer Dim PDST As Boolean = False Dim CirD As Double Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load '生成圆形 SetCircle() '初始化一些变量 ini() End Sub '生成圆 Private Sub SetCircle() Dim Cir As New OvalShape Dim contain As New ShapeContainer contain.Parent = Me.Panel1 Cir.Parent = contain Dim Wid As Integer If Panel1.Width > Panel1.Height Then Wid = Panel1.Height Else Wid = Panel1.Width End If CirD = Wid With Cir .Location = New Point(0, 0) .Width = Wid .Height = Wid End With End Sub '初始化变量 Private Sub ini() A_1_R = CirD A_1_L = CirD x1R = CirD / 2 x1L = CirD / 2 y1R = CirD y1L = CirD x2R = x2L = 0 y2R = y2L = 0 Dim ArrayS As New ArrayList Dim ArrayE As New ArrayList Dim ArrayL As New ArrayList Dim ArrayR As New ArrayList ArrayS.Clear() ArrayE.Clear() ArrayR.Clear() ArrayL.Clear() ind = 0 Rin = 0 PD = False indx = 0 Lin = 0 PDST = True End Sub '定时器1.绘制右半边直线群 Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick DrawRigth(Panel1, 4, CirD) End Sub '定时器2,绘制左半边直线群 Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick DrawingLeft(Panel1, -4, CirD) End Sub '定时器3,绘制心形的宽头 Private Sub Timer3_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer3.Tick If Not PD Then Dim g As Graphics = Panel1.CreateGraphics Using g.DrawLine(Pens.Red, ArrayR(Rin), ArrayL(ind)) If Rin = ArrayR.Count - 1 Or ind <= 1 Then PD = True End If Rin += 1 ind -= 2 End Using End If If PD Then Dim gr As Graphics = Panel1.CreateGraphics Using gr.DrawLine(Pens.Red, ArrayL(Lin), ArrayR(indx)) If Lin = (ArrayL.Count - 1) / 2 Or indx >= ArrayR.Count - 2 Then Timer3.Enabled = False Dim g As Graphics = Panel1.CreateGraphics g.DrawString("我爱你", New Font("楷体", 40, FontStyle.Bold), Brushes.DeepPink, New Point(CirD * 1.5 / 5, CirD / 2)) Exit Sub End If indx += 2 Lin -= 1 End Using End If End Sub '绘制心形右半边 Private Sub DrawRigth(ByVal Drawingpanel As Panel, ByVal DrawingStep As Double, ByVal circleD As Double) Dim CircleR As Double = circleD / 2 Dim g As Graphics = Drawingpanel.CreateGraphics A_1_R = circleD If Math.Abs(x1R - circleD) < 0.2 Or y1R < CircleR Then Timer1.Enabled = False g.DrawLine(Pens.Red, New Point(circleD, CircleR), New Point(CircleR, 0)) ArrayS.Add(New Point(circleD, CircleR)) ArrayE.Add(New Point(CircleR, 0)) For i = 0 To ArrayS.Count - 1 ArrayR.Add(ArrayS(i)) Next For i = 0 To ArrayE.Count - 1 ArrayR.Add(ArrayE(i)) Next ArrayE.Clear() ArrayS.Clear() Timer2.Enabled = True Exit Sub End If If y1R < circleD * 3 / 4 Then y1R -= DrawingStep x1R = Math.Sqrt(CircleR * CircleR - (y1R - CircleR) * (y1R - CircleR)) + CircleR Else y1R = Math.Sqrt(CircleR * CircleR - (x1R - CircleR) * (x1R - CircleR)) + CircleR End If Dim Stepnum As Double = 0.5 For i = CircleR To 0 Step -Stepnum y2R = i x2R = Math.Sqrt(CircleR * CircleR - (y2R - CircleR) * (y2R - CircleR)) + CircleR Dim A As Double = Math.Abs(Math.Sqrt((x1R - x2R) * (x1R - x2R) + (y1R - y2R) * (y1R - y2R)) - (circleD / Math.Sqrt(2))) If A_1_R > A Then A_1_R = A Else ArrayS.Add(New Point(x1R, y1R)) ArrayE.Add(New Point(x2R, y2R)) g.DrawLine(Pens.Red, New Point(x1R, y1R), New Point(x2R, y2R)) Exit For End If Next x1R += DrawingStep End Sub '绘制心形左半边 Private Sub DrawingLeft(ByVal Drawingpanel As Panel, ByVal DrawingStep As Double, ByVal circleD As Double) Dim CircleR As Double = circleD / 2 Dim g As Graphics = Drawingpanel.CreateGraphics A_1_L = circleD If Math.Abs(x1L) < 0.2 Or y1L < CircleR Then Timer2.Enabled = False ArrayS.Add(New Point(0, CircleR)) ArrayE.Add(New Point(CircleR, 0)) g.DrawLine(Pens.Red, New Point(0, CircleR), New Point(CircleR, 0)) For i = 0 To ArrayS.Count - 1 ArrayL.Add(ArrayS(i)) Next For i = 0 To ArrayE.Count - 1 ArrayL.Add(ArrayE(i)) Next ind = ArrayL.Count - 1 Rin = (ArrayR.Count - 1) / 2 Lin = ArrayL.Count - 1 Timer3.Enabled = True Exit Sub End If If y1L < circleD * 3 / 4 Then y1L += DrawingStep x1L = -Math.Sqrt(CircleR * CircleR - (y1L - CircleR) * (y1L - CircleR)) + CircleR Else y1L = Math.Sqrt(CircleR * CircleR - (x1L - CircleR) * (x1L - CircleR)) + CircleR End If 'y1L = Math.Sqrt(CircleR * CircleR - (x1L - CircleR) * (x1L - CircleR)) + CircleR Dim Stepnum As Double = 0.5 For i = CircleR To 0 Step -Stepnum y2L = i x2L = -Math.Sqrt(CircleR * CircleR - (y2L - CircleR) * (y2L - CircleR)) + CircleR Dim A As Double = Math.Abs(Math.Sqrt((x1L - x2L) * (x1L - x2L) + (y1L - y2L) * (y1L - y2L)) - (circleD / Math.Sqrt(2))) If A_1_L > A Then A_1_L = A Else ArrayS.Add(New Point(x1L, y1L)) ArrayE.Add(New Point(x2L, y2L)) g.DrawLine(Pens.Red, New Point(x1L, y1L), New Point(x2L, y2L)) Exit For End If Next x1L += DrawingStep End Sub '绘制心形宽头 Private Sub DrawingAll(ByVal ArrL As ArrayList, ByVal ArrR As ArrayList) Dim ind As Integer = ArrL.Count - 1 Dim indx As Integer = 0 For i = (ArrR.Count - 1) / 2 To ArrR.Count - 1 Dim g As Graphics = Panel1.CreateGraphics g.DrawLine(Pens.Red, ArrR(i), ArrL(ind)) ind -= 2 Next For i = ArrL.Count - 1 To (ArrL.Count - 1) / 2 Step -1 Dim g As Graphics = Panel1.CreateGraphics g.DrawLine(Pens.Red, ArrL(i), ArrR(indx)) indx += 2 Next End Sub '开始绘制 Private Sub Button_StartR_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_StartR.Click ini() Timer1.Enabled = True End Sub End Class好了,看看效果吧,赶紧表白吧。哈哈
VB.NET 章鱼哥 ——程序员也懂爱,动态绘制红心,很浪漫哦
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。