frm泵日表.frm

VISUAL BASIC 6 实现的自动化控制系统程序. 里面包含了好几个OCX源代码.我5年前的作品.现在看起来有点垃圾了.

      EndProperty
      BeginProperty Column02 
         DataField       =   "日期"
         Caption         =   "日  期"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   1
            Format          =   "yyyy""年""M""月""d""日"""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column03 
         DataField       =   "用水量"
         Caption         =   "用水量"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   1
            Format          =   "0.0"
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column04 
         DataField       =   "费用"
         Caption         =   "费    用"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   1
            Format          =   """￥""#,##0.00"
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column05 
         DataField       =   "备   注"
         Caption         =   "备   注"
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
            Object.Visible         =   0   'False
            ColumnWidth     =   1005.165
         EndProperty
         BeginProperty Column01 
            ColumnWidth     =   1005.165
         EndProperty
         BeginProperty Column02 
            ColumnWidth     =   1500.095
         EndProperty
         BeginProperty Column03 
            ColumnWidth     =   1005.165
         EndProperty
         BeginProperty Column04 
            ColumnWidth     =   1500.095
         EndProperty
         BeginProperty Column05 
            ColumnWidth     =   2085.166
         EndProperty
      EndProperty
   End
   Begin MSComCtl2.DTPicker DTPicker1 
      Height          =   345
      Left            =   1380
      TabIndex        =   12
      Top             =   180
      Width           =   2145
      _ExtentX        =   3784
      _ExtentY        =   609
      _Version        =   393216
      CustomFormat    =   "yyyy年mm月dd日"
      Format          =   24772608
      CurrentDate     =   36980
   End
End
Attribute VB_Name = "frm泵日表"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private strSQLTime As String
Private strSQLName As String
Private strSQL As String
Private SelectIndex As Integer
Private SelectTab As String
Private SelectTime As String
Private TipStringTime As String
Private TipStringTime1 As String

'是否选择全部日期
Private Sub Check1_Click()
If Check1.Value = 1 Then
    DTPicker1.Enabled = False
Else
    DTPicker1.Enabled = True
End If
Select Case SelectTab
Case "泵日表"
    Cmdpump_Click 0
Case "泵月表"
    Cmdpump_Click 1
Case "泵年表"
    Cmdpump_Click 2
End Select
End Sub

Private Sub Cmdpump_Click(Index As Integer)
Dim I As Integer

    DTPicker1.UpDown = False
For I = 0 To 4
    CmdPump(I).Enabled = True
Next

CmdPump(Index).Enabled = False

If Index <= 2 Then SelectCountIndex = Index
Select Case Index
Case 0
    SelectTab = "泵日表"
    TipStringTime = "天"
    TipStringTime1 = CStr(Format(DTPicker1.Value, "yyyy年m月d日"))
    
    SelectTime = "#" & CStr(Format(DTPicker1.Value, "yyyy-m-d")) & "#"
    grdDataGrid.Columns(2).NumberFormat = "yyyy年m月d日"
    grdDataGrid.Columns(2).Width = 2000
    
    DTPicker1.Format = dtpLongDate
        
    WorkOut SelectTab, SelectTime
    

Case 1
    SelectTab = "泵月表"
    TipStringTime = "月"
    grdDataGrid.Columns(2).Width = 1600
    SelectTime = "#" & CStr(Format(DTPicker1.Value, "yyyy-m")) & "#"
    TipStringTime1 = CStr(Format(DTPicker1.Value, "yyyy年m月"))
    grdDataGrid.Columns(2).NumberFormat = "yyyy年mm月"

    DTPicker1.Format = dtpLongDate
    
    WorkOut SelectTab, SelectTime

Case 2
    SelectTab = "泵年表"
    TipStringTime = "年"
    TipStringTime1 = CStr(Format(DTPicker1.Value, "yyyy年"))
    grdDataGrid.Columns(2).Width = 1000
    SelectTime = "'" & CStr(Format(DTPicker1.Value, "yyyy")) & "年'"
    DTPicker1.UpDown = True
    WorkOut SelectTab, SelectTime

Case 3  '阀门统计

    Unload Me
    frm阀日表.Show
Case 4  '打印

    MsgBox "打印"
    
    DoPrint datPrimaryRS.Recordset, StatusBar1.Panels.Item(1).Text
    
Case 5 '退回到主界面
    Unload Me

End Select

End Sub

Private Sub Combo1_Change()
    strSQLName = Combo1.Text
Select Case SelectTab
Case "泵日表"
    Cmdpump_Click 0
Case "泵月表"
    Cmdpump_Click 1
Case "泵年表"
    Cmdpump_Click 2
End Select
End Sub

Private Sub Combo1_Click()
    strSQLName = Combo1.Text
Select Case SelectTab
Case "泵日表"
    Cmdpump_Click 0
Case "泵月表"
    Cmdpump_Click 1
Case "泵年表"
    Cmdpump_Click 2
End Select
End Sub

Private Sub WorkOut(mSelectTab As String, mSelectTime As String)
Dim MyStrName As String


On Error GoTo RefreshErr

If Combo1.Text = "" Or Combo1.Text = "所有泵" Then
    If Check1.Value = 1 Then
        '所有泵,所有时间
        StatusBar1.Panels.Item(1).Text = "所有泵各" & TipStringTime & "的灌溉记录"
        strSQL = "select * from " & mSelectTab
        datPrimaryRS.RecordSource = strSQL
        datPrimaryRS.Refresh
        datPrimaryRS.Recordset.Sort = "PID"
        Exit Sub
    Else
        '所有泵,选定时间
        StatusBar1.Panels.Item(1).Text = TipStringTime1 & "所有泵" & "的灌溉记录"
         strSQL = "select * from " & mSelectTab & " WHERE 日期 =" & mSelectTime
        datPrimaryRS.RecordSource = strSQL
        datPrimaryRS.Refresh
        datPrimaryRS.Recordset.Sort = "PID"
        Exit Sub
    End If
Else
    If Check1.Value = 1 Then
        '选定泵,所有时间
        StatusBar1.Panels.Item(1).Text = strSQLName & "各" & TipStringTime & "的灌溉记录"
        strSQL = "select * from " & mSelectTab & " WHERE 器件名='" & strSQLName & "'"
        datPrimaryRS.RecordSource = strSQL
        datPrimaryRS.Refresh
        Exit Sub
Else
        '选定泵，选定时间
        StatusBar1.Panels.Item(1).Text = TipStringTime1 & "，" & strSQLName & "的灌溉记录"
        strSQL = "select * from " & mSelectTab & " WHERE 器件名='" & strSQLName & "'and 日期 =" & mSelectTime
        datPrimaryRS.RecordSource = strSQL
        datPrimaryRS.Refresh
        Exit Sub
    End If
End If
RefreshErr:
  MsgBox Err.Description
End Sub

Private Sub Command1_Click()
Select Case SelectTab
Case "泵日表"
    Cmdpump_Click 0
Case "泵月表"
    Cmdpump_Click 1
Case "泵年表"
    Cmdpump_Click 2
End Select
End Sub

Private Sub DTPicker1_Change()

Select Case SelectTab
Case "泵日表"
    Cmdpump_Click 0
Case "泵月表"
    Cmdpump_Click 1
Case "泵年表"
    Cmdpump_Click 2
End Select

End Sub

Private Sub DTPicker1_CloseUp()
    strSQLTime = DTPicker1.Value
    '查询按扭
    Command1_Click
End Sub

Private Sub Form_Load()
DTPicker1.Value = Now
Dim I As Integer
    Combo1.AddItem "所有泵"
    Check1.Value = 1
    DTPicker1.Enabled = False
For I = 0 To 1
    Combo1.AddItem FrmMain.MyPump(I).TitlName
Next
    Combo1.TopIndex = 0
    Combo1.Text = "所有泵"
    Cmdpump_Click (SelectCountIndex)
End Sub

Private Sub Form_Resize()
  On Error Resume Next
'  SetWindowPos frmDBTabpump.hwnd, -1, 0, 0, 0, 0, &H1 Or &H2
  grdDataGrid.Height = Me.ScaleHeight - datPrimaryRS.Height - 1000
  grdDataGrid.Width = Me.ScaleWidth - 1500
  datPrimaryRS.Recordset.Sort = "PID"
  strSQLTime = DTPicker1.Value
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
  '错误处理程序代码置于此处
  '想要捕获它们，在此添加代码以处理它们
  MsgBox "Data error event hit err:" & Description
End Sub

'Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'  '验证代码置于此处
'  '下列动作发生时该事件被调用
'  Dim bCancel As Boolean
'
'  Select Case adReason
'  Case adRsnAddNew
'  Case adRsnClose
'  Case adRsnDelete
'  Case adRsnFirstChange
'  Case adRsnMove
'  Case adRsnRequery
'  Case adRsnResynch
'  Case adRsnUndoAddNew
'  Case adRsnUndoDelete
'  Case adRsnUndoUpdate
'  Case adRsnUpdate
'  End Select
'
'  If bCancel Then adStatus = adStatusCancel
'End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr

  datPrimaryRS.Recordset.UpdateBatch adAffectAll
  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub