📄 frmsubmitadjustbill.frm
字号:
TabIndex = 2
Tag = "2"
Top = 120
Visible = 0 'False
Width = 1380
End
End
Attribute VB_Name = "FrmSubmitAdjustBill"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' 单据（代销调拨单）窗体
' 作者：蔡奇科
' 日期：1998.07.2
'
' 方法：
' ShowANewBill 新增单据
' showaOldOldbill 修改单据
' 函数
' SaveBill 保存当前单据
' getID 取当前单据的ID号
' ReponseMessage 消息处理
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Dim ReceiptTypeID As Integer
Dim clsBill As SubmitAdjust '
Dim clsLst As clsListMethod '确定凭证是否存在等的类模块
Dim WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Dim lgID As Long
Dim srName As String
Dim srCode As String
Dim blnNotResize As Boolean
Dim lngInActivityID As Long
Dim lngOutActivityID As Long
Dim blnIsCanEventChk_Click As Boolean
Dim blnEdit As Boolean '填制权限
Dim blnView As Boolean '查询权限
Dim blnNotRaiseEvents As Boolean '不响应按键事件标志
Public blnIsLoading As Boolean '正在引入数据标志
Private blnFirstIn As Boolean '首次进入窗体（从SHOWANEWTYPEBILL和showaoldbill)标志
Private intBillState As Integer
'单据状态标志0---可修改，1---已结算，2----已开票，3--已经入库，4--已开票，5-- 被分摊加工费用
'6--有批次管理的商品已经出库
Public Sub InsertARow(Optional ByVal blnBeforeOrAppend As Boolean = False)
clsBill.InsertARow blnBeforeOrAppend
End Sub
Private Sub AddDataToGrid(ByVal rst As rdoResultset, blnIsOut As Boolean)
Dim i As Integer
i = 1
With rst
Do While Not .EOF
Dim dblTemp As String, dblRate As Double, dblFactor As Double
If blnIsOut Then
' dblRate = TaxIDToRate(IIf(IsNull(!lngTaxID), 0, !lngTaxID), False) / 100 '销项税率
GrdCol.TextMatrix(i, 0) = !lngActivityDetailID
GrdCol.TextMatrix(i, 1) = IIf(IsNull(!itemNameStyle), "", !itemNameStyle) '商品
GrdCol.TextMatrix(i, 29) = IIf(IsNull(!lngItemID), 0, !lngItemID) '商品ID
GrdCol.TextMatrix(i, 2) = IIf(IsNull(!ReceiptNo), "", !ReceiptNo) '委托出库单据号
GrdCol.TextMatrix(i, 2) = strAccountYearPeriodOfDate(Left(GrdCol.TextMatrix(i, 2), 10)) & "-" & Mid(GrdCol.TextMatrix(i, 2), 12)
GrdCol.TextMatrix(i, 30) = IIf(IsNull(!lngOrderDetailID), 0, !lngOrderDetailID) '委托出库单明细ID
GrdCol.TextMatrix(i, 3) = IIf(IsNull(!strUnitName), "", !strUnitName) '计量单位
GrdCol.TextMatrix(i, 31) = IIf(IsNull(!lngUnitID), 0, !lngUnitID) '计量单位ID
GrdCol.TextMatrix(i, 4) = IIf(IsNull(!strTaxName), "", !strTaxName) '税率
GrdCol.TextMatrix(i, 32) = IIf(IsNull(!lngTaxID), 0, !lngTaxID) '税率ID
'对数量进行转换
dblFactor = ConvertFactor(C2Dbl(GrdCol.TextMatrix(i, 31)), C2Dbl(GrdCol.TextMatrix(i, 29)))
GrdCol.TextMatrix(i, 40) = dblFactor
dblTemp = NumberConvert(IIf(IsNull(!dblQuantity), 0, CStr(!dblQuantity)) _
, dblFactor, False)
clsBill.WriteGrd dblTemp, i, 5 '调拨数量
GrdCol.TextMatrix(i, 42) = clsBill.MaxMaySelectQuantity(i) '最大可选数量
clsBill.WriteGrd Format(IIf(IsNull(!dblCurrPrice), 0, !dblCurrPrice * !dblFactor), FormatString(gclsBase.PriceDec)), i, 6 '调出单价
clsBill.WriteGrd Format(IIf(IsNull(!dblCurrPriceTax), 0, !dblCurrPriceTax * !dblFactor), FormatString(gclsBase.PriceDec)), i, 7 '调出含税单价
' clsBill.WriteGrd Format((1 + dblRate) * IIf(IsNull(!dblCurrPrice), 0, !dblCurrPrice * !dblFactor), FormatString(gclsBase.PriceDec)), i, 7 '调出含税单价
clsBill.WriteGrd Format(IIf(IsNull(!dblCurrAmount), 0, !dblCurrAmount), FormatString(gclsBase.NaturalCurDec)), i, 8 '调出原币金额
clsBill.WriteGrd Format(IIf(IsNull(!dblAmount), 0, !dblAmount), FormatString(gclsBase.NaturalCurDec)), i, 9 '调出本币金额
clsBill.WriteGrd Format(IIf(IsNull(!dblCurrTaxAmount), 0, !dblCurrTaxAmount), FormatString(gclsBase.NaturalCurDec)), i, 10 '调出原币税额
clsBill.WriteGrd Format(IIf(IsNull(!dblTaxAmount), 0, !dblTaxAmount), FormatString(gclsBase.NaturalCurDec)), i, 11 '调出本币税额
clsBill.WriteGrd Format(C2Dbl(GrdCol.TextMatrix(i, 8)) + C2Dbl(GrdCol.TextMatrix(i, 10)), FormatString(gclsBase.NaturalCurDec)), i, 12 '调出原币价税合计
clsBill.WriteGrd Format(C2Dbl(GrdCol.TextMatrix(i, 9)) + C2Dbl(GrdCol.TextMatrix(i, 11)), FormatString(gclsBase.NaturalCurDec)), i, 13 '调出本币价税合计
GrdCol.TextMatrix(i, 22) = IIf(IsNull(!strJobName), "", !strJobName) '工程
GrdCol.TextMatrix(i, 33) = IIf(IsNull(!lngJobID), 0, !lngJobID) '工程ID
GrdCol.TextMatrix(i, 23) = IIf(IsNull(!c0), "", !c0) '自定义项目1
GrdCol.TextMatrix(i, 34) = IIf(IsNull(!lngCustomID0), 0, !lngCustomID0)
GrdCol.TextMatrix(i, 24) = IIf(IsNull(!c1), "", !c1) '自定义项目2
GrdCol.TextMatrix(i, 35) = IIf(IsNull(!lngCustomID1), 0, !lngCustomID1)
GrdCol.TextMatrix(i, 25) = IIf(IsNull(!c2), "", !c2) '自定义项目3
GrdCol.TextMatrix(i, 36) = IIf(IsNull(!lngCustomID2), 0, !lngCustomID2)
GrdCol.TextMatrix(i, 26) = IIf(IsNull(!c3), "", !c3) '自定义项目4
GrdCol.TextMatrix(i, 37) = IIf(IsNull(!lngCustomID3), 0, !lngCustomID3)
GrdCol.TextMatrix(i, 27) = IIf(IsNull(!c4), "", !c4) '自定义项目5
GrdCol.TextMatrix(i, 38) = IIf(IsNull(!lngCustomID4), 0, !lngCustomID4)
GrdCol.TextMatrix(i, 28) = IIf(IsNull(!c5), "", !c5) '自定义项目6
GrdCol.TextMatrix(i, 39) = IIf(IsNull(!lngCustomID5), 0, !lngCustomID5)
Else
' dblRate = TaxIDToRate(IIf(IsNull(!lngTaxID), 0, !lngTaxID), False) / 100 '销项税率
GrdCol.TextMatrix(i, 41) = !lngActivityDetailID
clsBill.WriteGrd Format(IIf(IsNull(!dblCurrPrice), 0, !dblCurrPrice * !dblFactor), FormatString(gclsBase.PriceDec)), i, 14 '调入单价
clsBill.WriteGrd Format(IIf(IsNull(!dblCurrPriceTax), 0, !dblCurrPriceTax * !dblFactor), FormatString(gclsBase.PriceDec)), i, 15 '调入含税单价
' clsBill.WriteGrd Format((1 + dblRate) * IIf(IsNull(!dblCurrPrice), 0, !dblCurrPrice * !dblFactor), FormatString(gclsBase.PriceDec)), i, 15 '调入含税单价
clsBill.WriteGrd Format(IIf(IsNull(!dblCurrAmount), 0, !dblCurrAmount), FormatString(gclsBase.PriceDec)), i, 16 '调入原币金额
clsBill.WriteGrd Format(IIf(IsNull(!dblAmount), 0, !dblAmount), FormatString(gclsBase.NaturalCurDec)), i, 17 '调入本币金额
clsBill.WriteGrd Format(IIf(IsNull(!dblCurrTaxAmount), 0, !dblCurrTaxAmount), FormatString(gclsBase.NaturalCurDec)), i, 18 '调入原币税额
clsBill.WriteGrd Format(IIf(IsNull(!dblTaxAmount), 0, !dblTaxAmount), FormatString(gclsBase.NaturalCurDec)), i, 19 '调入本币税额
clsBill.WriteGrd Format(C2Dbl(GrdCol.TextMatrix(i, 16)) + C2Dbl(GrdCol.TextMatrix(i, 18)), FormatString(gclsBase.NaturalCurDec)), i, 20 '调入原币价税合计
clsBill.WriteGrd Format(C2Dbl(GrdCol.TextMatrix(i, 17)) + C2Dbl(GrdCol.TextMatrix(i, 19)), FormatString(gclsBase.NaturalCurDec)), i, 21 '调入本币价税合计
End If
clsBill.setItemproperty i, GrdCol.TextMatrix(i, 29)
.MoveNext
i = i + 1
Loop
End With
End Sub
Private Function CustomerName(ByVal CustomerID As Long) As String
Dim strSql As String
Dim rst As rdoResultset
CustomerName = ""
strSql = "SELECT strCustomerName FROM Customer WHERE lngCustomerID=" & CustomerID
Set rst = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If Not rst.EOF Then
rst.MoveFirst
CustomerName = rst!strCustomerName
End If
If Not rst Is Nothing Then rst.Close
End Function
Private Sub cmbInput_Click()
Static blnFirst As Boolean
clsBill.SaveInput2Form
If clsBill.bytRegion = FHead Then
Dim lngID As Long
Dim lngT As Long
Dim strT As String
Dim strC As String
lngID = BillPublic.ReceiptNameToTypeID(cmbInput.Text)
lngT = FirstId(xTemplatE, lngID)
Call BillPublic.IdToCodeAndName(xTemplatE, lngT, strC, strT)
lblHead(2).Tag = lngID
lblHead(3).Caption = cmbInput.Text
lblHead(4).Tag = lngT
lblHead(5).Caption = strT
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
clsBill.Form_key_Down KeyCode, Shift
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If blnNotRaiseEvents Then Exit Sub
Dim CtrDown As Integer
If KeyCode = 93 Then
If clsBill.bytRegion = FGrid Or clsBill.bytRegion = FGrid1 Or clsBill.bytRegion = FPicture Then
GrdCol_Mouseup vbRightButton, 0, 0, 0
Else
Form_MouseUp vbRightButton, 0, 0, 0
End If
Exit Sub
End If
CtrDown = Shift And vbCtrlMask
If CtrDown > 0 Then
Select Case KeyCode
Case 33 'Ctr+PageUp
cmdButton_Click 1
Case 34 'Ctl-PageDown
cmdButton_Click 0
Case 13 'ctr_Enter
cmdButton_Click 4
End Select
Debug.Print KeyCode
' ElseIf KeyCode = 27 Then 'ESCAPE
' cmdButton_Click 5
Else
clsBill.Form_KeyDown KeyCode, Shift
End If
End Sub
Private Sub Form_Load()
SetDtm
' -------------------------------
ReceiptTypeID = 6 '代销商品调拨单ID
' -------------------------------
Dim i As Integer
If gclsSys Is Nothing Then Exit Sub
Me.HelpContextID = 40026
Set clsBill = New SubmitAdjust
Set clsLst = New clsListMethod
clsBill.ReceiptTypeID = ReceiptTypeID
Set clsBill.Form = Me
blnNotResize = True
Set mclsMainControl = gclsSys.MainControls.Add(Me)
blnNotResize = False
If blnIsLoading = False Then MsgForm.PleaseWait
clsBill.AddReferOfCustomer
clsBill.AddReferOfItem
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If blnNotRaiseEvents Then Exit Sub
clsBill.Form_MouseUp
If Button = vbRightButton Then
MakeListEditMenu
clsBill.blnNotRespondKeyPress = True
PopupMenu frmMain.mnuListEdit
clsBill.blnNotRespondKeyPress = False
blnNotRaiseEvents = True
DoEvents
blnNotRaiseEvents = False
End If
End Sub
'窗体尺寸变化处理程序
Private Sub Form_Resize()
' If grdCol.Visible = False Then Exit Sub
If Not blnNotResize Then clsBill.Form_Resize
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If gclsSys Is Nothing Then Exit Sub
If clsBill Is Nothing Then Exit Sub
If UnloadMode = vbFormControlMenu Then
If blnNotRaiseEvents Then
Cancel = 1
gblnCancel = True
Exit Sub
End If
End If
If Not ChangeSaveNote() Then
Cancel = 1
gblnCancel = True
Exit Sub
End If
' BillPublic.blnModifyMaxNO gclsBase.AccountYear, gclsBase.Period, 26, BillPublic.strAlphaOfStr(lblField(2).Caption), C2Lng(BillPublic.strDigitOfStr(lblField(2).Caption))
SaveColWidthDefault Me
gclsSys.MainControls.Remove Me
Set clsBill = Nothing
Set clsLst = Nothing '确定凭证是否存在等的类模块
Set mclsMainControl = Nothing '主控对象
Unload MsgForm
Unload Me
frmListLendAdjust.IAmCLosed
End Sub
Private Sub chkPrint0_Click()
'frmMain.mnuEditShowAll.Checked = chkPrint(0).Value
clsBill.blnIsChanged = True
End Sub
Private Sub chkPrint1_Click()
Dim intYesNo As Integer
If chkPrint(1).Value = 1 And blnIsCanEventChk_Click Then
blnNotRaiseEvents = True
chkPrint(1).Value = 0
blnNotRaiseEvents = False
intYesNo = ShowMsg(Me.hWnd, "该调拨单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "单据作废")
blnNotRaiseEvents = True
If intYesNo = IDYES Then
chkPrint(1).Value = 1
End If
blnNotRaiseEvents = False
End If
clsBill.blnIsChanged = True
If chkPrint(1).Value = 0 Then
GrdCol.Refresh
Else
With Me.GrdCol
DrawAIcon .hWnd, .Left + (.width - 140 * Screen.TwipsPerPixelX) \ 2, .RowHeight(0) + (.Height - .RowHeight(0) - 70 * Screen.TwipsPerPixelY) \ 2, 1024
End With
Utility.RemoveFormResPicture (1024)
End If
End Sub
Private Sub chkPrint_Click(index As Integer)
If blnNotRaiseEvents Then Exit Sub
clsBill.CHK_CLICK index
Select Case index
Case 0
chkPrint0_Click
Case 1
chkPrint1_Click
Case 2 '已开发票
Case 3 '冲销
End Select
End Sub
Private Sub cmdButton_Click(index As Integer)
If blnNotRaiseEvents Then Exit Sub
blnNotRaiseEvents = True
clsBill.blnKeyDown = False
If index <> 5 Then clsBill.cmdButton_Click index
Select Case index
Case 0
cmdNext_Click
Case 1
CmdPrev_Click
Case 2
cmdHome_Click
Case 3
CmdEnd_Click
Case 4
If SaveBill() Then
clsBill.blnIsChanged = False
blnNotRaiseEvents = False
Unload Me
Else
blnNotRaiseEvents = False
End If
Exit Sub
Case 5
clsBill.blnChangeEvent = False
clsBill.blnIsChanged = False
blnNotRaiseEvents = False
Unload Me
Exit Sub
Case 6 '多选单据
cmdButton6_Click
clsBill.SetAFocus
Case 7
CmdNote_Click
clsBill.SetAFocus
Case 8
CmdPrint_Click
clsBill.SetAFocus
End Select
blnNotRaiseEvents = True
DoEvents
blnNotRaiseEvents = False
End Sub
Private Sub CmdEnd_Click()
If Not ChangeSaveNote() Then Exit Sub
Dim lngInID As Long, lngOutID As Long
Dim lngInCustomerID As Long, lngOutCustomerID As Long
On Error Resume Next
ReturnBillID 26, C2Date(lblField(3).Caption), lblField(2).Caption _
, lngInID, lngOutID, lngInCustomerID, lngOutCustomerID, 3
lngInActivityID = lngInID
lngOutActivityID = lngOutID
On Error GoTo 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -