📄 frmwopcl_m.frm
字号:
Index = 3
Left = 3240
TabIndex = 14
Top = 960
Width = 735
End
Begin VB.Label txtMM_SC
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
DataField = "WLM_SC"
DataSource = "datInput"
Height = 255
Left = 4200
TabIndex = 13
Top = 960
Width = 975
End
Begin VB.Label Label2
Caption = "大市:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 2
Left = 240
TabIndex = 11
Top = 960
Width = 735
End
Begin VB.Label txtMM_LC
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
DataField = "WLM_LC"
DataSource = "datInput"
Height = 255
Left = 1080
TabIndex = 10
Top = 960
Width = 975
End
Begin VB.Label Label2
Caption = "影象轨道:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 3720
TabIndex = 6
Top = 600
Width = 1095
End
Begin VB.Label Label2
Caption = "处理日期:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 240
TabIndex = 5
Top = 600
Width = 1095
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "三麦油菜面积遥感监测分析系统"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 15
Left = 480
TabIndex = 4
Top = 0
Width = 4935
End
Begin VB.Shape Shape1
Height = 615
Left = 480
Top = 7560
Width = 5535
End
Begin VB.Menu mnuFile
Caption = "文件[&F]"
Begin VB.Menu mnuPrint
Caption = "打印"
Begin VB.Menu mnuFilePrintWord
Caption = "&Word"
End
End
Begin VB.Menu mnuFileBack
Caption = "退出[&E]"
End
End
End
Attribute VB_Name = "frmWOPCL_M"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim def_WLM_AD, def_WLM_ION, def_WLM_LC, def_WLM_SC As String
Dim def_WLM_CLT, def_WLM_CLTN, def_WLM_FP, def_WLM_USCN, def_WLM_USIG, def_WLM_SCN, def_WLM_SSIG As String
Dim def_WLM_SCUN, def_WLM_CFM, def_WLM_SFN, def_WLM_EFN, def_WLM_MFN As String
Dim i, j As Integer
'Dim RecordSelect1 As Recordset
Private Sub cboMM_LC_Click()
If cboMM_LC.ListIndex >= 0 Then
txtMM_LC = cboMM_LC.Text
End If
Call FillCboMM_SC(Me)
End Sub
Private Sub cboMM_SC_Click()
If cboMM_SC.ListIndex >= 0 Then
txtMM_SC = cboMM_SC.Text
End If
End Sub
Private Sub cboWLM_CLT_Click()
If cboWLM_CLT.ListIndex >= 0 Then
txtWLM_CLT = cboWLM_CLT.Text
End If
End Sub
Private Sub cmdAdd_Click()
On Error GoTo HandleAddErrors
If cmdAdd.Caption = "增加[&A]" Then
datInput.Recordset.AddNew
txtWLM_AD.Enabled = True
txtWLM_ION.Enabled = True
cboMM_LC.Enabled = True
cboMM_SC.Enabled = True
txtWLM_WGDM.Enabled = True
txtWLM_OGDM.Enabled = True
txtWLM_VGDM.Enabled = True
cboWLM_CLT.Enabled = True
txtWLM_CLTN.Enabled = True
txtWLM_FP.Enabled = True
txtWLM_USCN.Enabled = True
txtWLM_USIG.Enabled = True
txtWLM_SCN.Enabled = True
txtWLM_SSIG.Enabled = True
txtWLM_SCUN.Enabled = True
txtWLM_UUVA.Enabled = True
txtWLM_SVA.Enabled = True
txtWLM_CFM.Enabled = True
txtWLM_CFVA.Enabled = True
txtWLM_SFN.Enabled = True
txtWLM_SFVA.Enabled = True
txtWLM_EFN.Enabled = True
txtWLM_EFVA.Enabled = True
txtWLM_MFN.Enabled = True
txtWLM_MFVA.Enabled = True
txtWLM_SON.Enabled = True
txtWLM_SOVA.Enabled = True
txtWLM_DES.Enabled = True
'********** Setup Intilization *********
txtWLM_AD = def_WLM_AD
txtWLM_ION = def_WLM_ION
txtMM_LC = def_WLM_LC
txtMM_SC = def_WLM_SC
txtWLM_CLT = def_WLM_CLT
txtWLM_CLTN = def_WLM_CLTN
txtWLM_FP = def_WLM_FP
txtWLM_USCN = def_WLM_USCN
txtWLM_USIG = def_WLM_USIG
txtWLM_SCN = def_WLM_SCN
txtWLM_SSIG = def_WLM_SSIG
txtWLM_SCUN = def_WLM_SCUN
txtWLM_CFM = def_WLM_CFM
txtWLM_SFN = def_WLM_SFN
txtWLM_EFN = def_WLM_EFN
txtWLM_MFN = def_WLM_MFN
'***************************************
cmdUpdate.Enabled = False
cmdSave.Enabled = True
cmdDel.Enabled = False
cmdAdd.Caption = "取消[&C]"
mnuFile.Enabled = False
datInput.Enabled = False
Else
datInput.Recordset.CancelUpdate
datInput.Enabled = True
txtWLM_AD.Enabled = False
txtWLM_ION.Enabled = False
cboMM_LC.Enabled = False
cboMM_SC.Enabled = False
txtWLM_WGDM.Enabled = False
txtWLM_OGDM.Enabled = False
txtWLM_VGDM.Enabled = False
cboWLM_CLT.Enabled = False
txtWLM_CLTN.Enabled = False
txtWLM_FP.Enabled = False
txtWLM_USCN.Enabled = False
txtWLM_USIG.Enabled = False
txtWLM_SCN.Enabled = False
txtWLM_SSIG.Enabled = False
txtWLM_SCUN.Enabled = False
txtWLM_UUVA.Enabled = False
txtWLM_SVA.Enabled = False
txtWLM_CFM.Enabled = False
txtWLM_CFVA.Enabled = False
txtWLM_SFN.Enabled = False
txtWLM_SFVA.Enabled = False
txtWLM_EFN.Enabled = False
txtWLM_EFVA.Enabled = False
txtWLM_MFN.Enabled = False
txtWLM_MFVA.Enabled = False
txtWLM_SON.Enabled = False
txtWLM_SOVA.Enabled = False
txtWLM_DES.Enabled = False
cmdUpdate.Enabled = True
cmdSave.Enabled = False
cmdDel.Enabled = True
cmdAdd.Caption = "增加[&A]"
mnuFile.Enabled = True
cmdAdd.SetFocus
End If
cmdadd_Click_Exit:
Exit Sub
HandleAddErrors:
Dim stmess As String
stmess = "Cannot complete operation. " & vbCrLf & vbCrLf & Err.Description
MsgBox stmess, vbExclamation, "Database Error"
On Error GoTo 0 ' turn off error trapping
End Sub
Private Sub cmdDel_Click()
Dim iResp As Integer
On Error GoTo HandleDelErrors
If datInput.Recordset.RecordCount > 0 Then
iResp = MsgBox("删除当前记录？", vbYesNo, "删除记录")
If iResp = vbYes Then
With datInput.Recordset
.Delete 'delete current record
.MoveNext 'move to following recoId
If .EOF Then
.MovePrevious
If .BOF Then
MsgBox "记录为空. ", vbInformation, "没有记录"
End If
End If
End With
End If
Else
MsgBox "No records to delete. ", vbExclamation, " Delete Event'"
End If
cmdDel_Click_Exit:
Exit Sub
HandleDelErrors:
Dim stMsg As String
If Err.Number = 3426 Then
Resume Next 'On Error GoTo 0 '
Else
stMsg = "Cannot complete operation." & vbCrLf & vbCrLf & Err.Description
MsgBox stMsg, vbExclamation, "Database Error "
On Error GoTo 0 ' turn off error trapping
End If
End Sub
Private Sub cmdSave_Click()
'save the current record
On Error GoTo HandleSaveErrors
txtWLM_AD.Enabled = False
txtWLM_ION.Enabled = False
cboMM_LC.Enabled = False
cboMM_SC.Enabled = False
txtWLM_WGDM.Enabled = False
txtWLM_OGDM.Enabled = False
txtWLM_VGDM.Enabled = False
cboWLM_CLT.Enabled = False
txtWLM_CLTN.Enabled = False
txtWLM_FP.Enabled = False
txtWLM_USCN.Enabled = False
txtWLM_USIG.Enabled = False
txtWLM_SCN.Enabled = False
txtWLM_SSIG.Enabled = False
txtWLM_SCUN.Enabled = False
txtWLM_UUVA.Enabled = False
txtWLM_SVA.Enabled = False
txtWLM_CFM.Enabled = False
txtWLM_CFVA.Enabled = False
txtWLM_SFN.Enabled = False
txtWLM_SFVA.Enabled = False
txtWLM_EFN.Enabled = False
txtWLM_EFVA.Enabled = False
txtWLM_MFN.Enabled = False
txtWLM_MFVA.Enabled = False
txtWLM_SON.Enabled = False
txtWLM_SOVA.Enabled = False
txtWLM_DES.Enabled = False
If txtMM_LC = "" Or txtMM_SC = "" Or txtWLM_CLT = "" Then
MsgBox "You must input all data before saving. ", vbExclamation, "Add Event"
datInput.Recordset.CancelUpdate
Else
def_WLM_AD = txtWLM_AD
def_WLM_ION = txtWLM_ION
def_WLM_LC = txtMM_LC
def_WLM_SC = txtMM_SC
def_WLM_CLT = txtWLM_CLT
def_WLM_CLTN = txtWLM_CLTN
def_WLM_FP = txtWLM_FP
def_WLM_USCN = txtWLM_USCN
def_WLM_USIG = txtWLM_USIG
def_WLM_SCN = txtWLM_SCN
def_WLM_SSIG = txtWLM_SSIG
def_WLM_SCUN = txtWLM_SCUN
def_WLM_CFM = txtWLM_CFM
def_WLM_SFN = txtWLM_SFN
def_WLM_EFN = txtWLM_EFN
def_WLM_MFN = txtWLM_MFN
datInput.Recordset.Update
datInput.Recordset.MoveLast
End If
cmdSave.Enabled = False
cmdUpdate.Enabled = True
cmdDel.Enabled = True
cmdAdd.Caption = "增加[&A]"
mnuFile.Enabled = True
datInput.Enabled = True
cmdAdd.SetFocus
cmdSave_C1ick_Exit:
Exit Sub
HandleSaveErrors:
Dim stmess As String
Select Case Err.Number
Case 3022 ' duplicate key field
stmess = "这个类型已经存在 "
MsgBox stmess, vbExclamation, "数据库错误"
Resume Next
'On Error GoTo 0 ' turn off error trapping
Case 3058, 3315 'no entry in key field
stmess = "Select a txtRMEANa and a txtRMEANs and a txtESCN and a txtEST before saving. "
MsgBox stmess, vbExclamation, "数据库错误"
On Error GoTo 0 ' turn off error trapping
Case Else
stmess = "Record could not be saved." & vbCrLf & Err.Description
MsgBox stmess, vbExclamation, "数据库错误"
datInput.Recordset.CancelUpdate
Resume Next
End Select
End Sub
Private Sub cmdUpdate_Click()
If cmdUpdate.Caption = "更改[&U]" And datInput.Recordset.RecordCount > 0 Then
cmdUpdate.Caption = "存储[&S]"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -