frmimst.frm

仓库管理软件,库存信息,仓库入库,仓库出库,单据新增,修改,删除,审核,反审核等等功能.

    mChanged = False
    
    Me.Toolbar.Buttons("tlbAuditing").Enabled = False
    Me.Toolbar.Buttons("tlbUnAuditing").Enabled = False
    
    Label3.Visible = False
    StatusBar1.Panels(2).Text = "审核人:"
    StatusBar1.Panels(3).Text = "审核日期:"
    
End Sub


Public Sub EditBill(ImSTID As Long)
    If rstExec.State = 1 Then rstExec.Close
    Set rstExec = Nothing
    rstExec.CursorLocation = adUseClient
    rstExec.Open "select * from ImST where ImSTID=" & ImSTID, con, adOpenStatic, adLockBatchOptimistic
    
    If IsNull(rstExec.Fields("ImSTCode")) Then
        Message "找不到记录!"
        Exit Sub
    Else
        txtBillNo.Text = rstExec.Fields("ImSTCode")
        dtpDate.Value = rstExec.Fields("MakeDate")
        txtMemo.Text = rstExec.Fields("memo1")
        
        If rstExec.Fields("state") Then
            Label3.Caption = "已审核"
            Label3.Visible = True
            Me.Toolbar.Buttons("tlbAuditing").Enabled = False
            Me.Toolbar.Buttons("tlbUnAuditing").Enabled = True
            BtnState 1
            StatusBar1.Panels(2).Text = "审核人:" & rstExec.Fields("Audier")
            StatusBar1.Panels(3).Text = "审核日期:" & rstExec.Fields("AudiDate")
        Else
            Label3.Caption = "未审核"
            Label3.Visible = True
            Me.Toolbar.Buttons("tlbAuditing").Enabled = True
            Me.Toolbar.Buttons("tlbUnAuditing").Enabled = False
            BtnState 2
            StatusBar1.Panels(2).Text = "审核人:"
            StatusBar1.Panels(3).Text = "审核日期:"
        End If
        
    End If

    If rstGrid.State = 1 Then rstGrid.Close
    Set rstGrid = Nothing
    rstGrid.CursorLocation = adUseClient
    rstGrid.Open "select * from imst_d where imstid=" & ImSTID, con, adOpenStatic, adLockBatchOptimistic
    
    LoadGrid
    
    
    mEdit = True
    mImSTID = ImSTID
    mChanged = False

End Sub

Public Function SaveBill() As Boolean
On Error GoTo isErr
    SaveBill = False
    
    If Trim(txtBillNo.Text) = "" Then
        Message "单据编号不能为空!"
        Exit Function
    End If
    
    If mChanged = False Then Exit Function
    
    Dim sSQL As String
    Dim i As Long
    
    If mEdit = False Then

        sSQL = "insert into imst(imstcode,maker,makedate,memo1,state) values(" _
            & "'" & Trim(txtBillNo.Text) & "'," _
            & "'" & LoginName & "'," _
            & "'" & CStr(dtpDate.Value) & "'," _
            & "'" & txtMemo.Text & "'," _
            & False & ")"


        Debug.Print sSQL
        
        con.Execute sSQL
    
        If rstExec.State = 1 Then rstExec.Close
        Set rstExec = Nothing
        rstExec.CursorLocation = adUseClient
        rstExec.Open "select ImSTID from ImST where imstcode='" & txtBillNo.Text & "'", con, adOpenStatic, adLockBatchOptimistic
        
        If rstExec.RecordCount < 1 Then
            Message "保存失败!"
            Exit Function
        End If
        
        mImSTID = rstExec.Fields("ImSTID")
  
        
        rstGrid.MoveFirst
        For i = 0 To rstGrid.RecordCount - 1
            rstGrid.Fields("ImSTID") = mImSTID
            rstGrid.Fields("itemno") = i
            rstGrid.MoveNext
        Next
        
        rstGrid.UpdateBatch
        
    Else
    
        sSQL = "update imst set imstcode='" & txtBillNo.Text & "',maker ='" & LoginName & "',makedate='" & CStr(dtpDate.Value) & "',memo1='" & txtMemo.Text & "',state=false where imstid=" & mImSTID
    
        Debug.Print sSQL
        
        con.Execute sSQL
        
        rstGrid.MoveFirst
        For i = 0 To rstGrid.RecordCount - 1
            rstGrid.Fields("ImSTID") = mImSTID
            rstGrid.Fields("itemno") = i
            rstGrid.MoveNext
        Next
        rstGrid.UpdateBatch
        
    End If
    
    SaveBill = True
    mEdit = True
    mChanged = False
    
    EditBill (mImSTID)
    
    If FindWindow("FrmImSTExp") = True Then
        FrmImSTExp.LoadGrid
    End If
    
    Exit Function

isErr:
    Message Err.Description

