frmmain.frm

车辆管理信息系统,一个非常好的vb源码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.MDIForm frmMain 
   BackColor       =   &H8000000C&
   Caption         =   "运输管理信息系统"
   ClientHeight    =   5112
   ClientLeft      =   132
   ClientTop       =   732
   ClientWidth     =   7740
   LinkTopic       =   "MDIForm1"
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin MSComctlLib.StatusBar sbStatusBar 
      Align           =   2  'Align Bottom
      Height          =   264
      Left            =   0
      TabIndex        =   0
      Top             =   4848
      Width           =   7740
      _ExtentX        =   13653
      _ExtentY        =   466
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   3
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            AutoSize        =   1
            Object.Width           =   8043
            Text            =   "Status"
            TextSave        =   "Status"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   6
            AutoSize        =   2
            TextSave        =   "2001-11-3"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Style           =   5
            AutoSize        =   2
            TextSave        =   "20:20"
         EndProperty
      EndProperty
   End
   Begin VB.Menu menuSystem 
      Caption         =   "系统"
      Begin VB.Menu menuModifypwd 
         Caption         =   "修改密码"
      End
      Begin VB.Menu menuAdduser 
         Caption         =   "添加用户"
      End
      Begin VB.Menu menuExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu menuDrivers 
      Caption         =   "司机信息管理"
      Begin VB.Menu menuAdddrivers 
         Caption         =   "添加司机信息"
      End
      Begin VB.Menu menuModifydrivers 
         Caption         =   "修改司机信息"
      End
      Begin VB.Menu menuDeletedriver 
         Caption         =   "删除司机信息"
      End
      Begin VB.Menu menuInquiredrivers 
         Caption         =   "查询司机信息"
      End
   End
   Begin VB.Menu menuCars 
      Caption         =   "车辆信息管理"
      Begin VB.Menu menuAddcars 
         Caption         =   "添加车辆信息"
      End
      Begin VB.Menu menuModifycars 
         Caption         =   "修改车辆信息"
      End
      Begin VB.Menu menuDeletecars 
         Caption         =   "删除车辆信息"
      End
      Begin VB.Menu menuInquirecars 
         Caption         =   "查询车辆信息"
      End
   End
   Begin VB.Menu menuOperation 
      Caption         =   "业务管理"
      Begin VB.Menu menuRun 
         Caption         =   "运营管理"
         Begin VB.Menu menuAddrun 
            Caption         =   "添加运营信息"
         End
         Begin VB.Menu menuModifyrun 
            Caption         =   "修改运营信息"
         End
         Begin VB.Menu menuDeleterun 
            Caption         =   "删除运营信息"
         End
         Begin VB.Menu menuInquirerun 
            Caption         =   "查询运营信息"
         End
      End
      Begin VB.Menu menuRepair 
         Caption         =   "维修管理"
         Begin VB.Menu menuAddrepair 
            Caption         =   "添加维修信息"
         End
         Begin VB.Menu menuModifyrepair 
            Caption         =   "修改维修信息"
         End
         Begin VB.Menu menuDeleterepair 
            Caption         =   "删除维修信息"
         End
         Begin VB.Menu menuInquirerepair 
            Caption         =   "查询维修信息"
         End
      End
      Begin VB.Menu menuAccident 
         Caption         =   "事故信息管理"
         Begin VB.Menu menuAddacc 
            Caption         =   "添加事故信息"
         End
         Begin VB.Menu menuModifyacc 
            Caption         =   "修改事故信息"
         End
         Begin VB.Menu menuDeleteacc 
            Caption         =   "删除事故信息"
         End
         Begin VB.Menu menuInquireacc 
            Caption         =   "查询事故信息"
         End
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub MDIForm_Load()
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    
End Sub





Private Sub MDIForm_Unload(Cancel As Integer)
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub

Private Sub menuAddacc_Click()
    gintaMode = 1
    frmAcc1.Show
    frmAcc1.ZOrder 0
End Sub

Private Sub menuAddcars_Click()
    gintvMode = 1
    frmVehicle1.Show
    frmVehicle1.ZOrder 0
End Sub

Private Sub menuAdddrivers_Click()
    gintdMode = 1
    frmDriver1.Show
    frmDriver1.ZOrder 0
    
End Sub

Private Sub menuAddrepair_Click()
    gintrMode = 1
    frmRepair1.Show
    frmRepair1.ZOrder 0
End Sub

Private Sub menuAddrun_Click()
    gintsMode = 1
    frmStatistic1.Show
    frmStatistic1.ZOrder 0
End Sub

Private Sub menuDeleteacc_Click()
    Dim txtSQL As String
    Dim intCount As Integer
    Dim mrc As ADODB.Recordset
    Dim MsgText As String
    
    If frmAcc.msgList.Rows > 1 Then
        If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            intCount = frmAcc.msgList.Row
            txtSQL = "delete from accident where sgid='" & Trim(frmAcc.msgList.TextMatrix(intCount, 1)) & "' and sgdate='" & Format(frmAcc.msgList.TextMatrix(intCount, 2), "yyyy-mm-dd") & "' and sgplace='" & Trim(frmAcc.msgList.TextMatrix(intCount, 3)) & "'"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            
            Unload frmAcc
            frmAcc.txtSQL = "select sgid,sgdate,sgplace,sgreason,sgdriver,sgopp_dept,sgopp_id,sgmode,sgvalue,sgmemo from accident"
            frmAcc.Show
        End If
    End If
    
End Sub

Private Sub menuDeletecars_Click()
    Dim txtSQL As String
    Dim intCount As Integer
    Dim mrc As ADODB.Recordset
    Dim MsgText As String
    
    If frmVehicle.msgList.Rows > 1 Then
        If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            intCount = frmVehicle.msgList.Row
            txtSQL = "delete from vehicle where clid='" & Trim(frmVehicle.msgList.TextMatrix(intCount, 1)) & "'"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            
            Unload frmVehicle
            frmVehicle.txtSQL = "select * from vehicle"
            frmVehicle.Show
        End If
    End If
End Sub

Private Sub menuDeletedriver_Click()
    Dim txtSQL As String
    Dim intCount As Integer
    Dim mrc As ADODB.Recordset
    Dim MsgText As String
    
    If frmDriver.msgList.Rows > 1 Then
        If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            intCount = frmDriver.msgList.Row
            txtSQL = "delete from driver where sjid='" & Trim(frmDriver.msgList.TextMatrix(frmDriver.msgList.Row, 1)) & "'"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            
            Unload frmDriver
            frmDriver.txtSQL = "select * from driver"
            frmDriver.Show
        End If
    End If
End Sub

Private Sub menuDeleterepair_Click()
    Dim txtSQL As String
    Dim intCount As Integer
    Dim mrc As ADODB.Recordset
    Dim MsgText As String
    
    If frmRepair.msgList.Rows > 1 Then
        If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            intCount = frmRepair.msgList.Row
            txtSQL = "delete from repair where wxid='" & Trim(frmRepair.msgList.TextMatrix(intCount, 1)) & "' and wxdate='" & Format(frmRepair.msgList.TextMatrix(intCount, 2), "yyyy-mm-dd") & "'"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            
            Unload frmRepair
            frmRepair.txtSQL = "select * from repair"
            frmRepair.Show
        End If
    End If
End Sub

Private Sub menuDeleterun_Click()
    Dim txtSQL As String
    Dim intCount As Integer
    Dim mrc As ADODB.Recordset
    Dim MsgText As String
    
    If frmStatistic.msgList.Rows > 1 Then
        If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
            intCount = frmStatistic.msgList.Row
            txtSQL = "delete from statistic where yyid='" & Trim(frmStatistic.msgList.TextMatrix(intCount, 1)) & "' and yydriver='" & Trim(frmStatistic.msgList.TextMatrix(intCount, 2)) & "' and yybegin_date='" & Format(frmStatistic.msgList.TextMatrix(intCount, 3), "yyyy-mm-dd") & "'"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
            
            Unload frmStatistic
            frmStatistic.txtSQL = "select * from statistic"
            frmStatistic.Show
        End If
    End If
