frmcaryylr.frm

来自「用VB开发的车辆数据库管理系统」· FRM 代码 · 共 572 行 · 第 1/2 页

      Height          =   330
      Left            =   1845
      Picture         =   "frmcarYYlr.frx":1D2BC
      Stretch         =   -1  'True
      Top             =   1635
      Width           =   900
   End
   Begin VB.Image Imgupdate 
      Height          =   330
      Left            =   945
      Picture         =   "frmcarYYlr.frx":212CB
      Stretch         =   -1  'True
      Top             =   1635
      Width           =   900
   End
   Begin VB.Image Imgadd 
      Height          =   330
      Left            =   45
      Picture         =   "frmcarYYlr.frx":252E6
      Stretch         =   -1  'True
      Top             =   1635
      Width           =   900
   End
End
Attribute VB_Name = "frmcarYYlr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************************************************************
'**模 块 名：frmcarYYlr
'**版权说明：吉林省明日科技有限公司享有本软件的所有版权，如果本软件用于商
'**          业用途，必须经过吉林省明日科技有限公司授权。如果提供网上免费
'**          下载，必须经过吉林省明日科技有限公司授权，并保证程序的完整，
'**          不得修改代码、注释和相关内容，否则，我公司将追究其法律责任
'**网    址：www.mingrisoft.com  价值无限，服务无限
'**电    话：[phone],84978982
'**创 建 人：明日科技
'**日    期：2007-10-31
'**修 改 人：mraj
'**日    期：2007-10-31
'**描    述：
'*************************************************************************
Dim i As Integer
Private Sub Lockctl()
   Text1.Enabled = False: Text2.Enabled = False
   Text3.Enabled = False: Text4.Enabled = False
   DTPicker1.Enabled = False
End Sub
Private Sub Unlockctl()
   Text1.Enabled = True: Text2.Enabled = True
   Text3.Enabled = True: Text4.Enabled = True
   DTPicker1.Enabled = True
End Sub

Private Sub DTPicker1_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then Text2.SetFocus
End Sub

Private Sub DTPicker1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then Text2.SetFocus
End Sub

Private Sub Form_Load()
  frmcarYYlr.Height = 2490: frmcarYYlr.Width = 8235
  '自动识别路径
  Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\clgl.mdb;Persist Security Info=False"
  Adodc1.RecordSource = "select * from 车辆运营表"
  Adodc1.Refresh
  If Adodc1.Recordset.RecordCount > 0 Then DTPicker1.Value = Adodc1.Recordset.Fields("运营日期").Value
End Sub

Private Sub Image1_Click(Index As Integer)   '数据浏览
On Error Resume Next
  Select Case Index
         Case 0   '首记录
         Adodc1.Recordset.MoveFirst
         Case 1   '上一条记录
         If Adodc1.Recordset.BOF = False Then
            Adodc1.Recordset.MovePrevious
         Else
            MsgBox "向前已经没有记录了！", , "车辆管理系统"
            Adodc1.Recordset.MoveFirst
         End If
         Case 2   '下一条
         If Adodc1.Recordset.EOF = False Then
            Adodc1.Recordset.MoveNext
         Else
            MsgBox "向后已经没有记录了！", , "车辆管理系统"
            Adodc1.Recordset.MoveLast
         End If
         Case 3   '尾记录
         Adodc1.Recordset.MoveLast
  End Select
  Text5.Text = Adodc1.Recordset.Fields("运营编号")
  Text1.Text = Adodc1.Recordset.Fields("车牌号码")
  DTPicker1.Value = Adodc1.Recordset.Fields("运营日期")
  Text2.Text = Adodc1.Recordset.Fields("运营时间")
  Text3.Text = Adodc1.Recordset.Fields("运营收入")
  Text4.Text = Adodc1.Recordset.Fields("备注")
End Sub

Private Sub Imgadd_Click()  '增加
    Unlockctl
   
    '清空文本内容
    Text1 = "": Text2 = ""
    Text3 = "": Text4 = ""
    DTPicker1.Value = Format(Now, "yyyy-mm-dd")
    Dim rs As New ADODB.Recordset
    rs.Open "select * from 车辆运营表", cnn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount > 0 Then
    rs.MoveLast
    aa = rs.Fields(0)
      Text5.Text = "YY" + Format(Val(Right(rs.Fields("运营编号"), 3)) + 1, "###000")
    Else
      Text5.Text = "YY001"
    End If
    Text1.SetFocus
    Imgok.Enabled = True: Imgcancel.Enabled = True
    Imgupdate.Enabled = False: Imgdelete.Enabled = False
    Adodc1.Enabled = False
    i = 1
End Sub

Private Sub Imgcancel_Click()  '取消
    On Error Resume Next     '当没有添加数据的时候 处理异常
    Adodc1.Recordset.CancelUpdate
    Adodc1.Refresh
    Lockctl
    Imgok.Enabled = False: Imgcancel.Enabled = False
    Imgadd.Enabled = True: Imgupdate.Enabled = True
    Imgdelete.Enabled = True: Adodc1.Enabled = True
End Sub