End Function


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    If mChanged = True Then
    
        Dim l As Long
        l = ChangeDly("单据已更改,是否保存!")
        If l = vbYes Then
            If SaveBill = True Then Cancel = 0 Else Cancel = 1
        ElseIf l = vbNo Then
            Cancel = 0
        ElseIf l = vbCancel Then
            Cancel = 1
        End If
        
    End If
    
End Sub

Private Sub Form_Resize()
On Error Resume Next
    Frame1.Move 0, Me.Toolbar.Height - 10, Me.ScaleWidth, 840
    
    dtpDate.Move Frame1.Width - dtpDate.Width - 120, Frame1.Height * 0.5 - 40
    Label2.Move dtpDate.Left - Label2.Width - 60, Frame1.Height * 0.5
    txtBillNo.Move Label2.Left - txtBillNo.Width - 120, Frame1.Height * 0.5 - 40
    Label1.Move txtBillNo.Left - Label1.Width - 60, Frame1.Height * 0.5
    
    Frame2.Move 0, Me.ScaleHeight - Me.Frame2.Height - Me.StatusBar1.Height, Me.ScaleWidth
    txtMemo.Move 60, 200, Frame2.Width - 120, Frame2.Height - 300
    
    Grid.Move 0, Me.Toolbar.Height + Me.Frame1.Height, Me.ScaleWidth, Me.ScaleHeight - Me.Frame1.Height - Me.Frame2.Height - Me.Toolbar.Height - Me.StatusBar1.Height
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If rstGrid.State = 1 Then rstGrid.Close
    Set rstGrid = Nothing
    If rstExec.State = 1 Then rstExec.Close
    Set rstExec = Nothing
End Sub

Private Sub Grid_AfterColEdit(ByVal ColIndex As Integer)
    mChanged = True
    If Grid.Value(3) <> "" Then
        If ColIndex = 5 Or ColIndex = 6 Then
            Grid.Value(7) = Grid.Value(5) * Grid.Value(6)
        End If
    End If
End Sub

Private Sub Grid_ColButtonClick(ByVal ColIndex As Integer)
    Load frmSelect
    Set frmSelect.iForm = Me
    frmSelect.Show vbModal
End Sub


Private Sub Grid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        PopupMenu frmMnu.Edit
    End If
End Sub

Public Sub DelRec()
    Grid.AllowDelete = True
    Grid.Delete
    mChanged = True
End Sub

Private Sub Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Dim l As Long
    Select Case Button.Key
        Case "tlbNew"
            Me.AddBill
        
        Case "tlbSave"
            Me.SaveBill
        
        Case "tlbAuditing"
            
            If rstExec.State = 1 Then rstExec.Close
            Set rstExec = Nothing
            rstExec.CursorLocation = adUseClient
            rstExec.Open "select * from ImST where imSTID=" & mImSTID, con, adOpenStatic, adLockBatchOptimistic
            If rstExec.RecordCount < 1 Then
                Message "没有可用单据!"
                Exit Sub
            End If
            If rstExec.Fields("state") Then
                Message "该单据已审核!"
                Exit Sub
            End If
            
            If mChanged = True Then
            
                l = ChangeDly("单据已更改,是否保存!")
                If l = vbYes Then
                    If SaveBill = True Then ImAudi mImSTID, 1 Else Exit Sub
                ElseIf l = vbNo Then
                    ImAudi mImSTID, 1
                ElseIf l = vbCancel Then
                    Exit Sub
                End If
                
            Else
                ImAudi mImSTID, 1
                
            End If
            
            
            EditBill mImSTID
            
            If FindWindow("FrmImSTExp") = True Then
                FrmImSTExp.LoadGrid
            End If
            
        Case "tlbUnAuditing"
        
            If rstExec.State = 1 Then rstExec.Close
            Set rstExec = Nothing
            rstExec.CursorLocation = adUseClient
            rstExec.Open "select * from ImST where imSTID=" & mImSTID, con, adOpenStatic, adLockBatchOptimistic
            If rstExec.RecordCount < 1 Then
                Message "没有可用单据!"
                Exit Sub
            End If
            If rstExec.Fields("state") = False Then
                Message "该单据未审核!"
                Exit Sub
            End If
            
            If mChanged = True Then
            
                
                l = ChangeDly("单据已更改,是否保存!")
                If l = vbYes Then
                    If SaveBill = True Then ImAudi mImSTID, 2 Else Exit Sub
                ElseIf l = vbNo Then
                    ImAudi mImSTID, 1
                ElseIf l = vbCancel Then
                    Exit Sub
                End If
                
            Else
                ImAudi mImSTID, 2
                
            End If
            
            EditBill mImSTID
        
            If FindWindow("FrmImSTExp") = True Then
                FrmImSTExp.LoadGrid
            End If
            
        Case "tlbClose"
            Unload Me
    End Select
        
End Sub

Private Sub txtBillNo_Change()
mChanged = True
End Sub

Private Sub txtMemo_Change()
mChanged = True
End Sub