正文
vb.net绘制五角星 vs怎么画五角星
提示：扫一扫查出行【扫一扫了解最新限行尾号】
复制提示
（400分）VB 画圆，矩形，三角形，五角星
Private Sub Command1_Click()
Picture1.Circle (50, 50), 50
End Sub
Private Sub Command2_Click()
Picture1.Line (10, 10)-(10, 60)
Picture1.Line (10, 60)-(60, 60)
Picture1.Line (60, 60)-(60, 10)
Picture1.Line (60, 10)-(10, 10)
End Sub
Private Sub Command3_Click()
Picture1.Line (50, 50)-(50 + 10, 50 + 10 * Sqr(3))
Picture1.Line (50 + 10, 50 + 10 * Sqr(3))-(50 - 10, 50 + 10 * Sqr(3))
Picture1.Line (50 - 10, 50 + 10 * Sqr(3))-(50, 50)
End Sub
Private Sub Command4_Click()
Dim l As Long, a As Long, b As Long, du As Double
du = 3.1415926 / 10 '18度
a = 20
b = 20
l = 20
Picture1.Line (a, b)-(a + l * Sin(du), b + l * Cos(du))
Picture1.Line (a + l * Sin(du), b + l * Cos(du))-(a - l / 2, b + l / 2 * Tan(2 * du))
Picture1.Line (a - l / 2, b + l / 2 * Tan(2 * du))-(a + l / 2, b + l / 2 * Tan(2 * du))
Picture1.Line (a + l / 2, b + l / 2 * Tan(2 * du))-(a - l * Sin(du), b + l * Cos(du))
Picture1.Line (a - l * Sin(du), b + l * Cos(du))-(a, b)
End Sub
Private Sub Command5_Click()
Picture1.Circle (50, 50), 50, , , , 2
End Sub
Private Sub Command6_Click()
Picture1.Cls
End Sub
Private Sub Form_Load()
Picture1.AutoRedraw = True
End Sub
不早说，那样得重新规划变量。。。
墨渍在做我就不重复做了。
'新建窗体，添加command1-5,picture1,复制粘贴下段代码
Dim x1 As Single, y1 As Single, s As Integer
Const pi = 3.14159265
Private Sub Form_Load()
Command1.Caption = "圆"
Command2.Caption = "矩形"
Command3.Caption = "三角"
Command4.Caption = "五角"
Command5.Caption = "清"
End Sub
Private Sub Command1_Click()
s = 1
End Sub
Private Sub Command2_Click()
s = 2
End Sub
Private Sub Command3_Click()
s = 3
End Sub
Private Sub Command4_Click()
s = 4
End Sub
Private Sub Command5_Click()
Picture1.Cls
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then x1 = x: y1 = y
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Picture1.AutoRedraw = False
Picture1.Refresh
Picture1.PSet (x1, y1)
Select Case s
Case 1
Picture1.Circle (x1, y1), Sqr((x - x1) ^ 2 + (y - y1) ^ 2)
Case 2
Picture1.Line (x1, y1)-(x, y), , B
Case 3
duobianxing x1, y1, x, y, 3, 60
Case 4
duobianxing x1, y1, x, y, 5, 36
End Select
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Picture1.AutoRedraw = True
Select Case s
Case 1
Picture1.Circle (x1, y1), Sqr((x - x1) ^ 2 + (y - y1) ^ 2)
Case 2
Picture1.Line (x1, y1)-(x, y), , B
Case 3
duobianxing x1, y1, x, y, 3, 60
Case 4
duobianxing x1, y1, x, y, 5, 36
End Select
End If
End Sub
'duobianxing函数参数：
'zhongxinX-多边形中心的横坐标
'zhongxinY-多边形中心的纵坐标
'dingdianX-多边形一个顶点的横坐标
'dingdianY-多边形一个顶点的纵坐标
'bianhuoxing-正多边形的边数或者星形的星角数，例如biaohuoxing=5,dingjiao=72则为正五边形,若dingjiao=36则为五角星(该函数将正多边形按相邻顶角点间的折点成直线的特殊星形绘制)
'dingjiao-多边形的顶角的角度(角度制°)
Function duobianxing(ByVal zhongxinX As Single, ByVal zhongxinY As Single, ByVal dingdianX As Single, ByVal dingdianY As Single, ByVal bianhuoxing As Integer, ByVal dingjiao As Single)
If bianhuoxing = 0 Then Exit Function
l = Sqr((zhongxinX - dingdianX) ^ 2 + (zhongxinY - dingdianY) ^ 2) '星形中心到顶角距离
t1 = Abs(Tan((dingjiao / 2) * pi / 180)) '星形顶角的1/2求正切
t2 = Abs(Tan((360 / (2 * bianhuoxing)) * pi / 180)) '星形每条边所对应的中心角的1/2求正切
r = l * t2 / (t1 + t2) / Cos((dingjiao / 2) * pi / 180) '星形边长
If zhongxinX = dingdianX Then '求星形中心到顶角这条线的角度j
j = IIf(dingdianY zhongxinY, 90, -90)
Else
j = Atn((zhongxinY - dingdianY) / (dingdianX - zhongxinX)) * 180 / pi
If dingdianX zhongxinX Then
If dingdianY zhongxinY Then
j = j - 180
Else
j = j + 180
End If
End If
End If
j1 = j - dingjiao / 2 '边偏离初始角1
j2 = 360 / bianhuoxing + dingjiao + j - dingjiao / 2 '边偏离初始角2(如果是正多边形j1=j2)
px1 = dingdianX: py1 = dingdianY '指定星形的第一个顶点
For i = 1 To bianhuoxing * 2
If i Mod 2 = 0 Then
px2 = px1 + r * Cos(j2 * pi / 180): py2 = py1 - r * Sin(j2 * pi / 180) '指定星形下一个顶点
j2 = j2 + 360 / bianhuoxing '边偏角+2个边长对应的中心角
Else
px2 = px1 - r * Cos(j1 * pi / 180): py2 = py1 + r * Sin(j1 * pi / 180)
j1 = j1 + 360 / bianhuoxing
End If
Picture1.Line (px1, py1)-(px2, py2) '画线
px1 = px2: py1 = py2
Next
End Function
相关问答
Q1: 跪求vb.net代码
这个图案其实可以根据另一个问题中的钻石型图案的绘制方法统一，仅仅是改动了均分圆的分格数为5：图案效果如下不含外接圆。
均分圆5格的两两顶点连线
Q2: 如何创建特殊形状的VB按钮？耐心的大侠帮忙啊！！
1，使用其它控件
2，用api切割需要更改的控件，就像做不规则的窗体一样
3，用image加上一些漂亮的ico图标代替command button
Q3: vb输入外接圆半径,和中心坐标画出五角星怎么写。
Private Type tPoint
x As Single
y As Single
End Type
Private Sub Form_Load()
HScroll1.Min = 0
HScroll1.Max = 360
End Sub
Private Sub fun_Paint()
Const PI As Double = 3.141592653
Dim intR As Integer
Dim intO As tPoint
Dim intK As Integer
Dim pp(4) As tPoint
Dim i As Integer
Me.Cls
Me.AutoRedraw = True
intR = Int(Val(Text1.Text))
intO.x = Int(Val(Text2.Text))
intO.y = Int(Val(Text3.Text))
intK = Me.HScroll1.Value
Me.DrawWidth = 10
Me.PSet (intO.x, intO.y), vbRed
For i = 0 To 4
pp(i).x = intO.x + intR * Sin(((intK + 72 * i) / 360) * (2 * PI))
pp(i).y = intO.y + intR * Cos(((intK + 72 * i) / 360) * (2 * PI))
Me.DrawWidth = 6
Me.PSet (pp(i).x, pp(i).y), vbBlue
Next i
Me.DrawWidth = 3
For i = 0 To 4
Me.Line (pp(i).x, pp(i).y)-(pp((i + 2) Mod 5).x, pp((i + 2) Mod 5).y), vbBlack
Next
End Sub
Private Sub Form_Click()
fun_Paint
End Sub
Private Sub HScroll1_Change()
fun_Paint
End Sub
Private Sub HScroll1_Scroll()
fun_Paint
End Sub
vb.net绘制五角星的介绍就聊到这里吧，感谢你花时间阅读本站内容，更多关于vs怎么画五角星、vb.net绘制五角星的信息别忘了在本站进行查找喔。
