mutigrid.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 = "MutiGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  GRID类
'  作者：黄涛
'  日期：1998.06.03
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MSFlexGrid中第0列隐藏，用于存储ID。
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Const GridReadWrite As Long = 1                                     '读写标志
Const GridReadOnly As Long = 0                                      '只读标志

Const GridNoOrder As Long = 0                                       '没有排序
Const GridAscOrder As Long = 1                                      '升序标志
Const GridDescOrder As Long = 2                                     '降序标志

Const GridUnOrder As Long = 0                                       '不可排序
Const GridOrder As Long = 1                                         '可排序

Const GridTextType As Long = 0                                      '字符类型
Const GridNumericType As Long = 1                                   '数值类型
Const GridDateType As Long = 2                                      '日期类型

Private WithEvents mclsSubClassBody As SubClass32.SubClass          'SubClass对象：处理MSFlexGrid对象
Attribute mclsSubClassBody.VB_VarHelpID = -1
Private WithEvents mclsSubClassHead As SubClass32.SubClass          'SubClass对象：处理MSFlexGrid对象
Attribute mclsSubClassHead.VB_VarHelpID = -1
Private WithEvents mBodyFlex As MSFlexGrid                          'MSFlexGrid对象
Attribute mBodyFlex.VB_VarHelpID = -1
Private WithEvents mHeadFlex As MSFlexGrid                          'MSFlexGrid对象
Attribute mHeadFlex.VB_VarHelpID = -1
Private mclsListSet As ListSet                                      'Grid数据对象
Attribute mclsListSet.VB_VarHelpID = -1
Private WithEvents mFlex As MSFlexGrid
Attribute mFlex.VB_VarHelpID = -1

Const GridEditText As Long = 1                                      '用EditText编辑
Const GridCalEdit As Long = 2                                      '用CalEdit编辑
Const GridListText As Long = 3                                      '用ListText编辑
Const GridCalendar As Long = 4                                      '用Calendar编辑
Const GridTeditText As Long = 5                                     '用TeditText编辑
Private WithEvents mEditText As TextBox
Attribute mEditText.VB_VarHelpID = -1
Private WithEvents mCalEdit As CalEdit
Attribute mCalEdit.VB_VarHelpID = -1
Private WithEvents mListText As ListText
Attribute mListText.VB_VarHelpID = -1
Private WithEvents mCalendar As GACALENDARLibCtl.calendar
Attribute mCalendar.VB_VarHelpID = -1
Private WithEvents mTEditText As TEdit
Attribute mTEditText.VB_VarHelpID = -1
Private mEditObject As Control
Private mintRalationCol As Integer
Private mstrRalationValue As String
Private mstrFormat As String
Private mblnEdit As Boolean
Private mblnCancel As Boolean

Private mClipRect As RECT                                           'Paint事件矩形区域

Private mlngColOfs As Long                                          'Grid中ListSet列开始位置

Private mlngSortedCol As Long                                       '排序列
Private mlngSortedType As Long                                      '排序方式

Private mblnMouseDownOnFixedRow As Boolean                          'MouseDown时位于固定行区域标志
Private mlngMouseDownCol As Long                                    'MouseDown列
Private mblnCancelRowColChange As Boolean                           '取消Grid行列改变事件

Private mblnNoRefresh As Boolean                                      '是否需要格式化数据
Private mblnColResize As Boolean
Private mblnSaveList As Boolean
Private mblnRowSel As Boolean

Private hdc As Long
Private lngKeyID As Long

Public Event DataValid(blnCancel As Boolean)
Public Event BeforeEdit(blnCancel As Boolean)
Public Event BeforeSave(blnCancel As Boolean)
Public Event BeforeRefresh(lngRow As Long)
Public Event BeforePageRefresh()
Public Event AfterSort(lngCol As Long)
Public Event AfterSave()
Public Event AfterRefresh(lngRow As Long)
Public Event AfterColResize(lngCol As Long)

Private Sub Class_Initialize()
    '创建对象
    Set mclsSubClassBody = New SubClass32.SubClass
    Set mclsSubClassHead = New SubClass32.SubClass
    Set mclsListSet = New ListSet
    
    ' MSFlexGrid中第0列隐藏，用于存储ID。
    mlngColOfs = 1
    lngKeyID = 6
End Sub

Private Sub Class_Terminate()
    '撤消对象
    On Error Resume Next
    If Not mclsListSet Is Nothing And Not mBodyFlex Is Nothing Then
        If mclsListSet.ViewId > 0 And mblnSaveList Then
            GridToListSet
            mclsListSet.SaveList
        End If
    End If
    Set mclsSubClassBody = Nothing
    Set mclsSubClassHead = Nothing
    Set mclsListSet = Nothing
    Set mFlex = Nothing
    Set mBodyFlex = Nothing
    Set mHeadFlex = Nothing
    Set mEditText = Nothing
    Set mCalEdit = Nothing
    Set mListText = Nothing
    Set mCalendar = Nothing
    Set mTEditText = Nothing
    Set mEditObject = Nothing
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  属性
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'表体属性
Public Property Get Grid() As MSFlexGrid
    Set Grid = mBodyFlex
End Property

Public Property Set Grid(ByVal vNewValue As MSFlexGrid)
    '设置Grid
    Set mBodyFlex = vNewValue
    
    '设置SubClass消息
    With mclsSubClassBody
        .hwnd = mBodyFlex.hwnd
        .Messages(WM_PAINT) = True
        .Messages(WM_LBUTTONUP) = True
        .Messages(WM_LBUTTONDOWN) = True
        .Messages(WM_MOUSEMOVE) = True
    End With
    
    If mHeadFlex Is Nothing Then
        Set mFlex = vNewValue
    End If
End Property


'表头Grid属性
Public Property Get HeadGrid() As MSFlexGrid
    Set HeadGrid = mHeadFlex
End Property

Public Property Set HeadGrid(ByVal vNewValue As MSFlexGrid)
    '设置Grid
    Set mHeadFlex = vNewValue
    
    '设置SubClass消息
    With mclsSubClassHead
        .hwnd = mHeadFlex.hwnd
        .Messages(WM_PAINT) = True
        .Messages(WM_LBUTTONUP) = True
        .Messages(WM_LBUTTONDOWN) = True
        .Messages(WM_MOUSEMOVE) = True
        .Messages(WM_KEYDOWN) = True
        .Messages(WM_KILLFOCUS) = True
    End With
    
    Set mFlex = vNewValue
End Property


'是否需要格式化数据
Public Property Get FormatData() As Boolean
    FormatData = Not mblnNoRefresh
End Property

Public Property Let FormatData(ByVal vNewValue As Boolean)
    mblnNoRefresh = Not vNewValue
End Property

'IsSelected属性：返回FlexGrid选中行状态。
Public Property Get IsSelected() As Boolean
    '如果MSFlexGrid当前列和选择列为零，无选中行。
    With mBodyFlex
        IsSelected = Not (.col = 0 And .ColSel = 0) And (.Row >= .FixedRows And .Row < .Rows)
    End With
End Property

'编辑框
Public Property Get EditText() As Object
    Set EditText = mEditObject
End Property

Public Property Set EditText(ByVal vNewValue As Object)
    'Dim prpLoop As Property
    
    If TypeOf vNewValue Is TextBox Then
        Set mEditText = vNewValue
        mEditText.Visible = False
        mEditText.Tag = "Saved"
    ElseIf TypeOf vNewValue Is CalEdit Then
        Set mCalEdit = vNewValue
        mCalEdit.Visible = False
        mCalEdit.Tag = "Saved"
    ElseIf TypeOf vNewValue Is ListText Then
        Set mListText = vNewValue
        mListText.Visible = False
        mListText.Tag = "Saved"
    ElseIf TypeOf vNewValue Is GACALENDARLibCtl.calendar Then
        Set mCalendar = vNewValue
        mCalendar.Visible = False
        mCalendar.Tag = "Saved"
    ElseIf TypeOf vNewValue Is TEdit Then
        Set mTEditText = vNewValue
        mTEditText.Visible = False
        mTEditText.Tag = "Saved"
    End If
    
    mstrFormat = ""
    mintRalationCol = -1
End Property

'列只读属性
Public Property Get ReadOnlyCol(ByVal lngCol As Long) As Boolean
    ReadOnlyCol = True
    With mBodyFlex
        If lngCol >= .FixedCols And lngCol <= .Cols - 1 And .Rows > 1 Then
            If (.ColData(lngCol) And &HF) = GridReadWrite Then
                ReadOnlyCol = False
            End If
        End If
    End With
End Property

Public Property Let ReadOnlyCol(ByVal lngCol As Long, ByVal blnReadOnly As Boolean)
    With mBodyFlex
        If lngCol >= .FixedCols And lngCol <= .Cols - 1 Then
            If ReadOnlyCol(lngCol) <> blnReadOnly Then
                If blnReadOnly Then
                    .ColData(lngCol) = (.ColData(lngCol) And &HFFF0) + GridReadOnly
                Else
                    .ColData(lngCol) = (.ColData(lngCol) And &HFFF0) + GridReadWrite
                End If
            End If
        End If
    End With
End Property


'列类型：0 字符类型/ 1 数值类型
Public Property Get ColType(ByVal lngCol As Long) As Integer
    ColType = 0
    With mBodyFlex
        If lngCol >= 1 And lngCol <= .Cols - 1 Then
            ColType = (.ColData(lngCol) And &HF0) \ &H10
        End If
    End With
End Property

Public Property Let ColType(ByVal lngCol As Long, ByVal intType As Integer)
    With mBodyFlex
        If lngCol >= 1 And lngCol <= .Cols - 1 Then
            .ColData(lngCol) = (.ColData(lngCol) And &HFF0F) + intType * &H10
        End If
    End With
End Property

'可排序列：False 不可排序/ True 可排序
Public Property Get ColSort(ByVal lngCol As Long) As Boolean
    ColSort = False
    With mBodyFlex
        If lngCol >= 1 And lngCol <= .Cols - 1 Then
            If (.ColData(lngCol) And &HF00) \ &H100 = GridOrder Then
                ColSort = True
            End If
        End If
    End With
End Property

Public Property Let ColSort(ByVal lngCol As Long, ByVal blnSort As Boolean)
    With mBodyFlex
        If lngCol >= 1 And lngCol <= .Cols - 1 Then
            If blnSort Then
                .ColData(lngCol) = (.ColData(lngCol) And &HF0FF) + &H100
            Else
                .ColData(lngCol) = (.ColData(lngCol) And &HF0FF)
            End If
        End If
    End With
End Property

'列编辑对象类型
Public Property Get EditType(ByVal lngCol As Long) As Integer
    EditType = 0
    With mBodyFlex
        If lngCol >= .FixedCols And lngCol <= .Cols - 1 And .Rows > 1 Then
            EditType = (.ColData(lngCol) And &HF000)
        End If
    End With
End Property

Public Property Let EditType(ByVal lngCol As Long, ByVal intEditType As Integer)
    Dim lngSaveCol As Long, lngSaveColSel As Long
    Dim lngSaveRow As Long, lngSaveRowSel As Long
    
    With mBodyFlex
        If lngCol >= .FixedCols And lngCol <= .Cols - 1 And .Rows > 1 Then
           .ColData(lngCol) = (.ColData(lngCol) And &HFFF) + &H1000 * intEditType
        End If
    End With
End Property

'返回排序列
Public Property Get SortedCol() As Long
    SortedCol = mlngSortedCol
End Property

'列排序方式：0 没有排序/ 1 升序/ 2 降序
Public Property Get SortedType() As Integer
    SortedType = mlngSortedType
End Property

'Grid中ListSet列开始位置
Public Property Get ColOfs() As Long
    ColOfs = mlngColOfs
End Property

Public Property Let ColOfs(ByVal vNewValue As Long)
    If vNewValue >= 1 Then
        mlngColOfs = vNewValue
    
        If Not mBodyFlex Is Nothing Then
            If mclsListSet.ViewId = 0 Then
                mBodyFlex.FixedCols = mlngColOfs
            Else
                mBodyFlex.FixedCols = mclsListSet.FixColumns + mlngColOfs
            End If
        End If
    End If
End Property

'返回ListSet对象
Public Property Get ListSet() As ListSet
    Set ListSet = mclsListSet