📄 frminvoiceinfo.frm
字号:
Begin VB.Shape Shape1
BackColor = &H00FFFFFF&
BackStyle = 1 'Opaque
BorderColor = &H80000005&
Height = 1485
Index = 1
Left = 30
Top = 210
Width = 6930
End
Begin VB.Shape Shape1
BackColor = &H80000010&
BackStyle = 1 'Opaque
BorderColor = &H80000010&
Height = 1485
Index = 0
Left = 105
Top = 300
Width = 6930
End
End
Attribute VB_Name = "frmInvoiceInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'---------------------------------
'应收单回款资料
'王兴元
'1998年7月
'提供给外部调用的方法
' SetList(frmName,ActivityID)
'---------------------------------
Private WithEvents mclsSubClass As SubClass32.SubClass '“钩子”对象
Attribute mclsSubClass.VB_VarHelpID = -1
Private blnBz As Boolean
Private mclsGrid As Grid
Private ActivityID1 As Long
Private ActivityTypeID1 As Long
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 strAmount As String
Private strCurrAmount As String
Private intCurDec As Integer
Private intRateDec As Integer
'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
Screen.MousePointer = vbHourglass
'===================判断有无收款记录====================
If gclsBase.ControlAccount Then
strSql = "SELECT DECODE(zSPBillInfo.strSource,'0',QARAPInit.lngARAPInitID," _
& "'2',ItemActivityQuery.lngActivityID," _
& "ActivityQuery.Activity_lngActivityID) AS 付款ID, " _
& "DECODE(zSPBillInfo.strSource,'0',QARAPInit.strDate," _
& "'2',ItemActivityQuery.strDate,"
strSql = strSql & "ActivityQuery.strDate) AS 日期, ' ' AS 单据类型, " _
& "DECODE(zSPBillInfo.strSource,'0',QARAPInit.strReceiptNo," _
& "'2',ItemActivityQuery.strReceiptNo," _
& "ActivityQuery.strReceiptNo) || TO_CHAR(DECODE(zSPBillInfo.strSource,'0'," _
& "QARAPInit.lngReceiptNo,'2'," _
& "ItemActivityQuery.lngReceiptNo,ActivityQuery.lngReceiptNo),'0000') AS 单据号, "
strSql = strSql & "zSPBillInfo.dblCurrPaymentAmount AS 收款金额, " _
& "zSPBillInfo.dblCurrDisCount AS 折扣金额, 0 AS 应收余额, " _
& "zSPBillInfo.lngActivityTypeID AS 业务类型ID, DECODE(zSpBillInfo.strSource,'0'," _
& "QARAPInit.bytCurrencyDec,DECODE(zSpBillInfo.strSource,'2'," _
& "ItemActivityQuery.bytCurrencyDec,ActivityQuery.bytCurrencyDec)) AS bytCurrencyDec, " _
& "zSPBillInfo.strSource AS strSource "
strSql = strSql & "FROM zSPBillInfo,QArApInit,ItemActivityQuery,ActivityQuery " _
& " WHERE zSPBillInfo.lngCashActivityDetailID = " _
& "QArApInit.lngARAPInitID(+) AND zSPBillInfo.lngCashActivityDetailID = " _
& "ActivityQuery.lngActivityDetailID(+) AND " _
& "zSPBillInfo.lngCashActivityDetailID = ItemActivityQuery.lngActivityDetailID(+) " _
& "AND zSPBillInfo.dblCurrPaymentAmount <> 0 AND " _
& "zSPBillInfo.lngActivityID =" & ActivityID
Else
strSql = "SELECT DECODE(zSpBillInfoNotControlAccount.strSource,'0'," _
& "ARAPInitQuery.lngARAPInitID,'2'," _
& "ItemActivityQuery.lngActivityID,'3'," _
& "VoucherQuery.lngVoucherID1,ActivityQuery.Activity_lngActivityID) AS 收款ID, " _
& "DECODE(zSpBillInfoNotControlAccount.strSource,'0',ArapInitQuery.strDate," _
& "'1',ActivityQuery.strDate," _
& "'2',ItemActivityQuery.strDate," _
& "VoucherQuery.strDate) AS 日期,"
strSql = strSql & "' ' AS 单据类型, DECODE(zSpBillInfoNotControlAccount.strSource,'0'," _
& "VoucherType.strVoucherTypeCode,'2'," _
& "ItemActivityQuery.strReceiptNo,'3'," _
& "VoucherType.strVoucherTypeCode,ActivityQuery.strReceiptNo) || "
strSql = strSql & "TO_CHAR(DECODE(zSpBillInfoNotControlAccount.strSource,'0'," _
& "ARAPInitQuery.intVoucherNo,'2'," _
& "ItemActivityQuery.lngReceiptNo,'3'," _
& "VoucherQuery.intVoucherNO,ActivityQuery.lngReceiptNo),'0000') AS 单据号, " _
& "zSpBillInfoNotControlAccount.dblCurrPaymentAmount AS 收款金额, " _
& "zSpBillInfoNotControlAccount.dblCurrDisCount AS 折扣金额, 0 AS 应收余额, " _
& "zSpBillInfoNotControlAccount.lngActivityTypeID AS 业务类型ID, "
strSql = strSql & "DECODE(zSpBillInfoNotControlAccount.strSource,'2'," _
& "ItemActivityQuery.bytCurrencyDec,'3'," _
& "VoucherQuery.bytCurrencyDec,'0'," _
& "ARAPInitQuery.bytCurrencyDec,ActivityQuery.bytCurrencyDec) as bytCurrencyDec," _
& "zSpBillInfoNotControlAccount.strSource AS strSource "
strSql = strSql & "FROM zSpBillInfoNotControlAccount,VoucherType,ActivityType,ActivityQuery,ItemActivityQuery " _
& ",ArapInitQuery,VoucherQuery" _
& " WHERE zSpBillInfoNotControlAccount.lngActivityTypeID = VoucherType.lngVoucherTypeID(+) " _
& "and zSpBillInfoNotControlAccount.lngActivityTypeID = ActivityType.lngActivityTypeID(+) " _
& "and zSpBillInfoNotControlAccount.lngCashActivityDetailID = ActivityQuery.lngActivityDetailID(+) " _
& "and zSpBillInfoNotControlAccount.lngCashActivityDetailID = ItemActivityQuery.lngActivityDetailID(+) "
strSql = strSql & "and zSpBillInfoNotControlAccount.lngCashActivityDetailID = ArapInitQuery.lngARAPInitID(+) " _
& "and zSpBillInfoNotControlAccount.lngCashActivityDetailID = VoucherQuery.lngVoucherDetailID(+) " _
& "and zSpBillInfoNotControlAccount.dblCurrPaymentAmount <> 0 " _
& "and zSpBillInfoNotControlAccount.lngActivityID = " & ActivityID
End If
Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'===================有收款记录====================
If Not (recTemp.BOF And recTemp.EOF) Then
recTemp.MoveLast
recTemp.MoveFirst
End If
Set datGrid.Resultset = recTemp
'显示"应收单信息"
With frmInvoiceInfo
.lblField(0).Caption = frmName.lblhead(1).Caption '单位
.lblField(1).Caption = frmName.lblField(1).Caption '单据号
.lblField(2).Caption = cutString(frmName.lblField(15).Caption) '付款条件
.lblField(3).Caption = frmName.lblField(2).Caption '日期
.lblField(4).Caption = cutString(frmName.lblField(12).Caption) '币种
.lblField(5).Caption = cutString(frmName.lblField(4).Caption) '部门
.lblField(6).Caption = cutString(frmName.lblField(3).Caption) '业务员
.lblField(7).Caption = GetLabel(frmName.lblField(10))
End With
'---------------GET OTHER ID-------------------------
lngCurID = frmName.GetOtherID(12) 'CurrencyID
lngActID = frmName.GetOtherID(5) 'lngAccountID
lngCustomerID = C2lng(frmName.lblhead(0).Tag) 'lngCustomerID
lngDepID = frmName.GetOtherID(4) 'lngDepartmentID
lngEmpID = frmName.GetOtherID(3) 'lngEmployeeID
lngJobID = frmName.GetOtherID(8) 'lngJobID
lngClsID1 = frmName.GetOtherID(7) 'lngClassID1
lngClsID2 = frmName.GetOtherID(6) 'lngClassID2
Call BillPublic.CurRateDec(lngCurID, intCurDec, intRateDec)
lblField(7).Caption = Format(lblField(7).Caption, FormatString(intCurDec))
strRate = Format(GetLabel(frmName.lblField(11)), FormatString(intRateDec)) 'Rate
strAmount = Format(GetLabel(frmName.lblField(9)), FormatString(gclsBase.NaturalCurDec)) 'strAmount
'------------------END ------------------------------
'显示"收款信息":将生成结果绑定到MSFlexGrid控件中:
If Not recTemp Is Nothing Then
If recTemp.RowCount > 0 Then
recTemp.MoveFirst
Else
End If
End If
'-------------计算“余额”--------------
dblMoney = C2Dbl(lblField(7).Caption)
With grdList
If grdList.Rows > 1 Then
For i = 1 To grdList.Rows - 1
.TextMatrix(i, 4) = Format(C2Dbl(.TextMatrix(i, 4)), FormatString(C2Dbl(.TextMatrix(i, 8))))
.TextMatrix(i, 5) = Format(C2Dbl(.TextMatrix(i, 5)), FormatString(C2Dbl(.TextMatrix(i, 8))))
dblMoney = dblMoney - C2Dbl(.TextMatrix(i, 4)) - C2Dbl(.TextMatrix(i, 5))
.TextMatrix(i, 6) = Format(C2Dbl(dblMoney), FormatString(C2Dbl(.TextMatrix(i, 8))))
'写单据类型
Call ID2str(i, .TextMatrix(i, 9))
Next i
End If
End With
grdList.ColWidth(1) = 990
If gclsBase.ControlAccount Then
grdList.ColWidth(2) = 1057
Else
If grdList.Rows = grdList.FixedRows Then
grdList.ColWidth(2) = 0
grdList.TextMatrix(0, 3) = "凭证字号"
ElseIf grdList.ColWidth(2) <> 0 Then
grdList.ColWidth(2) = 1057
End If
End If
grdList.ColWidth(3) = 825
grdList.ColWidth(4) = 1340
grdList.ColWidth(5) = 1340
grdList.ColWidth(6) = 1340
grdList.ColWidth(7) = 0
grdList.ColWidth(8) = 0
grdList.ColWidth(9) = 0
If gclsBase.ControlAccount = False Then
#If conVersionType = 16 Then
grdList.ColWidth(2) = 0
#End If
End If
mclsGrid.ColOfs = 1
mclsGrid.SetupStyle
grdList.ColSel = grdList.Cols - 1
blnBz = False
If grdList.Rows = grdList.FixedRows Then
Cmdbutton(1).Enabled = False
End If
Screen.MousePointer = vbDefault
frmInvoiceInfo.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
Me.Hide
ActivityTypeID1 = C2lng(grdList.TextMatrix(grdList.Row, 7))
Select Case ActivityTypeID1
Case 40 '收款单
Set frm = FrmReceive
Case 39 '付款单
Set frm = FrmReceive 'FrmPayment
Case Else
Set frm = FrmReceive
End Select
Screen.MousePointer = vbHourglass
'----------------------------------------------
strCurrAmount = Format(grdList.TextMatrix(grdList.Row, 6), FormatString(C2Dbl(grdList.TextMatrix(grdList.Row, 8))))
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
'-----------------------------------------------
frm.ShowABill strAmount, strCurrAmount, strRate, lngCustomerID, lngCurID, lngActID, lngDepID, lngEmpID, lngJobID, lngClsID1, lngClsID2
Unload Me
ElseIf grdList.Rows = 1 Then
Me.Hide
Set frm = FrmReceive
Screen.MousePointer = vbHourglass
strCurrAmount = Format(lblField(7).Caption, FormatString(intCurDec))
frm.ShowABill strAmount, strCurrAmount, strRate, lngCustomerID, lngCurID, lngActID, lngDepID, lngEmpID, lngJobID, lngClsID1, lngClsID2
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, 920, 210
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -