📄 frmentrustamount.frm
字号:
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 = 0
Left = 1080
TabIndex = 24
Top = 120
Width = 1005
End
Begin MSForms.CheckBox chkChange
Height = 255
Left = 5910
TabIndex = 23
Top = 4650
Width = 1215
BackColor = -2147483633
ForeColor = -2147483630
DisplayStyle = 4
Size = "2143;450"
Value = "0"
Caption = "加工商品(&I)"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
End
Begin MSForms.CheckBox chkCost
Height = 270
Left = 5910
TabIndex = 22
Top = 4380
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 = 3
Left = 60
TabIndex = 7
Top = 2610
Width = 1005
End
Begin VB.Label lblArr
BackStyle = 0 'Transparent
Caption = "加工费用(&E)"
Height = 195
Index = 2
Left = 90
TabIndex = 0
Top = 120
Width = 1005
End
Begin VB.Label lblShare
BackStyle = 0 'Transparent
Caption = "待分摊费用：0.00 - 已分摊费用：0.00 = 0.00"
Height = 195
Left = 1110
TabIndex = 10
Top = 2610
Width = 4695
End
End
Attribute VB_Name = "frmEntrustAmount"
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 mclsAddCostGrid As Grid '加工费用Grid对象
Attribute mclsAddCostGrid.VB_VarHelpID = -1
Private WithEvents mclsAddChangeGrid As Grid '加工商品Grid对象
Attribute mclsAddChangeGrid.VB_VarHelpID = -1
Private Const mintAddCostViewID = 40 '加工费用视图ID
Private Const mintAddChangeViewID = 42 '加工商品视图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 mblnIsAddCostEmpoty As Boolean '加工费用列表有无记录
Private mblnIsAddChangeEmpoty As Boolean '加工商品列表有无记录
Private mblnAddCostIsAllShow As Boolean '加工费用列表是否只显选择记录
Private mblnAddChangeIsAllShow As Boolean '加工商品列表是否只显选择记录
Private mstrArrAddCostId() As String '本次加工费用选择ID数组
Private mstrArrAddChangeID() As String '本次加工商品选择ID数组
Private mdblArrAddcost() As Double '加工费用本次分摊值
Private mdblArrAddChange() 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 mblnIsAddCostEmpoty Then
intCol = GetColNO(msgAddCost, "本次分摊费用", mintAddCostViewID)
With msgAddCost
For intCount = 1 To .Rows - 1
.TextMatrix(intCount, 1) = ""
.TextMatrix(intCount, intCol) = ""
Next
txtShare2Set
.Row = 1
End With
On Error Resume Next
msgAddCost.SetFocus
On Error GoTo 0
End If
End If
If mintIsListActivate = 2 Then
If mblnIsAddChangeEmpoty Then
intCol = GetColNO(msgAddChange, "本次分摊费用", mintAddChangeViewID)
With msgAddChange
For intCount = 1 To .Rows - 1
.TextMatrix(intCount, 1) = ""
.TextMatrix(intCount, intCol) = ""
Next
txtShare2Set
.Row = 1
End With
On Error Resume Next
msgAddChange.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 mblnIsAddCostEmpoty Then
With msgAddCost
intCol = GetColNO(msgAddCost, "日期", mintAddCostViewID)
intCol1 = GetColNO(msgAddCost, "未分摊费用", mintAddCostViewID)
intCol2 = GetColNO(msgAddCost, "本次分摊费用", mintAddCostViewID)
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 msgAddChange.Rows - 1
' If msgAddChange.TextMatrix(intCount, 1) = "√" Then
' lngCustomerID = msgAddChange.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
End If
End If
Next
txtShare2Set
If lngTmpRow > 0 Then
.Row = lngTmpRow
Else
.Row = .Rows - 1
End If
End With
On Error Resume Next
msgAddCost.SetFocus
On Error GoTo 0
End If
End If
If mintIsListActivate = 2 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -