frmitemdata.frm

金算盘软件代码

    End With
End Sub

Private Sub msgGrid_Click()
'鼠标单击Grid响应的事件
Dim i As Integer, k As Integer
Dim xx 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
        '本循环找出本次调拨所在的列
        While (msgGrid.TextMatrix(0, i) <> "销售金额")
               i = i + 1
        Wend
        While (msgGrid.TextMatrix(0, k) <> "销售数量")
               k = k + 1
        Wend
        If (msgGrid.TextMatrix(0, 6) = "选择") And (msgGrid.MouseCol = 6) Then
           If (msgGrid.TextMatrix(ytextRow, 6) = "") 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
                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
    End If
End Sub

Private Sub msgGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'鼠标在Grid上移动响应的事件
    With msgGrid
        If x < .ColWidth(6) And y < .Rows * .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 j As Integer
    Dim k As Integer
    Dim recRecordset As rdoResultset
    Dim recOneToOther As rdoResultset
    Dim dblNumber As Double
    Dim qrf As QueryDef
    Dim lngID As Long
    Dim blnIsOK As Boolean
    With msgGrid
        'Grid为空则退出
        If .Rows = 1 Then
            Exit Sub
        End If
        '查找销售金额列
        j = 6
        k = 6
'        MousePointer = vbHourglass
        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
'        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.dblCurrSettlementAmount" _
'            & "=ItemActivityDetail.dblCurrSettlementAmount-qrf_Calc_Ditail.dblAmount," _
'            & "ItemActivityDetail.dblSettlementQuantity=ItemActivityDetail.dblSettlementQuantity-" _
'            & "qrf_Calc_Ditail.dblQuantity WHERE " _
'            & "ItemActivityDetail.lngActivityDetailID=PurchaseToSale.lngPurchaseActivityDetailID"
'        gclsBase.BaseDB.Execute Strsql
'        qrf.Close
'        Set qrf = Nothing
'        gclsBase.BaseDB.QueryDefs.Delete "qrf_Calc_Ditail"
'        Strsql = "DELETE PurchaseToSale.* FROM PurchaseToSale INNER JOIN (ItemActivity INNER JOIN " _
'            & "ItemActivityDetail ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) " _
'            & "ON PurchaseToSale.lngPurchaseActivityDetailID = ItemActivityDetail.lngActivityDetailID" _
'            & " WHERE ItemActivity.lngActivityID=" & mlngID
'        gclsBase.BaseDB.Execute Strsql
        '商品业务明细表
        Strsql = "SELECT ItemActivityDetail.dblCurrSettlementAmount," _
            & "ItemActivityDetail.lngActivityDetailID,ItemActivityDetail.dblSettlementQuantity" _
            & " FROM (ItemActivityDetail INNER JOIN ItemActivity ON ItemActivity.lngActivityID" _
            & "=ItemActivityDetail.lngActivityID) INNER JOIN ActivityType ON " _
            & "ActivityType.lngActivityTypeID=ItemActivity.lngActivityTypeID "
        Set recRecordset = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenDynaset)
        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 Not ToFormName.SaveBill() Then
            MousePointer = vbDefault
             recRecordset.Close
             ShowMsg Me.hwnd, "销售单录入有误，请修改", vbInformation, Me.Caption
             Unload Me
            Exit Sub
        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.dblCurrSettlementAmount" _
            & "=ItemActivityDetail.dblCurrSettlementAmount-qrf_Calc_Ditail.dblAmount," _
            & "ItemActivityDetail.dblSettlementQuantity=ItemActivityDetail.dblSettlementQuantity-" _
            & "qrf_Calc_Ditail.dblQuantity WHERE " _
            & "ItemActivityDetail.lngActivityDetailID=PurchaseToSale.lngPurchaseActivityDetailID"
        'gclsBase.BaseDB.Execute Strsql
        blnIsOK = gclsBase.ExecSQL(Strsql)
        qrf.Close
        Set qrf = Nothing
        gclsBase.BaseDB.QueryDefs.Delete "qrf_Calc_Ditail"
        Strsql = "DELETE PurchaseToSale.* FROM PurchaseToSale INNER JOIN (ItemActivity INNER JOIN " _
            & "ItemActivityDetail ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) " _
            & "ON PurchaseToSale.lngPurchaseActivityDetailID = ItemActivityDetail.lngActivityDetailID" _
            & " WHERE ItemActivity.lngActivityID=" & mlngID
        'gclsBase.BaseDB.Execute Strsql
        blnIsOK = gclsBase.ExecSQL(Strsql)
        
        Do While i < .Rows
            '写对照表
            Strsql = ""
            dblValue = 0
            dblNumber = 0
            lngID = Balance.GetSalePurchaseItemID(ToFormName.grdCol, Val(.TextMatrix(i, 0)))
'            recOneToOther.Edit
'            If recOneToOther.EOF() Then
'
'            End If
            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 PurchaseToSale (lngPurchaseActivityDetailID" _
                        & ",lngSaleActivityDetailID,dblQuantity,dblAmount) Values(" _
                        & .TextMatrix(i, 0) & "," & lngID & "," & dblNumber _
                        & "," & dblValue & ")"
'                    dblValue = C2Dbl(.TextMatrix(i, j))
'                    dblNumber = C2Dbl(.TextMatrix(i, k))
                    blnIsOK = gclsBase.ExecSQL(Strsql)
                End If
'            Else
'                Strsql = "INSERT INTO PurchaseToSale (lngPurchaseActivityDetailID" _
'                    & ",lngSaleActivityDetailID,dblQuantity,dblAmount) Values(" _
'                    & .TextMatrix(i, 0) & "," & lngID & "," & .TextMatrix(i, 5) _
'                    & "," & .TextMatrix(i, 2) & ")"
'                dblValue = .TextMatrix(i, 2)
'                dblNumber = Val(Trim(.TextMatrix(i, 5)))
'            End If
'            If Len(Strsql) > 0 Then
'                gclsBase.BaseDB.Execute Strsql
'            End If
'            '写商品业务明细表表
'            If dblValue > 0 Then
'                recRecordset ''' .FindFirst "lngActivityDetailID=" & .TextMatrix(i, 0)
                recRecordset.Edit
                recRecordset!dblCurrSettlementAmount = recRecordset!dblCurrSettlementAmount _
                    + dblValue
                recRecordset!dblSettlementQuantity = recRecordset!dblSettlementQuantity + dblNumber
                recRecordset.Update
            End If
            i = i + 1
        Loop
 '       End If
        gclsBase.BaseWorkSpace.CommitTrans
    End With
    MousePointer = vbHourglass
    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 InitCurrency()
'初始化币种
    Dim strFrom As String
    Dim Strsql As String
    Dim recRecordset As rdoResultset
    Dim strName As String
    Dim qrf As QueryDef
    With mclsGrid1.ListSet
        strFrom = .FromOfSql
    End With
    Strsql = "SELECT lngCurrencyID,strCurrencyName,STRING(SUM (0) ,' ') " _
        & "AS STRsum " & strFrom & " GROUP BY lngCurrencyID,strCurrencyName"
    Set qrf = gclsBase.BaseDB.CreateQueryDef("", Strsql)
    qrf.Parameters("mlngCurrencyID") = -1
    qrf.Parameters("DetailID") = mlngID
    Set recRecordset = qrf.OpenRecordset
    If Not recRecordset.EOF() Then
        recRecordset.MoveLast
        recRecordset.MoveFirst
        strName = recRecordset!strCurrencyName
        litItemData.SeekCol = "1,2"
        Set litItemData.Recordset = recRecordset
'        litItemData.ColWidth(1) = 0
'        litItemData.ColWidth(3) = 0
        litItemData.ReferWidth = litItemData.Width
        If litItemData.SeekId(mlngCurrencyID) = False Then
           DispartString ToFormName.lblField(7).Caption, Strsql, strName                 '取单位名称
           litItemData.Text = strName
        End If
    End If
    recRecordset.Close
    Set recRecordset = Nothing
    qrf.Close
    Set qrf = Nothing
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 = 4
                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