listgrid.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 = "ListGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   LIST类
'
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MSFlexGrid中第0列隐藏，用于存储ID，第1列用于存储“停用”标志。
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mclsListSet As ListSet                          '列表设置对象
Private WithEvents mDbTabCtrl As WINCTRLLib.DBTableCtrl
Attribute mDbTabCtrl.VB_VarHelpID = -1
Private mResultset() As rdoResultset                    '数据源
'Private WithEvents mDataGrid As PictureBox
Private mThwnd As Long                                  '(窗体句柄）
Private mTab As Integer                                 '当前页面
Private mTabs As Integer                                '总的页数
Private mblnShowAll As Boolean                          '“全部显示”标志
Private mstrFindColName As String                       '当前选定行
'Private mctlFind As TextBox                            '内容TextBox控件
Private mclsFindText As String                          '(内容）
Private mintSortCol As Integer                          '当前排序列
Private mintSortType As Integer                         '排序类型
Private mlngRow As Long                                 '当前行
Private mblnIsReception As Boolean                      '是否为单据列表
Private mTotalRows() As Long                            '总行数
Private mTotalCols() As Long                            '总的列数
Private mHaveDealRow() As Long                          '是否为弹出菜单后处理
Private mTopRow As Long                                 '最高可见行
Private mButtonRow As Long                              '最低可见行

Public Property Let Thwnd(ByVal vNewValue As Long)
    mThwnd = vNewValue
End Property
Public Property Get Thwnd() As Long
     Thwnd = mThwnd
End Property

Public Property Let strText(ByVal vNewValue As String)
    mclsFindText = vNewValue
End Property
Public Property Get strText() As String
     strText = mclsFindText
End Property
Public Property Let TotalRow(ByVal Index As Integer, ByVal vNewValue As Long)
     mTotalRows(Index) = vNewValue
End Property
Public Property Get TotalRow(ByVal Index As Integer) As Long
     TotalRow = mTotalRows(Index)
End Property
Public Property Get TotalCol(ByVal Index As Integer) As Long
     TotalCol = mTotalCols(Index)
End Property
Public Property Get intTab() As Integer
     intTab = mTab
End Property

Public Property Let intTab(ByVal vNewValue As Integer)
      mTab = vNewValue
      mDbTabCtrl.Rows = mTotalRows(mTab) + 1
      mTotalCols(mTab) = mResultset(mTab).rdoColumns.Count
      mDbTabCtrl.Cols = mTotalCols(mTab)
      mDbTabCtrl.RDORecordset = mResultset(mTab)
      mDbTabCtrl.hwnd = mThwnd ' mDataGrid.hwnd
      ReDim mHaveDealRow(0)
End Property

Public Property Get intTabs() As Integer
     intTabs = mTabs
End Property

Public Property Let intTabs(ByVal vNewValue As Integer)
      mTabs = vNewValue
      ReDim mResultset(0 To mTabs - 1)
      ReDim mTotalRows(0 To mTabs - 1)
      ReDim mTotalCols(0 To mTabs - 1)
End Property

Public Property Get DbTabCtrl() As WINCTRLLib.DBTableCtrl
     Set DbTabCtrl = mDbTabCtrl
End Property
Public Property Get Resultset(ByVal intTab As Integer) As rdoResultset
     On Error GoTo Handler1:
        If mResultset(intTab).EOF Then
            Set Resultset = mResultset(intTab)
        Else
            Set Resultset = mResultset(intTab)
        End If
        Exit Property
Handler1:
    On Error GoTo 0
    On Error GoTo Hander2
    mResultset(intTab).Requery
    Set Resultset = mResultset(intTab)
    Exit Property
Hander2:
    Resume
End Property
Public Property Set Resultset(ByVal intTab As Integer, NewRecordset As rdoResultset)
     If Not mResultset(intTab) Is Nothing Then mResultset(intTab).Close
     Set mResultset(intTab) = NewRecordset
End Property
'Public Property Get DataGrid() As PictureBox
'    Set DataGrid = mDataGrid
'End Property
'
'Public Property Set DataGrid(ByVal vNewValue As PictureBox)
'     Set mDataGrid = vNewValue
'End Property

Public Property Get ShowAll() As Boolean
    ShowAll = mblnShowAll
End Property

Public Property Let ShowAll(ByVal vNewValue As Boolean)
    mblnShowAll = vNewValue
End Property

