（400分）VB 画圆,矩形,三角形,五角星一定得实现可以拖动鼠标来控制图形的大小!Command可以换成Option控件.鼠标拖动改变图形大小可参照下面的代码,实现功能就这样：Option ExplicitPrivate rx As Long

（400分）VB 画圆,矩形,三角形,五角星一定得实现可以拖动鼠标来控制图形的大小!Command可以换成Option控件.鼠标拖动改变图形大小可参照下面的代码,实现功能就这样：Option ExplicitPrivate rx As Long
（400分）VB 画圆,矩形,三角形,五角星
一定得实现可以拖动鼠标来控制图形的大小!
Command可以换成Option控件.
鼠标拖动改变图形大小可参照下面的代码,实现功能就这样：
Option Explicit
Private rx As Long,ry As Long,isDraw As Boolean
Private Sub Form_MouseDown(Button As Integer,Shift As Integer,X As Single,Y As Single)
rx = X
ry = Y
isDraw = True
End Sub
Private Sub Form_MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)
Static oldx As Long,oldy As Long,oldcolor As Long
oldcolor = Me.ForeColor
If isDraw Then
Me.ForeColor = Me.BackColor
Me.Circle (rx,ry),Sqr((oldx - rx) * (oldx - rx) + (oldy - ry) * (oldy - ry))
Me.ForeColor = oldcolor
Me.Circle (rx,ry),Sqr((X - rx) * (X - rx) + (Y - ry) * (Y - ry))
End If
oldx = X
oldy = Y
End Sub
Private Sub Form_MouseUp(Button As Integer,Shift As Integer,X As Single,Y As Single)
isDraw = False
End Sub

（400分）VB 画圆,矩形,三角形,五角星一定得实现可以拖动鼠标来控制图形的大小!Command可以换成Option控件.鼠标拖动改变图形大小可参照下面的代码,实现功能就这样：Option ExplicitPrivate rx As Long
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