frmdbtabvalve.frm

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

      BeginProperty Column03 
         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 Column04 
         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 Column05 
         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 Column06 
         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 
            ColumnWidth     =   1005.165
         EndProperty
         BeginProperty Column01 
            ColumnWidth     =   1395.213
         EndProperty
         BeginProperty Column02 
            ColumnWidth     =   1395.213
         EndProperty
         BeginProperty Column03 
            ColumnWidth     =   1995.024
         EndProperty
         BeginProperty Column04 
            ColumnWidth     =   1005.165
         EndProperty
         BeginProperty Column05 
            ColumnWidth     =   1005.165
         EndProperty
         BeginProperty Column06 
            ColumnWidth     =   3000.189
         EndProperty
      EndProperty
   End
   Begin VB.Image Print 
      Height          =   345
      Left            =   120
      Picture         =   "frmDBTabValve.frx":0329
      Stretch         =   -1  'True
      ToolTipText     =   "打印报表"
      Top             =   60
      Width           =   360
   End
End
Attribute VB_Name = "frmDBTabValve"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Com As ADODB.Command
Private strSQLTime As String
Private strSQLName As String
Private strSQL As String

Private Sub Check1_Click()
If Check1.Value = 1 Then
    DTPicker1.Enabled = False
Else
    DTPicker1.Enabled = True
End If
Command1_Click
End Sub

Private Sub Combo1_Change()
    strSQLName = Combo1.Text
End Sub

Private Sub Combo1_Click()
    strSQLName = Combo1.Text
    
End Sub

Private Sub Command1_Click()
Dim MyStrName As String
On Error GoTo RefreshErr

If Combo1.Text = "" Or Combo1.Text = "所有阀" Then
    If Check1.Value = 1 Then
        '所有阀,所有时间
        LabShowStart.Caption = "所有阀所有时间的灌溉记录"
        strSQL = "select * from DBTabValve "
        datPrimaryRS.RecordSource = strSQL

        datPrimaryRS.Refresh
        datPrimaryRS.Recordset.Sort = "VID"
        Exit Sub
    Else
        '所有阀,选定时间
        LabShowStart.Caption = "所有阀在" & Format(DTPicker1.Value, "yyyy年m月d日") & "的灌溉记录"
         strSQL = "select * from DBTabValve WHERE 日期 = #" & Format(DTPicker1.Value, "yyyy-m-d") & "#"
        datPrimaryRS.RecordSource = strSQL
        datPrimaryRS.Refresh
        datPrimaryRS.Recordset.Sort = "VID"
        Exit Sub
    End If
Else
    If Check1.Value = 1 Then
        '选定阀,所有时间
        LabShowStart.Caption = strSQLName & "在所有时间的灌溉记录"
        strSQL = "select * from DBTabValve WHERE 器件名='" & strSQLName & "'"
        datPrimaryRS.RecordSource = strSQL
        datPrimaryRS.Refresh
        Exit Sub
    Else
        '所有阀，所有时间
        LabShowStart.Caption = strSQLName & Format(DTPicker1.Value, "yyyy年m月d日") & "的灌溉记录"
        strSQL = "select * from DBTabValve WHERE 器件名='" & strSQLName & "'and 日期 = #" & Format(DTPicker1.Value, "yyyy-m-d") & "#"
        datPrimaryRS.RecordSource = strSQL
        datPrimaryRS.Refresh
        Exit Sub
    End If
End If
RefreshErr:
  MsgBox Err.Description
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 9
    Combo1.AddItem FrmMain.MyValve(I).TitlName
Next
    Combo1.TopIndex = 0
    Combo1.Text = "所有阀"
    Command1_Click
End Sub

Private Sub Form_Resize()
  On Error Resume Next
'  SetWindowPos frmDBTabValve.hwnd, -1, 0, 0, 0, 0, &H1 Or &H2
  grdDataGrid.Top = Combo1.Height + 100
  grdDataGrid.Height = Me.ScaleHeight - Combo1.Height - Picture1.Height - 100 ' datPrimaryRS.Height
  Picture1.Top = Me.Height - Picture1.Height - 300
  grdDataGrid.Left = 0
  grdDataGrid.Width = Me.Width - 150
  datPrimaryRS.Recordset.Sort = "VID"
  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 Print_Click()
PrintDay datPrimaryRS.Recordset, LabShowStart.Caption
End Sub