clsr_p.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 = "clsR_P"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'商品采购销售、期初单据表头序号定义:
' （期初单不包括10-14项）
'
'    0 = "单位详细内容"
'    1 = "单据号"
'    2 = "制单日期"
'    3 = "职员"
'    4 = "部门"
'    5 = "科目"
'    6 = "汇率"
'    7 = "币种"
'    8 = "项目"
'    9 = "统计"
'    10 = "到期日"
'    11 = "开票日"
'    12 = "付款条件"
'    13 = "发票号"
'    14 = "发票类型"

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  单据（采购单）类
'  作者：蔡奇科
'  日期：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滚动条的存在
'  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       修改货位批次明细表
Const intButtonWidth = 255 '下拉按纽宽度
#If conWan Then
    Const intCmd0Width = -75    '命令按纽宽度
    Const lngDefaultHeight = 5050 'Min 5600
#Else
    Const intCmd0Width = 1215    '命令按纽宽度
    Const lngDefaultHeight = 5600 'Min 5600
#End If
Const intCaptionHeight = 195 'FIELD按纽标题高度
Const intField0width = 2500 'FIELD按纽标题高度
Const intFieldHeight = 270 'FIELD按纽输入框高度
Const FixedCols = 1 'GRID固定列数
Const lngDefaultWidth = 8985  'Min 8985
'Const SeparateLineColor = 8421504    'GRID列分隔线色
Private SeparateLineColor   As Long     'GRID列分隔线色
Private IntSpace  As Integer '= 10 '粘贴控件之间距
Private SPACETWIPS As Integer '= 30 '单据头控件之列距
Private SpaceTwRow As Integer '= 15 '单据头控件之行距

Private blnTime As Boolean
Private intReceiptTypeID As Integer   '  13 =应付单ID
Private WithEvents mclsSubClass As SubClass32.SubClass  'Grid回调函数对象
Attribute mclsSubClass.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 ColProperty() As ClassGridProperty   'GRID附加属性
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 lngBackColor As Long             '窗体WINDOWS系统背静色
'局部变量保存属性值
Private frmName As frmR_P
Private fccolor As FormColor    '窗体色彩组合
Private blnUpDown As Boolean   '标题左右结构标志
Private lngAccountID As Long         '默认科目ID
Private strAccountName As String     '默认科目名称
Private mblnKeyDown As Boolean   '标志
Private lngPrintSetupID  As Long
Dim blnNotScroll As Boolean  ' 不触发msflexgrid SCROLL事件标志
Private ShiftDown    As Long    'Shift按状态
Dim mblnNotRespondKeyPress As Boolean
Dim blnMark As AccountblnOther
Private Type RowProperty
   lngDetailID As Long           '业务明细ID          原第00列
   strDate As String             '日期                原第01列
   strReceiptType As String      '单据类型            原第02列
   strReceiptNo As String        '单据号              原第03列
   strCurrencyName As String     '币种                原第04列
   strRate As String             '汇率                     5
   dblNoPayCurrencyAmount As Double            '原币未付款金额6
   dblCurerntPayCurrencyAmount As Double       '原币本次付款  7
   dblMayDiscountCurrencyAmount As Double      '原币可获折扣  8
   dblCurrentDiscountCurrencyAmount As Double  '原币本次折扣  9
   dblNoPayAmount As Double            '本币未付款金额       10
   dblCurerntPayAmount As Double       '本币本次付款         11
   dblMayDiscountAmount As Double      '本币可获折扣         12
   dblCurrentDiscountAmount As Double  '本币本次折扣         13
   
   strTerm As String             '付款条件          原第14列
   strInvoiceDate As String      '开票日            原第15列
   strEndDate As String          '到期日            原第16列
   strItemName As String         '商品劳务          原第17列
   strItemUnit As String         '计量单位          原第18列
   strNoPayQuantity As String        '未付款数量    原第19列
   strCurrentPayQuantity As String   '本次付款数量  原第20列
   strAccountName As String      '科目                  21
   strDepartmentName As String   '部门              原第22列
   strEmployeeName As String     '职员              原第23列
   strClass1Name As String       '统计              原第24列
   strClass2Name As String       '项目              原第25列
   strCustomID0 As String        '自定义0           原第26列
   strCustomID1 As String        '自定义1           原第27列
   strCustomID2 As String        '自定义2           原第28列
   strCustomID3 As String        '自定义3           原第29列
   strCustomID4 As String        '自定义4           原第30列
   strCustomID5 As String        '自定义5           原第31列
   strOperatorName As String     '制单               32
   strNote As String             '备注               33
   lngItemActivityDetailID As Long     '原单据明细ID 34
   dblFactor As Double         '折算因子   35
   bytCurrencydec As Byte      '币种小数位 36
   bytRateDec As Byte      '汇率小数位 37
   lngAccountID As Long    '科目id
   lngCurrencyID As Long
   lngDepartmentID As Long
   lngEmployeeID As Long
   lngClassID1 As Long
   lngClassID2 As Long
   lngDiscountActivityID As Long
   strARAPSource As String
End Type

Private RowPropertys() As RowProperty
Private RowNo() As Long
Private NewQ As New UnitCtrl
Public blnQuantityTotal As Boolean

Private mblnReadOnly As Boolean '  单据只读标志
Private intTotalRowHeight As Integer
Dim mblnDebit As Boolean
Private mstrAlpha As String
Private mlngDigit As Long
'----------------------------------------
Private mblnSound As Boolean '是否进行发音标志
'----------------------------------------
Private mblnTell As Boolean '是否进行报警示志
'----------------------------------------
Dim mblnOldVoid As Boolean  '是否是一张已经作废了的单子
Dim mstrOldDate As String       '保存当前单据的日期
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 strOldDate() As String
    strOldDate = mstrOldDate
End Property
Public Property Let strOldDate(ByVal vData As String)
    Let mstrOldDate = 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 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)
    Let mstrAlpha = vData
End Property
Public Property Get strAlpha() As String
    strAlpha = mstrAlpha
End Property

Public Property Let blnSound(ByVal vData As Boolean)
    Let mblnSound = vData
End Property
Public Property Get blnSound() As Boolean
    blnSound = mblnSound
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 TextMatrix(ByVal lngRow As Long, ByVal lngCol As Long) As String
   TextMatrix = strGrdCell(lngRow, lngCol)
End Property

Public Property Let TextMatrix(ByVal lngRow As Long, ByVal lngCol As Long, ByVal vData As String)
   WriteGrd vData, lngRow, lngCol
End Property

Public Property Get blnKeyDown() As Boolean
    blnKeyDown = mblnKeyDown
End Property
Public Property Let blnKeyDown(ByVal vData As Boolean)