billset.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 = "BillSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  单据(应收/应付、收款/付款)类
'  作者：蔡奇科
'  日期：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            单据类型

'===========================================================================================
' 方法：
'  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上粘贴一行

'===========================================================================================
' 函数：
'  blnRowIsVisible          在GRID上确定行是否可见
'  lngSumOfColWidth         各列宽度之和
'  dblTotalOfCol            GRID列合计
'  blnNotNullRow            确定GRID上的某一行是否为空行
'                           出口：为TRUE时不是空行为FALSE时是空行
'  blnDeleteARow            在GRID上删除一行
'                           入口：行号
'  strGrdCell               从GRID上某一单元格内取出字符串
'  NextUsableCol            找当前GRID行的下一个可用Col
'  PrevUsableCol            找当前GRID行的前一个可用Col
'  DataValid_LostFocus      当前输入框LostFocus通用响应程序
'  getFieldID               获取Field的ID号
'===========================================================================================

Option Explicit

Const intButtonWidth = 255 '下拉按纽宽度
#If conWan = 1 Then
    Const intCmd0Width = -75    '命令按纽宽度
#Else
    Const intCmd0Width = 1215    '命令按纽宽度
#End If
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固定列数
Const SeparateLineColor = &H808080    'GRID列分隔线色
Const lngDefaultWidth = 8985  'Min 8985
#If conWan Then
    Const lngDefaultHeight = 5655 'Min 5540
#Else
    Const lngDefaultHeight = 5510 'Min 5540
#End If
Private IntSpace  As Integer '= 10 '粘贴控件之间距
Private SPACETWIPS As Integer '= 30 '单据头控件之列距
Private SpaceTwRow As Integer '= 15 '单据头控件之行距
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private blnTime As Boolean
Private intReceiptTypeID As Integer
Private WithEvents mclsSubClass As SubClass32.SubClass  'Grid回调函数对象
Attribute mclsSubClass.VB_VarHelpID = -1
Dim WithEvents mclsPicFooter As SubClass32.SubClass     '输入PictureBox回调函数对象
Attribute mclsPicFooter.VB_VarHelpID = -1
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(10) As ClassPicInputField  'PIC输入时的附加属性
Private ColProperty() As ClassGridProperty   'GRID附加属性
Private FormClipRect As RECT
Private GridClipRect As RECT
Private My As clsBillMark
Private clsBase As Base
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 strFOldRate As String        '上次的汇率值
Private strFOldPrice As String       '上次的单价
Private strGOldRate As String        '上次的汇率值
Private strGOldPrice As String       '上次的单价
Private intYN As Integer            '对话框的返回值变量
Private intGrdBorderWidth As Long    'GRD边框垂直线宽
Private intGrdBorderHeight As Long   'GRD边框水平线宽
Private intTotalRowHeight As Integer
Private strOldText As String         '输入点原内容
Private lngOldID As Long             '输入点原ID
Private blnBusy As Boolean
Public blnHaveISVoucher As Boolean         '确定此单据是否已生成了凭证
Public lngVoucherID As Long            '根据业务ID找到的凭证ID
Private clsLstMethod As clsListMethod
Private blnJob As Boolean   '是否有工程输入框
Private frmName As Form
Private clsRed As RecordClass
Private frmColor As FormColor
'----------------------------------------
Private mblnSound As Boolean '是否进行发音标志
'----------------------------------------
Private mblnTell As Boolean '是否进行报警示志
'----------------------------------------
Private mblnKeyDown As Boolean
Private mblnReadOnly As Boolean '  单据只读标志
Private mblnYSJX As Boolean     '确定是否为应收计息单据
Private mblnIsDiscount As Boolean       '确定是否为折扣单据
Private lngH As Long
Dim lngOldHeight As Long        'GRID上次的行高
Dim blnFirstToPic As Boolean  '从其它位置首次进入某列的PIC方式输入标志
Dim blnMark As AccountblnOther
Dim lngOldIndex As Long '原来的INDEX
'在“收款单和付款单”中如果核销则应从相应的对照表清除
'blnIsHaveVoid 属性就是用来保存和设置是否核销(此属性只在CHK_CLICK中设为TRUE)
'其它地方均为FALSE
'局部变量保存属性值
Private mvarblnIsHaveVoid As Boolean '本地复本
Private mstrAlpha As String
Private mlngDigit As Long
Dim mblnLeftRight As Boolean  'FIELD控件标题内容水平排列标志
Dim mQuantity As String
Dim mPrice As String
Dim strQuantityUnit As String   '数量计量单位
Dim mblnDebit As Boolean
Dim mblnOldVoid As Boolean  '是否是一张已经作废了的单子
Dim mblngrdCellDoing As Boolean  'GRD内是否仍在继续运行(在FORM_UNLOAD 内识别)
Dim mblnNotRaiseEvent As Boolean    '不激活事件标志
Dim mstrOldDate As String       '保存当前单据的日期
Dim mblnNotFormActive As Boolean
Dim mblnNotRespondKeyPress As Boolean
Dim mLastRegion As Byte
Dim lngOneTextWidth As Long '一个字的显示宽度（TWIPS）
Dim blnPaint As Boolean
Dim blnNoPaint As Boolean
Dim blnScroll As Boolean '
Public blnCashLine As Boolean
Dim mstrCancelDate  As String '冲销原单据的日期

Public Property Get strCancelDate() As String
    strCancelDate = mstrCancelDate
End Property
Public Property Let strCancelDate(ByVal vData As String)
    Let mstrCancelDate = vData
End Property

Public Property Get blnKeyDown() As Boolean
    blnKeyDown = mblnKeyDown
End Property
Public Property Let blnKeyDown(ByVal vData As Boolean)
    Let mblnKeyDown = vData
End Property
Public Property Get blnNotRespondKeyPress() As Boolean
    blnNotRespondKeyPress = mblnNotRespondKeyPress
End Property
Public Property Let blnNotRespondKeyPress(ByVal vData As Boolean)
    Let mblnNotRespondKeyPress = vData
End Property
Public Property Get blnNotFormActive() As Boolean
    blnNotFormActive = mblnNotFormActive
End Property
Public Property Let blnNotFormActive(ByVal vData As Boolean)
    Let mblnNotFormActive = vData
End Property

Public Property Get blnOldVoid() As Boolean
    blnOldVoid = mblnOldVoid
End Property
Public Property Let blnOldVoid(ByVal vData As Boolean)
    Let mblnOldVoid = vData
End Property

Public Property Get strOldDate() As String
    strOldDate = mstrOldDate
End Property
Public Property Let strOldDate(ByVal vData As String)
    Let mstrOldDate = vData
End Property

Public Property Get blnNotRaiseEvent() As Boolean
    blnNotRaiseEvent = mblnNotRaiseEvent
End Property
Public Property Let blnNotRaiseEvent(ByVal vData As Boolean)
    Let mblnNotRaiseEvent = vData
End Property

Public Property Get blnGrdCellDoing() As Boolean
    blnGrdCellDoing = mblngrdCellDoing
End Property
Public Property Let blnGrdCellDoing(ByVal vData As Boolean)
    Let mblngrdCellDoing = vData
End Property

Public Property Get blnTell() As Boolean
    blnTell = mblnTell
End Property
Public Property Let blnTell(ByVal vData As Boolean)
    Let mblnTell = vData
End Property

Public Property Get blnDebit() As Boolean
    blnDebit = mblnDebit
End Property
Public Property Let blnDebit(ByVal vData As Boolean)
    Let mblnDebit = vData
End Property


Public Property Get Quantity() As String
    Quantity = mQuantity
End Property
Public Property Let Quantity(ByVal vData As String)
    Let mQuantity = vData
End Property
Public Property Get Price() As String
    Price = mPrice
End Property
Public Property Let Price(ByVal vData As String)
    Let mPrice = vData
End Property
'------------------------------------
Public Property Get blnLeftRight() As Boolean
    blnLeftRight = mblnLeftRight
End Property
Public Property Let blnLeftRight(ByVal vData As Boolean)
    Let mblnLeftRight = vData
End Property
Public Property Get blnIsDiscount() As Boolean
    blnIsDiscount = mblnIsDiscount
End Property
Public Property Let blnIsDiscount(ByVal vData As Boolean)
    Let mblnIsDiscount = vData
End Property
'-------------------------------------
Public Property Let lngDigit(ByVal vData As Long)
    Let mlngDigit = vData
End Property
Public Property Get lngDigit() As Long
    lngDigit = mlngDigit
End Property
Public Property Let strAlpha(ByVal vData As String)