frmwopcl_m.frm

来自「对ACCESS数据库的数据根据用户的选择做简单分类」· FRM 代码 · 共 2,004 行 · 第 1/5 页

FRM
2,004 行
字号
12345
       
        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
        
        cmdSave.Enabled = False
        cmdDel.Enabled = False
        cmdAdd.Enabled = False
        mnuFile.Enabled = False
        datInput.Enabled = False
        If datInput.Recordset.EOF = True Then datInput.Recordset.MoveLast
      
        datInput.Recordset.Edit
    Else
        If datInput.Recordset.RecordCount > 0 Then
                          
            datInput.Recordset.Update
                
              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
            
        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
        
            cmdDel.Enabled = True
            cmdAdd.Enabled = True
            cmdAdd.SetFocus
            cmdUpdate.Caption = "更改[&U]"
            mnuFile.Enabled = True
            datInput.Enabled = True
        
        End If
    
    End If
End Sub
Private Sub datInput_Reposition()
    SetInputRecordNumber
End Sub

Private Sub SetInputRecordNumber()
    Dim iRecordCount As Integer
    Dim iCurrentRecord As Integer
    On Error GoTo HandleSetInputErrors
    
    With datInput
          iRecordCount = .Recordset.RecordCount
          iCurrentRecord = .Recordset.AbsolutePosition + 1
    
          If .Recordset.EOF Then
             .Caption = "No more records .."
           Else
             .Caption = "Record " & iCurrentRecord & " of " & iRecordCount '状态表
             
           End If
    End With
   
    
out:
   Exit Sub
   
HandleSetInputErrors:
    If Err.Number = 94 Then
            'stMess = "不应该随意使用Null "
            'MsgBox stMess, vbExclamation, "数据库错误"
            Resume Next
        'On Error GoTo 0
   End If
   
End Sub

Private Sub Form_Load()
       
    If gstNewdatabase = "" Then gstNewdatabase = GetNewDatabase(Me)
    If gstNewdatabase = "" Then GoTo ss1 '用户没有输入数据库文件名
    
    If frmMain.mnuFileSaveAs.Enabled = False Then frmMain.mnuFileSaveAs.Enabled = True
    If frmMain.mnuFileNew.Enabled = False Then frmMain.mnuFileNew.Enabled = True

    Set db = OpenDatabase(gstNewdatabase)
    datInput.DatabaseName = gstNewdatabase
    Call SetMM_LC(Me)
    Call SetWLM_CLT
              
    On Error GoTo ss2
    With datInput
        .Refresh
        If Not .Recordset.EOF Then
            .Recordset.MoveLast
             
             def_WLM_AD = .Recordset("WLM_AD")
             def_WLM_ION = .Recordset("WLM_ION")
             def_WLM_LC = .Recordset("WLM_LC")
             def_WLM_SC = .Recordset("WLM_SC")
             
             def_WLM_CLT = .Recordset("WLM_CLT")
             def_WLM_CLTN = .Recordset("WLM_CLTN")
             def_WLM_FP = .Recordset("WLM_FP")
             def_WLM_USCN = .Recordset("WLM_USCN")
             def_WLM_USIG = .Recordset("WLM_USIG")
             def_WLM_SCN = .Recordset("WLM_SCN")
             def_WLM_SSIG = .Recordset("WLM_SSIG")
             def_WLM_SCUN = .Recordset("WLM_SCUN")
             def_WLM_CFM = .Recordset("WLM_CFM")
             def_WLM_SFN = .Recordset("WLM_SFN")
             def_WLM_EFN = .Recordset("WLM_EFN")
             def_WLM_MFN = .Recordset("WLM_MFN")
             
             Call FillCboMM_SC(Me)
            .Recordset.MoveFirst
          Else
             def_WLM_AD = ""
             def_WLM_ION = ""
             def_WLM_LC = ""
             def_WLM_SC = ""
             
             def_WLM_CLT = ""
             def_WLM_CLTN = ""
             def_WLM_FP = ""
             def_WLM_USCN = ""
             def_WLM_USIG = ""
             def_WLM_SCN = ""
             def_WLM_SSIG = ""
             def_WLM_SCUN = ""
             def_WLM_CFM = ""
             def_WLM_SFN = ""
             def_WLM_EFN = ""
             def_WLM_MFN = ""
            
        End If
    End With
    'datInput_Reposition
    
    Exit Sub
        
ss1:
        Call Form_Unload(1)
        Exit Sub
ss2:
        If Err.Number = 94 Then Resume Next
        
End Sub

Private Sub Form_Unload(Cancel As Integer)
            frmMain.Enabled = True
            'If frmSmhaC1Out = True Then Unload frmSmha_c1_out
            Unload Me
