我粘贴的， 对于多边形面积就不知道怎么算了
下面是代码：
新建一个Txt文档，复制下面代码保存为.Frm 就可以使用了
VERSION 5.00
Begin VB.Form FrmDraw
Caption = "Form1"
ClientHeight = 10425
ClientLeft = 120
ClientTop = 450
ClientWidth = 13260
LinkTopic = "Form1"
ScaleHeight = 10425
ScaleWidth = 13260
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "清除图像"
Height = 615
Left = 1320
TabIndex = 10
Top = 120
Width = 1455
End
Begin VB.TextBox tJg
Height = 270
Left = 2280
TabIndex = 9
Text = "1"
Top = 1080
Width = 495
End
Begin VB.TextBox tJs
Height = 270
Left = 1800
TabIndex = 8
Text = "5"
Top = 1080
Width = 495
End
Begin VB.OptionButton Option1
Caption = "正多角形"
Height = 255
Index = 4
Left = 120
TabIndex = 6
Top = 1080
Width = 1095
End
Begin VB.TextBox tBs
Height = 270
Left = 1800
TabIndex = 4
Text = "3"
Top = 840
Width = 495
End
Begin VB.OptionButton Option1
Caption = "正多边形"
Height = 255
Index = 3
Left = 120
TabIndex = 3
Top = 840
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "五边形"
Height = 255
Index = 2
Left = 120
TabIndex = 2
Top = 600
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "五角星"
Height = 255
Index = 1
Left = 120
TabIndex = 1
Top = 360
Width = 1095
End
Begin VB.OptionButton Option1
Caption = "正三角形"
Height = 255
Index = 0
Left = 120
TabIndex = 0
Top = 120
Width = 1095
End
Begin VB.Label Label2
Caption = "角数:"
Height = 255
Left = 1320
TabIndex = 7
Top = 1080
Width = 495
End
Begin VB.Label Label1
Caption = "边数:"
Height = 255
Left = 1320
TabIndex = 5
Top = 840
Width = 495
End
End
Attribute VB_Name = "FrmDraw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim MX As Long
Dim MY As Long
Dim NX As Long
Dim NY As Long
Dim Num1 As Double
Dim Num2 As Double
Dim Num3 As Double
Dim OIdx As Long
Private Sub Draw(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Clr As Long)
On Error Resume Next
Select Case OIdx
Case 0
DrawDBX X1, Y1, X2, Y2, Clr, 3
Case 1
DrawW X1, Y1, X2, Y2, Clr
Case 2
DrawDBX X1, Y1, X2, Y2, Clr, 5
Case 3
Dim Bs As Long
Bs = Val(tBs.Text)
If Bs >= 3 Then DrawDBX X1, Y1, X2, Y2, Clr, Bs
Case 4
Dim Js As Long
Dim Jg As Long
Js = Val(tJs.Text)
Jg = Val(tJg.Text)
If Js Mod 2 <> 1 Then Js = Js + 1
tJs.Text = Js
If Jg < 1 Then Jg = 1
If Jg > Js - 4 Then Jg = Js - 4
If Jg Mod 2 <> 1 Then Jg = Jg - 1
If Js Mod Jg = 0 Then Jg = 1
tJg.Text = Jg
If Js >= 5 And Js Mod 2 = 1 Then DrawDJX X1, Y1, X2, Y2, Clr, Js, Jg
End Select
End Sub
Private Sub DrawW(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Clr As Long)
Dim X3 As Long
Dim Y3 As Long
Dim X4 As Long
Dim Y4 As Long
Dim X5 As Long
Dim Y5 As Long
GetXY X3, Y3, X1, Y1, X2, Y2
GetXY X4, Y4, X2, Y2, X3, Y3
GetXY X5, Y5, X3, Y3, X4, Y4
Me.Line (X1, Y1)-(X2, Y2), Clr
Me.Line -(X3, Y3), Clr
Me.Line -(X4, Y4), Clr
Me.Line -(X5, Y5), Clr
Me.Line -(X1, Y1), Clr
End Sub
Private Sub DrawDBX(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Clr As Long, Optional ByVal Bs As Long = 3)
If Bs < 3 Then Exit Sub
Dim X() As Long
Dim Y() As Long
Dim i As Long
ReDim X(Bs - 3)
ReDim Y(Bs - 3)
Dim Du As Double
Du = (Bs - 2) * 180 / Bs
Me.Line (X1, Y1)-(X2, Y2), Clr
GetXY X(0), Y(0), X1, Y1, X2, Y2, Du
Me.Line -(X(0), Y(0)), Clr
If Bs > 3 Then
GetXY X(1), Y(1), X2, Y2, X(0), Y(0), Du
Me.Line -(X(1), Y(1)), Clr
If Bs > 4 Then
For i = 2 To Bs - 3
GetXY X(i), Y(i), X(i - 2), Y(i - 2), X(i - 1), Y(i - 1), Du
Me.Line -(X(i), Y(i)), Clr
Next
End If
End If
Me.Line -(X1, Y1), Clr
End Sub
Private Sub DrawDJX(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Clr As Long, Optional ByVal Js As Long = 5, Optional ByVal Jg As Long = 1)
If Js < 5 Then Exit Sub
If Js Mod 2 <> 1 Then Exit Sub
Dim X() As Long
Dim Y() As Long
Dim i As Long
ReDim X(Js - 3)
ReDim Y(Js - 3)
Dim Du As Double
Du = Jg * 180 / Js
Me.Line (X1, Y1)-(X2, Y2), Clr
GetXY X(0), Y(0), X1, Y1, X2, Y2, Du
Me.Line -(X(0), Y(0)), Clr
If Js > 3 Then
GetXY X(1), Y(1), X2, Y2, X(0), Y(0), Du
Me.Line -(X(1), Y(1)), Clr
If Js > 4 Then
For i = 2 To Js - 3
GetXY X(i), Y(i), X(i - 2), Y(i - 2), X(i - 1), Y(i - 1), Du
Me.Line -(X(i), Y(i)), Clr
Next
End If
End If
Me.Line -(X1, Y1), Clr
End Sub
Private Sub GetXY(ByRef X As Long, ByRef Y As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, Optional ByVal sDu As Double = 0)
Dim Ln As Long
Dim Du As Double
Dim YS As Long
Dim SSDU As Double
If sDu = 0 Then SSDU = Num3 Else SSDU = sDu / Num2
YS = IIf(Y2 > Y1, -1, 1)
If Y1 = Y2 Then
X = X2 + (X1 - X2) * Cos(SSDU)
Y = Y2 - (X1 - X2) * Sin(SSDU)
Else
Ln = Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)
Du = Atn((X2 - X1) / (Y2 - Y1))
X = X2 + Sin(SSDU + Du) * Ln * YS
Y = Y2 + Cos(SSDU + Du) * Ln * YS
End If
End Sub
Private Sub Command1_Click()
Me.Cls
End Sub
Private Sub Form_Load()
Num1 = Sqr(3) / 2
Num2 = 180 / 3.14159265
Num3 = 36 / Num2
Option1_Click 0
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
MX = X
MY = Y
NX = X
NY = Y
Me.DrawWidth = 2
Me.DrawMode = 7
'Line (NX, NY)-(MX, MY), RGB(255, 255, 255)
Draw MX, MY, NX, NY, RGB(255, 255, 255)
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Me.DrawWidth = 2
Me.DrawMode = 7
If Int(X) <> NX Or Int(Y) <> NY Then
'Line (NX, NY)-(MX, MY), RGB(255, 255, 255)
Draw MX, MY, NX, NY, RGB(255, 255, 255)
NX = X
NY = Y
Draw MX, MY, NX, NY, RGB(255, 255, 255)
'Line (NX, NY)-(MX, MY), RGB(255, 255, 255)
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Me.DrawWidth = 2
Me.DrawMode = 7
Draw MX, MY, NX, NY, RGB(255, 255, 255)
'Line (NX, NY)-(MX, MY), RGB(255, 255, 255)
Me.DrawMode = 13
Draw MX, MY, X, Y, RGB(255, 0, 0)
End Sub
Private Sub Option1_Click(Index As Integer)
OIdx = Index
End Sub
追问是用户自己用鼠标画！
追答这个真不会。。。。