Private Sub Imgdelete_Click()  '删除
    If Adodc1.Recordset.AbsolutePosition <> adPosBOF And Adodc1.Recordset.AbsolutePosition <> adPosEOF Then
        If MsgBox("您确实要删除记录吗？", vbOKCancel, "车辆管理系统") = vbOK Then
            Adodc1.Recordset.Delete
            MsgBox " 记录已删除！", , "车辆管理系统"
            Adodc1.Refresh
        End If
    End If
End Sub

Private Sub Imgexit_Click()  '退出
    MDIForm1.StatusBar1.Panels(1).Text = ""
    Unload Me
End Sub
Private Sub Imgok_Click()  '确定
 Select Case i
        Case 1
          If Text1.Text = "" Then
             MsgBox "车牌号码不能为空！！", , "车辆管理系统"
             Text1.SetFocus
             Exit Sub
          End If
          If Text2.Text = "" Then
             MsgBox "运营时间不能为空！！", , "车辆管理系统"
             Text2.SetFocus
             Exit Sub
             Text3.SetFocus
          End If
         If Text3.Text = "" Then
           MsgBox "运营收入不能为空！！", , "车辆管理系统"
           Text3.SetFocus
           Exit Sub
         End If
           Adodc1.Recordset.AddNew   '添加一条新纪录
           Adodc1.Recordset.Fields("运营编号") = Text5.Text
           Adodc1.Recordset.Fields("车牌号码") = Text1.Text
           Adodc1.Recordset.Fields("运营日期") = Format(str(DTPicker1.Value), "yyyy-mm-dd")
           Adodc1.Recordset.Fields("运营时间") = Val(Text2.Text)
           Adodc1.Recordset.Fields("运营收入") = Text3.Text
           Adodc1.Recordset.Fields("备注") = Text4.Text
           Adodc1.Recordset.Update
           Adodc1.Refresh
          MsgBox "记录添加成功！", , "车辆管理系统"
        Case 2
          Dim rss As New ADODB.Recordset
          rss.Open "select * from 车辆运营表 where 运营编号='" + Text5.Text + "'", cnn, adOpenKeyset, adLockOptimistic
          If rss.RecordCount > 0 Then
            rss.Fields("车牌号码") = Text1.Text
            rss.Fields("运营日期") = Format(str(DTPicker1.Value), "yyyy-mm-dd")
            rss.Fields("运营时间") = Val(Text2.Text)
            rss.Fields("运营收入") = Text3.Text
            rss.Fields("备注") = Text4.Text
            rss.Update
            MsgBox "记录修改成功！", , "车辆管理系统"
          Adodc1.Refresh
          End If
  End Select
    Lockctl
    '设置控件状态
    Imgok.Enabled = False: Imgcancel.Enabled = False
    Imgadd.Enabled = True: Imgupdate.Enabled = True
    Imgdelete.Enabled = True: Adodc1.Enabled = True
End Sub

Private Sub Imgupdate_Click()   '修改
    Text2.Enabled = True
    Text3.Enabled = True: Text4.Enabled = True
    DTPicker1.Enabled = False
    Text1.Enabled = True
    Text5.Enabled = False
    i = 2
    Imgok.Enabled = True: Imgcancel.Enabled = True
    Imgadd.Enabled = False: Imgdelete.Enabled = False
    Adodc1.Enabled = False
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
   If Text1.Text = "" Then
      MsgBox "车牌号码不能为空！！", , "车辆管理系统"
      Text1.SetFocus
      Exit Sub
   End If
   DTPicker1.SetFocus
End If
End Sub
Private Sub Text1_LostFocus()
    If Text1.Text = "" Then Exit Sub
    Dim rss As New ADODB.Recordset    '定义数据集对象
    Dim rss1 As New ADODB.Recordset   '定义数据集对象
    Dim rss2 As New ADODB.Recordset   '定义数据集对象
    '此车是否是本公司的
    Call main1
    Set rss = adoCon.Execute("select * from 车辆档案 where 车牌号码='" & Text1.Text & "'")
    If rss.EOF Then
       MsgBox "这辆车不属于本公司的！", , "车辆管理系统"
       Text1.Text = ""
       Text1.SetFocus
       Exit Sub
    End If
    rss.Close

    '此车是否报废了
    Set rss1 = adoCon.Execute("select * from 车辆报废表 where 车牌号码='" & Text1.Text & "'")
    If rss1.EOF Then
    Else
       MsgBox "此车已经报废，不能参加运营！", , "车辆管理系统"
       Text1.Text = ""
       Text1.SetFocus
       Exit Sub
    End If
    rss1.Close
    '此车是否异动了
    Set rss2 = adoCon.Execute("select * from 车辆异动表 where 车牌号码='" & Text1.Text & "'")
    If rss2.EOF Then
    Else
       MsgBox "此车为“异动车辆”不能参加运营！", , "车辆管理系统"
       Text1.Text = ""
       Text1.SetFocus
       Exit Sub
    End If
    rss2.Close
    adoCon.Close
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
   If Text2.Text = "" Then
      MsgBox "运营时间不能为空！！", , "车辆管理系统"
      Text2.SetFocus
      Exit Sub
   End If
   Text3.SetFocus
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
KeyAscii = valiText(KeyAscii, "0123456789." & Chr(13) & Chr(8), True)
End Sub

Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
   If Text3.Text = "" Then
      MsgBox "运营收入不能为空！！", , "车辆管理系统"
      Text3.SetFocus
      Exit Sub
   End If
   Text4.SetFocus
End If
End Sub