mdlspread.bas

用VB6.0编写的关于车辆运输调度的系统

Attribute VB_Name = "mdlSpread"
Option Explicit


Public Enum genuBACKCOLOR
    CST_Lock = &H8000000F                'txt文本框锁定时的颜色——灰色
    CST_UnLock = &H80000005              'txt文本框未锁定时的颜色——白色
    CST_All_GotFocus = &HFFFFC0          '所有控件获得焦点时的颜色——淡蓝绿色
    CST_Grid_LostFocus = &H8000000F      '原来为灰色“&H8000000F”底色的控件失去焦点时的恢复颜色——灰色
    CST_White_LostFocus = &H80000005     '原来为白色“&H80000005”底色的控件失去焦点时的恢复颜色——白色
    CST_SPREAD_WHITE = vbWhite
End Enum

'功能：设定某列的标题名称、列宽
Public Sub SetColHead(spread As vaSpread, ByVal lcol As Long, ByVal sCaption As String, Optional ByVal dWidth As Double = 10, Optional ByVal bIsHidden As Boolean = False)
    
    With spread
        .Row = 0
        .Col = lcol
        .Text = sCaption
        .ColWidth(lcol) = dWidth
        .Row = -1
        .ColHidden = bIsHidden
    End With
    
End Sub

'返回Row行Col列的值
Public Function GetValue(spread As vaSpread, ByVal Row As Long, ByVal Col As Long) As Variant
Dim tempRow, TempCol As Long '保存原Spread控件Row、Col值

    tempRow = spread.Row
    TempCol = spread.Col
    With spread
        .Row = Row
        .Col = Col
        GetValue = .Value
    End With
    
    spread.Row = tempRow
    spread.Col = TempCol

End Function


'设置Row行Col列的值
Public Sub SetValue(spread As vaSpread, ByVal Row As Long, ByVal Col As Long, ByVal vVariant As Variant)
Dim tempRow, TempCol As Long '保存原Spread控件Row、Col值

    tempRow = spread.Row
    TempCol = spread.Col
    With spread
        .Row = Row
        .Col = Col
'        If vVariant = "" Then
'            vVariant = 0
'        End If
        .Value = vVariant
    End With
    
    spread.Row = tempRow
    spread.Col = TempCol

End Sub

'功能：对某个单元格进行加锁或解锁
'参数：Spread, Row, Col, Locked
Public Sub LockCell(spread As vaSpread, ByVal Col As Long, ByVal Locked As Boolean)
Dim tempRow, TempCol As Long

    tempRow = spread.Row
    TempCol = spread.Col
    
    With spread
        .Row = -1
        .Col = Col
        .Lock = Locked
    End With
    
    spread.Row = tempRow
    spread.Col = TempCol

End Sub

'对某个Spread进行加锁或解锁
Public Sub lockspread(spread As vaSpread, ByVal IsLock As Boolean)
    
    With spread
        .Col = -1
        .Row = -1
        .Lock = IsLock
    End With

End Sub

Public Sub ChangeColor(ByRef spread As vaSpread, ByVal lNewRow As Long, ByVal lNewCol As Long, Optional ByVal lOldRow As Long = -1, Optional ByVal lOldCol As Long = -1, Optional ByVal bGotFocus As Boolean = True)
Dim lCurRow As Long, lCurCol As Long
    
    With spread
        For lCurRow = 1 To .MaxRows
            If lCurRow = lNewRow Then GoTo NextLoop
            .Row = lCurRow
            For lCurCol = 1 To .MaxCols
                .Col = lCurCol
                If .BackColor = genuBACKCOLOR.CST_All_GotFocus Then
                    .BackColor = genuBACKCOLOR.CST_Grid_LostFocus
                End If
            Next lCurCol
NextLoop:
        Next lCurRow
        If bGotFocus Then
            .Row = lNewRow: .Col = 1
            If .BackColor = genuBACKCOLOR.CST_Grid_LostFocus Then
                .Col = -1
                .BackColor = genuBACKCOLOR.CST_All_GotFocus
            End If
            Exit Sub
        End If
    End With

End Sub

Public Function NextVisibleCell(ByVal spread As vaSpread, ByVal lCurCol As Long) As Integer
On Error Resume Next
Dim iNumber As Integer
Dim iLoop As Integer
    
    iNumber = -1
    With spread
        For iLoop = lCurCol + 1 To .MaxCols
            .Col = iLoop
            If Not .ColHidden And Not .Lock Then
                iNumber = iLoop
                Exit For
            End If
        Next
    End With
    NextVisibleCell = iNumber
    
End Function

Public Sub ActiveCell(ByRef spread As vaSpread, ByVal lrow As Long, ByVal lcol As Long)
On Error Resume Next
    With spread
        .Row = lrow: .Col = lcol
        .Action = 0
        .EditMode = False
        Call ChangeColor(spread, lrow, lcol)
    End With
End Sub

Public Sub LeaveCellEvent(spread As vaSpread, ByVal Col As Long, ByVal Row As Long, ByVal NewCol As Long, ByVal NewRow As Long, Cancel As Boolean)
    If Row = NewRow Then Exit Sub
    If NewRow = -1 And NewCol = -1 Then     '** LostFocus **
        Call ChangeColor(spread, 0, 0, Row, -1, False)
    Else
        Call ChangeColor(spread, NewRow, -1, Row)
    End If
End Sub

Public Sub SetBooleanType(spread As vaSpread, ByVal lrow As Long, ByVal lcol As Long)

    With spread
        .Row = lrow
        .Col = lcol
        .CellType = 10
        .TypeHAlign = 2
        .TypeCheckCenter = True
    End With
    
End Sub