frmchecksale.frm

金算盘软件代码

           .TextMatrix(.Row, 6) = ""
        End If
    End With
End Sub
'鼠标单击Grid响应的事件
Private Sub msgGrid_Click()
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
'鼠标在Grid上移动响应的事件
Private Sub msgGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    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)
    Dim dblValue As Double
    Dim Strsql As String
    Dim i As Integer
    Dim j As Integer
    Dim p As Integer
    Dim k As Integer
    Dim blnIsOK As Boolean
    Dim recresultset As rdoResultset
    Dim recOneToOther As rdoResultset
    Dim dblNumber As Double
    Dim qrf As QueryDef
    Dim lngID As Long
    With msgGrid
        'Grid为空则退出
        If .Rows = 1 Then
            Exit Sub
        End If
        '查找销售金额列
'        MousePointer = vbHourglass
        j = 6
        k = 6
        p = 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 PurchaseToSale.* FROM (ItemActivity INNER JOIN ItemActivityDetail " _
'            & "ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) INNER JOIN " _
'            & " PurchaseToSale ON ItemActivityDetail.lngActivityDetailID = " _
'            & "PurchaseToSale.lngSaleActivityDetailID 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.dblAmount," _
'            & "ItemActivityDetail.dblInvoiceQuantity=ItemActivityDetail.dblInvoiceQuantity-" _
'            & "qrf_Calc_Ditail.dblQuantity WHERE qrf_Calc_Ditail.lngSaleActivityDetailID=ItemActivityDetail.lngActivityDetailID"
'        gclsBase.BaseDB.Execute Strsql
'        qrf.Close
'        Set qrf = Nothing
'        gclsBase.BaseDB.QueryDefs.Delete "qrf_Calc_Ditail"
'        Strsql = "DELETE InvoiceToSale.* FROM InvoiceToSale INNER JOIN (ItemActivity INNER JOIN " _
'            & "ItemActivityDetail ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) " _
'            & "ON InvoiceToSale.lngSaleActivityDetailID = 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 recresultset = gclsBase.BaseDB.OpenResultset(Strsql, dbOpenDynaset)
        If recresultset.EOF Then
            MousePointer = vbDefault
            Unload Me
            Exit Sub
        Else
            recresultset.MoveLast
            recresultset.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 PurchaseToSale.* FROM (ItemActivity INNER JOIN ItemActivityDetail " _
            & "ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) INNER JOIN " _
            & " PurchaseToSale ON ItemActivityDetail.lngActivityDetailID = " _
            & "PurchaseToSale.lngSaleActivityDetailID 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.dblAmount," _
            & "ItemActivityDetail.dblInvoiceQuantity=ItemActivityDetail.dblInvoiceQuantity-" _
            & "qrf_Calc_Ditail.dblQuantity WHERE qrf_Calc_Ditail.lngSaleActivityDetailID=ItemActivityDetail.lngActivityDetailID"
'        gclsBase.BaseDB.Execute Strsql
        blnIsOK = gclsBase.ExecSQL(Strsql)
        qrf.Close
        Set qrf = Nothing
        gclsBase.BaseDB.QueryDefs.Delete "qrf_Calc_Ditail"
        Strsql = "DELETE InvoiceToSale.* FROM InvoiceToSale INNER JOIN (ItemActivity INNER JOIN " _
            & "ItemActivityDetail ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) " _
            & "ON InvoiceToSale.lngSaleActivityDetailID = ItemActivityDetail.lngActivityDetailID" _
            & " WHERE ItemActivity.lngActivityID=" & mlngID
'        gclsBase.BaseDB.Execute Strsql
        blnIsOK = gclsBase.ExecSQL(Strsql)
        Do While i < .Rows
            '写对照表
            Strsql = ""
            dblValue = 0
            dblNumber = 0
'            recOneToOther.Edit
'            If recOneToOther.EOF() Then
'
'            End If
            lngID = Balance.GetSalePurchaseItemID(ToFormName.grdCol, Val(.TextMatrix(i, 0)))
            If .TextMatrix(i, 6) = "√" Then
               dblValue = C2Dbl(.TextMatrix(i, j))
               dblNumber = Balance.translate_minsl(.TextMatrix(i, k), C2Dbl(.TextMatrix(i, 3)))
               If Val(Trim(.TextMatrix(i, j))) <> 0 Then
                    Strsql = "INSERT INTO InvoiceToSale (lngInvoiceActivityDetailID" _
                        & ",lngSaleActivityDetailID,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
                '写商品业务明细表表
'                recresultset ''' .FindFirst "lngActivityDetailID=" & .TextMatrix(i, 0)
                recresultset.Edit
                If msgGrid.TextMatrix(i, p) = "√" Then
                   recresultset!blnIsNoInvoice = True
                End If
                recresultset!dblCurrInvoiceAmount = recresultset!dblCurrInvoiceAmount _
                    + dblValue
                recresultset!dblInvoiceQuantity = recresultset!dblInvoiceQuantity + dblNumber
                recresultset.Update
            End If
            i = i + 1
        Loop
 '       End If
        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.CreateQueryDef("qrf_Calc_Ditail", Strsql)
    Resume Next
End Sub
Private Sub InitListText()
    '初始化单位列表
    Dim strFrom As String
    Dim Strsql As String
    Dim recresultset As rdoResultset
    Dim strName As String
    Dim qrf As QueryDef
    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.CreateQueryDef("", Strsql)
    qrf.Parameters("mlngCustomerID") = -1
    qrf.Parameters("mlngCurrencyID") = mlngCurrencyID
    qrf.Parameters("DetailID") = mlngID
'    Set recresultset = qrf.OpenResultset
'    If Not recresultset.EOF() Then
'        recresultset.MoveLast
'        recresultset.MoveFirst
' '       strName = recresultset!strCustomerName
' '       mlngCustomerID = recresultset!lngCustomerID
'        litEdit.SeekCol = "1,2"
'        Set litEdit.Resultset = recresultset
'        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
'        recresultset.Close
'        Set recresultset = 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), "#.00"))
                    i = i + 1
                Loop
                hlb(j) = Format(dblValue, "###,###,###.00")
            End If
        End With
        mlngCol = 0
    End If
End Sub