VB.NET 章鱼哥 ——程序员也懂爱，动态绘制红心，很浪漫哦

概述先看看效果图吧：有动态绘制效果哦。 想不想知道怎么绘制的啊，别急，下面就直接给源码！ 1界面设计。一个Form窗体，一个Panel控件，一个Button按钮。就这么简单。 代码： '********************************************************************* '作者：章鱼哥，QQ：3107073263 群：309816713 先看看效果图吧：有动态绘制效果哦。

想不想知道怎么绘制的啊，别急，下面就直接给源码！

1界面设计。一个Form窗体，一个Panel控件，一个button按钮。就这么简单。

代码：

'*********************************************************************     '作者：章鱼哥，QQ：3107073263 群：309816713         '如有疑问或好的建议请联系我，大家一起进步       '*********************************************************************       imports Microsoft.VisualBasic.PowerPacksPublic 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 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,0))            g.Drawline(Pens.Red,New Point(0,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 章鱼哥 ——程序员也懂爱，动态绘制红心，很浪漫哦全部内容，希望文章能够帮你解决VB.NET 章鱼哥 ——程序员也懂爱，动态绘制红心，很浪漫哦所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。