Attribute VB_Name = "modAdjustGrid"
Option Explicit
Public gintGridAlternateColor As Integer
Public glngGridDefaultColor As Long
Public glngGridAlterColor As Long
Public gintMaxAlterRow As Integer
Public gblnAdjustGrid As Boolean
Public gblnIgnoreRowColChange As Boolean
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
Public Sub GridSelChange(ByRef tmpGrid As MSFlexGrid) '處理多行選取的問題
On Error GoTo ErrHandler
With tmpGrid
If .Rows > 1 And .Visible = True Then
.RowSel = .Row
End If
End With
Exit Sub
ErrHandler:
End Sub
' 明細項目表格使用的資料
Public Function ChkGridDetailsEmpty(tmpGrid As MSFlexGrid, tmpStatusCol As Integer) As Boolean
Dim intY As Integer
Dim tmpResult As Boolean
tmpResult = True
With tmpGrid
If .Rows > 1 Then
For intY = 1 To .Rows - 1
If .TextMatrix(intY, tmpStatusCol) <> "3" Then
tmpResult = False
Exit For
End If
Next
End If
End With
ChkGridDetailsEmpty = tmpResult
End Function
Public Function FindGridDetailsNextRow(tmpGrid As MSFlexGrid, tmpStatusCol As Integer) As Boolean
Dim intY As Integer
With tmpGrid
If .Rows > 1 Then
If .Row > 1 Then
For intY = .Row To 1 Step -1
If .TextMatrix(intY, tmpStatusCol) <> "3" Then
.Row = intY
FindGridDetailsNextRow = True
Exit Function
End If
Next
For intY = .Row To .Rows - 1
If .TextMatrix(intY, tmpStatusCol) <> "3" Then
.Row = intY
FindGridDetailsNextRow = True
Exit Function
End If
Next
Else
For intY = .Row To .Rows - 1
If .TextMatrix(intY, tmpStatusCol) <> "3" Then
.Row = intY
FindGridDetailsNextRow = True
Exit Function
End If
Next
End If
End If
FindGridDetailsNextRow = False
End With
End Function
Public Function GridCompare(ByRef tmpGrid As MSFlexGrid, tmpRow1 As Long, tmpRow2 As Long, tmpSortType As Integer, tmpSortAscend As Boolean) As Integer
Dim mDate1 As Date
Dim mDate2 As Date
Dim mDbl1 As Double
Dim mDbl2 As Double
Dim tmpResult As Integer
With tmpGrid
Select Case tmpSortType
Case 1
.Row = tmpRow1
If cuIsDate(.Text) Then mDate1 = CDate(.Text) Else: mDate1 = 0
.Row = tmpRow2
If cuIsDate(.Text) Then mDate2 = CDate(.Text) Else: mDate2 = 0
If tmpSortAscend = True Then
If mDate1 > mDate2 Then
tmpResult = -1
ElseIf mDate1 < mDate2 Then
tmpResult = 1
Else
tmpResult = 0
End If
Else
If mDate1 > mDate2 Then
tmpResult = 1
ElseIf mDate1 < mDate2 Then
tmpResult = -1
Else
tmpResult = 0
End If
End If
Case 2
.Row = tmpRow1
mDbl1 = cuDbl(.Text)
.Row = tmpRow2
mDbl2 = cuDbl(.Text)
If tmpSortAscend = True Then
If mDbl1 > mDbl2 Then
tmpResult = -1
ElseIf mDbl1 < mDbl2 Then
tmpResult = 1
Else
tmpResult = 0
End If
Else
If mDbl1 > mDbl2 Then
tmpResult = 1
ElseIf mDbl1 < mDbl2 Then
tmpResult = -1
Else
tmpResult = 0
End If
End If
Case 3
End Select
End With
GridCompare = tmpResult
End Function
Public Function ChkGridMaxRows(ByRef tmpGrid As MSFlexGrid) As Boolean
Dim tmpResult As Boolean
With tmpGrid
If ((.Rows + 1) * .Cols) < 350000 Then
tmpResult = True
Else
tmpResult = False
End If
End With
ChkGridMaxRows = tmpResult
End Function
Public Sub ResetGridAlignment(tmpGrid As MSFlexGrid)
Dim intX As Integer
With tmpGrid
If .Cols > 0 Then
For intX = 0 To .Cols - 1
If .ColWidth(intX) = 0 Then .ColAlignment(intX) = flexAlignLeftCenter
Next
End If
End With
End Sub
Public Sub ClearGridNoise(tmpGrid As MSFlexGrid)
Dim k As Integer
With tmpGrid
.Redraw = False
.Row = 0
For k = 0 To .Cols - 1
If .ColWidth(k) = 0 Then
.Col = k
.CellAlignment = flexAlignLeftCenter
End If
Next k
.Redraw = True
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 GridSetHighLight(tmpGrid As MSFlexGrid, Optional tmpPosRow As Integer = -1, Optional tmpPosCol As Integer = 0)
With tmpGrid
If .Rows > .FixedRows Then
gblnIgnoreRowColChange = True
.Redraw = False
If tmpPosRow > -1 And tmpPosRow <= .Rows - 1 Then .Row = tmpPosRow 'Else: .Row = .Rows - 1
.HighLight = flexHighlightAlways
'.Col = 0
.Col = tmpPosCol
.ColSel = .Cols - 1
Else
.HighLight = flexHighlightNever
End If
.Redraw = True
gblnIgnoreRowColChange = False
End With
End Sub
Public Sub GridRefillItemNo(tmpGrid As MSFlexGrid, Optional tmpCol As Integer = 0)
Dim intY As Integer
With tmpGrid
If .Rows > 1 Then
For intY = 1 To .Rows - 1
.TextMatrix(intY, tmpCol) = intY
Next intY
End If
End With
End Sub
Public Sub GridHeaderAlignment(tmpGrid As MSFlexGrid, Optional tmpAlignment As Integer = flexAlignCenterCenter)
Dim intX As Integer
With tmpGrid
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 Sub GridAdjustment(tmpGrid As MSFlexGrid)
With tmpGrid
If .Rows > 1 Then
.HighLight = flexHighlightAlways
If .RowHeight(1) = 0 Then
.RowHeight(1) = 15
End If
Else
.HighLight = flexHighlightNever
End If
End With
End Sub
Public Sub GridPaste(tmpGrid As MSFlexGrid, tmpClipData As String)
With tmpGrid
.Col = 0
.ColSel = .Cols - 1
.Clip = tmpClipData
End With
End Sub
Public Function GridCopy(tmpGrid As MSFlexGrid, tmpRow As Integer) As String
Dim tmpResult As String
With tmpGrid
.Row = tmpRow
.Col = 0
.ColSel = .Cols - 1
tmpResult = .Clip
End With
GridCopy = tmpResult
End Function
Public Sub GotoLastGridRow(tmpGrid As MSFlexGrid)
On Error GoTo ErrHandler
With tmpGrid
If .Rows > 1 Then
.Row = .Rows - 1
If .Visible = True Then
.SetFocus
.Col = 0
.ColSel = .Cols - 1
End If
End If
End With
Exit Sub
ErrHandler:
End Sub
Public Sub AdjustFixed(ByVal tmpGrid As MSFlexGrid, EndCol As Integer, Optional FontSize As Integer = 12)
Dim k As Integer
With tmpGrid
For k = 0 To EndCol
.Row = 0
.Col = k
.CellAlignment = flexAlignCenterCenter
.CellFontSize = FontSize
Next k
End With
End Sub
Public Sub AutoAdjustGridWithColor(tmpGrid As MSFlexGrid, StartRow As Integer, StartCol As Integer, EndCol As Integer, AdjustCol As Integer)
Dim k As Integer, i As Integer
Dim intItemNo As Integer
With tmpGrid
For k = StartRow To .Rows - 1
intItemNo = k Mod 2
If intItemNo = 1 Then
For i = StartCol To EndCol
.Row = k
.Col = i
.CellBackColor = ColorLightYellow
Next i
End If
Next k
End With
Call AutoAdjustGridColWidth(tmpGrid, AdjustCol)
End Sub
Public Sub AutoAdjustGridColWidth(ByVal tmpGrid As MSFlexGrid, WhichCol As Integer, Optional IsScaleAll As Boolean = False)
On 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 tmpGrid.Cols - 1
tmpTotalWidth = tmpTotalWidth + tmpGrid.ColWidth(intX)
Next
If tmpTotalWidth - tmpGrid.ColWidth(WhichCol) > tmpGrid.Width Or IsScaleAll = True Then
tmpScaleRate = tmpGrid.Width / tmpTotalWidth
For intX = 0 To tmpGrid.Cols - 1
If tmpGrid.ColWidth(intX) > 0 Then
tmpGrid.ColWidth(intX) = Int(tmpGrid.ColWidth(intX) * tmpScaleRate)
End If
Next
tmpTotalWidth = 0
For intX = 0 To tmpGrid.Cols - 1
tmpTotalWidth = tmpTotalWidth + tmpGrid.ColWidth(intX)
Next
tmpGrid.ColWidth(WhichCol) = (tmpGrid.Width - tmpTotalWidth) + tmpGrid.ColWidth(WhichCol) - 100
If IsScrollbarVisible(tmpGrid.hWnd, WS_VSCROLL) Then
tmpGrid.ColWidth(WhichCol) = tmpGrid.ColWidth(WhichCol) - vSbWidth
End If
Else
tmpGrid.ColWidth(WhichCol) = (tmpGrid.Width - tmpTotalWidth) + tmpGrid.ColWidth(WhichCol) - 100
If IsScrollbarVisible(tmpGrid.hWnd, WS_VSCROLL) Then
tmpGrid.ColWidth(WhichCol) = tmpGrid.ColWidth(WhichCol) - vSbWidth
End If
End If
Exit Sub
ErrorHandler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "Error" 'gstrMsgError
End Sub
' 這個 Procedure 會引致 GridRowColChange 的事件, 有問題未處理
Public Sub SetAlternateColor(ByRef tmpGrid As MSFlexGrid, Optional tmpMainColor As Long = &HFFFFFF, Optional tmpAlterColor As Long = &HC0FFFF, Optional tmpFirstFill As Boolean = True)
Dim intX As Integer
Dim lngY As Long
Dim intRow As Integer
intRow = 2
With tmpGrid
If .Rows > 1 Then
gblnIgnoreRowColChange = True
If .Rows >= gintMaxAlterRow Then intRow = 5
.Redraw = False
.SelectionMode = flexSelectionByRow
.BackColor = tmpMainColor
For lngY = 1 To .Rows - 1
If lngY Mod intRow = 0 Then
.FillStyle = flexFillRepeat
.Row = lngY
.RowSel = lngY
.Col = .Cols - 1
.ColSel = 0
.CellBackColor = tmpAlterColor
Else
If tmpFirstFill = True Then
.FillStyle = flexFillSingle
Else
.FillStyle = flexFillRepeat
.Row = lngY
.RowSel = lngY
.Col = .Cols - 1
.ColSel = 0
.CellBackColor = tmpMainColor
End If
End If
Next lngY
.Redraw = True
gblnIgnoreRowColChange = False
End If
End With
End Sub
Public Sub SetGridDisableColor(ByVal tmpGrid As MSFlexGrid, tmpActiveCol As Integer, Optional tmpBackColor As Long = vbGrayText)
Dim intY As Integer
With tmpGrid
If .Rows > 1 Then
.Redraw = False
.FillStyle = flexFillRepeat
For intY = 1 To .Rows - 1
If cuVal(.TextMatrix(intY, tmpActiveCol)) = 0 Then
.Row = intY
.Col = .Cols - 1
.ColSel = 0
If tmpBackColor <> 0 Then .CellBackColor = tmpBackColor
End If
Next intY
.Redraw = True
.FillStyle = flexFillSingle
End If
End With
End Sub
Public Sub SetGridRowColor(ByVal tmpGrid As MSFlexGrid, 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
Public Sub setGridColColor(ByVal tmpGrid As MSFlexGrid, tmpCol As Integer, Optional tmpBackColor As Long = -1, Optional tmpForeColor As Long = -1)
With tmpGrid
.Redraw = False
.FillStyle = flexFillRepeat
If tmpCol > .FixedCols Then
.Col = tmpCol
.Row = .Rows - 1
.RowSel = 0
If tmpBackColor <> -1 Then .CellBackColor = tmpBackColor
If tmpForeColor <> -1 Then .CellForeColor = tmpForeColor
End If
.Redraw = True
.FillStyle = flexFillSingle
End With
End Sub
Public Sub SetGridRowFont(ByVal tmpGrid As MSFlexGrid, tmpRow As Integer, tmpFontName As String, Optional tmpFontStyle As String = "0000")
With tmpGrid
.Redraw = False
.FillStyle = flexFillRepeat
If tmpRow + 1 > .FixedRows Or .FixedRows = 0 Then
.Row = tmpRow
.Col = .Cols - 1
.ColSel = 0
.CellFontName = tmpFontName
.CellFontBold = cuBool(Val(Mid(tmpFontStyle, 1, 1)))
.CellFontItalic = cuBool(Val(Mid(tmpFontStyle, 2, 1)))
.CellFontUnderline = cuBool(Val(Mid(tmpFontStyle, 3, 1)))
.CellFontStrikeThrough = cuBool(Val(Mid(tmpFontStyle, 4, 1)))
End If
.Redraw = True
.FillStyle = flexFillSingle
End With
End Sub
Public Sub SetGridCellFont(tmpGrid As MSFlexGrid, tmpCol As Integer, tmpFontName As String, Optional tmpColor As Long = vbBlack, Optional tmpLastRow As Boolean = False)
Dim intX As Integer
With tmpGrid
If tmpLastRow = False Then
.Col = tmpCol
For intX = 1 To .Rows - 1
.Row = intX
.CellFontName = tmpFontName
.CellForeColor = tmpColor
Next
Else
.Col = tmpCol
.Row = tmpGrid.Rows - 1
.CellFontName = tmpFontName
.CellForeColor = tmpColor
End If
End With
End Sub
Public Sub SetGridBoolean(tmpGrid As MSFlexGrid, tmpCol As Integer, tmpFontName As String, Optional tmpRow As Integer = 0)
Dim intX As Integer
Dim tmpCurRow As Integer
With tmpGrid
tmpCurRow = .Row
.Redraw = False
gblnIgnoreRowColChange = True
Select Case tmpRow
Case -1
.Col = tmpCol
.Row = tmpGrid.Rows - 1
.CellFontName = tmpFontName
If Val(.Text) = 1 Then
.CellForeColor = vbBlue
Else
.CellForeColor = vbRed
End If
Case 0
.Col = tmpCol
For intX = 1 To .Rows - 1
.Row = intX
.CellFontName = tmpFontName
If Val(.Text) = 1 Then
.CellForeColor = vbBlue
Else
.CellForeColor = vbRed
End If
Next
Case Else
.Col = tmpCol
.Row = tmpRow
.CellFontName = tmpFontName
If Val(.Text) = 1 Then
.CellForeColor = vbBlue
Else
.CellForeColor = vbRed
End If
End Select
.Redraw = True
.Row = tmpCurRow
If .HighLight = flexHighlightAlways Then GridSetHighLight tmpGrid, .Row
gblnIgnoreRowColChange = False
End With
End Sub
Sub GridDown(ControlGrid As MSFlexGrid, NoOfRow As Integer)
If ControlGrid.Rows = 0 Then Exit Sub
With ControlGrid
If Not .Row = .Rows - 1 Then
If .Row - .TopRow > NoOfRow - 2 Then
.TopRow = .TopRow + 1
.Row = .Row + 1
.Col = 0
.ColSel = .Cols - 1
Else
.Row = .Row + 1
.Col = 0
.ColSel = .Cols - 1
End If
End If
End With
End Sub
Sub GridUp(ControlGrid As MSFlexGrid)
If ControlGrid.Rows = 0 Then Exit Sub
With ControlGrid
If Not .Row = 0 And Not ControlGrid.Rows = 0 Then
If .TopRow = .Row Then
.TopRow = .TopRow - 1
.Row = .Row - 1
.Col = 0
.ColSel = .Cols - 1
Else
.Row = .Row - 1
.Col = 0
.ColSel = .Cols - 1
End If
End If
End With
End Sub
Sub GridPgUp(ControlGrid As MSFlexGrid, NoOfRow As Integer)
If ControlGrid.Rows = 0 Then Exit Sub
With ControlGrid
If .Row - NoOfRow <= 0 Or .TopRow - NoOfRow <= 0 Then
.TopRow = 0
.Row = 0
.Col = 0
.ColSel = .Cols - 1
Else
.TopRow = .TopRow - NoOfRow
.Row = .Row - NoOfRow
.Col = 0
.ColSel = .Cols - 1
End If
End With
End Sub
Sub GridPgDn(ControlGrid As MSFlexGrid, NoOfRow As Integer)
If ControlGrid.Rows = 0 Then Exit Sub
With ControlGrid
If .Row + NoOfRow >= .Rows - 1 Or .TopRow + NoOfRow >= .Rows - 1 Then
.TopRow = .Rows - 1
.Row = .Rows - 1
.Col = 0
.ColSel = .Cols - 1
Else
.TopRow = .TopRow + NoOfRow
.Row = .Row + NoOfRow
.Col = 0
.ColSel = .Cols - 1
End If
End With
End Sub
