frm_main.frm

卧虎山水库监测管理程序：包含实时数据浏览、历史数据浏览以及曲线绘制

      Begin VB.Menu M_F_Backup 
         Caption         =   "数据库备份"
      End
      Begin VB.Menu M_F_Imp 
         Caption         =   "数据库恢复"
      End
      Begin VB.Menu M_1 
         Caption         =   "-"
      End
      Begin VB.Menu M_F_Exit 
         Caption         =   "退  出(&E)"
      End
   End
   Begin VB.Menu M_View 
      Caption         =   "视  图 (&V)"
      Begin VB.Menu M_V_Pic 
         Caption         =   "水库图片"
      End
      Begin VB.Menu M_2 
         Caption         =   "-"
      End
      Begin VB.Menu M_V_NewD 
         Caption         =   "实时数据"
      End
   End
   Begin VB.Menu M_Query 
      Caption         =   "查  询 (&Q)"
      Begin VB.Menu M_Q_SW 
         Caption         =   "数据查询"
      End
      Begin VB.Menu M_67 
         Caption         =   "-"
      End
      Begin VB.Menu M_G_SW 
         Caption         =   "曲线查询"
      End
   End
   Begin VB.Menu M_Imp 
      Caption         =   "录  入 (&I)"
      Begin VB.Menu M_I_Imp 
         Caption         =   "数据录入"
      End
   End
   Begin VB.Menu M_PSet 
      Caption         =   "设  置 (&S)"
      Begin VB.Menu M_SKSet 
         Caption         =   "水库基本信息"
      End
      Begin VB.Menu M_9 
         Caption         =   "-"
      End
      Begin VB.Menu M_Plot_Set 
         Caption         =   "测站设置"
      End
      Begin VB.Menu M_10 
         Caption         =   "-"
      End
      Begin VB.Menu M_User_Set 
         Caption         =   "用户设置"
      End
   End
   Begin VB.Menu M_Help 
      Caption         =   "帮  助 (&H)"
      Begin VB.Menu M_Help1 
         Caption         =   "帮助"
         Shortcut        =   {F1}
      End
      Begin VB.Menu M_About 
         Caption         =   "关于"
      End
   End
End
Attribute VB_Name = "Frm_Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub Command1_Click()
    Frm_DataQuery.Show
End Sub

Private Sub Command2_Click()
    Calendar1.Value = Now
End Sub

Private Sub Form_Load()
    Calendar1.Value = Now
    '加载数据
    Set ListView1.SmallIcons = ImageList1
    Load_ViewL ListView1
    '加载实时数据
    
    For i = 1 To ListView1.ListItems.Count
    
        Open_Data ("select top 1 * from ST_River_R where stcd='" & ListView1.ListItems(i).Text & "' order by  tm desc")
        If rs.RecordCount > 0 Then
            For j = 2 To 15
                ListView1.ListItems(i).SubItems(j) = Trim(rs.Fields(j - 1) & "")
                If j = 2 Then ListView1.ListItems(i).SubItems(j) = Format(ListView1.ListItems(i).SubItems(j), "yyyy-mm-dd hh:mm")
            Next j
        Else
        
        End If
    Next i
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    If MsgBox("确定要退出本系统吗？是/否", vbYesNo) = vbYes Then
        End
    Else
        Cancel = 1
    End If
End Sub

Private Sub M_About_Click()
    Frm_About.Show
End Sub

Private Sub M_F_Backup_Click()
On Error GoTo Err:
    Dim s As String
    Dim F_Str As String
    d = MsgBox("确实要进行数据备份？", vbOKCancel, "提示")
    If d = vbOK Then
        FileDialog.DialogTitle = "数据备份"
        FileDialog.CancelError = True
        FileDialog.ShowSave
        
        s = FileDialog.FileName
        F_Str = "backup database WaterMang to disk='" & s & " '"
        Open_Data F_Str
        MsgBox "数据备份完成!"
        Exit Sub
    End If
Err:
End Sub

Private Sub M_F_Exit_Click()
    Unload Me
End Sub

Private Sub M_F_Imp_Click()
On Error GoTo Err:
    d = MsgBox("系统将回到备份文件前的状态!确认要恢复已备份数据库吗？", vbOKCancel, "提示")
    If d = vbOK Then
        Me.MousePointer = 11

        Dim r_str As String
        Dim r_conn As ADODB.Connection
        Dim r_rs As ADODB.Recordset
        Dim r_rs1 As ADODB.Recordset

        Set r_conn = New ADODB.Connection
        Set r_rs = New ADODB.Recordset
        Set r_rs1 = New ADODB.Recordset
        Set r_comm = New ADODB.Command
        r_conn.CursorLocation = adUseClient
        r_conn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=master;"
        
        Set r_rs.ActiveConnection = r_conn
        Set r_rs1.ActiveConnection = r_conn
        FileDialog.DialogTitle = "数据恢复"
        FileDialog.CancelError = True
        FileDialog.ShowOpen
        s = FileDialog.FileName
        r_str = "select spid from master..sysprocesses where dbid=db_id('WaterMang')"
        r_rs.Open r_str
        If r_rs.RecordCount > 0 Then
            For i = 1 To r_rs.RecordCount
                r_str = "kill " & r_rs.Fields(0)
                r_rs1.Open r_str
                r_rs.MoveNext
                If r_rs.EOF Then r_rs.MoveFirst

            Next i
        End If
        r_rs.Close
        r_str = "restore database WaterMang from disk='" & s & " '"
        r_rs.Open r_str
        MsgBox "数据恢复完成,请重新启动程序!"
        Me.MousePointer = 0

        Exit Sub
    End If
Err:
    Me.MousePointer = 0

End Sub

Private Sub M_G_SW_Click()
    Frm_Quxian.Show
End Sub

Private Sub M_I_Imp_Click()
    Frm_DataLR.Show
End Sub

Private Sub M_Plot_Set_Click()
    Frm_TPSet.Show
End Sub

Private Sub M_Q_SW_Click()
    Frm_DataQuery.Show
End Sub

Private Sub M_SKSet_Click()
    Frm_InfoSet.Show
End Sub

Private Sub M_User_Set_Click()
    Frm_UserSet.Show
End Sub

Private Sub M_V_NewD_Click()
    Frm_Now.Show
End Sub

Private Sub M_V_Pic_Click()
    Frm_Piclist.Show
End Sub

Private Sub Timer1_Timer()
    Lab_Time.Caption = Format(Now, "yyyy-mm-dd hh:mm:ss")
    If Val(Hour(Now)) = 0 And Val(Minute(Now)) = 0 And Val(Second(Now)) = 1 Then
        Week_Day = Weekday(Now)
        If Week_Day = "1" Then
            Week_Day = " 星 期 日"
        ElseIf Week_Day = "2" Then
            Week_Day = " 星 期 一"
        ElseIf Week_Day = "3" Then
            Week_Day = " 星 期 二"
        ElseIf Week_Day = "4" Then
            Week_Day = " 星 期 三"
        ElseIf Week_Day = "5" Then
            Week_Day = " 星 期 四"
        ElseIf Week_Day = "6" Then
            Week_Day = " 星 期 五"
        ElseIf Week_Day = "7" Then
            Week_Day = " 星 期 六"
        End If
        Lab_Week = Week_Day
    End If

End Sub

Private Sub TooB_M_Bar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "B_Pic"
            Frm_Piclist.Show
        Case "B_NData"
            Frm_Now.Show
        Case "B_PQuery"
            Frm_DataQuery.Show
        Case "B_Line"
            Frm_Quxian.Show
        Case "B_Help"
            Frm_About.Show
        Case "B_Exit"
            Unload Me
    End Select
End Sub

Private Sub TooB_M_Bar_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    Select Case ButtonMenu.Key
        Case "B_SK"
            Frm_InfoSet.Show
        Case "B_CZ"
            Frm_TPSet.Show
        Case "B_User"
            Frm_UserSet.Show
    End Select
End Sub

Public Sub Load_ViewL(LisV As ListView)
    LisV.ListItems.Clear
    Open_Data ("select STCD,STNM from ST_STBPRP_B order by STCD")
    If rs.RecordCount > 0 Then
        rs.MoveFirst
        While Not rs.EOF
            Set ite = LisV.ListItems.Add(, , rs.Fields(0))
                ite.SubItems(1) = rs.Fields(1)
            rs.MoveNext
        Wend
    
    End If
   
End Sub