Public Property Get FindColName() As String
    FindColName = mstrFindColName
End Property
Public Property Let FindColName(ByVal vNewValue As String)
     mstrFindColName = vNewValue
End Property

'Public Property Set Find(ByVal vNewValue As TextBox)
'    Set mctlFind = vNewValue
'End Property

Public Property Get SortCol() As Integer
    SortCol = mintSortCol
End Property


Public Property Let SortCol(ByVal vNewValue As Integer)
    mintSortCol = vNewValue
End Property
Public Property Get SortType() As Integer
    SortType = mintSortType
End Property

Public Property Let SortType(ByVal vNewValue As Integer)
    mintSortType = vNewValue
End Property
Public Property Get CurRow() As Long
    CurRow = mlngRow
End Property

Public Property Get IsReception() As Boolean
    IsReception = mblnIsReception
End Property
Public Property Get ListSet() As ListSet
    Set ListSet = mclsListSet
End Property

'方法：
'1
'设置DataGrid格式
Public Sub SetGridFormate()
    Dim i As Long
    Dim intCols As Integer
    Dim strSql As String
    Dim recDec As rdoResultset
    Dim intCurrencyDec As Integer, intRateDec As Integer
    
    intCols = mResultset(mTab).rdoColumns.Count
    With mDbTabCtrl
        '.SetOption -1, -1, -1, -1, 0, -1, -1, -1
        .ClipCell = 1
        .SetBorder 0, -1, 1 + 2
        .SetColBorder 0, intCols, 1, 0, 2
        .SetColBorder 2, 2, 2, 0, 32
        .SelectionMode = 4
        .FixedRows = 1
        .ResizeCol = 1
        .FixedCols = 0
        .SetOption -1, -1, 0, -1, -1, -1, -1, -1
    End With
    With mDbTabCtrl
        If mclsListSet.Columns = mclsListSet.FixColumns Then    '只有固定列
            .FixedCols = mclsListSet.FixColumns + 1
        Else
            .FixedCols = mclsListSet.FixColumns + 2
        End If
            .FixedCols = 0
        '设置固定行颜色
        For i = 0 To intCols - 1
            .SetCellPattern 0, i, 0, i, 0, RGB(192, 192, 192), -1, -1
            .SetCellForeColor 0, 0, 0, intCols, RGB(0, 0, 0)
            .ColName(i) = mResultset(mTab).rdoColumns(i).Name
            If i = mintSortCol + 1 Then
                If mintSortType = 1 Then
                    .CellFormula(0, i) = mResultset(mTab).rdoColumns(i).Name & "↑"
                Else
                    .CellFormula(0, i) = mResultset(mTab).rdoColumns(i).Name & "↓"
                End If
            Else
                .CellFormula(0, i) = mResultset(mTab).rdoColumns(i).Name
            End If
        Next
        '得到datagrid的列宽,设置列的对齐方式
        For i = 1 To mclsListSet.Columns
            .ColWidth(i + 1) = mclsListSet.ColumnWidth(i) / Screen.TwipsPerPixelX
            Select Case UCase(mclsListSet.ColumnFieldType(i))
                Case "INTEGER", "LONG", "DOUBLE"
                    .SetColAlignment i + 1, i + 1, 3, 2, -1, -1, -1
            End Select
        Next i
        '取得原币和汇率的数位数
        strSql = "SELECT max(Currencys.bytCurrencyDec) as strCurrencyDec, max(Currencys.bytRateDec) as strRateDec " _
            & " FROM Currencys Where Currencys.lngCurrencyID <> " & gclsBase.NaturalCurId
        Set recDec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recDec.EOF Then
            If IsNull(recDec!strCurrencyDec) Then
                If Trim(recDec!strCurrencyDec) <> "" Then
                    intCurrencyDec = C2lng(recDec!strCurrencyDec)
                Else
                    intCurrencyDec = 0
                End If
            Else
                intCurrencyDec = 0
            End If
            If IsNull(recDec!strRateDec) Then
                If Trim(recDec!strRateDec) <> "" Then
                    intRateDec = C2lng(recDec!strRateDec)
                Else
                    intRateDec = 0
                End If
            Else
                intRateDec = 0
            End If
        Else
            intCurrencyDec = 0
            intRateDec = 0
        End If
        recDec.Close
        Set recDec = Nothing
        '显示格式 0=其他 1=数量 2=单价 3=原币 4=汇率 5=本币 6=日期
        '