ctllistviewgraphical.ctl

来自「一个关于电脑管理汽车的软件」· CTL 代码 · 共 1,006 行 · 第 1/3 页

        
        If lngColorRow(lngRow) <> lngColor Then
            lngColorRow(lngRow) = lngColor
            blnRepaintScreen = True
        End If

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub

Public Sub SetCellColor(lngRow As Long, lngColumn As Long, lngColor As Long)
On Error GoTo errHandler
Dim X As Long
        tmrDetectColumnResize.Enabled = True
        
        ResizeArray2 lngColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
        ResizeArray2 lngColorRow, lv.ListItems.Count
        ResizeArray2 lngColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorRow, lv.ListItems.Count
        ResizeArray2 lngGridLineColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
       
        ' 0 is used to indicate no painting is necessary, so we need to go ahead and
        ' set any 0 values to "1", which is almost black :)
        If lngColor = 0 Then lngColor = 1
        
        ' -1 is used to reset the paint value
        If lngColor = -1 Then lngColor = 0
        
        If lngColorValue(lngRow, lngColumn) <> lngColor Then
            lngColorValue(lngRow, lngColumn) = lngColor
            blnRepaintScreen = True
        End If

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub

Public Sub SetGridLineColumnColor(lngColumn As Long, lngColor As Long, blnRightSide As Boolean)
On Error GoTo errHandler
Dim X As Long
        tmrDetectColumnResize.Enabled = True

        ResizeArray2 lngColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
        ResizeArray2 lngColorRow, lv.ListItems.Count
        ResizeArray2 lngColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorRow, lv.ListItems.Count
        ResizeArray2 lngGridLineColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
        
        ' 0 is used to indicate no painting is necessary, so we need to go ahead and
        ' set any 0 values to "1", which is almost black :)
        If lngColor = 0 Then lngColor = 1
        
        ' -1 is used to reset the paint value
        If lngColor = -1 Then lngColor = 0
        
        If lngGridLineColorColumn(lngColumn) <> lngColor Then
            If blnRightSide Then
                lngGridLineColorColumn(lngColumn) = lngColor
            Else
                lngGridLineColorColumn(lngColumn) = -lngColor
            End If
            blnRepaintScreen = True
        End If
        

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub

Public Sub SetGridLineRowColor(lngRow As Long, lngColor As Long, blnBottomSide As Boolean)
On Error GoTo errHandler
Dim X As Long
        tmrDetectColumnResize.Enabled = True
        
        ResizeArray2 lngColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
        ResizeArray2 lngColorRow, lv.ListItems.Count
        ResizeArray2 lngColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorRow, lv.ListItems.Count
        ResizeArray2 lngGridLineColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
        
        ' 0 is used to indicate no painting is necessary, so we need to go ahead and
        ' set any 0 values to "1", which is almost black :)
        If lngColor = 0 Then lngColor = 1
        
        ' -1 is used to reset the paint value
        If lngColor = -1 Then lngColor = 0
        
        If lngGridLineColorRow(lngRow) <> lngColor Then
            If blnBottomSide Then
                lngGridLineColorRow(lngRow) = lngColor
            Else
                lngGridLineColorRow(lngRow) = -lngColor
            End If
            blnRepaintScreen = True
        End If

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub

Public Sub SetGridLineBoxCellColor(lngRow As Long, lngColumn As Long, lngColor As Long)
On Error GoTo errHandler
Dim X As Long
        tmrDetectColumnResize.Enabled = True

        ResizeArray2 lngColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
        ResizeArray2 lngColorRow, lv.ListItems.Count
        ResizeArray2 lngColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorRow, lv.ListItems.Count
        ResizeArray2 lngGridLineColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
        
        ' 0 is used to indicate no painting is necessary, so we need to go ahead and
        ' set any 0 values to "1", which is almost black :)
        If lngColor = 0 Then lngColor = 1
        
        ' -1 is used to reset the paint value
        If lngColor = -1 Then lngColor = 0
        
        If lngGridLineColorValue(lngRow, lngColumn) <> lngColor Then
            lngGridLineColorValue(lngRow, lngColumn) = lngColor
            blnRepaintScreen = True
        End If

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub

Public Sub HideColumn(lngColumnToHide As Long)
On Error GoTo errHandler
Dim Y As Long
Dim blnCancel As Boolean
        
    'Duplicate check
    blnCancel = False
    For Y = 1 To UBound(HideColumnList)
        If HideColumnList(Y) = lngColumnToHide Then blnCancel = True
    Next
    
    If Not blnCancel Then
        ReDim Preserve HideColumnList(UBound(HideColumnList) + 1)
        HideColumnList(UBound(HideColumnList)) = lngColumnToHide
    End If

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub

Public Sub ShowColumn(lngColumnToShow As Long)
On Error GoTo errHandler
    Dim Y As Long
    Dim Z As Long
    
       
    Z = -1
    For Y = 1 To UBound(HideColumnList)
        If lngColumnToShow = HideColumnList(Y) Then
            Z = Y
        End If
    Next
    
    ' Remove array
    If Z <> -1 Then
        For Y = Z To UBound(HideColumnList) - 1
            HideColumnList(Y) = HideColumnList(Y + 1)
        Next
        ReDim Preserve HideColumnList(UBound(HideColumnList) - 1)
    End If
    

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub


Private Sub tmrDetectColumnResize_Timer()
'On Error GoTo errHandler
On Error Resume Next
Dim X As Long
Dim Y As Long
Dim blnRepainted As Boolean
Dim blnListViewHasChanged As Boolean

    
    tmrDetectColumnResize.Enabled = Ambient.UserMode
    
    GetListViewScrollPosition
        
    blnRepainted = False
    blnListViewHasChanged = False
    If ListView.ColumnHeaders.Count <> UBound(lngListViewColumnSizes) Then
        ' Reset the columns here
        ReDim Preserve lngListViewColumnSizes(ListView.ColumnHeaders.Count)
        ReDim Preserve lngListViewColumnKeys(ListView.ColumnHeaders.Count)
        ReDim Preserve lngListViewPositionLeft(ListView.ColumnHeaders.Count)
        For X = 1 To ListView.ColumnHeaders.Count
            lngListViewColumnSizes(X) = ListView.ColumnHeaders(X).Width
            lngListViewColumnKeys(X) = ListView.ColumnHeaders(X).Position
            lngListViewPositionLeft(ListView.ColumnHeaders(X).Position) = ListView.ColumnHeaders(X).Width
        Next
    Else
        blnRepainted = False
        blnListViewHasChanged = False
        For X = 1 To ListView.ColumnHeaders.Count
            ' Detect if any columns are marked as hidden
            For Y = 1 To UBound(HideColumnList)
                If X = HideColumnList(Y) Then
                    If ListView.ColumnHeaders(X).Width <> 0 Then
                        ListView.ColumnHeaders(X).Width = 0
                    End If
                End If
            Next
            If ListView.ColumnHeaders(X).Width <> lngListViewColumnSizes(X) Then
                blnRepainted = True
            End If
            If ListView.ColumnHeaders(X).Position <> lngListViewColumnKeys(X) Then
                blnListViewHasChanged = True
            End If
        Next
        If blnListViewHasChanged Then
            RaiseEvent ListViewHasColumnsChanged
            For X = 1 To ListView.ColumnHeaders.Count
                lngListViewColumnSizes(X) = ListView.ColumnHeaders(X).Width
                lngListViewColumnKeys(X) = ListView.ColumnHeaders(X).Position
                lngListViewPositionLeft(ListView.ColumnHeaders(X).Position) = ListView.ColumnHeaders(X).Width
            Next
            RepaintListView
        ElseIf blnRepainted Then
            RaiseEvent ListViewHasBeenResized
            For X = 1 To ListView.ColumnHeaders.Count
                lngListViewColumnSizes(X) = ListView.ColumnHeaders(X).Width
                lngListViewPositionLeft(ListView.ColumnHeaders(X).Position) = ListView.ColumnHeaders(X).Width
            Next
            RepaintListView
        End If
    End If
    
        
    ' Check our colors
    If ListView.ColumnHeaders.Count <> UBound(lngColorColumn) Or ListView.ListItems.Count <> UBound(lngColorRow) Then
        ResizeArray2 lngColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
        ResizeArray2 lngColorRow, lv.ListItems.Count
        ResizeArray2 lngColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorRow, lv.ListItems.Count
        ResizeArray2 lngGridLineColorColumn, lv.ColumnHeaders.Count
        ResizeArray2 lngGridLineColorValue, lv.ListItems.Count, lv.ColumnHeaders.Count
    End If
    
    If blnRepaintScreen = True And Not blnRepainted And Not blnListViewHasChanged Then
        blnRepaintScreen = False
        RepaintListView
    End If
    

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub

'***************************INITIALIZE THE CONTROL**********************************

Private Sub UserControl_Resize()
On Error GoTo errHandler
    ListView.tOp = 0
    ListView.left = 0
    ListView.Height = UserControl.Height
    ListView.Width = UserControl.Width

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub


Private Sub UserControl_Initialize()
On Error GoTo errHandler
         'Occurs the first time a UserControl is placed on a container.
         'UserControl.BackColor = vbRed
        'SubClass
        ReDim lngColorValue(0, 0)
        ReDim lngColorColumn(0)
        ReDim lngColorRow(0)
        ReDim lngGridLineColorRow(0)
        ReDim lngGridLineColorColumn(0)
        ReDim lngGridLineColorValue(0, 0)
        ReDim lngListViewColumnSizes(0)
        ReDim lngListViewColumnKeys(0)
        ReDim HideColumnList(0)
        
        Me.VerticalScrollBarPosition = 0
        Me.HorizontalScrollBarPosition = 0
        
        blnRepaintScreen = False
        
        ' Disable the timer until the user actually wants color
        tmrDetectColumnResize.Enabled = False
         

Exit Sub

errHandler:
    MsgBox Err.Description & " " & Err.Number

End Sub