Question

vb 画多边形

vb
1 画图形，要求封口就行了。让用户画，像铅笔一样
2 获取该图形的面积
3 在图形里填充颜色
第一项必填，20分；第二项三项各15分，好的追加，谢谢
要求1、3不要了，怎么获取面积？

Answer 1

我粘贴的， 对于多边形面积就不知道怎么算了
下面是代码：

新建一个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

追问

是用户自己用鼠标画！

追答

这个真不会。。。。

Answer 2

对多于三条边的图形，又分为凹、凸多边形等多种，计算十分繁杂，所心，只有划图。
因为用户用鼠标划线是划不直的，因而只能通过单击画顶点的方法画多边形
新建一个Txt文档，复制下面代码保存为.Frm 就可以使用了
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3090
ClientLeft = 60
ClientTop = 450
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3090
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command1
Caption = "面积计算"
Height = 495
Left = 1800
TabIndex = 0
Top = 1320
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim arrx(1000), arry(1000)
Dim n

Private Sub Command1_Click()
If Abs(arrx(0) - arrx(n - 1)) >= 100 Or Abs(arry(0) - arry(n - 1)) >= 100 Then MsgBox "未封口"
End Sub

Private Sub Form_Click()
If n < 2 Then
PSet (arrx(n), arry(n))
Else
If Abs(arrx(0) - arrx(n - 1)) < 100 And Abs(arry(0) - arry(n - 1)) < 100 Then
Line (arrx(n - 2), arry(n - 2))-(arrx(0), arry(0))

Else
Line (arrx(n - 2), arry(n - 2))-(arrx(n - 1), arry(n - 1))
End If
End If
End Sub

Private Sub Form_Load()
n = 0
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
arrx(n) = X
arry(n) = Y
n = n + 1
End Sub

Answer 3

1,数字图像处理 检测出图形的 连通分量是否增加1，如果增加，说明是封闭区域
参考 冈萨雷斯 数字图像处理
2,这个要学习 数字图像处理 用区域填充法 先要用提取出轮廓（例如虫随法）--用区域填充法 ，参考
http://www.tudou.com/programs/view/buvhWVSiBt0/

Answer 4

绘制多边形非常简单，只须按多边形顶点依次Line下去就ok了。

填充也根本没有你那么麻烦，直接使用ExtFloodFill函数就搞定了。

追问

禁止COPY，当我没有找过？