frmcheckpurchase.frm

金算盘软件代码

            End If
            blnIsEdit = True
            txtEdit.Text = Format(txtEdit.Text, "###,###,##0.00")
            If CDbl(txtEdit.Text) <> 0 Then
               .TextMatrix(.Row, 6) = "√"
            Else
               .TextMatrix(.Row, 6) = ""
            End If
        End If
'        If Val(.TextMatrix(.Row, .col)) > 0 Or (Val(.TextMatrix(.Row, .col)) = 0 And Val(txtEdit.Text) > 0) And blnIsEdit Then
'            .TextMatrix(.Row, 6) = ""
'        End If
    End With
End Sub
Private Sub msgGrid_Click()
'鼠标单击Grid响应的事件
Dim i As Integer, k As Integer, p As Integer
Dim m As Integer, n As Integer, xx As Double, temp As Double
'On Error GoTo Err
    ytextRow = msgGrid.Row
    ytextCol = msgGrid.col
    If ytextRow > 0 And ytextRow < msgGrid.Rows Then
         i = intfixl + 1
         k = intfixl + 1
         p = k
        '本循环找出本次调拨所在的列
        While (msgGrid.TextMatrix(0, i) <> "开票金额")
               i = i + 1
        Wend
        While (msgGrid.TextMatrix(0, k) <> "开票数量")
               k = k + 1
        Wend
        While (msgGrid.TextMatrix(0, p) <> "关闭")
               p = p + 1
        Wend
        If (msgGrid.TextMatrix(0, 6) = "选择") And (msgGrid.MouseCol = 6) Then
           If (msgGrid.TextMatrix(ytextRow, 6) = "") And (msgGrid.TextMatrix(ytextRow, p) <> "√") Then          '打√情况
               msgGrid.TextMatrix(ytextRow, 6) = "√"
               xx = getnumber(ytextRow, 2) - getnumber(ytextRow, i)
               msgGrid.TextMatrix(ytextRow, i) = msgGrid.TextMatrix(ytextRow, 2)
                              '总结算金额及数量的更新
               hlb(i).Caption = CStr(CDbl(IIf(Len(hlb(i).Caption) = 0, "0", hlb(i).Caption)) + xx)
               msgGrid.TextMatrix(ytextRow, k) = msgGrid.TextMatrix(ytextRow, 5)
           Else
               If (msgGrid.TextMatrix(ytextRow, p) <> "√") Then
                    msgGrid.TextMatrix(ytextRow, 6) = ""       '取消打√(结算)情况
                    hlb(i).Caption = CStr(CDbl(hlb(i).Caption) - getnumber(ytextRow, i))
                    msgGrid.TextMatrix(ytextRow, k) = ""
                    msgGrid.TextMatrix(ytextRow, i) = ""
               End If
           End If
       Else
        With msgGrid
        If .TextMatrix(0, .col) = "关闭" And (msgGrid.MouseCol = p) Then
            If .TextMatrix(ytextRow, .col) = "" Then
               .TextMatrix(ytextRow, 6) = ""
                xx = 0 - getnumber(ytextRow, i)
                msgGrid.TextMatrix(ytextRow, i) = ""
                hlb(i).Caption = CStr(CDbl(IIf(Len(hlb(i).Caption) = 0, "0", hlb(i).Caption)) + xx)
    '               'hLb(i).Caption = Format((CDbl(hLb(i).Caption) + xx), "###,###,##0.00")
                msgGrid.TextMatrix(ytextRow, k) = ""
                .TextMatrix(ytextRow, .col) = "√"
            Else
                .TextMatrix(ytextRow, .col) = ""
            End If
        End If
        End With
       End If
    End If
End Sub
Private Sub msgGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'鼠标在Grid上移动响应的事件
    Dim intLong As Integer
    With msgGrid
        intLong = Balance.CheckColsedCol(msgGrid, .LeftCol, mintCloseCol)
        If (x < .ColWidth(6) And y < .Rows * .RowHeight(0) And y > .RowHeight(0)) Or (x < intLong And y < .Rows * .RowHeight(0) And x > intLong - .ColWidth(mintCloseCol) And y > .RowHeight(0)) Then
            .MousePointer = vbCustom
        Else
            .MousePointer = vbDefault
        End If
    End With
End Sub
Private Sub FinishGrid(isOk As Boolean)
'按‘确定’按钮响应的存盘动作
'isOk=True， 表示存盘后退出窗体；
'isOk=False，表示存盘后不退出窗体；
    Dim dblValue As Double
    Dim Strsql As String
    Dim i As Integer
    Dim p As Integer
    Dim j As Integer
    Dim k As Integer
    Dim recRecordset As rdoResultset
    Dim recOneToOther As rdoResultset
    Dim dblNumber As Double
    Dim lngID As Integer
    Dim blnIsOK As Boolean
    Dim qrf As rdoQuery
    With msgGrid
        'Grid为空则退出
        If .Rows = 1 Then
            Exit Sub
        End If
        '查找销售金额列
'        MousePointer = vbHourglass
        j = 6
        p = 6
        k = 6
        Do While j < .Cols
            If Trim(.TextMatrix(0, j)) = "开票金额" Then
                Exit Do
            End If
            j = j + 1
        Loop
        Do While k < .Cols
            If Trim(.TextMatrix(0, k)) = "开票数量" Then
                Exit Do
            End If
            k = k + 1
        Loop
        While (msgGrid.TextMatrix(0, p) <> "关闭")
              p = p + 1
        Wend
        
'        Strsql = "SELECT InvoiceToPurchase.* FROM InvoiceToPurchase INNER JOIN (ItemActivityDetail " _
'            & "INNER JOIN ItemActivity ON ItemActivityDetail.lngActivityID = ItemActivity.lngActivityID) " _
'            & "ON InvoiceToPurchase.lngPurchaseActivityDetailID = ItemActivityDetail.lngActivityDetailID" _
'            & " Where ItemActivity.lngActivityID = " & mlngID
'        On Error GoTo Errors1
'        Set qrf = gclsBase.BaseDB.CreateQueryDef("qrf_Calc_Ditail", Strsql)
'        On Error GoTo 0
'        Strsql = "UPDATE qrf_Calc_Ditail,ItemActivityDetail SET ItemActivityDetail.dblCurrInvoiceAmount" _
'            & "=ItemActivityDetail.dblCurrInvoiceAmount-qrf_Calc_Ditail.dblCurrInvoiceAmount, " _
'            & "ItemActivityDetail.dblInvoiceQuantity=ItemActivityDetail.dblInvoiceQuantity-" _
'            & "qrf_Calc_Ditail.dblInvoiceQuantity WHERE qrf_Calc_Ditail.lngPurchaseActivityDetailID=ItemActivityDetail.lngActivityDetailID"
'        gclsBase.BaseDB.Execute Strsql
'        qrf.Close
'        Set qrf = Nothing
'        gclsBase.BaseDB.QueryDefs.Delete "qrf_Calc_Ditail"
'        Strsql = "DELETE InvoiceToPurchase.* FROM InvoiceToPurchase INNER JOIN (ItemActivity INNER JOIN " _
'            & "ItemActivityDetail ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) " _
'            & "ON InvoiceToPurchase.lngPurchaseActivityDetailID = ItemActivityDetail.lngActivityDetailID" _
'            & " WHERE ItemActivity.lngActivityID=" & mlngID
'        gclsBase.BaseDB.Execute Strsql
        '商品业务明细表
        Strsql = "SELECT ItemActivityDetail.dblCurrInvoiceAmount," _
            & "ItemActivityDetail.lngActivityDetailID,ItemActivityDetail.dblInvoiceQuantity" _
            & " FROM (ItemActivityDetail INNER JOIN ItemActivity ON ItemActivity.lngActivityID" _
            & "=ItemActivityDetail.lngActivityID) INNER JOIN ActivityType ON " _
            & "ActivityType.lngActivityTypeID=ItemActivity.lngActivityTypeID "
        Set recRecordset = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenDynamic, rdConcurValues)
        If recRecordset.EOF Then
            MousePointer = vbDefault
            Unload Me
            Exit Sub
        Else
            recRecordset.MoveLast
            recRecordset.MoveFirst
        End If
        i = 1
        '开始事务
        gclsBase.BaseWorkSpace.BeginTrans
        '写Grid
        Call Balance.WriteSaleOrPurchaseGrid(msgGrid, ToFormName.grdCol, True, j, 0, k, ToFormName)
        '调用存盘函数
        If ToFormName.grdCol.Rows > 1 Then
          If Not ToFormName.SaveBill() Then
            MousePointer = vbDefault
            ShowMsg Me.hwnd, "采购单录入有误，请修改", vbInformation, Me.Caption
            Unload Me
            Exit Sub
          End If
        End If
        '存对话框
'        If isOk = True Then
        
        
        Strsql = "SELECT InvoiceToPurchase.* FROM InvoiceToPurchase INNER JOIN (ItemActivityDetail " _
            & "INNER JOIN ItemActivity ON ItemActivityDetail.lngActivityID = ItemActivity.lngActivityID) " _
            & "ON InvoiceToPurchase.lngPurchaseActivityDetailID = ItemActivityDetail.lngActivityDetailID" _
            & " Where ItemActivity.lngActivityID = " & mlngID                 '取原本次开票数量、金额。
        On Error GoTo Errors1
        Set qrf = gclsBase.BaseDB.CreateQuery("qrf_Calc_Ditail", Strsql)
        On Error GoTo 0
        Strsql = "UPDATE qrf_Calc_Ditail,ItemActivityDetail SET ItemActivityDetail.dblCurrInvoiceAmount" _
            & "=ItemActivityDetail.dblCurrInvoiceAmount-qrf_Calc_Ditail.dblCurrInvoiceAmount, " _
            & "ItemActivityDetail.dblInvoiceQuantity=ItemActivityDetail.dblInvoiceQuantity-" _
            & "qrf_Calc_Ditail.dblInvoiceQuantity WHERE qrf_Calc_Ditail.lngPurchaseActivityDetailID=ItemActivityDetail.lngActivityDetailID"
        'blnIsOK = gclsBase.BaseDB.Execute(Strsql)
        blnIsOK = gclsBase.ExecSQL(Strsql)
        qrf.Close
        Set qrf = Nothing
'        gclsBase.BaseDB.rdoQueries.Delete "qrf_Calc_Ditail"
        Strsql = "DELETE InvoiceToPurchase.* FROM InvoiceToPurchase INNER JOIN (ItemActivity INNER JOIN " _
            & "ItemActivityDetail ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) " _
            & "ON InvoiceToPurchase.lngPurchaseActivityDetailID = ItemActivityDetail.lngActivityDetailID" _
            & " WHERE ItemActivity.lngActivityID=" & mlngID
        blnIsOK = gclsBase.ExecSQL(Strsql)
        Do While i < .Rows
            '写对照表
            Strsql = ""
            dblValue = 0
            dblNumber = 0
            lngID = Balance.GetSalePurchaseItemID(ToFormName.grdCol, Val(.TextMatrix(i, 0)))
            If .TextMatrix(i, 6) <> "" Then
                If Val(Trim(.TextMatrix(i, j))) <> 0 Then        '先把数量转换为最小单位数量
                    dblValue = C2Dbl(.TextMatrix(i, j))
                    dblNumber = Balance.translate_minsl(.TextMatrix(i, k), C2Dbl(.TextMatrix(i, 3)))
                    Strsql = "INSERT INTO InvoiceToPurchase (lngInvoiceActivityDetailID" _
                        & ",lngPurchaseActivityDetailID,dblInvoiceQuantity,dblCurrInvoiceAmount) Values(" _
                        & lngID & "," & .TextMatrix(i, 0) & "," & dblNumber _
                        & "," & dblValue & ")"
                    'dblValue = C2Dbl(.TextMatrix(i, j))
'                    dblNumber = C2Dbl(.TextMatrix(i, k))
                    blnIsOK = gclsBase.ExecSQL(Strsql)
                End If
'            Else
'                Strsql = "INSERT INTO InvoiceToPurchase (lngInvoiceActivityDetailID" _
'                    & ",lngPurchaseActivityDetailID,dblInvoiceQuantity,dblCurrInvoiceAmount) Values(" _
'                    & lngID & "," & .TextMatrix(i, 0) & "," & .TextMatrix(i, 2) _
'                    & "," & .TextMatrix(i, 2) & ")"
'                dblValue = .TextMatrix(i, 2)
'                dblNumber = Val(Trim(.TextMatrix(i, 5)))
  '          End If
            '写商品业务明细表表
   '         If dblValue > 0 Then
                recRecordset.FindFirst "lngActivityDetailID=" & .TextMatrix(i, 0)
                recRecordset.Edit
                If msgGrid.TextMatrix(i, p) = "√" Then
                   recRecordset!blnIsNoInvoice = True
                End If
                recRecordset!dblCurrInvoiceAmount = recRecordset!dblCurrInvoiceAmount _
                    + dblValue
                recRecordset!dblInvoiceQuantity = recRecordset!dblInvoiceQuantity + dblNumber
                recRecordset.Update
            End If
            i = i + 1
        Loop
       gclsBase.BaseWorkSpace.CommitTrans
    End With
    MousePointer = vbDefault
    If isOk = True Then
       Unload Me
    End If
    Exit Sub
Errors1:
    MousePointer = vbDefault
'    gclsBase.BaseDB.QueryDefs.Delete "qrf_Calc_Ditail"
    Set qrf = gclsBase.BaseDB.CreateQuery("qrf_Calc_Ditail", Strsql)
    Resume Next
End Sub
Private Sub InitListText()
    '初始化单位列表
    Dim strFrom As String
    Dim Strsql As String
    Dim recRecordset As rdoResultset
    Dim strName As String
    Dim qrf As rdoQuery
    Dim lngCustomerID As Long
    With mclsGrid1.ListSet
        strFrom = .FromOfSql
    End With
    Strsql = "SELECT lngCustomerID,strCustomerName,STRING(SUM (0) ,' ') " _
        & "AS STRsum " & strFrom & " GROUP BY lngCustomerID,strCustomerName"
    Set qrf = gclsBase.BaseDB.CreateQuery("", Strsql)
    qrf.Parameters("mlngCustomerID") = -1
    qrf.Parameters("mlngCurrencyID") = mlngCurrencyID
    qrf.Parameters("DetailID") = mlngID
    Set recRecordset = qrf.OpenResultset
    If Not recRecordset.EOF() Then
        recRecordset.MoveLast
        recRecordset.MoveFirst
        strName = recRecordset!strCustomerName
        lngCustomerID = recRecordset!lngCustomerID
'        intCount = 1
'        Do While intCount <= recRecordset.RecordCount
'            If mlngCustomerID = recRecordset!lngCustomerID Then
'               Exit Do
'            End If
'            intCount = intCount + 1
'            recRecordset.MoveNext
'        Loop
'        If intCount <= recRecordset.RecordCount Then
        litEdit.SeekCol = "1,2"
        Set litEdit.Recordset = recRecordset
        litEdit.ReferWidth = litEdit.Width
        If litEdit.SeekId(mlngCustomerID) = False Then
           DispartString ToFormName.lblHead(1).Caption, Strsql, strName                 '取单位名称
           litEdit.Text = strName
        End If
'        litEdit.Text = strName
        recRecordset.Close
        Set recRecordset = Nothing
        qrf.Close
        Set qrf = Nothing
    End If
End Sub
'计算合计
Private Sub SumGrid(dblText As Double)
    Dim i As Integer
    Dim j As Integer
    Dim dblValue As Double
    i = 1
    dblValue = 0
    If mlngCol > 0 Then
        With msgGrid
            If Trim(.TextMatrix(0, mlngCol)) <> "开票金额" Then
                j = intfixl
                Do While j < .Cols
                    If .TextMatrix(0, j) = "开票金额" Then
                        Exit Do
                    End If
                    j = j + 1
                Loop
                i = 1
                dblValue = 0
                Do While i < .Rows
                    dblValue = dblValue + Val(Format(.TextMatrix(i, j), "#########0.00"))
                    i = i + 1
                Loop
                hlb(j) = Format(dblValue, "###,###,##0.00")
            End If
        End With
        mlngCol = 0
    End If
End Sub