itemclass.cls

来自「金算盘软件代码」· CLS 代码 · 共 1,544 行 · 第 1/5 页

Public Property Let TextOfGrid(ByVal lngRow As Long, ByVal lngCol As Long, ByVal vData As String)
   WriteGrd vData, lngRow, lngCol
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 HwndForMsg(ByVal vData As Long)
    mlngHwndForMsg = vData
End Property
Public Property Get HwndForMsg() As Long
    HwndForMsg = mlngHwndForMsg
End Property
Public Property Get GetintCurDec() As Integer
   GetintCurDec = intCurDec
End Property

'Dim lngLeftCol As Long
'由单据类型决定的按钮是否可见标志（可见并有效）
Public Property Get ButtonEnabled(ByVal vData As Integer)
   ButtonEnabled = blnButtonEnabled(vData)
End Property
Public Property Let SourceActivityID(ByVal vData As Long)
    Let lngSourceActivityID = vData
End Property
Public Property Get SourceActivityID() As Long
    SourceActivityID = lngSourceActivityID
End Property

'原币小数位
Public Property Let CurDec(ByVal vData As Integer)
    Let intCurDec = vData
End Property
Public Property Get CurDec() As Integer
    CurDec = intCurDec
End Property
'汇率小数位
Public Property Let RateDec(ByVal vData As Integer)
    Let intRateDec = vData
End Property
Public Property Get RateDec() As Integer
    RateDec = intRateDec
End Property

'单据可修改权限属性
Public Property Let blnMayChange(ByVal vData As Boolean)
    Let My.blnMayChange = vData
End Property
Public Property Get blnMayChange() As Boolean
    blnMayChange = My.blnMayChange
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)
   Let My.blnChangeEvent = vData
End Property
Public Property Get blnChangeEvent() As Boolean
    blnChangeEvent = My.blnChangeEvent
End Property
    
'会计年度属性
Public Property Let intAccountYear(ByVal vData As Integer)
   Let My.intAccountYear = vData
End Property
Public Property Get intAccountYear() As Integer
    intAccountYear = My.intAccountYear
End Property
'会计期间属性
Public Property Let bytAccountPeriod(ByVal vData As Byte)
   Let My.bytAccountPeriod = vData
End Property
Public Property Get bytAccountPeriod() As Byte
    bytAccountPeriod = My.bytAccountPeriod
End Property
'GRD原列号属性
Public Property Let lngOldCol(ByVal vData As Long)
   Let My.lngOldCol = vData
End Property
Public Property Get lngOldCol() As Long
    lngOldCol = My.lngOldCol
End Property
'GRD原行号属性
Public Property Let lngOldRow(ByVal vData As Long)
   Let My.lngOldRow = vData
End Property
Public Property Get lngOldRow() As Long
    lngOldRow = My.lngOldRow
End Property
    
Public Property Get grdBorderWidth() As Integer
'当检索属性值时在参数右边使用。
'Syntax: Debug.Print X.grdBorderWidth
    grdBorderWidth = intGrdBorderWidth
End Property
Public Property Set Form(ByVal vData As Form)
'当把对象赋值给属性时在 Set 语句左边使用。
'Syntax: Set x.GridName = Form1
    Set frmName = vData
    #If conWan = 1 Then
        If UCase(frmName.Name) = "FRMSALESBILL" Then
            lngDefaultWidth = 10350
        Else
            lngDefaultWidth = 9885
        End If
    #Else
        lngDefaultWidth = 9435
    #End If
    Set NewQ = New UnitCtrl
    NewQ.SetWin frmName.QuanInput.hwnd
    NewQ.font = frmName.font
    
    My.blnIsChanged = False
    My.bytRegion = FcmdButton
    My.bytIndex = 0
    frmName.GrdCol.Cols = 28  '46
    
    '设置窗体控件颜色
    SetFormColor fccolor
    ApplyFormColor frmName, fccolor
    SeparateLineColor = fccolor.lngGridLineColor   'GRID列分隔线色

    '给GRDCOL设HOOK
    Set mclsSubClass = New SubClass32.SubClass
    mclsSubClass.hwnd = frmName.GrdCol.hwnd
    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True

    Set mclsHook = New SubClass32.SubClass
    mclsHook.hwnd = frmName.hwnd
    mclsHook.Messages(WM_PAINT) = True
    mclsHook.Messages(WM_KEYUP) = True
    mclsHook.Messages(WM_GETMINMAXINFO) = True
    mclsHook.Messages(WM_WINDOWPOSCHANGING) = True
    Set HookHe = New Hook
    HookHe.SetHookAll frmName.hwnd
    
    My.intAccountYear = gclsBase.AccountYear    '会计年度
    My.bytAccountPeriod = gclsBase.Period   '会计期间
    My.blnCtrlBinding = False
    My.blnRefresh = False
    My.blnPasteRec = False
    
    Set clsRecord = New RecordClass  '控件参照类
    Set clsRecordCustomer = New RecordClass  '控件参照类
    ReDim Field(14) As ClassField        '表头输入控件的附加属性

    ReDim ColProperty(27) As ClassGridProperty   'GRID附加属性
'设置GRID附加属性
    SetColProperty
'创建GRID列粘贴控键
  Dim i As Integer
    frmName.lblTotal(0).ZOrder 0
    For i = 1 To frmName.GrdCol.Cols
        Load frmName.lblTotal(i)
        frmName.lblTotal(i).Caption = ""
        frmName.lblTotal(i).ZOrder 0
    Next i
    frmName.lblTotal(1).Alignment = 2
'   创建Field控件(表头输入)
    CreateField (14)
    CreatelblNote
'    GrdAndLabelInitial
    ReDim strColRow(50) As String  '单据体行复制/粘贴存储区
    ReDim arrItemProperty(1) As ItemProperty
'设置默认小数位数
    intCurDec = gclsBase.NaturalCurDec
    intRateDec = gclsBase.PriceDec
    lngBackColor = GetSysColor(COLOR_BTNFACE)

    Select Case m_lngReceiptTypeID
    Case 13, 14, 15, 16, 18, 19
        blnCanAdjustDisc = IsCanDo(225)
    Case Else
        blnCanAdjustDisc = True
    End Select
    frmName.refInput(0).BackColor = fccolor.lngBackColor
    frmName.refInput(1).BackColor = fccolor.lngBackColor
    frmName.refInput(2).BackColor = fccolor.lngBackColor
    NewQ.BackColor = fccolor.lngBackColor
    
    frmName.curInput.Move -32000, -32000
    frmName.refInput(0).Move -32000, -32000
    frmName.refInput(1).Move -32000, -32000
    frmName.refInput(2).Move -32000, -32000
    frmName.txtInput.Move -32000, -32000
    frmName.dtmInput.Move -32000, -32000
    frmName.recList.Move -32000, -32000
    frmName.QuanInput.Move -32000, -32000
End Property
Public Property Get Form() As Object
'当检索属性值时在参数右边使用。
    Set Form = frmName
End Property
'确定滚动条的存在(待优化)
Public Sub ScrollBarExist(blnHscroll As Boolean, blnVscroll As Boolean)
    Dim intTotalColsWidth As Long
    intTotalColsWidth = lngSumOfColWidth()
    If frmName.GrdCol.Rows <= 2 Then
        '总行数小于2,必无垂直滚动条
        blnVscroll = False
        If intTotalColsWidth >= frmName.GrdCol.width - 2 * intGrdBorderWidth Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc
    End If
    If (Not frmName.GrdCol.RowIsVisible(frmName.GrdCol.Rows - 1)) Or (Not frmName.GrdCol.RowIsVisible(1)) Then
        '第一行或最大行不可视(第0行为固定行),必有垂直滚动条
        blnVscroll = True
        If intTotalColsWidth >= frmName.GrdCol.width - 2 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc
    End If
    If intTotalColsWidth >= frmName.GrdCol.width - 2 * intGrdBorderWidth Then
        blnHscroll = True
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight - gclsEniv.HScrollHeight Then
            blnVscroll = True
        Else
            blnVscroll = False
        End If
        GoTo EndProc
    End If
    If intTotalColsWidth < frmName.GrdCol.width - 2 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
        blnHscroll = False
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight Then
            blnVscroll = True