📄 itemclass.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "itemclass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 单据（采购单）类
' 作者：蔡奇科
' 日期：1998.07.2
'
'==================================================================================
' 属性：
' blnChangeEvent 是否触发CHANGE事件属性
' blnCtrlBinding 是否绑定控件属性
' blnIsChanged 数据是否改变属性
' blnMayDelete 是否可删除属性
' blnPasteRec 是否可行粘贴属性
' blnRefresh 窗体是否刷新属性
' bytAccountPeriod 会计期间属性
' bytIndex 当前输入区域序号属性
' bytRegion 当前输入区域属性
' DropButtonWidth 下拉按纽宽度（只读）
' Form 单据窗体对象属性
' grdBorderWidth GRD边框垂直线宽（只读）
' intAccountYear 会计年度属性
' lngNowID 当前单据ID 属性
' lngOldCol GRD原列号属性
' lngOldRow GRD原行号属性
' ReceiptTypeID 单据类型
' blnPasteBill 是否可粘贴单据属性
'===========================================================================================
' 方法：
' ScrollBarExist 确定GRID滚动条的存在
' NextLineWithAdded 在GRID上的下一行（增加行）
' WriteGrd 在GRID上写红字
' DrawReadOnlyCol 在GRID写只读列（置灰）
' ButtonLocal CommandButton 的上下位置及当前可视性
' InsertARow 在GRID上插入/添加一行
' CopyAccountProperty 从表头复制默认属性到GRID
' BuildNoteMsg 建立“说明”信息
' ctrID2Name 将各种ID号转换为名称
' SaveInput2Form 从输入控件获取数据到窗体
' SaveBillToCollection 将单据内容存入单据内容集合
' LoadBillFromCollection 从单据内容集合获取单据内容
' Form_Resize Form_Resize事件响应程序
' grdCol_EnterCell 进入GRID单元的响应程序
' ModifyPicInputItem 构造PIC录入框,并对有关内容赋值
' NewInputRow 给PIC上输入控件添加输入行
' Grid2PicInput 从GRID向PICTURE输入框上LABLE控件组赋值
' PicInput2Grid 从PICTURE输入框上LABLE控件组向GRID赋值
' grdCol_MouseUp 从表头再进入GRD原单元格
' grdCol_Scroll GRID滚动响应程序
' Field_Click Field_Click事件响应程序
' Field_MouseUp Field_MouseUp事件响应程序
' Head_Click Head_Click事件响应程序
' picLblInput_Getfocus picLblInput_Getfocus事件响应程序
' Memo_Click Memo_Click事件响应程序
' MoveCtr 移动通用输入控件
' TabOrder 控件Tab顺序调整
' Reload 放弃当前输入控件的输入内容
' PrevVisibleField 第一个可视的Field
' NextVisibleField 下一个可视的Field
' Grid2Button 当前行的内容传给粘贴控件
' Button2Grid 粘贴控件的内容传给Grid行
' SetButtonFocus 将焦点对准当前单元格上的粘贴控件
' ColButton_KeyDown 列表粘贴控件按键通用响应程序
' colButton_GotFocus 列表粘贴控件GotFocus通用响应程序
' ColIsGray 只读列显示背景变灰
' CellIsGray 只读列单元显示背景变灰
' AddNewRefer 添加新的参照
' TemplateChange 模板变化时从TEMPLATEFORMAT表中取出模板信
' 息控制显示界面
' cmdButton_Click cmdButton_Click通用响应程序
' CHK_CLICK CHK_CLICK通用响应程序
' Form_MouseUp Form_MouseUp通用响应程序
' LblBack_MouseUp LblBack_MouseUp通用响应程序
' GetANewBill 根据当前单据属性取一张新单据
' UpdateMainEditMenu 更新菜单栏的内容
' setFieldID 设置Field的lngID
' refInput_Choose refInput_Choose通用响应程序
' Form_KeyDown Form_KeyDown通用响应程序
' CopyARow 从GRID上复制一行
' PasteARow 在GRID上粘贴一行
' ReadonlyColBackColor 设只读列背静色
' CurrRedWord 对普通GRD内容中金额为负数的单元做红字显示处理
' InvoiceWithBill(ByVal blnInvoiceExit As Boolean) 开票标志改变后重新调整模板
' setAllItemproperty 设置所有商品属性
'===========================================================================================
' 函数：
' blnRowIsVisible 在GRID上确定行是否可见
' lngSumOfColWidth 各列宽度之和
' dblTotalOfCol GRID列合计
' blnNotNullRow 确定GRID上的某一行是否为空行
' 出口：为TRUE时不是空行为FALSE时是空行
' blnDeleteARow 在GRID上删除一行
' 入口：行号
' strGrdCell 从GRID上某一单元格内取出字符串
' NextUsableCol 找当前GRID行的下一个可用Col
' PrevUsableCol 找当前GRID行的前一个可用Col
' DataValid_LostFocus 当前输入框LostFocus通用响应程序
' Function DataValid 数据有效性判断（存盘时调用）
' getFieldID 获取Field的ID号
' ModifyPositionInfo 修改货位批次明细表
Option Explicit
Const intButtonWidth = 255 '下拉按纽宽度
Const intCmd0Width = 1215 '命令按纽宽度
Const intCaptionHeight = 195 'FIELD按纽标题高度
Const intField0width = 2500 'FIELD按纽标题高度
Const intFieldHeight = 270 'FIELD按纽输入框高度
Const IntSpace = 10 '粘贴控件之间距
Const SPACETWIPS = 30 '单据头控件之列距
Const SpaceTwRow = 15 '单据头控件之行距
Const FixedCols = 1 'GRID固定列数
Private lngDefaultWidth As Long
Const lngDefaultHeight = 6200 'Min
'Const SeparateLineColor = 8421504 'GRID列分隔线色
Private SeparateLineColor As Long 'GRID列分隔线色
Private blnTime As Boolean
Private intReceiptTypeID As Integer ' 13 =应付单ID
Private WithEvents mclsSubClass As SubClass32.SubClass 'Grid回调函数对象
Attribute mclsSubClass.VB_VarHelpID = -1
'Dim WithEvents mclsPicHook As SubClass32.SubClass '输入PictureBox回调函数对象
Private WithEvents mclsHook As SubClass32.SubClass '窗体回调函数对象
Attribute mclsHook.VB_VarHelpID = -1
Private WithEvents HookHe As Hook '窗体回调函数对象
Attribute HookHe.VB_VarHelpID = -1
Private Field() As ClassField '表头输入控件的附加属性
'Private PicLbl() As ClassPicInputField 'PIC输入时的附加属性
Private ColProperty() As ClassGridProperty 'GRID附加属性
Private arrItemProperty() As ItemProperty 'GRD行属性（商品属性）
Private FormClipRect As RECT
Private GridClipRect As RECT
Private My As clsBillMark
Private lngPosition(0 To 20, 0 To 3) As Long 'FieldButton定位数组 Left,Top,Width,Height
Private strColRow() As String '单据体行复制/粘贴存储区
Private ColBill As New Collection '单据内容集合(不包括ActivityID和DetailID)
Private ctrInput As Object '通用输入控件
Private ctrPicInput As Object '列表输入为PIC方式时的输入控件
Private Account As AccountblnOther '科目相关属性
Private Customer As CustomerProperty '单位相关属性
Private intGrdBorderWidth As Long 'GRD边框垂直线宽
Private intGrdBorderHeight As Long 'GRD边框水平线宽
Private strOldText As String '输入点原内容
Private lngOldID As Long '输入点原ID
Private m_bBusy As Boolean
Private m_pBusy As Boolean
Private intCurDec As Integer '原币金额小数位数
Private intRateDec As Integer '原币汇率小数位数
Private clsRecord As RecordClass '参照类
Private clsRecordCustomer As RecordClass '参照类
Private lngBackColor As Long '窗体WINDOWS系统背静色
'局部变量保存属性值
Private frmName As Form
Private fccolor As FormColor '窗体色彩组合
Private blnUpDown As Boolean '标题左右结构标志
Private lngAccountID As Long '默认科目ID
Private strAccountName As String '默认科目名称
Private blnKeyInForm As Boolean '按键是否在本窗体标志
Private blnEscNoCancel As Boolean 'Esc不引起unload
Private ShiftDown As Integer 'Shift按状态
Dim blnNotScroll As Boolean ' 不触发msflexgrid SCROLL事件标志
Dim blnCurrencyInDirectRec As Boolean '币种折算方式
Dim blnButtonEnabled(16) As Boolean '由单据类型决定的按钮是否可见标志（可见并有效）
Dim blnSelected As Boolean '单据已被选择标志
Dim lngOldCustomerID As Long
Dim lngOldCurrencyID As Long
Private lngSourceActivityID As Long '冲销单据源ID
Private blnNotGridMouseUp As Boolean
Private blnCanAdjustDisc As Boolean
Private DiscInfos As New Collection
Private m_lngReceiptTypeID As Long
Private blnEnterCellByMouse As Boolean
Private blnMenuVisible As Boolean
Private m_lngLastVisibleCol As Long
Private blnMoveCtrByScroll As Boolean
Private mblnIsPrinted As Boolean '单据已打印标志
Private mblnModifyPrintedBill As Boolean '修改已打印单据权限
Private mblnPrintPrintedBill As Boolean '打印已打印单据权限
Private mblnModifyPrice As Boolean '修改单价权限
Private mblnModifyDiscountRate As Boolean '修改扣率单据权限
Private mblnNoLimitSalePrice As Boolean '低于最低价销售权限
Private mblnQuantityTotal As Boolean '是否显示数量合计
Private mlngHwndForMsg As Long '对话框句柄
'Private m_blnCanAdjustPrice As Boolean
Private Type RowProperty
lngDetailID As Long '业务明细ID 原第00列
strItem As String '商品 原第01列
lngItemID As Long '商品ID 原第28列
strSelectBill As String '选择单据 原第02列
lngOrderDetailID As Long '追踪ID 原第29列
strPosition As String '货位 原第02列
lngPositionID As Long '货位ID 原第30列
strUnit As String '单位 原第04列
lngUnitID As Long '单位ID 原第31列
dblFactor As Double '折算因子 原第40列
strQuantity As String '数量 原第05列
dblMinQuantity As Double '最小单位数量 原第41列
strPrice As String '不含税单价 原第06列
strPriceTax As String '含税单价 原第07列
strDiscount As String '扣率 原第08列
strCurrAmount As String '原币金额 原第09列
strCurrAmountTax As String '原币含税金额 原第14列
strCurrTaxAmount As String '原币税额 原第12列
strAmount As String '本币金额 原第10列
strAmountTax As String '本币含税金额 原第15列
strTaxAmount As String '本币税额 原第13列
strTax As String '税率 原第11列
lngTaxID As Long '税率ID 原第32列
strExpenseAmount As String '分摊金额 原第16列
strProduceNum As String '生产批号 原第17列
strProduceDate As String '生产日期 原第18列
strValidDate As String '到期日期 原第19列
intValidDay As Integer '有效期 原第20列
strJob As String '工程 原第21列
lngJobID As Long '工程ID 原第33列
strCustomID0 As String '自定义0 原第22列
lngCustomID0 As Long '自定义0ID 原第34列
strCustomID1 As String '自定义1 原第23列
lngCustomID1 As Long '自定义1ID 原第35列
strCustomID2 As String '自定义2 原第24列
lngCustomID2 As Long '自定义2ID 原第36列
strCustomID3 As String '自定义3 原第25列
lngCustomID3 As Long '自定义3ID 原第37列
strCustomID4 As String '自定义4 原第26列
lngCustomID4 As Long '自定义4ID 原第38列
strCustomID5 As String '自定义5 原第27列
lngCustomID5 As Long '自定义5ID 原第39列
lngInActivityDetailID As Long '批次INID 原第42列
dblMaxQuantityOfBatch As Double '批次最大数 原第43列
dblOutedQuantityOfBatch As Double '批次已出数 原第44列
strDiscInfo As String '折扣信息 原第45列
bytLastInputCol As Byte '最后输入位置 46
blnNotMayChange As Boolean '是否可修改 47
lngOldDetailID As Long '原单据明细ID 48
dblOldMinQuantity As Double '原最小单位数量 49
dblTaxRate As Double '税率值(未调整) 50
dblPositionQuantity As Double '货位数量(报警用) 51
blnPositionQuantityGeted As Boolean '货位数量已经取出标志 52
lngOldItemID As Long '原商品ID 53
lngOldPositionID As Long '原货位ID 54
blnSelectRealVoucher As Boolean '采购发票选择的单据已作非暂估凭证 55
dblCostAmount As Double '56
dblCostDiff As Double '57
dblSaleTax As Double '58
dblAvgCostAmount As Double '59
blnCanNotModifyExpenseAmount As Boolean '60
dblOldExpenseAmount As Double '61
End Type
Private RowPropertys() As RowProperty
Private Row2Position() As Long
Private NewQ As UnitCtrl
'当前输入控件文本
Public Property Let TextOfCtrInput(ByVal vData As String)
If Not ctrInput Is Nothing Then
If UCase(ctrInput.Name) = UCase("QuanInput") Then
NewQ.Text = vData
Else
ctrInput.Text = vData
End If
End If
End Property
Public Property Get TextOfCtrInput() As String
If Not ctrInput Is Nothing Then
If UCase(ctrInput.Name) = UCase("QuanInput") Then
TextOfCtrInput = NewQ.Text
If Abs(C2Dbl(TextOfCtrInput)) >= (10 ^ 12) Then
TextOfCtrInput = IIf(C2Dbl(TextOfCtrInput) > 0, "", "-") & "999999999999" & IIf(NewQ.Factor <= 1, "", "." & NewQ.Factor - 1)
End If
Else
If My.bytRegion = FGrid And My.lngOldCol = 4 Then '计量单位
If ctrInput.ID <> 0 Then
TextOfCtrInput = ctrInput.TextMatrix(ctrInput.ReferRow, 2)
Else
TextOfCtrInput = ctrInput.Text
End If
ElseIf My.bytRegion = FGrid And My.lngOldCol = 3 Then '货位
If ctrInput.ID <> 0 Then
TextOfCtrInput = ctrInput.TextMatrix(ctrInput.ReferRow, 2) & " " & ctrInput.TextMatrix(ctrInput.ReferRow, 3)
Else
TextOfCtrInput = ctrInput.Text
End If
Else
TextOfCtrInput = ctrInput.Text
If UCase(ctrInput.Name) = UCase("curinput") Then
If C2Dbl(TextOfCtrInput) >= (10 ^ 12) Then
TextOfCtrInput = IIf(C2Dbl(TextOfCtrInput) > 0, "", "-") & "999999999999" & IIf(ctrInput.Digits < 1, "", "." & String(ctrInput.Digits, "9"))
End If
End If
End If
End If
End If
End Property
Public Property Get TextOfGrid(ByVal lngRow As Long, ByVal lngCol As Long) As String
TextOfGrid = strGrdCell(lngRow, lngCol)
End Property
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -