www.pudn.com > contour234.zip > Form1.frm, change:2004-11-24,size:12882b
VERSION 5.00
Begin VB.Form Form1
BackColor = &H00FFC0FF&
Caption = "Form1"
ClientHeight = 7605
ClientLeft = 60
ClientTop = 345
ClientWidth = 9825
LinkTopic = "Form1"
ScaleHeight = 7605
ScaleWidth = 9825
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command11
Caption = "绘等高线"
Height = 495
Left = 8040
TabIndex = 19
Top = 2880
Width = 1335
End
Begin VB.CommandButton Command10
Caption = "清除"
Height = 495
Left = 8640
TabIndex = 18
Top = 3720
Width = 1095
End
Begin VB.CommandButton Command9
Caption = "&Exit"
Height = 495
Left = 8280
TabIndex = 17
Top = 6720
Width = 1215
End
Begin VB.TextBox TexNtri
Height = 375
Left = 9000
TabIndex = 16
Text = "三角形数"
Top = 4440
Width = 615
End
Begin VB.CommandButton Command8
Caption = "Deal3Dot"
Height = 375
Left = 7440
TabIndex = 12
Top = 1680
Width = 1335
End
Begin VB.TextBox Text4
Height = 375
Left = 9000
TabIndex = 11
Text = "Text4"
Top = 4920
Width = 615
End
Begin VB.CommandButton Command7
Caption = "Delaunay构网"
Height = 495
Left = 7440
TabIndex = 10
Top = 3720
Width = 1215
End
Begin VB.CommandButton Command6
Caption = "Deal2Dot"
Height = 495
Left = 8400
TabIndex = 9
Top = 1320
Width = 1335
End
Begin VB.CommandButton Command5
Caption = "Getthirddot"
Height = 615
Left = 8400
TabIndex = 8
Top = 1320
Width = 1215
End
Begin VB.CommandButton Command4
Caption = "nullcircle"
Height = 495
Left = 8520
TabIndex = 7
Top = 960
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 615
Left = 7440
TabIndex = 6
Top = 720
Width = 975
End
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 495
Left = 7560
TabIndex = 5
Top = 120
Width = 975
End
Begin VB.TextBox Text3
Height = 375
Left = 9000
TabIndex = 4
Text = "Text3"
Top = 5400
Width = 615
End
Begin VB.TextBox Text2
Height = 495
Left = 8640
TabIndex = 3
Text = "Text2"
Top = 5880
Width = 975
End
Begin VB.TextBox Text1
Height = 495
Left = 7680
TabIndex = 2
Text = "Text1"
Top = 5880
Width = 975
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 615
Left = 8520
TabIndex = 1
Top = 240
Width = 1095
End
Begin VB.PictureBox Pic1
BackColor = &H80000018&
Height = 7095
Left = 360
ScaleHeight = 7035
ScaleWidth = 7035
TabIndex = 0
Top = 120
Width = 7095
End
Begin VB.Label Label3
BackColor = &H00FFC0FF&
Caption = "点数："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7560
TabIndex = 15
Top = 5400
Width = 855
End
Begin VB.Label Label2
BackColor = &H00FFC0FF&
Caption = "三角形数："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 7440
TabIndex = 14
Top = 4440
Width = 1215
End
Begin VB.Label Label1
BackColor = &H00FFC0FF&
Caption = "未用边数："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 7440
TabIndex = 13
Top = 4920
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim ccc1 As Boolean
For i = 0 To MaxNdot
ccc1 = OnLeft(STdot(0), STdot(1), STdot(i))
If ccc1 = True Then
MsgBox i
End If
Next i
End Sub
Private Sub Command10_Click()
Dim cld, clb, clt As Integer
Form1.Pic1.Cls
For cld = 0 To MaxNdot
STdot(cld).X = 0
STdot(cld).Y = 0
STdot(cld).Z = 0
Next cld
For clb = 0 To MaxNedge
STedge(clb).dot1.X = 0
STedge(clb).dot1.Y = 0
STedge(clb).dot2.X = 0
STedge(clb).dot2.Y = 0
STedge(clb).sign = False
Next clb
For clt = 0 To Ntriangle
Next clt
MaxNdot = 0
MaxNedge = 0
NedgeNOuse = 0
Ntriangle = 0
i = 0
End Sub
Private Sub Command11_Click()
Dim ZH As Integer
Dim i3 As Integer
For ZH = 100 To 0 Step -10
For i3 = 1 To Ntriangle
Call DrawContour(STtriangle(i3), ZH)
Next i3
Next ZH
End Sub
'Private Sub Command11_Click()
'Dim i1, i2 As Integer
'Form1.Pic1.Cls
' Dim EdgeNow As edge
' Call GetFirstEdge
' MaxNedge = 1
' NedgeNOuse = 2
'Do While NedgeNOuse > 0
' For i1 = MaxNedge To 0 Step -1
' If STedge(i1).sign = False Then
' EdgeNow = STedge(i1)
' Exit For
' End If
' Next i1
' Call Delaunay(EdgeNow.dot1, EdgeNow.dot2)
' Form1.Text4.Text = NedgeNOuse
' NedgeNOuse = 0
' For i2 = 0 To MaxNedge
' If STedge(i2).sign = False Then
' NedgeNOuse = NedgeNOuse + 1
' End If
' Next i2
'Loop
'MsgBox "完成！"
'End Sub
Private Sub Command2_Click()
Dim aa As dot
Dim bb As dot
Dim cc As dot
Dim ooo As dot
Dim rrr As Double
Dim ccc2 As Boolean
aa = STdot(0)
bb = STdot(1)
For i = 0 To MaxNdot
cc = STdot(i)
ccc2 = OnLeft(aa, bb, cc)
If ccc2 = True Then
rrr = CreateCircle(aa, bb, cc).RR
ooo = CreateCircle(aa, bb, cc).OO
Form1.Pic1.Circle (ooo.X, ooo.Y), rrr
Else
MsgBox i
End If
Next i
End Sub
Private Sub Command3_Click()
Dim ooo As dot
Dim rrr As Double
ooo = CreateCircle(STdot(O), STdot(1), STdot(2)).OO
rrr = CreateCircle(STdot(O), STdot(1), STdot(2)).RR
Form1.Pic1.Circle (ooo.X, ooo.Y), rrr
Form1.Pic1.Print ooo.X
Form1.Pic1.Print ooo.Y
Form1.Pic1.Print rrr
End Sub
Private Sub Command4_Click()
Dim OO As dot
Dim RR As Double
Dim ccc4 As Boolean
Dim CCC42 As Boolean
OO = CreateCircle(STdot(O), STdot(1), STdot(2)).OO
RR = CreateCircle(STdot(O), STdot(1), STdot(2)).RR
ccc4 = NullCircle(OO, RR)
CCC42 = OnLeft(STdot(O), STdot(1), STdot(2))
If ccc4 = True And CCC42 = True Then
Form1.Pic1.Circle (OO.X, OO.Y), RR
Form1.Pic1.Line (STdot(0).X, STdot(0).Y)-(STdot(1).X, STdot(1).Y)
Form1.Pic1.Line (STdot(1).X, STdot(1).Y)-(STdot(2).X, STdot(2).Y)
Form1.Pic1.Line (STdot(0).X, STdot(0).Y)-(STdot(2).X, STdot(2).Y)
End If
End Sub
Private Sub Command5_Click()
Dim oo5 As dot
Dim rr5 As Double
Dim aaa5 As dot
Dim ccc5 As Boolean
Call GetFirstEdge
If GetThirdDot(STedge(0).dot1, STedge(0).dot2).JJ = True Then
aaa5 = GetThirdDot(STedge(0).dot1, STedge(0).dot2).DD
oo5 = CreateCircle(STedge(0).dot1, STedge(0).dot2, aaa5).OO
rr5 = CreateCircle(STedge(0).dot1, STedge(0).dot2, aaa5).RR
Form1.Pic1.Circle (oo5.X, oo5.Y), rr5
Form1.Pic1.Line (STedge(0).dot1.X, STedge(0).dot1.Y)-(STedge(0).dot2.X, STedge(0).dot2.Y), RGB(255, 0, 0)
Form1.Pic1.Line (STedge(0).dot2.X, STedge(0).dot2.Y)-(aaa5.X, aaa5.Y), RGB(255, 0, 0)
Form1.Pic1.Line (STedge(0).dot1.X, STedge(0).dot1.Y)-(aaa5.X, aaa5.Y), RGB(255, 0, 0)
End If
If GetThirdDot(STedge(0).dot2, STedge(0).dot1).JJ = True Then
aaa5 = GetThirdDot(STedge(0).dot2, STedge(0).dot1).DD
oo5 = CreateCircle(STedge(0).dot2, STedge(0).dot1, aaa5).OO
rr5 = CreateCircle(STedge(0).dot2, STedge(0).dot1, aaa5).RR
Form1.Pic1.Circle (oo5.X, oo5.Y), rr5
Form1.Pic1.Line (STedge(0).dot1.X, STedge(0).dot1.Y)-(STedge(0).dot2.X, STedge(0).dot2.Y)
Form1.Pic1.Line (STedge(0).dot2.X, STedge(0).dot2.Y)-(aaa5.X, aaa5.Y)
Form1.Pic1.Line (STedge(0).dot1.X, STedge(0).dot1.Y)-(aaa5.X, aaa5.Y)
End If
End Sub
Private Sub Command6_Click()
Call GetFirstEdge
MaxNedge = 1
NedgeNOuse = 2
If STedge(0).sign = False Then
Call Deal2Dot(STedge(0).dot1, STedge(0).dot2)
End If
If STedge(0).sign = True Then
MsgBox "修改成功true"
End If
Form1.Text4.Text = NedgeNOuse
End Sub
Private Sub Command7_Click()
Dim i1, i2 As Integer
Dim EdgeNow As edge
Call GetFirstEdge
MaxNedge = 1
NedgeNOuse = 2
Do While NedgeNOuse > 0
For i1 = MaxNedge To 0 Step -1
If STedge(i1).sign = False Then
EdgeNow = STedge(i1)
Exit For
End If
Next i1
Call Delaunay(EdgeNow.dot1, EdgeNow.dot2)
Form1.Text4.Text = NedgeNOuse
NedgeNOuse = 0
For i2 = 0 To MaxNedge
If STedge(i2).sign = False Then
NedgeNOuse = NedgeNOuse + 1
End If
Next i2
Loop
Form1.TexNtri.Text = Ntriangle
MsgBox "完成！"
End Sub
Private Sub Command8_Click()
Dim aa8 As dot
Dim ccc8 As Boolean
Dim k8 As Integer
Call GetFirstEdge
MaxNedge = 0
NedgeNOuse = 1
' STedge(0).sign = True
'STedge(1).sign = True
If GetThirdDot(STedge(0).dot1, STedge(0).dot2).JJ = True Then
aa8 = GetThirdDot(STedge(0).dot1, STedge(0).dot2).DD
Call DrawTriangle(STedge(0).dot1, STedge(0).dot2, aa8)
Call Deal3Dot(STedge(0).dot1, STedge(0).dot2, aa8)
End If
NedgeNOuse = 0
For k8 = 0 To MaxNedge
If STedge(k8).sign = False Then
NedgeNOuse = NedgeNOuse + 1
End If
Form1.Text5.Text = MaxNedge
Form1.Text6.Text = NedgeNOuse
Next k8
End Sub
Private Sub Command9_Click()
End
End Sub
Private Sub Form_Load()
Form1.Pic1.Scale (-3500, 3500)-(3500, -3500)
End Sub
Private Sub Pic1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
STdot(i).X = X
STdot(i).Y = Y
'给点的高程赋植
' STdot(i).Z = Int(Abs(X * Y) / 70)
Form1.Pic1.Circle (STdot(i).X, STdot(i).Y), 50
Form1.Pic1.Print i
i = i + 1
MaxNdot = i - 1
Text3.Text = MaxNdot
End Sub
Private Sub Pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.Text = X
Text2.Text = Y
End Sub