⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmvaninventory.frm

📁 Inventory control system
💻 FRM
📖 第 1 页 / 共 2 页
字号:
                            Dim OLD_BO As Long
                            Dim RSDetails As New Recordset
                            
                            CN.BeginTrans
                    
                            RSDetails.Open "SELECT * FROM tbl_IC_VanInvDetails WHERE VanInvFK=" & CLng(LeftSplitUF(lvList.SelectedItem.Tag)), CN, adOpenStatic, adLockOptimistic
                            
                            With RSDetails
                                If .RecordCount > 0 Then
                                    .MoveFirst
                                    While Not .EOF
                                        OLD_BO = toNumber(getValueAt("SELECT PK,BO FROM tbl_IC_Products WHERE PK=" & ![ProductFK], "BO"))
                                        ChangeValue CN, "tbl_IC_Products", "BO", OLD_BO - toNumber(![BO]), True, "WHERE PK=" & ![ProductFK]
                                        
                                        .MoveNext
                                    Wend
                                End If
                            End With
                    
                            'Remove
                            DelRecwSQL "tbl_IC_VanInv", "PK", "", True, CLng(LeftSplitUF(lvList.SelectedItem.Tag))
                            
                            CN.CommitTrans
                            
                            OLD_BO = 0
                            Set RSDetails = Nothing
                            'Refresh the records
                            RefreshRecords
                            MsgBox "Record has been successfully removed.", vbInformation, "Confirm"
                        End If
                        ANS = 0
                        Me.MousePointer = vbDefault
                    End If
                End If
            Else
                MsgBox "No record to void.", vbExclamation
            End If
        Case "Refresh"
            RefreshRecords
        Case "Print"
        Case "Close"
            Unload Me
    End Select
    Exit Sub
    'Trap the error
err:
    If err.Number = -2147467259 Then
        CN.RollbackTrans
        MsgBox "You cannot delete this record because it was used by other records! If you want to delete this record" & vbCrLf & _
               "you will first have to delete or change the records that currenly used this record as shown bellow." & vbCrLf & vbCrLf & _
               err.Description, , "Delete Operation Failed!"
        Me.MousePointer = vbDefault
    End If
End Sub

Public Sub RefreshRecords()
    SQLParser.RestoreStatement
    ReloadRecords SQLParser.SQLStatement
End Sub

'Procedure for reloadingrecords
Public Sub ReloadRecords(ByVal srcSQL As String)
    '-In this case I used SQL because it is faster than Filter function of VB
    '-when hundling millions of records.
    On Error GoTo err
    With rsLoading
        If .State = adStateOpen Then .Close
        .Open srcSQL
    End With
    RecordPage.Refresh
    FillList 1
    Exit Sub
err:
        If err.Number = -2147217913 Then
            srcSQL = Replace(srcSQL, "'", "", , , vbTextCompare)
            Resume
        ElseIf err.Number = -2147217900 Then
            MsgBox "Invalid search operation.", vbExclamation
            SQLParser.RestoreStatement
            srcSQL = SQLParser.SQLStatement
            Resume
        Else
            prompt_err err, Name, "ReloadRecords"
        End If
End Sub

Private Sub btnClose_Click()
    Unload Me
End Sub

Private Sub btnFirst_Click()
    If RecordPage.PAGE_CURRENT <> 1 Then FillList 1
End Sub

Private Sub btnLast_Click()
    If RecordPage.PAGE_CURRENT <> RecordPage.PAGE_TOTAL Then FillList RecordPage.PAGE_TOTAL
End Sub

Private Sub btnNext_Click()
    If RecordPage.PAGE_CURRENT <> RecordPage.PAGE_TOTAL Then FillList RecordPage.PAGE_NEXT
End Sub

Private Sub btnPrev_Click()
    If RecordPage.PAGE_CURRENT <> 1 Then FillList RecordPage.PAGE_PREVIOUS
End Sub

Private Sub Form_Activate()
    HighlightInWin Me.Name: MAIN.ShowTBButton "tttttft"
    Active
End Sub

Private Sub Form_Deactivate()
    MAIN.HideTBButton "", True
    Deactive
End Sub

Private Sub Active()
    With MAIN
        .tbMenu.Buttons(4).Caption = "View"
        .tbMenu.Buttons(6).Caption = "Void"
        .tbMenu.Buttons(4).Image = 13
        .tbMenu.Buttons(6).Image = 14

        .mnuRAES.Caption = "View Selected"
        .mnuRADS.Caption = "Void Selected"
    End With
End Sub

