📄 frmlossratedetail.frm
字号:
Height = 255
Left = 360
TabIndex = 17
Top = 720
Width = 375
End
Begin VB.Label Label23
Caption = "洪损率"
Height = 255
Left = 1920
TabIndex = 16
Top = 480
Width = 615
End
Begin VB.Line Line58
X1 = 240
X2 = 1800
Y1 = 1080
Y2 = 1080
End
Begin VB.Line Line36
BorderColor = &H80000012&
X1 = 240
X2 = 1800
Y1 = 600
Y2 = 600
End
Begin VB.Label Label48
BackColor = &H80000016&
Caption = "米"
ForeColor = &H00000000&
Height = 255
Left = 1440
TabIndex = 14
Top = 720
Width = 255
End
Begin VB.Label Label65
Caption = "洪损率"
Height = 255
Left = 1920
TabIndex = 12
Top = 960
Width = 615
End
Begin VB.Line Line46
BorderColor = &H80000012&
X1 = 1800
X2 = 3360
Y1 = 840
Y2 = 840
End
Begin VB.Line Line41
BorderColor = &H00FF0000&
BorderWidth = 2
X1 = 240
X2 = 3360
Y1 = 360
Y2 = 360
End
Begin VB.Line Line32
BorderWidth = 2
X1 = 1800
X2 = 1800
Y1 = 360
Y2 = 1320
End
Begin VB.Line Line31
BorderColor = &H00FF0000&
BorderWidth = 2
X1 = 240
X2 = 240
Y1 = 360
Y2 = 1320
End
Begin VB.Line Line30
BorderColor = &H00FF0000&
BorderWidth = 2
X1 = 240
X2 = 3360
Y1 = 1320
Y2 = 1320
End
End
Begin VB.Frame Frame1
Caption = "评估项目"
Height = 1215
Left = 120
TabIndex = 4
Top = 840
Width = 3255
Begin VB.TextBox strRicePrice
Alignment = 1 'Right Justify
Height = 285
Left = 1200
TabIndex = 7
Text = "2000"
Top = 720
Width = 975
End
Begin VB.TextBox strCropName
Alignment = 1 'Right Justify
Height = 285
Left = 1200
TabIndex = 5
Text = "untitled"
Top = 240
Width = 975
End
Begin VB.Label Label36
Caption = "元/亩"
Height = 255
Left = 2280
TabIndex = 9
Top = 720
Width = 495
End
Begin VB.Label Label35
Caption = "作物产值"
Height = 255
Left = 360
TabIndex = 8
Top = 720
Width = 855
End
Begin VB.Label Label34
Caption = "作物名称"
Height = 255
Left = 360
TabIndex = 6
Top = 240
Width = 855
End
End
Begin VB.CommandButton cmdOK
Caption = "完成"
Height = 375
Left = 2280
TabIndex = 3
Top = 3240
Width = 735
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
Height = 375
Left = 360
TabIndex = 2
Top = 3240
Width = 735
End
Begin VB.TextBox RateLevel
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 225
Left = 2520
TabIndex = 1
Top = 2250
Width = 375
End
Begin VB.Label Label33
Caption = "请设置淹没水深等级:"
Height = 255
Left = 720
TabIndex = 0
Top = 2280
Width = 2295
End
End
Attribute VB_Name = "frmLossRateDetail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Dim m_depthBreak(7) As Single
'Dim m_lossRate(8) As Single
Public bOKFlag As Boolean
Public bContinueFlag As Boolean
Public bSetLevel As Boolean
Private Sub form_load()
bOKFlag = False
bContinueFlag = False
bSetLevel = False
m_numRateLevel = 1
frameLoss1.Visible = False
frameLoss2.Visible = False
frameLoss3.Visible = False
frameLoss4.Visible = False
frameLoss5.Visible = False
frameLoss6.Visible = False
End Sub
Private Sub cmdCancel_Click()
bOKFlag = False
bContinueFlag = False
Me.Hide
End Sub
Private Sub cmdContinue_Click()
If Not bSetLevel Then
MsgBox "请先设置水深等级"
Exit Sub
End If
m_numRateLevel = CInt(RateLevel.Text)
Select Case m_numRateLevel
Case 1
m_depthBreak(1) = CSng(DepthBreak11.Text)
m_lossRate(1) = CSng(LossRate11.Text)
m_lossRate(2) = CSng(LossRate12.Text)
Case 2
m_depthBreak(1) = CSng(DepthBreak21.Text)
m_depthBreak(2) = CSng(DepthBreak22.Text)
m_lossRate(1) = CSng(LossRate21.Text)
m_lossRate(2) = CSng(LossRate22.Text)
m_lossRate(3) = CSng(LossRate23.Text)
Case 3
m_depthBreak(1) = CSng(DepthBreak31.Text)
m_depthBreak(2) = CSng(DepthBreak32.Text)
m_depthBreak(3) = CSng(DepthBreak33.Text)
m_lossRate(1) = CSng(LossRate31.Text)
m_lossRate(2) = CSng(LossRate32.Text)
m_lossRate(3) = CSng(LossRate33.Text)
m_lossRate(4) = CSng(LossRate34.Text)
Case 4
m_depthBreak(1) = CSng(DepthBreak41.Text)
m_depthBreak(2) = CSng(DepthBreak42.Text)
m_depthBreak(3) = CSng(DepthBreak43.Text)
m_depthBreak(4) = CSng(DepthBreak44.Text)
m_lossRate(1) = CSng(LossRate41.Text)
m_lossRate(2) = CSng(LossRate42.Text)
m_lossRate(3) = CSng(LossRate43.Text)
m_lossRate(4) = CSng(LossRate44.Text)
m_lossRate(5) = CSng(LossRate45.Text)
Case 5
m_depthBreak(1) = CSng(DepthBreak51.Text)
m_depthBreak(2) = CSng(DepthBreak52.Text)
m_depthBreak(3) = CSng(DepthBreak53.Text)
m_depthBreak(4) = CSng(DepthBreak54.Text)
m_depthBreak(5) = CSng(DepthBreak55.Text)
m_lossRate(1) = CSng(LossRate51.Text)
m_lossRate(2) = CSng(LossRate52.Text)
m_lossRate(3) = CSng(LossRate53.Text)
m_lossRate(4) = CSng(LossRate54.Text)
m_lossRate(5) = CSng(LossRate55.Text)
m_lossRate(6) = CSng(LossRate56.Text)
Case 6
m_depthBreak(1) = CSng(DepthBreak61.Text)
m_depthBreak(2) = CSng(DepthBreak62.Text)
m_depthBreak(3) = CSng(DepthBreak63.Text)
m_depthBreak(4) = CSng(DepthBreak64.Text)
m_depthBreak(5) = CSng(DepthBreak65.Text)
m_depthBreak(6) = CSng(DepthBreak66.Text)
m_lossRate(1) = CSng(LossRate61.Text)
m_lossRate(2) = CSng(LossRate62.Text)
m_lossRate(3) = CSng(LossRate63.Text)
m_lossRate(4) = CSng(LossRate64.Text)
m_lossRate(5) = CSng(LossRate65.Text)
m_lossRate(6) = CSng(LossRate66.Text)
m_lossRate(7) = CSng(LossRate67.Text)
End Select
If m_numRateLevel > 6 Or m_numRateLevel < 1 Then
bOKFlag = False
bContinueFlag = False
Else
bOKFlag = True
bContinueFlag = True
End If
Me.Hide
End Sub
Private Sub cmdOK_Click()
If Not bSetLevel Then
MsgBox "请先设置水深等级"
Exit Sub
End If
m_numRateLevel = CInt(RateLevel.Text)
Select Case m_numRateLevel
Case 1
m_depthBreak(1) = CSng(DepthBreak11.Text)
m_lossRate(1) = CSng(LossRate11.Text)
m_lossRate(2) = CSng(LossRate12.Text)
Case 2
m_depthBreak(1) = CSng(DepthBreak21.Text)
m_depthBreak(2) = CSng(DepthBreak22.Text)
m_lossRate(1) = CSng(LossRate21.Text)
m_lossRate(2) = CSng(LossRate22.Text)
m_lossRate(3) = CSng(LossRate23.Text)
Case 3
m_depthBreak(1) = CSng(DepthBreak31.Text)
m_depthBreak(2) = CSng(DepthBreak32.Text)
m_depthBreak(3) = CSng(DepthBreak33.Text)
m_lossRate(1) = CSng(LossRate31.Text)
m_lossRate(2) = CSng(LossRate32.Text)
m_lossRate(3) = CSng(LossRate33.Text)
m_lossRate(4) = CSng(LossRate34.Text)
Case 4
m_depthBreak(1) = CSng(DepthBreak41.Text)
m_depthBreak(2) = CSng(DepthBreak42.Text)
m_depthBreak(3) = CSng(DepthBreak43.Text)
m_depthBreak(4) = CSng(DepthBreak44.Text)
m_lossRate(1) = CSng(LossRate41.Text)
m_lossRate(2) = CSng(LossRate42.Text)
m_lossRate(3) = CSng(LossRate43.Text)
m_lossRate(4) = CSng(LossRate44.Text)
m_lossRate(5) = CSng(LossRate45.Text)
Case 5
m_depthBreak(1) = CSng(DepthBreak51.Text)
m_depthBreak(2) = CSng(DepthBreak52.Text)
m_depthBreak(3) = CSng(DepthBreak53.Text)
m_depthBreak(4) = CSng(DepthBreak54.Text)
m_depthBreak(5) = CSng(DepthBreak55.Text)
m_lossRate(1) = CSng(LossRate51.Text)
m_lossRate(2) = CSng(LossRate52.Text)
m_lossRate(3) = CSng(LossRate53.Text)
m_lossRate(4) = CSng(LossRate54.Text)
m_lossRate(5) = CSng(LossRate55.Text)
m_lossRate(6) = CSng(LossRate56.Text)
Case 6
m_depthBreak(1) = CSng(DepthBreak61.Text)
m_depthBreak(2) = CSng(DepthBreak62.Text)
m_depthBreak(3) = CSng(DepthBreak63.Text)
m_depthBreak(4) = CSng(DepthBreak64.Text)
m_depthBreak(5) = CSng(DepthBreak65.Text)
m_depthBreak(6) = CSng(DepthBreak66.Text)
m_lossRate(1) = CSng(LossRate61.Text)
m_lossRate(2) = CSng(LossRate62.Text)
m_lossRate(3) = CSng(LossRate63.Text)
m_lossRate(4) = CSng(LossRate64.Text)
m_lossRate(5) = CSng(LossRate65.Text)
m_lossRate(6) = CSng(LossRate66.Text)
m_lossRate(7) = CSng(LossRate67.Text)
End Select
If m_numRateLevel > 6 Or m_numRateLevel < 1 Then
bOKFlag = False
bContinueFlag = False
Else
bOKFlag = True
bContinueFlag = False
End If
Me.Hide
End Sub
Private Sub RateLevel_Change()
Dim nLevel As Integer
If RateLevel.Text = "" Then Exit Sub
nLevel = CInt(RateLevel.Text)
If nLevel > 6 Or nLevel < 1 Then
MsgBox "对不起,系统允许的等级范围为1-6级!"
RateLevel.Text = "1"
nLevel = 1
End If
bSetLevel = True
frameLoss1.Visible = False
frameLoss2.Visible = False
frameLoss3.Visible = False
frameLoss4.Visible = False
frameLoss5.Visible = False
frameLoss6.Visible = False
Select Case nLevel
Case 1
frameLoss1.Visible = True
Case 2
frameLoss2.Visible = True
Case 3
frameLoss3.Visible = True
Case 4
frameLoss4.Visible = True
Case 5
frameLoss5.Visible = True
Case 6
frameLoss6.Visible = True
End Sele
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -