frmsalesbillinfo.frm

金算盘软件代码

Attribute VB_Exposed = False
'---------------------------------
'销售单回款资料
'王兴元
'1998年7月
'提供给外部调用的方法
'   SetList(frmName,ActivityID)
'---------------------------------
Private WithEvents mclsSubClass As SubClass32.SubClass          '“钩子”对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private mclsGrid As Grid
Private ActivityID1 As Long
Private ActivityTypeID1 As Long
Private blnBz As Boolean
Private frm As Form

Private lngCurID As Long
Private lngActID As Long
Private lngDepID As Long
Private lngEmpID As Long
Private lngJobID As Long
Private lngClsID1 As Long
Private lngClsID2 As Long
Private lngCustomerID As Long
Private strRate As String
Private strCurrAmount As String
Private strAmount As String

Private intCurDec As Integer
Private intRateDec As Integer
Private lngNowID As Long

'lngActivityID:销售单号
Public Sub SetList(frmName As Form, ByVal ActivityID As Long)
    Dim strSQL As String
    Dim recTemp As rdoResultset
    Dim i As Integer
    Dim dblMoney As Double
'    Dim Que As rdoQuery
    
    On Error GoTo Err
    
    Set frm = frmName
    
    Screen.MousePointer = vbHourglass
    
    '===================判断有无收款记录====================
    If gclsBase.ControlAccount Then
            strSQL = "SELECT Decode(zSalesBillInfo.strSource,'1',Activity.lngActivityID,'2'," _
                            & "ItemActivity.lngActivityID,ArapInit.lngArapInitID) as 收款ID, Decode(zSalesBillInfo.strSource,'1'," _
                            & "Activity.strDate,'2',ItemActivity.strDate,ArapInit.strDate) " _
                            & "as 日期,Decode(zSalesBillInfo.strSource,'1',ReceiptType.strReceiptTypeName," _
                            & "'2',ReceiptType_1.strReceiptTypeName,ReceiptType_2.strReceiptTypeName) as 单据类型,"
            strSQL = strSQL & "Decode(zSalesBillInfo.strSource,'1',Activity.strReceiptNo || LPAD(Activity.lngReceiptNo,4,'0')," _
                            & "'2',ItemActivity.strReceiptNo || " _
                            & "LPAD(ItemActivity.lngReceiptNo,4,'0'),ArapInit.strReceiptNo||" _
                            & "LPAD(ArapInit.lngReceiptNo,4,'0')) as 单据号,zSalesBillInfo.dblCurrPaymentAmount AS 收款金额," _
                            & "zSalesBillInfo.dblCurrDiscount AS 折扣金额,0 AS 应收余额,Decode(zSalesBillInfo.strSource,'1'," _
                            & "Activity.lngActivityTypeID,'2',ItemActivity.lngActivityTypeID,"
            strSQL = strSQL & "ArapInit.lngActivityTypeID) as 业务类型ID,Decode(zSalesBillInfo.strSource,'1'," _
                            & "CurrencyS.bytCurrencyDec,'2',CurrencyS_1.bytCurrencyDec," _
                            & "CurrencyS_2.bytCurrencyDec) as bytCurrencyDec,zSalesBillInfo.strSource AS strSource  "
            strSQL = strSQL & " FROM zSalesBillInfo,Activity,ActivityDetail,ItemActivity,ItemActivityDetail," _
                            & "ARAPInit,ReceiptType,ReceiptType ReceiptType_1,ReceiptType ReceiptType_2,Currencys,Currencys Currencys_1,Currencys Currencys_2 "
            strSQL = strSQL & " WHERE zSalesBillInfo.lngCashActivityDetailID = ActivityDetail.lngActivityDetailID(+) " _
                            & " AND Activity.lngActivityID(+) = ActivityDetail.lngActivityID " _
                            & " AND zSalesBillInfo.lngActivityID = ItemActivity.lngActivityID" _
                            & " AND ItemActivity.lngActivityID(+) = ItemActivityDetail.lngActivityID " _
                            & " AND zSalesBillInfo.lngCashActivityDetailID = ARAPInit.lngARAPInitID(+) " _
                            & " AND Activity.lngReceiptTypeID = ReceiptType.lngReceiptTypeID(+) "
            strSQL = strSQL & " AND ARAPInit.lngReceiptTypeID = ReceiptType_1.lngReceiptTypeID(+) " _
                            & " AND ItemActivity.lngReceiptTypeID = ReceiptType_2.lngReceiptTypeID(+) " _
                            & " AND ActivityDetail.lngCurrencyID = Currencys.lngCurrencyID(+) " _
                            & " AND ARAPInit.lngCurrencyID = Currencys_1.lngCurrencyID(+) " _
                            & " AND ItemActivity.lngCurrencyID = Currencys_2.lngCurrencyID(+) " _
                            & " AND zSalesBillInfo.dblCurrPaymentAmount<>0 " _
                            & " AND zSalesBillInfo.lngActivityID=" & ActivityID
    Else
            strSQL = "SELECT Decode(zSalesBillInfo.strSource,'0',ArapInitQuery.lngArapInitID," _
                            & "'1',ActivityQuery.ACTIVITY_LNGACTIVITYID," _
                            & "'2',ItemActivityQuery.lngActivityID," _
                            & "VoucherQuery.LNGVOUCHERID1) AS 收款ID,"
            strSQL = strSQL & "Decode(zSalesBillInfo.strSource,'0',ArapInitQuery.strDate," _
                            & "'1',ActivityQuery.strDate," _
                            & "'2',ItemActivityQuery.strDate," _
                            & "VoucherQuery.strDate) as 日期," _
                            & "Decode(zSalesBillInfo.strSource,'0',VoucherType.strVoucherTypeName,"
            strSQL = strSQL & "'1',ReceiptType.strReceiptTypeName," _
                            & "'2',ReceiptType_1.strReceiptTypeName," _
                            & "VoucherType_1.strVoucherTypeName) as 单据类型," _
                            & "Decode(zSalesBillInfo.strSource,'0',VoucherType.strVoucherTypeCode,"
            strSQL = strSQL & "'1',ActivityQuery.strReceiptNo," _
                            & "'2',ItemActivityQuery.strReceiptNo," _
                            & "VoucherType_1.strVoucherTypeCode) || " _
                            & "LPAD(Decode(zSalesBillInfo.strSource,'0',ArapInitQuery.intVoucherNO,"
            strSQL = strSQL & "'1',ActivityQuery.lngReceiptNo," _
                            & "'2',ItemActivityQuery.lngReceiptNo," _
                            & "VoucherQuery.intVoucherNo),4,'0') as 单据号," _
                            & "zSalesBillInfo.dblCurrPaymentAmount AS 收款金额," _
                            & "zSalesBillInfo.dblCurrDiscount AS 折扣金额," _
                            & "0 AS 应收余额," _
                            & "Decode(zSalesBillInfo.strSource,'0',ArapInitQuery.lngVoucherTypeID," _
                            & "'1',ActivityQuery.lngActivityTypeID," _
                            & "'2',ItemActivityQuery.lngActivityTypeID,"
            strSQL = strSQL & "VoucherQuery.lngVoucherTypeID) as 业务类型ID," _
                            & "Decode(zSalesBillInfo.strSource,'0',ArapInitQuery.bytCurrencyDec," _
                            & "'1',ActivityQuery.bytCurrencyDec," _
                            & "'2',ItemActivityQuery.bytCurrencyDec," _
                            & "VoucherQuery.bytCurrencyDec) as bytCurrencyDec," _
                            & "zSalesBillInfo.strSource as strSource "
            strSQL = strSQL & " FROM zSalesBillInfo,ActivityQuery,ItemActivityQuery,VoucherQuery,ArapInitQuery, " _
                            & "VoucherType,VoucherType VoucherType_1,ReceiptType,ReceiptType ReceiptType_1 "
            strSQL = strSQL & " WHERE zSalesBillInfo.lngCashActivityDetailID = ActivityQuery.lngActivityDetailID(+) " _
                            & " AND zSalesBillInfo.lngCashActivityDetailID = ItemActivityQuery.lngActivityDetailID(+) " _
                            & " AND zSalesBillInfo.lngCashActivityDetailID = VoucherQuery.lngVoucherDetailID(+) " _
                            & " AND zSalesBillInfo.lngCashActivityDetailID = ArapInitQuery.lngARAPInitID(+) " _
                            & " AND ArapInitQuery.lngVoucherTypeID = VoucherType.lngVoucherTypeID(+) "
            strSQL = strSQL & " AND VoucherQuery.lngVoucherTypeID = VoucherType_1.lngVoucherTypeID(+) " _
                            & " AND ItemActivityQuery.lngReceiptTypeID = ReceiptType.lngReceiptTypeID(+) " _
                            & " AND ActivityQuery.lngReceiptTypeID = ReceiptType_1.lngReceiptTypeID(+) " _
                            & " AND zSalesBillInfo.dblCurrPaymentAmount<>0 " _
                            & " AND zSalesBillInfo.lngActivityID=" & ActivityID
    End If
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    
    lngNowID = ActivityID
    
    '===================有收款记录====================
    If Not (recTemp.EOF And recTemp.BOF) Then
        recTemp.MoveLast
        recTemp.MoveFirst
    End If
    Set datGrid.Resultset = recTemp
    '显示"销售单信息"
    With frmSalesBillInfo
        .lblField(0).Caption = frmName.lblHead(1).Caption  '单位
        lngCustomerID = C2lng(frmName.lblHead(0).Tag)
        .lblField(1).Caption = frmName.lblField(1).Caption   '单据号
        .lblField(2).Caption = cutString(frmName.lblField(12).Caption)  '付款条件
        .lblField(3).Caption = frmName.lblField(2).Caption   '日期
        .lblField(4).Caption = cutString(frmName.lblField(7).Caption)  '币种
        .lblField(5).Caption = cutString(frmName.lblField(4).Caption)  '部门
        .lblField(6).Caption = cutString(frmName.lblField(3).Caption)  '业务员
    End With
    '---------------GET OTHER ID-------------------------
        lngCurID = frmName.GetOtherID(7)   'CurrencyID
        lngActID = frmName.GetOtherID(5)    'lngAccountID
        lngCustomerID = C2lng(frmName.lblHead(0).Tag)   'lngCustomerID
        lngDepID = frmName.GetOtherID(4)    'lngDepartmentID
        lngEmpID = frmName.GetOtherID(3)    'lngEmployeeID
        lngJobID = 0                        'lngJobID
        lngClsID1 = frmName.GetOtherID(9)    'lngClassID1
        lngClsID2 = frmName.GetOtherID(8)    'lngClassID2
        Call BillPublic.CurRateDec(lngCurID, intCurDec, intRateDec)
        lblField(7).Caption = Format(GetLabel(frmName.lblTotal(14)), FormatString(intCurDec))
        strRate = Format(GetLabel(frmName.lblField(6)), FormatString(intRateDec))   'Rate
        strAmount = Format(GetLabel(frmName.lblTotal(15)), FormatString(gclsBase.NaturalCurDec)) 'strAmount
        strCurrAmount = Format(GetLabel(lblField(7)), FormatString(intCurDec))    'strCurrAmount
    '------------------END ------------------------------

    '显示"收款信息":将生成结果绑定到MSFlexGrid控件中:
'    If Not recTemp Is Nothing Then
'        If recTemp.RowCount > 0 Then
'            recTemp.MoveFirst
'        End If
'    End If
    
    '-------------计算“余额”--------------
    dblMoney = C2Dbl(frmSalesBillInfo.lblField(7).Caption)
    With grdList
        For i = 1 To grdList.Rows - 1
           .TextMatrix(i, 4) = Format(C2Dbl(.TextMatrix(i, 4)), FormatString(IIf(C2Dbl(.TextMatrix(i, 8)) = 0, 0, C2Dbl(.TextMatrix(i, 8)))))
           .TextMatrix(i, 5) = Format(C2Dbl(.TextMatrix(i, 5)), FormatString(IIf(C2Dbl(.TextMatrix(i, 8)) = 0, 0, C2Dbl(.TextMatrix(i, 8)))))
           dblMoney = dblMoney - C2Dbl(.TextMatrix(i, 4)) - C2Dbl(.TextMatrix(i, 5))
           .TextMatrix(i, 6) = Format(C2Dbl(dblMoney), FormatString(IIf(C2Dbl(.TextMatrix(i, 8)) = 0, 0, C2Dbl(.TextMatrix(i, 8)))))
           '写单据Type
           Call ID2str(i, .TextMatrix(i, 9))
        Next i
    End With
    grdList.ColWidth(1) = 990
    grdList.ColWidth(2) = 1057
    grdList.ColWidth(3) = 825
    grdList.ColWidth(4) = 1340
    grdList.ColWidth(5) = 1340
    grdList.ColWidth(6) = 1340
    grdList.ColAlignment(4) = 1
    grdList.ColAlignment(5) = 1
    grdList.ColAlignment(6) = 1
    grdList.ColWidth(7) = 0
    grdList.ColWidth(8) = 0
    grdList.ColWidth(9) = 0
    mclsGrid.ColOfs = 1
    
    mclsGrid.SetupStyle
    grdList.ColSel = grdList.Cols - 1
    blnBz = False
    If grdList.Rows = grdList.FixedRows Then
        cmdButton(1).Enabled = False
    End If
    Label2.Caption = frmName.Caption & "单信息"
    Screen.MousePointer = vbDefault
    frmSalesBillInfo.Show vbModal
    Set recTemp = Nothing
    If blnBz Then
        ShowBill ActivityTypeID1, ActivityID1
    End If
    Unload Me
    Exit Sub
Err:
    ShowMsg Me.hWnd, "系统出错！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
    Screen.MousePointer = vbDefault
End Sub


Private Sub cmdButton_Click(Index As Integer)
    Select Case Index
    Case 0
        cmdOK_Click
    Case 1
        CmdRelating_Click
    Case 2
        If grdList.Rows > 1 And grdList.ColSel <> 0 Then
            If grdList.Row < 1 Then grdList.Row = 1
            Me.Hide
            ActivityTypeID1 = C2lng(grdList.TextMatrix(grdList.Row, 7))
            Screen.MousePointer = vbHourglass
'----------------------------------------------
            strCurrAmount = grdList.TextMatrix(grdList.Row, 6)
            strRate = Format(RateValue(lngCurID, lblField(3).Caption), FormatString(intRateDec))
            
            If blnInDirect(lngCurID) Then
                strAmount = Format(C2Dbl(strCurrAmount) / IIf(C2Dbl(strRate) = 0, 1, C2Dbl(strRate)), FormatString(gclsBase.NaturalCurDec))
            Else
                strAmount = Format(C2Dbl(strCurrAmount) * IIf(C2Dbl(strRate) = 0, 1, C2Dbl(strRate)), FormatString(gclsBase.NaturalCurDec))
            End If
'-----------------------------------------------
            If frm.chkPrint(2).Value = 1 And _
                frm.chkPrint(3).Visible And _
                frm.chkPrint(3).Value = 1 Then
                
                frmCashSettle.ShowMe frm
            ElseIf IsSpecialBill(lngNowID) Then
            'XBQ 1999-10-27需求：商品销售、委托结算、分期收款结算、直运销售 显示“ 销售收款 ”
                ShowR_P False, , , lngCustomerID, lngNowID
            Else    '显示“ 其它收款 ”
                Set frm = FrmReceive
                frm.ShowABill strAmount, strCurrAmount, strRate, lngCustomerID, lngCurID, lngActID, lngDepID, lngEmpID, lngJobID, lngClsID1, lngClsID2
            End If
            Screen.MousePointer = vbDefault
            Unload Me
        ElseIf grdList.Rows = 1 Then
            Me.Hide
            If frm.chkPrint(2).Value = 1 And _
                frm.chkPrint(3).Visible And _
                frm.chkPrint(3).Value = 1 Then
                
                frmCashSettle.ShowMe frm
            ElseIf IsSpecialBill(lngNowID) Then
                Screen.MousePointer = vbHourglass
                ShowR_P False, , , lngCustomerID, lngNowID  '显示“ 销售收款 ”
                Screen.MousePointer = vbDefault
            Else '显示“ 其它收款 ”
                Set frm = FrmReceive
                Screen.MousePointer = vbHourglass
                frm.ShowABill strAmount, strCurrAmount, strRate, lngCustomerID, lngCurID, lngActID, lngDepID, lngEmpID, lngJobID, lngClsID1, lngClsID2
                Screen.MousePointer = vbDefault
            End If
            Unload Me
        End If
    End Select
End Sub

Private Sub Form_Activate()
    SetHelpID C2lng(Me.HelpContextID)
End Sub

Private Sub Form_Resize()
    Dim i As Integer
    If Me.WindowState = 1 Then Exit Sub
    For i = 0 To cmdButton.Count - 1
        cmdButton(i).Visible = False
    Next i
    Label2.Visible = False
    Label3.Visible = False
    Shape1(0).Visible = False
    Shape1(1).Visible = False
    For i = 0 To lblField.Count - 1
        Label1(i).Height = 195
        Label1(i).Visible = False
        lblField(i).Visible = False
        lblField(i).Height = 195
    Next i
    
    Label2.Move 50, 50, StrLen(Label2.Caption) * 2 * Me.FontSize * 10.05, 210 '920
    Shape1(1).Move 50, 50 + Label2.Height + 30, Me.ScaleWidth - cmdButton(0).width - 300
    Shape1(0).Move 80, Shape1(1).top + 30, Shape1(1).width, Shape1(1).Height
    Label3.Move 50, Shape1(0).top + Shape1(0).Height + 30, 920, 210
    
    grdList.Move 50, Label3.top + Label3.Height + 30, _
            Me.ScaleWidth - cmdButton(0).width - 300, _
            Me.ScaleHeight - Label3.top - Label3.Height - 50 - 30
    
    Dim WidthRate  As Integer
    WidthRate = Int(Shape1(1).width / 3)
    
    Label1(0).Left = Shape1(1).Left + 120
    Label1(0).top = Shape1(1).top + 225
    Label1(0).width = 795
    
    Label1(1).Left = Label1(0).Left
    Label1(1).width = 795
    Label1(1).top = Label1(0).top + Label1(0).Height + 225
    
    Label1(2).Left = Label1(0).Left
    Label1(2).width = 795
    Label1(2).top = Label1(1).top + Label1(1).Height + 225
    
    Label1(3).Left = Shape1(1).Left + WidthRate + 550
    Label1(3).width = 450
    Label1(3).top = Label1(1).top
    
    Label1(4).Left = Label1(3).Left
    Label1(4).width = 450
    Label1(4).top = Label1(2).top
    
    Label1(5).Left = Shape1(1).Left + 2 * WidthRate + 50