frmpschk.frm

这是一个用VB编写的“仓库管理系统”源码

VERSION 5.00
Begin VB.Form FrmPsChk 
   Caption         =   "采购入库单审核"
   ClientHeight    =   4590
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7020
   Icon            =   "FrmPsChk.frx":0000
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   4590
   ScaleWidth      =   7020
   Begin VB.CommandButton CmdCheck 
      Caption         =   "全部放弃(&U)"
      Height          =   375
      Index           =   1
      Left            =   5100
      TabIndex        =   6
      Top             =   1980
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "全部选中(&A)"
      Height          =   375
      Index           =   0
      Left            =   5100
      TabIndex        =   5
      Top             =   1200
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "退出(&X)"
      Height          =   375
      Index           =   3
      Left            =   5100
      TabIndex        =   4
      Top             =   3540
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "审核过帐(&C)"
      Height          =   375
      Index           =   2
      Left            =   5100
      TabIndex        =   3
      Top             =   2760
      Width           =   1635
   End
   Begin VB.ListBox LstDJ 
      Height          =   3420
      Left            =   60
      Style           =   1  'Checkbox
      TabIndex        =   0
      Top             =   840
      Width           =   4755
   End
   Begin VB.Label LblCap 
      Caption         =   "单据编号                       日期"
      Height          =   195
      Index           =   1
      Left            =   300
      TabIndex        =   2
      Top             =   540
      Width           =   4395
   End
   Begin VB.Label LblCap 
      Caption         =   "请先选中将要审核过帐的单据，然后点击“审核过帐”按钮"
      Height          =   195
      Index           =   0
      Left            =   60
      TabIndex        =   1
      Top             =   180
      Width           =   5235
   End
End
Attribute VB_Name = "FrmPsChk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private rsPSChk As ADODB.Recordset
Private cmPSChk As ADODB.Command
Private rsMHQP As ADODB.Recordset

Private Sub CmdCheck_Click(Index As Integer)
    Dim intCur As Integer
    Select Case Index
        Case 0
            For intCur = 0 To LstDJ.ListCount - 1
                If LstDJ.Selected(intCur) = False Then
                    LstDJ.Selected(intCur) = True
                End If
            Next
        Case 1
            For intCur = 0 To LstDJ.ListCount - 1
                If LstDJ.Selected(intCur) = True Then
                    LstDJ.Selected(intCur) = False
                End If
            Next
        Case 2
            Call PSCheck
            For intCur = LstDJ.ListCount - 1 To 0 Step -1
                If LstDJ.Selected(intCur) = True Then
                    LstDJ.RemoveItem intCur
                End If
            Next
            MsgBox "审核过帐完毕!", , "审核过帐"
        Case 3
            Unload Me
    End Select
End Sub

Private Sub Form_Load()
    Dim strItem As String
    intNumWindows = OpenWindow(intNumWindows)
    Me.Height = 4995
    Me.Width = 7140
    Call SetFormStu(Me, frmMain)
    Set rsPSChk = DEjxc.rsComPsHA
    rsPSChk.Open
    Set rsMHQP = New ADODB.Recordset
    Set cmPSChk = New ADODB.Command
    cmPSChk.ActiveConnection = DEjxc.Conjxc
    cmPSChk.CommandType = adCmdText
    With rsPSChk
        If .RecordCount <> 0 Then
            .MoveFirst
            While Not .EOF
                strItem = !PS_id & Space(20) & !PS_date
                LstDJ.AddItem strItem
                .MoveNext
            Wend
        End If
    End With
End Sub

Private Sub PSCheck()
    Dim strSQL As String
    Dim intCur As Integer
    Dim strPSID As String
    For intCur = 0 To LstDJ.ListCount - 1
        If LstDJ.Selected(intCur) = True Then
            strPSID = Left(LstDJ.List(intCur), 9)
'将ORDER_DETAIL_A中的记录加入到MAT_DETAIL中
'            strSQL = "create table mattmp(p_id text(8)," & _
'            "totalqty single,unit_price currency)"
'            cmPSChk.CommandText = strSQL
'            cmPSChk.Execute
'            strSQL = "insert into mat_detail select p_id,qty,unit_price " & _
'            "from order_detail_a where order_id='" & strPSID & "'"
'            cmPSChk.CommandText = strSQL
'            cmPSChk.Execute
'            strSQL = "insert into mattmp select p_id,sum(qty) as " & _
'            "totalqty,unit_price from mat_detail group by p_id,unit_price"
'            cmPSChk.CommandText = strSQL
'            cmPSChk.Execute
'           strSQL = "delete from mat_detail"
'            cmPSChk.CommandText = strSQL
'            cmPSChk.Execute
'            strSQL = "insert into mat_detail select p_id,totalqty " & _
'            "as qty,unit_price from  mattmp"
'            cmPSChk.CommandText = strSQL
'            cmPSChk.Execute
'            strSQL = "drop table mattmp"
'            cmPSChk.CommandText = strSQL
'            cmPSChk.Execute
'将ORDER_DETAIL_A中的记录加入到MAT_HEAD中
            strSQL = "select p_id,sum(qty) as tq,sum(price) as tp from " & _
            "order_detail_a where order_id='" & strPSID & "' group by " & _
            "p_id"
            rsMHQP.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
            With rsMHQP
                .MoveFirst
                While Not .EOF
                    strSQL = "update mat_head set qty=qty+" & !tq & _
                    ",price=price+" & !tp & " where p_id='" & !p_id & "'"
                    cmPSChk.CommandText = strSQL
                    cmPSChk.Execute
                    .MoveNext
                Wend
            End With
            rsMHQP.Close
'将PS_HEAD_A中的记录移动到PS_HEAD_B中
            strSQL = "insert into ps_head_b select * from ps_head_a " & _
            "where ps_id='" & strPSID & "'"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
            strSQL = "delete from ps_head_a " & "where ps_id='" & strPSID & "'"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
'将ORDER_DETAIL_A中的记录移动到ORDER_DETAIL_B中
            strSQL = "insert into order_detail_b select * from " & _
            "order_detail_a where order_id='" & strPSID & "'"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
            strSQL = "delete from order_detail_a " & "where order_id='" & strPSID & "'"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
        End If
    Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
    intNumWindows = Closewindow(intNumWindows)
    rsPSChk.Close
    Set rsPSChk = Nothing
    Set cmPSChk = Nothing
    Set rsMHQP = Nothing
End Sub