📄 simulation interface.frm
字号:
Begin VB.TextBox txt_ysidel
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 4320
TabIndex = 4
Text = "1000"
Top = 840
Width = 1560
End
Begin VB.TextBox txt_bufferwidth
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 4320
TabIndex = 7
Text = "50"
Top = 1320
Width = 1560
End
Begin ComCtl2.UpDown UpDown2
Height = 360
Left = 5880
TabIndex = 5
TabStop = 0 'False
Top = 840
Width = 255
_ExtentX = 450
_ExtentY = 635
_Version = 327681
AutoBuddy = -1 'True
BuddyControl = "txt_ysidel"
BuddyDispid = 196638
OrigLeft = 5880
OrigTop = 360
OrigRight = 6135
OrigBottom = 735
Max = 5000
SyncBuddy = -1 'True
BuddyProperty = 0
Enabled = -1 'True
End
Begin ComCtl2.UpDown UpDown3
Height = 360
Left = 5880
TabIndex = 8
TabStop = 0 'False
Top = 1320
Width = 255
_ExtentX = 450
_ExtentY = 635
_Version = 327681
AutoBuddy = -1 'True
BuddyControl = "txt_bufferwidth"
BuddyDispid = 196639
OrigLeft = 5880
OrigTop = 360
OrigRight = 6135
OrigBottom = 735
SyncBuddy = -1 'True
BuddyProperty = 0
Enabled = -1 'True
End
Begin VB.Label Label19
Caption = "BW = "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3600
TabIndex = 48
Top = 1320
Width = 615
End
Begin VB.Label Label18
Caption = "Y1 = "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3720
TabIndex = 47
Top = 920
Width = 615
End
Begin VB.Label Label17
Caption = "X1 = "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3720
TabIndex = 46
Top = 440
Width = 615
End
Begin VB.Label lbl_XsideL
Caption = "X Side Length (m)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 0
Top = 480
Width = 1770
End
Begin VB.Label lbl_YSideL
Caption = "Y Side Length (m)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 3
Top = 900
Width = 1695
End
Begin VB.Label lbl_BufferWidth
Caption = "Buffer Width (m)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 6
Top = 1320
Width = 1695
End
End
End
End
Attribute VB_Name = "Frm_Generation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 1
Private Sub cmd_cancel_Click()
If MsgBox("Do you really want to exit the process of data generation?", vbQuestion Or vbYesNo, "Exit Data Generation ?") = vbYes Then
Exit Sub
Else
cmd_ok.SetFocus
End If
End Sub
Private Sub cmd_ok_Click()
X1 = Val(txt_xsidel.Text) 'setting the X coordinate of survey area
Y1 = Val(txt_ysidel.Text) 'setting the Y coordinate of survey area
Bufferwidth = Val(txt_bufferwidth.Text) 'setting the buffer width of survey area_
Lambda1 = Val(txt_lbd(1).Text) 'read the argument passed to Poisson Variate Generation 'for the avoidance of edge effect
Lambda2 = Val(txt_lbd(2).Text) 'Read the argument passed to Poisson Variate Generation
Lambda3 = Val(txt_lbd(3).Text) 'Read the argument passed to Exponential Variate Generation
Dmean = Val(txt_Dmean.Text) 'read the given value of mean DBH
Dstdev = Val(txt_Dstdev.Text) 'read the given standard deviation of DBH
Dmax = Val(txt_Dmax.Text) 'read the maximum DBH
Dmin = Val(txt_Dmin.Text) 'read the minimum DBH
' Dim NOC As Integer 'Number of Clusters
Do
NOC = poissonrand(Lambda1) 'Generate Number of Clusters
Loop Until NOC <> 0 'Avoid NOC being zero and the problem with Redim XCC(NOC)
Dim Xcc() As Double 'Define X Coordinates of Cluster Center
Dim Ycc() As Double 'Define y coordinates of Cluster Center
ReDim Xcc(NOC) As Double 'Define X Coordinates of Cluster Center
ReDim Ycc(NOC) As Double 'Define y coordinates of Cluster Center
Dim Counter1 As Integer 'Randomly select the coordinates of Cluster Centers
For Counter1 = 1 To NOC
Xcc(Counter1) = X1 * Rnd
Ycc(Counter1) = Y1 * Rnd
Next Counter1
Dim NOI() As Double 'Number of Individuals per Cluster
ReDim NOI(NOC) 'Define Number of Individuals Array
TreeNo = 0 'TreeNo is a global variable and should be reinitialized here
Dim Counter2 As Integer
For Counter2 = 1 To NOC
NOI(Counter2) = poissonrand(Lambda2)
TreeNo = TreeNo + NOI(Counter2) 'Calculate the total number of trees
Next Counter2
ReDim X(TreeNo)
ReDim Y(TreeNo)
Dim C1, C2 As Integer
Dim Angle As Single
Angle = 2 * PI * Rnd
For C1 = 1 To NOC 'Randomly select tree locations
For C2 = 1 To NOI(C1)
C3 = C3 + 1
X(C3) = Xcc(C1) + exprand(1 / Lambda3) * Cos(Angle)
Y(C3) = Ycc(C1) + exprand(1 / Lambda3) * Sin(Angle)
Next C2
Next C1
For i = 1 To TreeNo
Debug.Print i, X(i), Y(i)
Next i
Call Generate_DBH 'Generate DBH
Call Generate_BA 'Calculate Individual Basal Area
CmnDlg.Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
CmnDlg.FilterIndex = 2 'Specify default filter
CmnDlg.ShowSave
On Error GoTo ErrHandler
Open CmnDlg.FileName For Output As #1
' Print #1, "Number of Clusters:"; NOC
' Print #1, "Tree Number:"; TreeNo
' Print #1, "Lambda1:"; Lambda1
' Print #1, "Lambda2:"; Lambda2
' Print #1, "Lambda3:"; Lambda3
'
' Print #1, "Mean DBH:"; Dmean
' Print #1, "DBH Stdev:"; Dstdev
' Print #1, "Max DBH:"; Dmax
' Print #1, "Min DBH:"; Dmin
' Print #1,
'
' Print #1, "Tree No", "X", "Y", "DBH", "Basal Area"
' Print #1,
Write #1, "X", "Y"
For i = 1 To TreeNo
Write #1, Round(X(i), 2), Round(Y(i), 2)
' i, X(i), , Y(i), , DBH(i), BA(i)
Next i
Close #1
'
'Open "E:\Output of ACS\test.txt" For Output As #1
' For i = 1 To TreeNo
' Print #1, i, X(i), Y(i)
' Next i
'Close #1
''Calculate the total number of trees
'
'
'' For i = 1 To NOC
'' Debug.Print NOI(i)
'' Next i
''
''
'' Print NOC
''
'
'
With Frm_Display.Datagrid
.Rows = TreeNo + 1
.Cols = 5
For i = 1 To 4
.ColWidth(i) = .Width / 4.8
Next i
.TextMatrix(0, 0) = "Tree No"
.TextMatrix(0, 1) = "X"
.TextMatrix(0, 2) = "Y"
.TextMatrix(0, 3) = "DBH"
.TextMatrix(0, 4) = "Basal Area"
.ColAlignmentFixed = flexAlignCenterCenter 'Centering the fixed columns
End With
Frm_Display.Pic_layout.Scale (0, Y1)-(X1, 0)
' Unload Frm_Generation
Frm_Display.Show
Call Graph
Call Writexy2Datagrid
' Open "E:\Output of ACS\test.txt" For Output As #1
' For i = 1 To TreeNo
' Print #1, i, X(i), Y(i), DBH(i)
' Next i
Close #1
ErrHandler: ' User pressed Cancel button
Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -