frmmain.frm

固定资产管理系统VB开发 已经测试

         Height          =   756
         Left            =   240
         TabIndex        =   1
         Top             =   6480
         Width           =   7815
         Begin VB.CommandButton cmdDelete 
            Caption         =   "删除设备"
            Height          =   396
            Left            =   1668
            TabIndex        =   11
            Top             =   204
            Width           =   1248
         End
         Begin VB.CommandButton cmdAdd 
            Caption         =   "新增设备[&A]"
            Height          =   396
            Left            =   144
            TabIndex        =   10
            Top             =   204
            Width           =   1248
         End
         Begin VB.CommandButton cmdLend 
            Caption         =   "借出借入"
            Height          =   396
            Left            =   3192
            TabIndex        =   4
            Top             =   192
            Width           =   1248
         End
         Begin VB.CommandButton cmdReject 
            Caption         =   "设备报废"
            Height          =   396
            Left            =   6288
            TabIndex        =   3
            Top             =   216
            Width           =   1248
         End
         Begin VB.CommandButton cmdDisCard 
            Caption         =   "设备注销"
            Height          =   396
            Left            =   4692
            TabIndex        =   2
            Top             =   204
            Width           =   1248
         End
      End
      Begin MSFlexGridLib.MSFlexGrid grdQuery 
         Height          =   3750
         Left            =   -74880
         TabIndex        =   12
         Top             =   3480
         Width           =   10050
         _ExtentX        =   17717
         _ExtentY        =   6625
         _Version        =   393216
         HighLight       =   2
         SelectionMode   =   1
         AllowUserResizing=   3
      End
      Begin VB.Label Label6 
         Caption         =   "所有设备列表[双击设备列表可以看详细内容]:"
         Height          =   324
         Left            =   204
         TabIndex        =   38
         Top             =   684
         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 & "\data" & FormatDateTime(Date, vbShortDate) & "(" & Right(Rnd(100), 1) & ").mdb"
    
    
    On Error GoTo err_handle
    
    FileCopy App.Path & "\data.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 cmdDisCard_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.Reject(iid, strDate) = True Then
                        .Tag = ""
                        fillDeviceGrid grdDevice
                    End If
                    Set device = Nothing
                End If
            End If
        End If
    End With

End Sub

Private Sub cmdExit_Click()

    If MsgBox("是否真的要退出系统吗?", vbYesNo) = vbYes Then
        Unload Me
    End If

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 cmdPass_Click()

    Dim oldPass As String
    Dim newPass1 As String
    Dim newPass2 As String
    
    
    oldPass = InputBox("请输入旧密码:", "密码修改")
    If Len(oldPass) > 0 Then
        If oldPass <> gUser.Password Then
            MsgBox "输入密码不正确!"
            Exit Sub
        End If
        
        newPass1 = InputBox("请输入新密码:", "密码修改")
        If Len(newPass1) = 0 Then
            MsgBox "密码修改不成功!"
            Exit Sub
        Else
            newPass2 = InputBox("请再次输入新密码确认:", "密码修改")
            If Len(newPass2) = 0 Then
                MsgBox "密码修改不成功!"
                Exit Sub
            ElseIf newPass1 = newPass2 Then
                If gUser.resetPassword(newPass1) = False Then
                    MsgBox "数据操作错误,密码修改不成功!"
                Else
                    MsgBox "密码成功修改!请保存好你的密码!"
                End If
                Exit Sub
            Else
                MsgBox "两次输入的新密码不一样,修改失败!"
                Exit Sub
            End If
        End If
    Else
        MsgBox "密码修改不成功!"
        Exit Sub
    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"