📄 frmexpenseamount.frm
字号:
ReadOnly = 0 'False
Appearance = -1 'True
DataSourceName = ""
RecordSource = ""
UserName = ""
Password = ""
Connect = ""
LogMessages = ""
Caption = "MSRDC1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label lblArr
BackStyle = 0 'Transparent
Caption = "截止日期(&Q) "
Height = 195
Index = 3
Left = 1140
TabIndex = 24
Top = 150
Width = 1005
End
Begin MSForms.CheckBox chkChange
Height = 255
Left = 6060
TabIndex = 23
Top = 4620
Width = 1185
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "2090;450"
Value = "0"
Caption = "采购商品"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin MSForms.CheckBox chkCost
Height = 270
Left = 6030
TabIndex = 22
Top = 4350
Width = 1215
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "2143;476"
Value = "0"
Caption = "采购费用"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin VB.Label lblArr
BackStyle = 0 'Transparent
Caption = "采购商品(&I)"
Height = 195
Index = 1
Left = 120
TabIndex = 7
Top = 2580
Width = 1005
End
Begin VB.Label lblArr
BackStyle = 0 'Transparent
Caption = "采购费用(&E)"
Height = 195
Index = 0
Left = 90
TabIndex = 0
Top = 150
Width = 1005
End
Begin VB.Label lblShare
BackStyle = 0 'Transparent
Caption = "待分摊费用：0.00 - 已分摊费用：0.00 = 0.00"
Height = 195
Left = 1140
TabIndex = 10
Top = 2580
Width = 4665
End
End
Attribute VB_Name = "frmExpenseAmount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 采购费用分摊
' 作者: 邹俊
' 日期 ： 1998. 06. 23
'
' 功能：
' 对商品采购过程中发生的共有费用分摊到每个采购商品上
' 输入接口：
' 1. GRID 类接口 ( Grid.cls)
' 2. 栏目设置接口( ListSet.cls, frmlistset.frm)
' 3. 筛选接口 (Filter.bas, TreeFilter.frm)
' 公共参数：
' ListFormRight (listmodule.bas) ,ListFormleft (listmodule.bas)
' gclsBase (Publc.bas) , gclsSys (Publc.bas) .
' 调用函数：
' ShowMsg (utility.bas )
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private WithEvents mclsProcurementCostGrid As Grid '采购费用Grid对象
Attribute mclsProcurementCostGrid.VB_VarHelpID = -1
Private WithEvents mclsProcurementChangeGrid As Grid '采购商品Grid对象
Attribute mclsProcurementChangeGrid.VB_VarHelpID = -1
Private Const mintProcurementCostViewID = 44 '采购费用视图ID
Private Const mintProcurementChangeViewId = 45 '采购商品视图ID
Private Const mintMinFormHeight = 5500 '窗体最小高度
Private Const mintMinFromWidth = 7500 '窗体最小宽度
Private mblnIsoptMoney As Boolean '费用是否按金额分摊
Private mblnIsoptAmount As Boolean '费用是否按数量分摊
Private mblnIschkCost As Boolean '是否选择费用列表
Private mblnIschkChange As Boolean '是否选择商品列表
Private mintIsListActivate As Integer '当前活动列表(1费用列表,2商品列表)
Private mblnIsFirst As Boolean '窗体第一次加载
Private mblnIsProcurementCostEmpoty As Boolean '采购费用列表有无记录
Private mblnIsProcurementChangeEmpoty As Boolean '采购商品列表有无记录
Private mblnProcurementCostIsAllShow As Boolean '采购费用列表是否只显选择记录
Private mblnProcurementChangeIsAllShow As Boolean '采购商品列表是否只显选择记录
Private mstrArrProcurementCostID() As String '本次采购费用选择ID数组
Private mstrArrProcurementChangeID() As String '本次采购商品选择ID数组
Private mdblArrProcurementCost() As Double '采购费用本次分摊值
Private mdblArrProcurementChange() As Double '采购商品本次分摊值
Private mblnArrIsFilter(1) As Boolean '是否取筛选条件
Private mblncostIsScroll As Boolean '是否为费用滚动条事件
Private mintActivateSum As Integer '窗体激活次数
Private Sub chkChange_Click()
mblnIschkChange = chkChange.Value
If Not mblnIsFirst Then
If Not mblnIschkChange And Not mblnIschkCost Then '两个 CHK 不能同时不选取
chkChange.Value = True
chkChange.SetFocus
End If
If Not mblnIschkChange Then
chkCost.SetFocus
End If
If chkChange.Value = True Then
mintIsListActivate = 2
Else
mintIsListActivate = 1
End If
formListPartSizeSet '重画窗体控件
chkCmdArrSelectEnabled
End If
End Sub
Private Sub chkCost_Click()
mblnIschkCost = chkCost.Value
If Not mblnIsFirst Then
If Not mblnIschkChange And Not mblnIschkCost Then '两个 CHK 不能同时不选取
chkCost.Value = True
chkCost.SetFocus
End If
If Not mblnIschkCost Then
chkChange.SetFocus
End If
If chkCost.Value = True Then
mintIsListActivate = 1
Else
mintIsListActivate = 2
End If
formListPartSizeSet '重画窗体控件
chkCmdArrSelectEnabled
End If
End Sub
'全部取消
Private Sub AllCancel_Click()
Dim intCol As Integer
Dim intCount As Integer
If mintIsListActivate <> 1 And mintIsListActivate <> 2 Then
mintIsListActivate = 1
End If
If mintIsListActivate = 1 Then
If mblnIsProcurementCostEmpoty Then
intCol = GetColNO(msgProcurementCost, "本次分摊费用", mintProcurementCostViewID) '得修改列号
With msgProcurementCost
For intCount = 1 To .Rows - 1
.TextMatrix(intCount, 1) = "" '清除选取标志
.TextMatrix(intCount, intCol) = "" '清除修改列的值
Next
txtShare1Set '设置待分和已分费用
.Row = 1
End With
On Error Resume Next
msgProcurementCost.SetFocus
On Error GoTo 0
End If
End If
If mintIsListActivate = 2 Then
If mblnIsProcurementChangeEmpoty Then
intCol = GetColNO(msgProcurementChange, "本次分摊费用", mintProcurementChangeViewId)
With msgProcurementChange
For intCount = 1 To .Rows - 1
.TextMatrix(intCount, 1) = ""
.TextMatrix(intCount, intCol) = ""
Next
txtShare1Set
.Row = 1
End With
On Error Resume Next
msgProcurementChange.SetFocus
On Error GoTo 0
End If
End If
End Sub
'全部选择
Private Sub Allselect_Click()
Dim intCount As Integer
Dim strDate1 As String
Dim strDate2 As String
Dim intCol As Integer
Dim intCol1 As Integer
Dim intCol2 As Integer
Dim dblCost As Double
Dim dblTmp As Double
Dim lngCustomerID As Long
Dim lngTmpRow As Long
If mintIsListActivate <> 1 And mintIsListActivate <> 2 Then
mintIsListActivate = 1
End If
strDate1 = Format(CalDate.Text, "yyyy-mm-dd")
If mintIsListActivate = 1 Then
If mblnIsProcurementCostEmpoty Then
With msgProcurementCost
intCol = GetColNO(msgProcurementCost, "日期", mintProcurementCostViewID)
intCol1 = GetColNO(msgProcurementCost, "未分摊费用", mintProcurementCostViewID)
intCol2 = GetColNO(msgProcurementCost, "本次分摊费用", mintProcurementCostViewID)
dblCost = 0
dblTmp = 0
lngCustomerID = 0
For intCount = 1 To .Rows - 1
If .TextMatrix(intCount, 1) = "√" Then
lngCustomerID = .TextMatrix(intCount, 2)
If Trim(.TextMatrix(intCount, intCol1)) <> "" Then
dblTmp = CDbl(.TextMatrix(intCount, intCol1))
End If
Exit For
End If
Next
' If lngCustomerID = 0 Then
' For intCount = 0 To msgProcurementChange.Rows - 1
' If msgProcurementChange.TextMatrix(intCount, 1) = "√" Then
' lngCustomerID = msgProcurementChange.TextMatrix(intCount, 2)
' Exit For
' End If
' Next
' End If
If dblTmp = 0 Then
For intCount = 1 To .Rows - 1
If Trim(.TextMatrix(intCount, intCol1)) <> "" Then
dblTmp = CDbl(.TextMatrix(intCount, intCol1))
End If
Exit For
Next
End If
If dblTmp = 0 Then
dblTmp = 1
End If
For intCount = 1 To .Rows - 1
.TextMatrix(intCount, 1) = ""
.TextMatrix(intCount, intCol2) = ""
Next
If lngCustomerID = 0 And .Row > 0 And .Row < .Rows Then
lngCustomerID = .TextMatrix(.Row, 2)
End If
lngTmpRow = 0
For intCount = 1 To .Rows - 1
strDate2 = Format(.TextMatrix(intCount, intCol), "yyyy-mm-dd")
If .RowHeight(intCount) > 0 And strDate2 <= strDate1 Then '保证隐藏行不再选择
If Trim(.TextMatrix(intCount, intCol1)) <> "" Then
dblCost = CDbl(.TextMatrix(intCount, intCol1))
If Sgn(dblTmp) = Sgn(dblCost) Then '只选全部为正或全部为负的单据
' If lngCustomerID > 0 Then
' If .TextMatrix(intCount, 2) = lngCustomerID Then
.TextMatrix(intCount, 1) = "√"
.TextMatrix(intCount, intCol2) = .TextMatrix(intCount, intCol1)
lngTmpRow = intCount
' End If
' Else
' .TextMatrix(intCount, 1) = "√"
' .TextMatrix(intCount, intCol2) = .TextMatrix(intCount, intCol1)
' lngCustomerID = .TextMatrix(intCount, 2)
' lngTmpRow = intCount
' End If
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -