📄 frmgrid.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmGrid
BorderStyle = 3 'Fixed Dialog
Caption = "三角化程序"
ClientHeight = 8268
ClientLeft = 48
ClientTop = 336
ClientWidth = 11412
BeginProperty Font
Name = "宋体"
Size = 11.4
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 689
ScaleMode = 3 'Pixel
ScaleWidth = 951
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox Picture1
Height = 8052
Left = 120
ScaleHeight = 667
ScaleMode = 3 'Pixel
ScaleWidth = 927
TabIndex = 0
Top = 120
Width = 11172
Begin VB.PictureBox PictureGrid
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 7.8
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 7680
Left = 3240
ScaleHeight = 7656
ScaleWidth = 7656
TabIndex = 19
Top = 120
Width = 7680
End
Begin VB.PictureBox PictureTools
Appearance = 0 'Flat
BackColor = &H80000000&
BeginProperty Font
Name = "MS Sans Serif"
Size = 7.8
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 7692
Left = 120
ScaleHeight = 7668
ScaleWidth = 2988
TabIndex = 1
Top = 120
Width = 3012
Begin VB.TextBox TextXStep
Appearance = 0 'Flat
Enabled = 0 'False
Height = 336
Left = 120
TabIndex = 12
Top = 2280
Width = 1332
End
Begin VB.TextBox TextYStep
Appearance = 0 'Flat
Enabled = 0 'False
Height = 336
Left = 1560
TabIndex = 11
Top = 2280
Width = 1332
End
Begin VB.TextBox TextXNX
Appearance = 0 'Flat
Enabled = 0 'False
Height = 336
Left = 120
TabIndex = 10
Top = 3000
Width = 1332
End
Begin VB.TextBox TextYNY
Appearance = 0 'Flat
Enabled = 0 'False
Height = 336
Left = 1560
TabIndex = 9
Top = 3000
Width = 1332
End
Begin VB.CommandButton CommandGridOK
Caption = "开始三角化"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 11.4
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 8
Top = 6000
Width = 2775
End
Begin VB.CommandButton CommandGridCacel
Caption = "退出"
BeginProperty Font
Name = "宋体"
Size = 11.4
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
TabIndex = 7
Top = 6720
Width = 2775
End
Begin VB.TextBox TextXmin
Appearance = 0 'Flat
Enabled = 0 'False
Height = 336
Left = 120
TabIndex = 6
Top = 840
Width = 1335
End
Begin VB.TextBox TextXmax
Appearance = 0 'Flat
Enabled = 0 'False
Height = 336
Left = 120
TabIndex = 5
Top = 1560
Width = 1332
End
Begin VB.TextBox TextYmin
Appearance = 0 'Flat
Enabled = 0 'False
Height = 336
Left = 1560
TabIndex = 4
Top = 840
Width = 1335
End
Begin VB.TextBox TextYmax
Appearance = 0 'Flat
Enabled = 0 'False
Height = 336
Left = 1560
TabIndex = 3
Top = 1560
Width = 1332
End
Begin VB.CommandButton CommandContouMeshWang
Caption = "打开文件..."
BeginProperty Font
Name = "宋体"
Size = 11.4
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 120
MousePointer = 1 'Arrow
TabIndex = 2
Top = 120
Width = 2772
End
Begin VB.Label LabelYmax
Alignment = 2 'Center
Caption = "Y最大值"
Enabled = 0 'False
Height = 252
Left = 1560
TabIndex = 21
Top = 1320
Width = 1332
End
Begin VB.Label LabelXmax
Alignment = 2 'Center
Caption = "X最大值"
Enabled = 0 'False
Height = 252
Left = 120
TabIndex = 20
Top = 1320
Width = 1332
End
Begin VB.Label LabelXStep
Alignment = 2 'Center
Caption = "X方向步长"
Enabled = 0 'False
Height = 252
Left = 120
TabIndex = 18
Top = 2040
Width = 1332
End
Begin VB.Label LabelYStep
Alignment = 2 'Center
Caption = "Y方向步长"
Enabled = 0 'False
Height = 252
Left = 1560
TabIndex = 17
Top = 2040
Width = 1332
End
Begin VB.Label LabelXNX
Alignment = 2 'Center
Caption = "X方向网格数"
Enabled = 0 'False
Height = 252
Left = 120
TabIndex = 16
Top = 2760
Width = 1332
End
Begin VB.Label LabelYNY
Alignment = 2 'Center
Caption = "Y方向网格数"
Enabled = 0 'False
Height = 252
Left = 1560
TabIndex = 15
Top = 2760
Width = 1332
End
Begin VB.Label LabelXmin
Alignment = 2 'Center
Caption = "X最小值"
Enabled = 0 'False
Height = 252
Left = 120
TabIndex = 14
Top = 600
Width = 1332
End
Begin VB.Label LabelYmin
Alignment = 2 'Center
Caption = "Y最小值"
Enabled = 0 'False
Height = 252
Left = 1560
TabIndex = 13
Top = 600
Width = 1332
End
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 240
Top = -120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
End
End
Attribute VB_Name = "FrmGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim TheContouPath As String, TheContouFile As String
Dim Xmin0 As Double, Xmax0 As Double, Ymin0 As Double, Ymax0 As Double
Dim XminT As Double, XmaxT As Double, YminT As Double, YmaxT As Double
Dim DataType As Integer
Dim nDec As Integer, FMT As String
Dim Xmin As Double, Xmax As Double, DX As Double, NX As Integer
Dim Ymin As Double, Ymax As Double, DY As Double, NY As Integer
Dim Vmin As Single, Vmax As Single
Dim Xcontou() As Double, Ycontou() As Double, Zcontou() As Double, NContou As Long
Dim BorderX() As Single, BorderY() As Single, nBorder As Integer
Dim nSJX As Integer, ID1() As Integer, ID2() As Integer, ID3() As Integer
Dim TheInstallPath As String
Private Sub CommandGridCacel_Click()
Unload Me
End Sub
Private Sub CommandGridOK_Click()
Dim iGrid As Integer
DX = Val(TextXStep.Text)
DY = Val(TextYStep.Text)
NX = Val(TextXNX.Text)
NY = Val(TextYNY.Text)
Call DrawOld
Call SJX
End Sub
Private Sub SJX()
Dim R As Double, RT As Double
Dim J As Integer, K As Integer
Dim A1 As Double, B1 As Double, C1 As Double, Tt As Double
Dim AA As Double, BB As Double, CC As Double, CosC As Double
Dim bCheck As Boolean, bEQBD As Boolean
Dim Ni As Integer, Nj As Integer, Pi As Integer, Pj As Integer, Pk As Integer
Dim M1 As Integer, M2 As Integer
Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, X3 As Double, Y3 As Double
Dim bSJX As Boolean
'边界段数
Dim nBD As Integer
'用于判断边界环是否搜索过
Dim bBD() As Boolean
'用于判断数据点是否在边界环内
Dim bPoint() As Byte
'第i边界起点BD,第i边对应顶点
Dim BD() As Integer, BDij() As Integer
'第i边界的上一节点、下一节点
Dim Nlast As Integer, Nnext As Integer
ReDim ID1(0 To 2 * NContou), ID2(0 To 2 * NContou), ID3(0 To 2 * NContou)
'Begin生成第一个三角形
Pi = 0
'找出距第一点最近的点2
RT = 1E+20
For J = 1 To NContou
R = (Xcontou(J) - Xcontou(Pi)) ^ 2 + (Ycontou(J) - Ycontou(Pi)) ^ 2
If (R < RT) Then
RT = R
Pj = J
End If
Next J
'找出第三点
Tt = 0
For J = 1 To NContou
If (J <> Pj) Then
AA = (Xcontou(Pj) - Xcontou(J)) ^ 2 + (Ycontou(Pj) - Ycontou(J)) ^ 2
BB = (Xcontou(Pi) - Xcontou(J)) ^ 2 + (Ycontou(Pi) - Ycontou(J)) ^ 2
CC = (Xcontou(Pi) - Xcontou(Pj)) ^ 2 + (Ycontou(Pi) - Ycontou(Pj)) ^ 2
CosC = 1# - (AA + BB - CC) / (2# * Sqr(AA * BB))
If (CosC > Tt + 0.00001) Then
Tt = CosC
Pk = J
End If
End If
Next J
nSJX = 0
ID1(nSJX) = Pi
ID2(nSJX) = Pj
ID3(nSJX) = Pk
'End生成第一个三角形
X1 = Xcontou(Pi)
X2 = Xcontou(Pj)
X3 = Xcontou(Pk)
Y1 = Ycontou(Pi)
Y2 = Ycontou(Pj)
Y3 = Ycontou(Pk)
PictureGrid.DrawMode = 13
PictureGrid.ForeColor = QBColor(12)
PictureGrid.Line (X1, Y1)-(X2, Y2)
PictureGrid.Line (X2, Y2)-(X3, Y3)
PictureGrid.Line (X3, Y3)-(X1, Y1)
DoEvents
'定义边界环数组
ReDim BD(0 To NContou), BDij(0 To NContou), bBD(0 To NContou), bPoint(0 To NContou)
For J = 0 To NContou
bBD(J) = False
bPoint(J) = 0
Next J
'生成三条边
nBD = 3
BD(1) = Pi
BDij(1) = Pk
bBD(1) = True
BD(2) = Pj
BDij(2) = Pi
bBD(2) = True
BD(3) = Pk
BDij(3) = Pj
bBD(3) = True
bPoint(Pi) = 1
bPoint(Pj) = 1
bPoint(Pk) = 1
Do
Ni = Ni + 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -