gdhtrainrule.frm

齐鲁石化某分公司的数据采集管理系统

      Height          =   5775
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   10335
      _ExtentX        =   18230
      _ExtentY        =   10186
      _Version        =   393216
      AllowUpdate     =   0   'False
      HeadLines       =   1
      RowHeight       =   19
      AllowDelete     =   -1  'True
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         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 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "gdhTrainrule"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim adoConnect As New ADODB.Connection
Dim adoRec As New ADODB.Recordset

Private Sub Command1_Click()
    Dim db As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim Query As String
    Dim str_Path As String
    
    If Text2(0).text = "" Then Exit Sub
    str_Path = App.Path & "\admin.mdb"
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & str_Path & ";Jet OLEDB:Database Password=dfrwadmin;"
    
    Query = "select * from trainrule where  val(" & Text2(0).text & ")<=val(终止车号) and val(" & Text2(0).text & ")>=val(起始车号)"
'    query = "select * from trainrule where 终止车号>= '" & Text2(0).text & "' and 起始车号<= '" & Text2(0).text & "'"
    
    rs.Open Query, db, adOpenDynamic, adLockOptimistic
    Set MSHFlexGrid1.DataSource = rs
    
    rs.Close
    db.Close
    
End Sub

Private Sub Command2_Click()
    Dim db As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim Query As String
    Dim str_Path As String
    
    If Text2(1).text = "" Then Exit Sub
    str_Path = App.Path & "\admin.mdb"
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & str_Path & ";Jet OLEDB:Database Password=dfrwadmin;"
    
'    query = "select * from trainrule where  val(" & Text2(0).text & ")<=val(终止车号) and val(" & Text2(0).text & ")>=val(起始车号)"
    If Check1.Value = 1 Then
        Query = "select * from trainrule where 车型 like '" & Text2(1).text & "%'"
    Else
        Query = "select * from trainrule where 车型 = '" & Text2(1).text & "'"
    End If
    rs.Open Query, db, adOpenDynamic, adLockOptimistic
    Set MSHFlexGrid1.DataSource = rs
    
    rs.Close
    db.Close
End Sub

Private Sub Command3_Click()
    Dim db As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim Query As String
    Dim str_Path As String
    Dim MaxNum As Integer
    
    On Error GoTo ok
    
    If Text3(0).text = "" Then Exit Sub
    str_Path = App.Path & "\admin.mdb"
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & str_Path & ";Jet OLEDB:Database Password=dfrwadmin;"
    
    Query = "select 序号 from trainrule order by 序号 ASC"
    rs.Open Query, db, adOpenDynamic, adLockOptimistic
    If Not rs.EOF And Not rs.BOF Then
        rs.MoveLast
        MaxNum = rs.Fields("序号") + 1
    Else
        MaxNum = MaxNum + 1
    End If
    rs.Close
    
'    query = "select * from trainrule where  val(" & Text2(0).text & ")<=val(终止车号) and val(" & Text2(0).text & ")>=val(起始车号)"
    Query = "select * from trainrule where 车型='" & Text3(0).text & "' and 终止车号= '" & Text3(4).text & "' and 起始车号= '" & Text3(3).text & "'"
    rs.Open Query, db, adOpenDynamic, adLockOptimistic
    
    If Not rs.EOF And Not rs.EOF Then
        MsgBox "数据库中已经存在次记录,请不要重复添加"
        rs.Close
        db.Close
        Exit Sub
    End If
    
    rs.AddNew
    rs.Fields("序号") = MaxNum
    rs.Fields("车型") = Text3(0).text
    rs.Fields("标重") = Text3(1).text
    rs.Fields("皮重") = Text3(2).text
    rs.Fields("起始车号") = Text3(3).text
    rs.Fields("终止车号") = Text3(4).text
    rs.Fields("客货标志") = Text3(5).text
    rs.Update
    rs.Close
    db.Close
    adoRec.Close
    adoConnect.Close
    Call ADO_Access2000(DataGrid1)
    Label3.Caption = MaxNum
    MsgBox "添加成功"
    Exit Sub
ok:
    
End Sub

Private Sub Command4_Click()
    If Command4.Caption = "开启修改" Then
        Command4.Caption = "关闭修改"
        DataGrid1.AllowUpdate = True
    ElseIf Command4.Caption = "关闭修改" Then
        Command4.Caption = "开启修改"
        DataGrid1.AllowUpdate = False
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then Unload Me
End Sub

Private Sub Form_Load()
    
    Dim str_Path As String
    Dim X0 As Long
    Dim Y0 As Long
    
    X0 = Screen.Width
    Y0 = Screen.Height
    X0 = (X0 - Me.Width) / 2
    Y0 = (Y0 - Me.Height) / 2
    Me.Move X0, 1550
    
    
    Call ADO_Access2000(DataGrid1)
'    Debug.Print DBGrid1.Columns(0)
    MSHFlexGrid1.ColWidth(0) = 700
    
End Sub

Function Read_Trainrule()
    
'    Dim Query As String
'
'    Query = "select distinct(车型),自重,标重 from trainrule order by 车型 ASC"
'    Query = "select * from trainrule order by 车型 ASC"
''    Data1.connect = ";   pwd=dfrwgdh"
'    Data1.DatabaseName = App.Path & "\db.mdb"
'
'    Data1.RecordSource = Query
'    Data1.Refresh
'
'    DBGrid1.Refresh
End Function

Function ADO_Access2000(GD As DataGrid)
    Dim str_Path As String
    Dim Query As String
    
    str_Path = App.Path & "\admin.mdb"
    adoConnect.CursorLocation = adUseClient
    adoConnect.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & str_Path & ";Jet OLEDB:Database Password=dfrwadmin;"
    
    Query = "select * from trainrule order by 序号 ASC"
    
'    Set adoRec = New ADODB.Recordset
    adoRec.Open Query, adoConnect, adOpenDynamic, adLockOptimistic
    
    Set GD.DataSource = adoRec
   
    adoRec.MoveLast
    GD.Refresh

'    adoRec.Close
'    adoConnect.Close
'    Set adoRec = Nothing
'    Set adoConnect = Nothing
End Function

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
'    gdhMain.Enabled = True
    Set adoRec = Nothing
    Set adoConnect = Nothing
    adoRec.Close
    adoConnect.Close
End Sub


Private Sub MSHFlexGrid1_DblClick()
    Dim temp As Integer
    Dim Query As String
    Dim mark As Variant
    temp = Int(MSHFlexGrid1.TextMatrix(MSHFlexGrid1.row, 0))
    Query = ""
    adoRec.Requery
    adoRec.Find "序号=" & temp & "" ', 1, adSearchBackward, mark
    
End Sub

Private Sub Text2_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Index = 0 Then Call Command1_Click
        If Index = 1 Then Call Command2_Click
    End If
End Sub