想不想知道怎么绘制的啊，别急，下面就直接给源码！
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 章鱼哥 ——程序员也懂爱，动态绘制红心，很浪漫哦
原文地址：http://blog.csdn.net/zhangyubishoulin/article/details/40984425