Private Sub Deactive()
    With MAIN
        .tbMenu.Buttons(4).Caption = "Edit"
        .tbMenu.Buttons(6).Caption = "Delete"
        .tbMenu.Buttons(4).Image = 2
        .tbMenu.Buttons(6).Image = 4

        .mnuRAES.Caption = "Edit Selected"
        .mnuRADS.Caption = "Delete Selected"
    End With
End Sub


Private Sub Form_Load()
    MAIN.AddToWin Me.Caption, Name
    
    'Set the graphics for the controls
    With MAIN
        'For listview
        Set lvList.SmallIcons = .i16x16
        Set lvList.Icons = .i16x16
    
        btnFirst.Picture = .i16x16.ListImages(3).Picture
        btnPrev.Picture = .i16x16.ListImages(4).Picture
        btnNext.Picture = .i16x16.ListImages(5).Picture
        btnLast.Picture = .i16x16.ListImages(6).Picture
        
        btnFirst.DisabledPicture = .i16x16g.ListImages(3).Picture
        btnPrev.DisabledPicture = .i16x16g.ListImages(4).Picture
        btnNext.DisabledPicture = .i16x16g.ListImages(5).Picture
        btnLast.DisabledPicture = .i16x16g.ListImages(6).Picture
    End With
    
    With SQLParser
        .Fields = "VanInventoryNo,Date,VanName,SoldAmount,PK"
        .Tables = "qry_IC_VanInv"
        .SortOrder = "PK DESC"
        
        .SaveStatement
    End With
    
    rsLoading.CursorLocation = adUseClient
    rsLoading.Open SQLParser.SQLStatement, CN, adOpenStatic, adLockReadOnly
    
    With RecordPage
        .Start rsLoading, 75
        FillList 1
    End With

End Sub

Private Sub FillList(ByVal whichPage As Long)
    RecordPage.CurrentPosition = whichPage
    Screen.MousePointer = vbHourglass
    Me.Enabled = False
    Call pageFillListView(lvList, rsLoading, RecordPage.PageStart, RecordPage.PageEnd, 4, 2, False, True, , , , "PK")
    Me.Enabled = True
    Screen.MousePointer = vbDefault
    SetNavigation
    'Display the page information
    lblPageInfo.Caption = "Record " & RecordPage.PageInfo
    'Display the selected record
    lvList_Click
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If WindowState <> vbMinimized Then
        If Me.Width < 9195 Then Me.Width = 9195
        If Me.Height < 4500 Then Me.Height = 4500
        
        shpBar.Width = ScaleWidth
        
        lvList.Width = Me.ScaleWidth
        lvList.Height = (Me.ScaleHeight - Picture1.Height) - lvList.Top
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    MAIN.RemToWin Me.Caption
    MAIN.HideTBButton "", True
    
    Set frmVanInventory = Nothing
End Sub

Private Sub SetNavigation()
    With RecordPage
        If .PAGE_TOTAL = 1 Then
            btnFirst.Enabled = False
            btnPrev.Enabled = False
            btnNext.Enabled = False
            btnLast.Enabled = False
        ElseIf .PAGE_CURRENT = 1 Then
            btnFirst.Enabled = False
            btnPrev.Enabled = False
            btnNext.Enabled = True
            btnLast.Enabled = True
        ElseIf .PAGE_CURRENT = .PAGE_TOTAL And .PAGE_CURRENT > 1 Then
            btnFirst.Enabled = True
            btnPrev.Enabled = True
            btnNext.Enabled = False
            btnLast.Enabled = False
        Else
            btnFirst.Enabled = True
            btnPrev.Enabled = True
            btnNext.Enabled = True
            btnLast.Enabled = True
        End If
    End With
End Sub

Private Sub lvList_Click()
On Error GoTo err
    lblCurrentRecord.Caption = "Selected Record: " & RightSplitUF(lvList.SelectedItem.Tag)
    Exit Sub
err:
        lblCurrentRecord.Caption = "Selected Record: NONE"
End Sub

Private Sub lvList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then PopupMenu MAIN.mnuRecA
End Sub

Private Sub lvList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    'Sort the listview
    If ColumnHeader.Index - 1 <> CURR_COL Then
        lvList.SortOrder = 0
    Else
        lvList.SortOrder = Abs(lvList.SortOrder - 1)
    End If
    lvList.SortKey = ColumnHeader.Index - 1
    
    lvList.Sorted = True
    CURR_COL = ColumnHeader.Index - 1
End Sub

Private Sub lvList_DblClick()
    CommandPass "Edit"
End Sub

Private Sub lvList_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 38 Or KeyCode = 40 Or KeyCode = 33 Or KeyCode = 34 Then lvList_Click
End Sub

Private Sub Picture1_Resize()
    Picture2.Left = Picture1.ScaleWidth - Picture2.ScaleWidth
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -