vbs画动态爱心代码_用vb算法画出爱心

展开全部

方法一：简62616964757a686964616fe58685e5aeb931333332643930单的画法。

Private Sub Command1_Click()

ForeColor = RGB(255, 0, 0)

Font.Name = "Webdings"

Font.Size = 200

Print "Y"

End Sub

方法二：给个自定义画法函数给你参考。'x，y：图上所示的心形的坐标  a，b：图上所示的心形的大小(b要大于等于a)'co: 心形的颜色 fill: 是否要填充 (true为填充) jd：画图精度(一般取10，太大会卡，太小会有间隙)

Function HuaXinXing(x As Single, y As Single, a As Single, b As Single, co As Long, fill As Boolean, jd As Integer)

If b 

Print "b不能小于a"

Exit Function

End If

If jd <= 0 Then

Print "jd不能小于等于0"

Exit Function

End If

Dim i As Integer, j As Integer, x1 As Single, x2 As Single, x3 As Single, x4 As Single, y1 As Single, y2 As Single

Dim hd As Single, r As Single, d As Single

hd = 3.1415926 / 180

r = (a + b ^ 2 / a) / 2

d = (b ^ 2 / a - a) / 2

For i = 0 To 180 * jd

x1 = x + (Cos(3.1415926 + i * hd / jd) - 1) * a / 2

x2 = x + (Cos(6.2831852 - i * hd / jd) + 1) * a / 2

y1 = y + Sin(3.1415926 + i * hd / jd) * a / 2

PSet (x1, y1), co

PSet (x2, y1), co

y2 = y + r * Sin(i * hd / jd / 2)

If y2 <= y + b Then

x3 = x - d + r * Cos(i * hd / jd / 2)

x4 = x + d + r * Cos(3.1415926 - i * hd / jd / 2)

Else

y2 = y + b

End If

If fill = True Then

Line (x1, y1)-(x4, y2), co

Line (x2, y1)-(x3, y2), co

Else

PSet (x4, y2), co

PSet (x3, y2), co

End If

Next

End Function

Private Sub Command1_Click()

HuaXinXing 1000, 1000, 800, 1200, &HFF&, False, 10

End Sub

方法二运行结果：