clsorder.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 = "clsOrder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  单据（采购/销售订单）类
'  作者：苏梦
'  日期：1998.07.25
'

'==================================================================================
' 属性：
'  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上插入/添加一行
'  BuildNoteMsg             建立“说明”信息
'  ctrID2Name               将各种ID号转换为名称
'  SaveInput2Form           从输入控件获取数据到窗体
'  SaveBillToCollection     将单据内容存入单据内容集合
'  LoadBillFromCollection   从单据内容集合获取单据内容
'  Form_Resize              Form_Resize事件响应程序
'  grdCol_EnterCell         进入GRID单元的响应程序
'  grdCol_MouseUp           从表头再进入GRD原单元格
'  grdCol_Scroll            GRID滚动响应程序
'  Field_Click              Field_Click事件响应程序
'  Field_MouseUp            Field_MouseUp事件响应程序
'  Head_Click               Head_Click事件响应程序
'  Memo_Click               Memo_Click事件响应程序
'  MoveCtr                  移动通用输入控件
'  TabOrder                 控件Tab顺序调整
'  Reload                   放弃当前输入控件的输入内容
'  PrevVisibleField         第一个可视的Field
'  NextVisibleField         下一个可视的Field
'  Grid2Button              当前行的内容传给粘贴控件
'  Button2Grid              粘贴控件的内容传给Grid行
'  SetButtonFocus           将焦点对准当前单元格上的粘贴控件
'  ColButton_KeyDown        列表粘贴控件按键通用响应程序
'  colButton_GotFocus       列表粘贴控件GotFocus通用响应程序
'  ColIsGray                只读列显示背景变灰
'  CellIsGray               只读列单元显示背景变灰
'  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上粘贴一行
'  SetColblnReadonly           设置表列只读属性
'===========================================================================================
' 函数：
'  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号
'  rowIsDone                判断采购订单是否已执行

Option Explicit
Const intButtonWidth = 285 '下拉按纽宽度
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 SeparateLineColor   As Long     'GRID列分隔线色
Private lngBackColor As Long             '窗体WINDOWS系统背景色
Const lngDefaultWidth = 8985  'Min 8985
Const lngDefaultHeight = 5600 'Min 5600

Private blnTime As Boolean
Private intReceiptTypeID As Integer   '  1 =采购订单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 ColProperty() As ClassGridProperty   'GRID附加属性
Private FormClipRect As RECT
Private GridClipRect As RECT
Private My As clsBillMark

