Attribute VB_Name = "modVSFlexGrid"
Option Explicit
Private Const GWL_STYLE As Long = (-16&)
Private Const SM_CXVSCROLL = 2
Private Const SM_CYHSCROLL = 3
Private Enum SCROLL_TYPE
WS_HSCROLL = &H100000
WS_VSCROLL = &H200000
End Enum
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetScrollRange Lib "user32" (ByVal hWnd As Long, ByVal nBar As Long, lpMinPos As Long, lpMaxPos As Long) As Long
Private Const SB_HORZ = &H0
Private Const SB_VERT = &H1
Dim lpMinPos As Long
Dim lpMaxPos As Long
Public Sub GotoLastVsgRow(tmpGrid As VSFlexGrid)
On Error GoTo ErrHandler
With tmpGrid
If .Rows > 1 Then
.Row = .Rows - 1
If .Visible = True Then
.SetFocus
End If
End If
End With
Exit Sub
ErrHandler:
End Sub
Function ScrollBarWidth() As Long
ScrollBarWidth = GetSystemMetrics(SM_CXVSCROLL) * Screen.TwipsPerPixelX
End Function
Function HorizontalScroll(VSGrid As VSFlexGrid) As Boolean
Dim i As Long
i = GetScrollRange(VSGrid.hWnd, SB_HORZ, lpMinPos, lpMaxPos)
If lpMaxPos <> lpMinPos Then
HorizontalScroll = True
Else
HorizontalScroll = False
End If
End Function
Function VerticalScroll(VSGrid As VSFlexGrid) As Boolean
Dim i As Long
i = GetScrollRange(VSGrid.hWnd, SB_VERT, lpMinPos, lpMaxPos)
If lpMaxPos <> lpMinPos Then
VerticalScroll = True
Else
VerticalScroll = False
End If
End Function
Sub SVGridUp(ControlGrid As VSFlexGrid, Optional ScrollWholePage As Boolean = False)
With ControlGrid
If .Row = -1 Then
Exit Sub
End If
If ScrollWholePage = True And Not .TopRow = 0 Then
.TopRow = .TopRow - 1
Else
If .Row = 0 Then
.Row = .Rows - 1
If .RowIsVisible(.Row) = False Then
.TopRow = .Row
End If
Else
.Row = .Row - 1
If .RowIsVisible(.Row) = False And Not .TopRow = 0 Then
.TopRow = .TopRow - 1
End If
End If
End If
End With
End Sub
Sub SVGridDown(ControlGrid As VSFlexGrid, Optional ScrollWholePage As Boolean = False)
With ControlGrid
If .Row = -1 Then
Exit Sub
End If
If ScrollWholePage = True Then
.TopRow = .TopRow + 1
Else
If .Row = .Rows - 1 Then
.Row = 0
If .RowIsVisible(.Row) = False Then
.TopRow = 0
End If
Else
.Row = .Row + 1
If .Row = .Rows - 1 Then
.TopRow = .Rows - 1
Else
If .RowIsVisible(.Row + 1) = False Then
.TopRow = .TopRow + 1
End If
End If
End If
End If
End With
End Sub
Public Sub FillVsgColCombo(tmpVsGrid As VSFlexGrid, inputSQL As String, inputCol As Integer, inputList As String, Optional inputKey As String = Empty)
On Local Error GoTo ErrHandler
Dim rsTemp As New ADODB.Recordset
Dim tmpData As String
rsTemp.Open inputSQL, Conn, adOpenForwardOnly, adLockReadOnly
tmpData = Empty
While Not rsTemp.EOF
If Len(cuStr(rsTemp(inputList))) > 0 Then
If inputKey = Empty Then
tmpData = tmpData & "|" & cuStr(rsTemp(inputList))
Else
tmpData = tmpData & "|#" & cuVal(rsTemp(inputKey)) & ";" & cuStr(rsTemp(inputList))
End If
End If
rsTemp.MoveNext
Wend
rsTemp.Close
tmpVsGrid.ColComboList(inputCol) = tmpData
Exit Sub
ErrHandler:
MsgBox Err.Description
rsTemp.Close
End Sub
Public Sub SetVsgRowColor(ByVal tmpGrid As VSFlexGrid, tmpRow As Integer, Optional tmpBackColor As Long = -1, Optional tmpForeColor As Long = -1)
With tmpGrid
.Redraw = False
.FillStyle = flexFillRepeat
If tmpRow + 1 > .FixedRows Or .FixedRows = 0 Then
.Row = tmpRow
.Col = .Cols - 1
.ColSel = 0
If tmpBackColor <> -1 Then .CellBackColor = tmpBackColor
If tmpForeColor <> -1 Then .CellForeColor = tmpForeColor
End If
.Redraw = True
.FillStyle = flexFillSingle
End With
End Sub
Private Function IsScrollbarVisible(ByVal hWnd&, ByVal eWhichScroll As SCROLL_TYPE) As Boolean
IsScrollbarVisible = ((GetWindowLong(hWnd, GWL_STYLE) And eWhichScroll) <> 0)
End Function
Public Sub AutoAdjustVsgColWidth(ByVal tmpVsGrid As VSFlexGrid, WhichCol As Integer, Optional IsScaleAll As Boolean = False)
On Local Error GoTo ErrorHandler
Dim tmpTotalWidth As Integer, tmpScaleRate As Double
Dim intX As Integer, vSbWidth As Integer
vSbWidth = GetSystemMetrics(SM_CXVSCROLL) * Screen.TwipsPerPixelX
tmpTotalWidth = 0
For intX = 0 To tmpVsGrid.Cols - 1
If tmpVsGrid.ColHidden(intX) = False Then
tmpTotalWidth = tmpTotalWidth + tmpVsGrid.ColWidth(intX)
End If
Next
If tmpTotalWidth - tmpVsGrid.ColWidth(WhichCol) > tmpVsGrid.Width Or IsScaleAll = True Then
tmpScaleRate = tmpVsGrid.Width / tmpTotalWidth
For intX = 0 To tmpVsGrid.Cols - 1
If tmpVsGrid.ColWidth(intX) > 0 And tmpVsGrid.ColHidden(intX) = False Then
tmpVsGrid.ColWidth(intX) = Int(tmpVsGrid.ColWidth(intX) * tmpScaleRate)
End If
Next
tmpTotalWidth = 0
For intX = 0 To tmpVsGrid.Cols - 1
If tmpVsGrid.ColHidden(intX) = False Then
tmpTotalWidth = tmpTotalWidth + tmpVsGrid.ColWidth(intX)
End If
Next
tmpVsGrid.ColWidth(WhichCol) = (tmpVsGrid.Width - tmpTotalWidth) + tmpVsGrid.ColWidth(WhichCol) - 100
If IsScrollbarVisible(tmpVsGrid.hWnd, WS_VSCROLL) Then
tmpVsGrid.ColWidth(WhichCol) = tmpVsGrid.ColWidth(WhichCol) - vSbWidth
End If
Else
tmpVsGrid.ColWidth(WhichCol) = (tmpVsGrid.Width - tmpTotalWidth) + tmpVsGrid.ColWidth(WhichCol) - 100
If IsScrollbarVisible(tmpVsGrid.hWnd, WS_VSCROLL) Then
tmpVsGrid.ColWidth(WhichCol) = tmpVsGrid.ColWidth(WhichCol) - vSbWidth
End If
End If
Exit Sub
ErrorHandler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "Error" 'gstrMsgError
End Sub
Public Sub vsgHeaderFont(tmpVsGrid As VSFlexGrid, tmpFontName As String, tmpFontSize As Integer)
Dim intX As Integer
With tmpVsGrid
For intX = 0 To .Cols - 1
.Cell(flexcpFontName, 0, intX) = tmpFontName
.Cell(flexcpFontSize, 0, intX) = tmpFontSize
Next
End With
End Sub
Public Sub vsgHeaderAlignment(tmpVsGrid As VSFlexGrid, Optional tmpAlignment As Integer = flexAlignCenterCenter)
Dim intX As Integer
With tmpVsGrid
For intX = 0 To .Cols - 1
If .ColWidth(intX) <> 0 Then
.FixedAlignment(intX) = tmpAlignment
Else
.FixedAlignment(intX) = flexAlignLeftCenter
End If
Next
' If .Rows > 1 Then
' .HighLight = flexHighlightAlways
' Else
' .HighLight = flexHighlightNever
' End If
End With
End Sub
Public Function GetPrevVisibleCol(tmpVsGrid As VSFlexGrid) As Long
Dim tmpResult As Long
Dim lngX As Long
With tmpVsGrid
tmpResult = .Col
If .Cols > 1 Then
For lngX = .Col - 1 To .FixedCols Step -1
If .ColHidden(lngX) = False And .ColWidth(lngX) > 0 Then
tmpResult = lngX
Exit For
End If
Next
End If
End With
GetPrevVisibleCol = tmpResult
End Function
Public Function GetNextVisibleCol(tmpVsGrid As VSFlexGrid) As Long
Dim tmpResult As Long
Dim lngX As Long
With tmpVsGrid
tmpResult = .Col
If .Cols > 1 Then
For lngX = .Col + 1 To .Cols - 1
If .ColHidden(lngX) = False And .ColWidth(lngX) > 0 Then
tmpResult = lngX
Exit For
End If
Next
End If
End With
GetNextVisibleCol = tmpResult
End Function
Public Function GetPrevVisibleRow(tmpVsGrid As VSFlexGrid) As Long
Dim tmpResult As Long
Dim lngY As Long
With tmpVsGrid
tmpResult = .Row
If .Rows > 1 Then
For lngY = .Row - 1 To .FixedRows Step -1
If .RowHidden(lngY) = False And .RowHeight(lngY) > 0 Then
tmpResult = lngY
Exit For
End If
Next
Else
tmpResult = 0
End If
End With
GetPrevVisibleRow = tmpResult
End Function
Public Function GetNextVisibleRow(tmpVsGrid As VSFlexGrid) As Long
Dim tmpResult As Long
Dim lngY As Long
With tmpVsGrid
tmpResult = .Row
If .Rows > 1 Then
For lngY = .Row + 1 To .Rows - 1
If .RowHidden(lngY) = False And .RowHeight(lngY) > 0 Then
tmpResult = lngY
Exit For
End If
Next
End If
End With
GetNextVisibleRow = tmpResult
End Function
Public Function GetFirstVisibleRow(tmpVsGrid As VSFlexGrid) As Long
Dim tmpResult As Long
Dim lngY As Long
tmpResult = 0
With tmpVsGrid
If .Rows > 1 Then
For lngY = .FixedRows To .Rows - 1
If .RowHidden(lngY) = False And .RowHeight(lngY) > 0 Then
tmpResult = lngY
Exit For
End If
Next
End If
End With
GetFirstVisibleRow = tmpResult
End Function
Public Function isInsideVsGrid(tmpVsGrid As VSFlexGrid, InputCode As String, tmpXPos As Integer, Optional tmpXPos2 As Integer = -1) As Boolean
On Local Error GoTo ErrHandler
Dim lngY As Long
Dim tmpLen As Integer
Dim tmpResult As Boolean
tmpLen = Len(InputCode)
tmpResult = False
With tmpVsGrid
If .Rows > 1 Then
.Redraw = flexRDNone
For lngY = .FixedRows To .Rows - 1
If .RowStatus(lngY) = 101 Then
.RowHidden(lngY) = True
Else
If UCase(Left(Trim(.TextMatrix(lngY, tmpXPos)), tmpLen)) = UCase(InputCode) Then
.RowHidden(lngY) = False
tmpResult = True
ElseIf tmpXPos2 > -1 Then
If UCase(Left(Trim(.TextMatrix(lngY, tmpXPos2)), tmpLen)) = UCase(InputCode) Then
.RowHidden(lngY) = False
tmpResult = True
Else
.RowHidden(lngY) = True
End If
Else
.RowHidden(lngY) = True
End If
End If
Next
.Redraw = flexRDDirect
End If
End With
ErrHandler:
isInsideVsGrid = tmpResult
End Function