End Sub

Private Sub menuInquireacc_Click()
    frmAcc2.Show
End Sub

Private Sub menuInquirecars_Click()
    frmVehicle2.Show
End Sub

Private Sub menuInquiredrivers_Click()
    frmDriver2.Show
End Sub

Private Sub menuInquirerepair_Click()
    frmRepair2.Show
End Sub

Private Sub menuInquirerun_Click()
    frmStatistic2.Show
End Sub

Private Sub menuModifyacc_Click()
    Dim intCount As Integer
    If flagaEdit Then
        If frmAcc.msgList.Rows > 1 Then
            gintaMode = 2
            intCount = frmAcc.msgList.Row
            frmAcc1.txtSQL = "select * from accident where  sgid='" & Trim(frmAcc.msgList.TextMatrix(intCount, 1)) & "' and sgdate='" & Format(frmAcc.msgList.TextMatrix(intCount, 2), "yyyy-mm-dd") & "' and sgplace='" & Trim(frmAcc.msgList.TextMatrix(intCount, 3)) & "'"
            frmAcc1.Show
        Else
            Call menuAddcars_Click
        End If
    Else
        frmAcc.txtSQL = "select sgid,sgdate,sgplace,sgreason,sgdriver,sgopp_dept,sgopp_id,sgmode,sgvalue,sgmemo from accident"
        frmAcc.Show
    End If
    
End Sub

Private Sub menuModifycars_Click()
    Dim intCount As Integer
    If flagvEdit Then
        If frmVehicle.msgList.Rows > 1 Then
            gintvMode = 2
            intCount = frmVehicle.msgList.Row
            frmVehicle1.txtSQL = "select * from vehicle where clid='" & Trim(frmVehicle.msgList.TextMatrix(intCount, 1)) & "'"
            frmVehicle1.Show
        Else
            Call menuAddcars_Click
        End If
    Else
        frmVehicle.txtSQL = "select * from vehicle"
        frmVehicle.Show
    End If
End Sub

Private Sub menuModifydrivers_Click()
    Dim intCount As Integer
    If flagdEdit Then
        If frmDriver.msgList.Rows > 1 Then
            gintdMode = 2
            intCount = frmDriver.msgList.Row
            frmDriver1.txtSQL = "select * from driver where sjid='" & Trim(frmDriver.msgList.TextMatrix(frmDriver.msgList.Row, 1)) & "'"
            frmDriver1.Show
        Else
            Call menuAdddrivers_Click
        End If
    Else
        frmDriver.txtSQL = "select * from driver"
        frmDriver.Show
    End If
End Sub

Private Sub menuModifyrepair_Click()
    Dim intCount As Integer
    If flagrEdit Then
        If frmRepair.msgList.Rows > 1 Then
            gintrMode = 2
            intCount = frmRepair.msgList.Row
            frmRepair1.txtSQL = "select * from repair where wxid='" & Trim(frmRepair.msgList.TextMatrix(intCount, 1)) & "' and wxdate='" & Format(frmRepair.msgList.TextMatrix(intCount, 2), "yyyy-mm-dd") & "'"
            frmRepair1.Show
        Else
            Call menuAddrepair_Click
        End If
    Else
        frmRepair.txtSQL = "select * from repair"
        frmRepair.Show
    End If
End Sub

Private Sub menuModifyrun_Click()
    
    Dim intCount As Integer
    If flagsEdit Then
        If frmStatistic.msgList.Rows > 1 Then
            gintsMode = 2
            intCount = frmStatistic.msgList.Row
            frmStatistic1.txtSQL = "select * from statistic where yyid='" & Trim(frmStatistic.msgList.TextMatrix(intCount, 1)) & "'"
            frmStatistic1.Show
        Else
            Call menuAddrun_Click
        End If
    Else
        frmStatistic.txtSQL = "select * from statistic"
        frmStatistic.Show
    End If
End Sub