Private lngPosition(0 To 12, 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 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 arrItemProperty() As ItemProperty   'GRD行属性（商品属性）

'局部变量保存属性值
Private frmName As Form
Private clsRecord As RecordClass
Private clsRecordCustomer As RecordClass
Dim strSQL As String
Public strCurDec As String      '原币小数位
Dim strPriceDec As String      '单价小数位
Dim strDec As String         '本币小数位
Public strRateDec As String     '原币汇率位
Public strOrderName As String       '订单名称
Public intCurDecS As Integer      '原币小数位
Public intRateDecS As Integer     '原币汇率位
Private fccolor As FormColor    '窗体色彩组合
Private blnKeyInForm    As Boolean    '按键是否在本窗体标志
Private blnEscNoCancel    As Boolean    'Esc不引起unload
Private ShiftDown    As Integer    'Shift按状态
Dim blnCurrencyInDirectRec As Boolean  '币种折算方式
Dim blnNotScroll As Boolean  ' 不触发msflexgrid SCROLL事件标志
Public strDiscountRate As String   '默认扣率
Dim blnSelected As Boolean  '单据已被选择标志
Dim lngOldCustomerID As Long
Dim lngOldCurrencyID As Long
Private blnCanAdjustDisc As Boolean
Private DiscInfos As New Collection
Private m_lngReceiptTypeID As Long
Private blnEnterCellByMouse As Boolean
Private m_blnCustomerIsPay As Boolean
Private m_blnEdit As Boolean
Private blnMenuVisible As Boolean
Private mblnIsPrinted As Boolean    '单据已打印标志
Private mblnModifyPrintedBill As Boolean    '修改已打印单据权限
Private mblnPrintPrintedBill As Boolean     '打印已打印单据权限
Private mblnModifyPrice As Boolean          '修改单价权限
Private mblnModifyDiscountRate As Boolean   '修改扣率单据权限
Private mblnQuantityTotal As Boolean        '是否显示数量合计
Private NewQ As UnitCtrl
Attribute NewQ.VB_VarHelpID = -1
Public Property Get CustomerIsPay() As Boolean
    CustomerIsPay = m_blnCustomerIsPay
End Property
'当前输入控件文本
Public Property Let TextOfCtrInput(ByVal vData As String)
    If Not ctrInput Is Nothing Then
        If UCase(ctrInput.Name) = UCase("QuanInput") Then
'            Debug.Assert NewQ.Text = vData
            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 = 2 Then '计量单位
                If ctrInput.ID <> 0 Then
                    TextOfCtrInput = ctrInput.TextMatrix(ctrInput.ReferRow, 2)
                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 Let MenuVisible(ByVal vData As Boolean)
    Let blnMenuVisible = vData
End Property
Public Property Get MenuVisible() As Boolean
    MenuVisible = blnMenuVisible
End Property

Public Property Let mblnEdit(ByVal vData As Boolean)
   Let m_blnEdit = vData
End Property
Public Property Get mblnEdit() As Boolean
     mblnEdit = m_blnEdit
     If mblnEdit = False Then
        If Not ctrInput Is Nothing Then
            ctrInput.Move -32000, -32000
            Set ctrInput = Nothing
        End If
     End If
End Property


Public Property Get DropButtonWidth() As Integer
     DropButtonWidth = intButtonWidth
End Property


'单据类型属性
Public Property Let ReceiptTypeID(ByVal vData As Integer)
   Let intReceiptTypeID = vData
End Property
Public Property Get ReceiptTypeID() As Integer
     ReceiptTypeID = intReceiptTypeID
End Property
'是否绑定控件属性
Public Property Let blnCtrlBinding(ByVal vData As Boolean)
   Let My.blnCtrlBinding = vData
End Property
Public Property Get blnCtrlBinding() As Boolean
     blnCtrlBinding = My.blnCtrlBinding
End Property
'当前单据ID 属性
Public Property Let lngNowID(ByVal vData As Long)
   Let My.lngNowID = vData
End Property
Public Property Get lngNowID() As Long
     lngNowID = My.lngNowID
End Property
'当前输入区域属性
Public Property Let bytRegion(ByVal vData As Byte)
   Let My.bytRegion = vData
End Property
Public Property Get bytRegion() As Byte
     bytRegion = My.bytRegion
End Property
'当前输入区域序号属性
Public Property Let bytIndex(ByVal vData As Byte)
   Let My.bytIndex = vData
End Property
Public Property Get bytIndex() As Byte
     bytIndex = My.bytIndex
End Property

'数据是否改变属性
Public Property Let blnIsChanged(ByVal vData As Boolean)
   Let My.blnIsChanged = vData
End Property
Public Property Get blnIsChanged() As Boolean
     blnIsChanged = My.blnIsChanged
End Property
'窗体是否刷新属性
Public Property Let blnRefresh(ByVal vData As Boolean)
   Let My.blnRefresh = vData
End Property
Public Property Get blnRefresh() As Boolean
    blnRefresh = My.blnRefresh
End Property
'是否可行粘贴属性
Public Property Let blnPasteRec(ByVal vData As Boolean)
   Let My.blnPasteRec = vData
End Property
Public Property Get blnPasteRec() As Boolean
    blnPasteRec = My.blnPasteRec
End Property
'是否可粘贴单据属性
Public Property Get blnPasteBill() As Boolean
    If ColBill.Count = 0 Then
        blnPasteBill = False
    Else
        blnPasteBill = True
    End If
End Property

'是否可删除属性
Public Property Let blnMayDelete(ByVal vData As Boolean)
   Let My.blnMayDelete = vData
End Property
Public Property Get blnMayDelete() As Boolean
    blnMayDelete = My.blnMayDelete
End Property
'是否触发CHANGE事件属性
Public Property Let blnChangeEvent(ByVal vData As Boolean)