vb 画多边形
发布网友
发布时间：2022-04-23 10:31
共4个回答
热心网友
时间：2023-10-11 13:05
我粘贴的， 对于多边形面积就不知道怎么算了
下面是代码：
新建一个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追问是用户自己用鼠标画！
追答这个真不会。。。。
热心网友
时间：2023-10-11 13:05
对多于三条边的图形，又分为凹、凸多边形等多种，计算十分繁杂，所心，只有划图。
因为用户用鼠标划线是划不直的，因而只能通过单击画顶点的方法画多边形
新建一个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
热心网友
时间：2023-10-11 13:06
1,数字图像处理 检测出图形的 连通分量是否增加1，如果增加，说明是封闭区域
参考 冈萨雷斯 数字图像处理
2,这个要学习 数字图像处理 用区域填充法 先要用提取出轮廓（例如虫随法）--用区域填充法 ，参考
http://www.tudou.com/programs/view/buvhWVSiBt0/
热心网友
时间：2023-10-11 13:07
绘制多边形非常简单，只须按多边形顶点依次Line下去就ok了。
填充也根本没有你那么麻烦，直接使用ExtFloodFill函数就搞定了。
追问禁止COPY，当我没有找过？