End Sub
 Sub SetWLM_CLT() '把作物表的值赋给ComboBox控件

              cboWLM_CLT.AddItem "三麦"
              cboWLM_CLT.AddItem "油菜"
              cboWLM_CLT.AddItem "蔬菜"
              cboWLM_CLT.AddItem "大棚"
End Sub
Private Sub mnuFileBack_Click()
            
            frmMain.Show
            frmMain.Enabled = True
            Unload Me
End Sub

Private Sub mnuFilePrintWord_Click() '打印窗体上正在显示的内容
     On Error GoTo mnuCreateWordApplication
     
    '如果WordAPp不存在，则建立
     If WordAPp.Visible = False Then
    '定义WORD文件
            Set WordAPp = New Word.Application
            WordAPp.Visible = True
                            'WordAPp.Documents.Open FileName:="C:\My Documents\Sales.doc"
            WordAPp.Documents.Add
            Set Doc = WordAPp.ActiveDocument
            Set Sel = WordAPp.Selection
     End If
     
     Sel.Paragraphs.Alignment = wdAlignParagraphCenter '本单元排列居中
     Sel.Font.Name = "仿宋_GB2312"
     Sel.Font.Size = 20
     Sel.Font.Bold = True
     Sel.TypeText Text:="江苏省农作物遥感监测报告"
     
      '定义表头
     Sel.Font.Size = 15
     Sel.TypeText Text:=Chr(10)
     Sel.TypeText Text:=Chr(10)
     Sel.Font.Bold = False
     Sel.Paragraphs.Alignment = wdAlignParagraphLeft '本单元排列居左
     Sel.Font.Name = "楷体_GB2312"
     
     Sel.TypeText Text:="报告日期:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_AD
     
     Sel.TypeText Text:=Space(10)
     Sel.TypeText Text:="影象轨道:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_ION
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="市:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtMM_LC
     Sel.TypeText Text:=Space(5)
     Sel.TypeText Text:="县:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtMM_SC
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="调查数据（万亩/公顷）：麦:" ' "油菜:" & Space(10) & " 蔬菜:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_WGDM & "/" & txtWLM_WGDH
     Sel.TypeText Text:=Space(2) & "油菜:" '& Space(10) & " 蔬菜:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_OGDM & "/" & txtWLM_OGDH
     Sel.TypeText Text:=Space(2) & " 蔬菜:"
     Sel.TypeText Text:=txtWLM_VGDM & "/" & txtWLM_VGDH
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="分类类型："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_CLT
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="分类号：" '& Space(20) & "文件位置："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_CLTN
     Sel.TypeText Text:=Space(5) & "文件位置："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_FP
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="非监督分类数：" ' & Space(20) & "SIG文件名："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_USCN
     Sel.TypeText Text:=Space(5) & "SIG文件名："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_USIG
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="监督分类数："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SCN
     Sel.TypeText Text:=Space(5) & "SIG文件名："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SSIG
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="含非监督类："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SCUN
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="非矢量面积：" '& Space(20) & "矢量面积：" & Space(20) & "误差："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_UUVA
     Sel.TypeText Text:=Space(5) & "矢量面积："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SVA
     Sel.TypeText Text:=Space(5) & "误差："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="聚类文件名："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_CFM
     Sel.TypeText Text:=Space(5) & "矢量面积："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_CFVA
     Sel.TypeText Text:=Space(5) & "误差："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_CFVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="过滤文件名："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SFN
     Sel.TypeText Text:=Space(5) & "矢量面积："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SFVA
     Sel.TypeText Text:=Space(5) & "误差："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SFVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="去除文件名："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_EFN
     Sel.TypeText Text:=Space(5) & "矢量面积："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_EFVA
     Sel.TypeText Text:=Space(5) & "误差："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_EFVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="人工编辑文件名："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_MFN
     Sel.TypeText Text:=Space(5) & "矢量面积："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_MFVA
     Sel.TypeText Text:=Space(5) & "误差："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_MFVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="细小地物数："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SON
     Sel.TypeText Text:=Space(5) & "遥感面积："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SOVA
     Sel.TypeText Text:=Space(5) & "误差："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SOVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:=Space(22) & "合万亩："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SOVAM
     Sel.TypeText Text:=Space(5) & "误差："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SOVAME
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="建议下次分类数："
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=txtWLM_SNCN
     Sel.TypeText Text:=Chr(10)
     
     Sel.Paragraphs.Alignment = wdAlignParagraphRight '本单元排列居右
     Sel.TypeText Text:="报告人：孙玲"
     Sel.TypeText Text:=
12345

frmwopcl_m.frm - 源码说明

本页面展示了「对ACCESS数据库的数据根据用户的选择做简单分类」中的 frmwopcl_m.frm 源码文件，采用 FRM 编程语言编写，共 2,004 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与ACCESS相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?