frmmain.frm

关于工业设备型号数量库存价格等信息的管理系统的课程设计

      Begin MSFlexGridLib.MSFlexGrid grdQuery 
         Height          =   3750
         Left            =   -74760
         TabIndex        =   38
         Top             =   3360
         Width           =   9330
         _ExtentX        =   16457
         _ExtentY        =   6615
         _Version        =   393216
         BackColor       =   16777215
         HighLight       =   2
         SelectionMode   =   1
         AllowUserResizing=   3
      End
      Begin VB.Label Label6 
         Caption         =   "所有设备列表[双击设备列表可以看详细内容]:"
         Height          =   330
         Left            =   -74730
         TabIndex        =   39
         Top             =   600
         Width           =   5280
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'执行设备显示列表操作
Private Sub doDevice(iid As String)

    Dim frm As New frmDevice
    
    If Len(iid) > 0 Then
        frm.loadDevice iid
    End If
    
    frm.setStatus
    
    frm.Show vbModal
    
    If frm.isUpdate = True Then
        grdDevice.Tag = ""
        Call fillDeviceGrid(grdDevice)
    End If
    
    Unload frm
    Set frm = Nothing

End Sub

'执行用户显示列表操作
Private Sub doUser(uid As String)

    Dim frm As New frmUser
    
    If Len(uid) > 0 Then
        frm.loadUser uid
    End If
    
    frm.setStatus
    
    frm.Show vbModal
    
    If frm.isUpdate = True Then
        grdUser.Tag = ""
        Call fillUserGrid
    End If
    
    Unload frm
    Set frm = Nothing

End Sub

Private Sub cmdAdd_Click()

    Call doDevice("")
    
End Sub

Private Sub cmdAll_Click()
    
    grdQuery.Tag = ""
    
    fillDeviceGrid grdQuery

End Sub

Private Sub cmdBackup_Click()

    Dim newPath As String
    
    newPath = App.Path & "\database\DeviceMIScopy" & FormatDateTime(Date, vbShortDate) & "(" & Right(Rnd(100), 1) & ").mdb"
   
    
    On Error GoTo err_handle
    
    FileCopy App.Path & "\database\DeviceMIS.mdb", newPath

    MsgBox "数据备份成功,备份文件在:" & newPath
    
    Exit Sub
    
err_handle:
    MsgBox Err.Description
    MsgBox "备份不成功!"

End Sub

Private Sub cmdDelete_Click()

    Dim iid As String
    
    With grdDevice
        If .Row = 0 Then
            MsgBox "请选择要删除的设备!"
        Else
            If MsgBox("你是否真的要删除当前选择的设备吗?删除后将不能恢复!", vbOKCancel) = vbOK Then
                .Col = 1
                iid = .Text
                
                Dim device As New classDevice
                
                device.deleteData iid
                grdDevice.Tag = ""
                Call fillDeviceGrid(grdDevice)
                
            End If
        End If
    End With

End Sub




Private Sub cmdGetDate_Click(Index As Integer)

    Dim thedate As String
    
    thedate = getDate(txtDate(Index).Text)
    
    If Len(thedate) > 0 Then txtDate(Index).Text = thedate
    
End Sub

Private Sub cmdLend_Click()
    
    Dim iid As String
    
    With grdDevice
        If .Row = 0 Then
            MsgBox "请选择要操作的设备!"
        Else
            .Col = 1
            iid = .Text

            Dim frm As New frmLend
            Dim result As Boolean
            
            result = frm.loadLendData(iid)
            
            If result = False Then
                Unload frm
                Exit Sub
            End If
            
            frm.Show vbModal
            
            If frm.isUpdate = True Then
                grdDevice.Tag = ""
                fillDeviceGrid grdDevice
            End If
            
            Unload frm
            Set frm = Nothing
            
        End If
    End With

End Sub




Private Sub cmdPack_Click()

    If MsgBox("你是否真的要整理数据库吗?这个操作将会删除所有记录!", vbOKCancel + vbDefaultButton2) = vbOK Then
        gConn.Execute "delete from tbldevice"
        gConn.Execute "delete from tbluser"
        gConn.Execute "delete from tbllend"
        gConn.Execute "insert into tbluser (login,pwd,level) values ('admin','888',-1)"
        
        gConn.Close
        
        MsgBox "整理数据库成功!管理系统将退出!!!"
        
        Unload Me
        
    End If
    
End Sub




Private Sub cmdQuery_Click()

    Dim DeptNo As String
    Dim DeviceName As String
    Dim DeviceModel As String
    Dim TypeNo As String
    Dim Pricefrom As String
    Dim Priceto As String
    Dim PurchaseDatefrom As String
    Dim PurchaseDateto As String
    Dim RejectDatefrom As String
    Dim RejectDateto As String
    
    Dim strSQL As String
        
    If cboQDept.ListIndex > 0 Then
        DeptNo = getDeptNo()
        strSQL = "a.deptno='" & DeptNo & "'"
    End If
    If cboQTypeNO.ListIndex > 0 Then
        TypeNo = getTypeNO()
        If Len(strSQL) > 0 Then
            strSQL = " AND a.typeno='" & TypeNo & "'"
        Else
            strSQL = "a.typeno='" & TypeNo & "'"
        End If
    End If
    
    DeviceName = Replace(Trim(txtQDeviceName.Text), "'", "''")
    DeviceModel = Replace(Trim(txtQModel.Text), "'", "''")
    Pricefrom = Trim(txtQP1.Text)
    Priceto = Trim(txtQP2.Text)
    PurchaseDatefrom = Trim(txtDate(0).Text)
    PurchaseDateto = Trim(txtDate(1).Text)
    RejectDatefrom = Trim(txtDate(2).Text)
    RejectDateto = Trim(txtDate(3).Text)
    
    If Len(Pricefrom) > 0 Then
        If Not IsNumeric(Pricefrom) Then
            MsgBox "购买价格输入不正确，请重新输入。"
            txtQP1.SetFocus
            Exit Sub
        Else
            If Len(strSQL) > 0 Then
                strSQL = strSQL & " AND ProductPrice>=" & Pricefrom
            Else
                strSQL = "ProductPrice>=" & Pricefrom
            End If
        End If
    End If
    If Len(Priceto) > 0 Then
        If Not IsNumeric(Priceto) Then
            MsgBox "购买价格输入不正确，请重新输入。"
            txtQP2.SetFocus
            Exit Sub
        Else
            If Len(strSQL) > 0 Then
                strSQL = strSQL & " AND ProductPrice<=" & Priceto
            Else
                strSQL = "ProductPrice<=" & Priceto
            End If
        End If
    End If
    If Len(PurchaseDatefrom) > 0 Then
        If Not IsDate(PurchaseDatefrom) Then
            MsgBox "购买日期输入不正确，请重新输入。"
            txtDate(0).SetFocus
            Exit Sub
        Else
            If Len(strSQL) > 0 Then
                strSQL = strSQL & " AND PurchaseDate>=#" & PurchaseDatefrom & "#"
            Else
                strSQL = "ProductPrice>=#" & PurchaseDatefrom & "#"
            End If
        End If
    End If
    If Len(PurchaseDateto) > 0 Then
        If Not IsDate(PurchaseDateto) Then
            MsgBox "购买日期输入不正确，请重新输入。"
            txtDate(1).SetFocus
            Exit Sub
        Else
            If Len(strSQL) > 0 Then
                strSQL = strSQL & " AND PurchaseDate<=#" & PurchaseDateto & "#"
            Else
                strSQL = "ProductPrice<=#" & PurchaseDateto & "#"
            End If
        End If
    End If
    If Len(RejectDatefrom) > 0 Then
        If Not IsDate(RejectDatefrom) Then
            MsgBox "注销日期输入不正确，请重新输入。"
            txtDate(2).SetFocus
            Exit Sub
        Else
            If Len(strSQL) > 0 Then
                strSQL = strSQL & " AND RejectDate>=#" & RejectDatefrom & "#"
            Else
                strSQL = "RejectDate>=#" & RejectDatefrom & "#"
            End If
        End If
    End If
    If Len(RejectDateto) > 0 Then
        If Not IsDate(RejectDateto) Then
            MsgBox "注销日期输入不正确，请重新输入。"
            txtDate(3).SetFocus
            Exit Sub
        Else
            If Len(strSQL) > 0 Then
                strSQL = strSQL & " AND RejectDate<=#" & RejectDateto & "#"
            Else
                strSQL = "RejectDate<=#" & RejectDateto & "#"
            End If
        End If
    End If
        
    If Len(DeviceName) > 0 Then
        If Len(strSQL) > 0 Then
            strSQL = strSQL & " AND DeviceName LIKE '%" & DeviceName & "%'"
        Else
            strSQL = "DeviceName LIKE '%" & DeviceName & "%'"
        End If
    End If
    If Len(DeviceModel) > 0 Then
        If Len(strSQL) > 0 Then
            strSQL = strSQL & " AND DeviceModel LIKE '%" & DeviceModel & "%'"
        Else
            strSQL = "DeviceModel LIKE '%" & DeviceModel & "%'"
        End If
    End If
    
    If Len(strSQL) > 0 Then
        strSQL = "SELECT a.*,b.department,c.TypeName FROM (tblDevice AS A INNER JOIN tblDepartment AS B ON a.DeptNO=b.DeptNO) INNER JOIN tblTypeInfo C ON a.TypeNO=c.TypeNO WHERE " & strSQL & " ORDER BY A.IID DESC"
    Else
        strSQL = "SELECT a.*,b.department,c.TypeName FROM (tblDevice AS A INNER JOIN tblDepartment AS B ON a.DeptNO=b.DeptNO) INNER JOIN tblTypeInfo C ON a.TypeNO=c.TypeNO ORDER BY A.IID DESC"
    End If
    
    grdQuery.Tag = ""
    
    fillDeviceGrid grdQuery, strSQL
    
    
End Sub

Private Sub cmdReject_Click()

    Dim iid As String
    Dim strDate As String
    
    With grdDevice
        If .Row = 0 Then
            MsgBox "请选择要报废的设备!"
        Else
            If MsgBox("你是否真的要报废当前选择的设备吗?报废后将不能恢复!", vbOKCancel) = vbOK Then
                .Col = 1
                iid = .Text
                                
                strDate = getDate("")
                If Len(strDate) > 0 Then
                    Dim device As New classDevice
                    If device.DisCard(iid, strDate) = True Then
                        .Tag = ""