VBFlexGrid Control (Replacement of the MSFlexGrid control)

[Krool]

Krool I noticed that properties RowIsVisible, ColIsVisible return always true, no matter if the respective Row or Col are hidden or not.
Or maybe I'm doing something wrong?

VBFlexGrid1.RowHidden(0) = True is just an "extended" way of VBFlexGrid1.RowHeight(0) = 0.
Thus like in original MSFlexGrid those zero height rows will still be return True by RowIsVisible if the row is within client rect, even if it's height is zero.

Even in the VSFlexGrid control it says: If a row has zero height or is hidden but is within the scrollable area, RowIsVisible will return True.

So I won't change the behavior in order to be full compatible.

However, you can make your own workaround helper function as following:

Public Function FlexGridRowIsVisible(ByRef FlexGrid As VBFlexGrid, ByVal Row As Long) As Boolean
If FlexGrid.RowIsVisible(Row) = True And FlexGrid.RowHidden(Row) = False Then FlexGridRowIsVisible = True
End Function

[immortalx]

Thank you very much for the explanation Krool. I didn't know that was the case for MSFlexGrid too and certainly I'd never ask you to change this behavior! I was just curious as a beginner and the original property names RowIsVisible/RowHidden were a bit misleading to me
Also thank you for the helper function and for all your contributions to this community. Much appreciated!

[gibra]

Good work, Krool.

There is a VerticalAlignment, for Text cell (Top, Middle, Bottom) ?

[Krool]

There is a VerticalAlignment, for Text cell (Top, Middle, Bottom) ?

The .CellAlignment is used for both, horizontal and vertical text alignment.

[gibra]

The .CellAlignment is used for both, horizontal and vertical text alignment.

Now I have found it, and it's very simple to use.
Great!!!


It would also be nice to have a FilterBar (like the ComponentOne TrueDBGrid control).
Have you ever thought about implementing it?

[Krool]

Update released.

The FlexSortCustom was totally broken. This fact appeared when I needed in a case a custom sorting and I noticed that Row1 in the Compare event was correct but Row2 was totally off.
Row2 had two errors, one could be fixed but the other is kind of impossible due to the partial temp out-of-place sorting in the recursive stable merge sort.

So now, whenever a custom sort is invoked an optimized stable bubble sort is performed internally. This ensure that the Row1/Row2/Col text matrix subscripts is meaningful and properly. Because bubble sort is full in-place and is swapping one by one. So .TextMatrix is always up to date. So no problem for the Compare event anymore.

If no custom sort is applied, then the fast and efficient stable merge sort is again internally used.

In order to decrease the need of custom sorting I have included now the possibility to sort by currency and date. (FlexCurrencyAscending/FlexCurrencyDescending and FlexDateAscending/FlexDateDescending)
These new enum flag can be set to both Sort and ColSort property. (Info: In order to use ColSort set FlexUseColSort enum into the Sort property)

[Krool]

Most stupid bugfix ever... related to yesterday bugfix and new bubble sort for custom sorting.

In the internal method BubbleSortIter it should be

If Cmp > 0 Then

and not

If Cmp >= 0 Then

Now, equal items (Cmp = 0) won't be sorted. (which is wanted)

[Krool]

DividerDblClick event included.

This convenient event can be a very quick helper for implementing an "user auto auto-sizing" functionality.

Example usage:

Private Sub VBFlexGrid1_DividerDblClick(ByVal Row As Long, ByVal Col As Long)
If Row = -1 Then
    VBFlexGrid1.AutoSize Col, , FlexAutoSizeModeColWidth
ElseIf Col = -1 Then
    VBFlexGrid1.AutoSize Row, , FlexAutoSizeModeRowHeight
End If
End Sub

Like in the ListView control it only fires on left mouse button.

[Krool]

Updated released.

Optimized the divider row/col dragging.

This means that now the splitter rect displayed during the divider row/col dragging starts not anymore at the current mouse position.
It now starts exactly at the divider line and calculates internally an offset to the current mouse position.
Of course when moving and releasing the mouse the offset is also considered.

The benefit of this optimization is a more precise dragging and no mini pixel movings anymore when pressing and releasing the mouse without moving.


Included the HitRowDivider/HitColDivider property which returns the divider row/col from the last invoked .HitTest.

The difference between HitRowDivider/HitColDivider and the normal HitRow/HitCol is an offset applied.
Also either HitRowDivider and HitColDivider is set to -1 or both. Never both can be higher than -1. Unlike HitRow/HitCol where both are usually higher than -1.
The offset accounts following:
Normally for FlexHitResultDividerRowTop/FlexHitResultDividerColumnLeft an offset of -1 must be applied to shift to the actual row/col.
For FlexHitResultDividerRowBottom/FlexHitResultDividerColumnRight an offset was never necessary.
In addition (new feature) the offset also accounts for hidden rows and cols. Though zero width rows/cols are not accounted to preserve MSFlexGrid compatibility.
Example: In MSFlexGrid a zero width row/col can be resized (unhide). This is also possible in VBFlexGrid.
Only when using ColHidden/RowHidden the hidden rows/cols cannot be resized anymore as they were offset.

[Krool]

Update released.

FontCharset issue resolved. Whenever the FontName is changed the FontCharset will be amended as well by default. Thus always working.
However, afterwards the FontCharset can be changed manually, if necessary.

Now that fix applies also for FlexFillStyleRepeat instead of FlexFillStyleSingle only. (FlexFillStyleRepeat was skip by an oversight..)

[Krool]

I find the .Clip property useful for copy/paste between grid and excel for example.
I also use RowHidden/ColHidden often to filter stuff out of sight.

Therefore the question in the room:
May the .Clip property skip hidden rows/cols by get and also set? (Kind of intuitive feature)
Or bring out a further property that controls such new behavior?

[DEXWERX]

I find the .Clip property useful for copy/paste between grid and excel for example.
I also use RowHidden/ColHidden often to filter stuff out of sight.

Therefore the question in the room:
May the .Clip property skip hidden rows/cols by get and also set? (Kind of intuitive feature)
Or bring out a further property that controls such new behavior?

I vote for a new property. While the intuitive behavior works from an end user point of view (this is how excel works), it may not be obvious to a programmer.

[ChenLin]

Who has the VBFlexGrid drag and drop example? How can I not use the following example?

Private m_bDragOK As Boolean
Private m_iDragCol As Integer
Private xdn As Integer, ydn As Integer

Private Sub VBFlexGrid1_DragDrop(Source As Control, X As Single, Y As Single)
If m_iDragCol = -1 Then Exit Sub
If VBFlexGrid1.MouseRow <> 0 Then Exit Sub
With VBFlexGrid1
.Redraw = False
.ColPosition(m_iDragCol) = .MouseCol
.Redraw = True
End With
End Sub

Private Sub VBFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
xdn = X
ydn = Y
m_iDragCol = -1 ' 清除拖拽标志
m_bDragOK = True
End Sub

Private Sub VBFlexGrid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
m_bDragOK = False
End Sub

[ChenLin]

I uploaded an example that can be dragged but cannot adjust the column width. This example is normal when using MSHFLEXGRID.

[Krool]

Update released.

I uploaded an example that can be dragged but cannot adjust the column width. This example is normal when using MSHFLEXGRID.

This is now fixed. Thanks for bringing this up!

[ChenLin]

Thank you Krool. The problem is solved. I hope this drag and drop attribute is the default, and no user need to write the code again. That's the best thing to do.

[Krool]

I vote for a new property. While the intuitive behavior works from an end user point of view (this is how excel works), it may not be obvious to a programmer.

Update, included ClipMode property that determines whether to include (default) or to exclude hidden cells in a clip command.

[Krool]

Further question in the room:

The AutoSize feature does not currently allow to exclude hidden rows or cols in it's calculation.
This can be disturbing in a filtered grid and you double click on a divider to autosize and it sizes larger as it should be visibly due to hidden cells that are larger in it's content.
So bring out a new parameter for this or rely on what is set in the new ClipMode property? (Kind of half intiutive)

[ChenLin]

Hi Krool, How to achieve multi-selection by pressing ctrl or shift? At the same time to know which line is selected.

[amitabh srivastav]

Dear Krool, Excellent Grid control. I have tested the Demo with some variations and it works well. But when I compile the OCX, I am unable to register it on windows 10 (It is saying some dll library file is missing) or use it in my other applications. Where I could be going wrong?

[amitabh srivastav]

Dear Krool, How do I distribute this wonderful OCX with my VB6 application. I am using Inno Setup5.

[gibra]

But when I compile the OCX, I am unable to register it on windows 10 (It is saying some dll library file is missing)

On latest builds of windows 10, in order to compile OCX/DLL, you need to run VB6 As Administrator.

[ChenLin]

Hi Krool,I want to implement the following functions:

For i = 1 To VBFlexGrid1.Rows - 1’Set the backcolor and forecolor of each row according to the conditions
If VBFlexGrid1.TextMatrix(i, 3) = -1 Then
VBFlexGrid1.RowBackColor(i) = vbRed
VBFlexGrid1.RowForeColor(i) = vbWhite
Else
BFlexGrid1.RowBackColor(i) = vbBlue
VBFlexGrid1.RowForeColor(i) = vbYellow
End If
Next i
VBFlexGrid1.AllowMultiSelection = True‘To press Ctrl and Shift to implement multiple selection

Can you implement this in the new version?

[Krool]

@ ChenLin,

you could make a helper function like following:

Private Sub RowBackColor(ByVal FlexGrid As VBFlexGrid, ByVal iRow As Long)
Dim OldFillStyle As FlexFillStyleConstants
With FlexGrid
OldFillStyle = .FillStyle
.FillStyle = FlexFillStyleRepeat
.Cell(FlexCellBackColor, iRow, .FixedCols, , .Cols - 1) = vbRed
.FillStyle = OldFillStyle
End With
End Sub

Same then analog with ForeColor.

[ChenLin]

Thanks Krool. The problem has been solved. I modify the color parameters and specify the colors directly:

Private Sub Command19_Click()
    RowBackColor Me.VBFlexGrid1, 8
    RowForceColor Me.VBFlexGrid1, 8
    RowBackColor Me.VBFlexGrid1, 9, vbBlue
    RowForceColor Me.VBFlexGrid1, 9, vbGreen
    RowBackColor Me.VBFlexGrid1, 10, vbGreen
    RowForceColor Me.VBFlexGrid1, 12, vbRed
End Sub

Private Sub RowBackColor(ByVal FlexGrid As VBFlexGrid, ByVal iRow As Long, Optional ByVal lColor As Long = vbRed)
    Dim OldFillStyle As FlexFillStyleConstants
    With FlexGrid
        OldFillStyle = .FillStyle
        .FillStyle = FlexFillStyleRepeat
        .Cell(FlexCellBackColor, iRow, .FixedCols, , .Cols - 1) = lColor
        .FillStyle = OldFillStyle
    End With
End Sub

Private Sub RowForceColor(ByVal FlexGrid As VBFlexGrid, ByVal iRow As Long, Optional ByVal lColor As Long = vbBlack)
    Dim OldFillStyle As FlexFillStyleConstants
    With FlexGrid
        OldFillStyle = .FillStyle
        .FillStyle = FlexFillStyleRepeat
        .Cell(FlexCellForeColor, iRow, .FixedCols, , .Cols - 1) = lColor
        .FillStyle = OldFillStyle
    End With
End Sub

Attachment 159099

[ChenLin]

Press Ctrl and Shift MultiSelection to solve the problem (of course you can also use BigSelection to achieve), I hope useful to you.

Attachment 159115

Private Sub VBFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Long, j As Long
    If Button = 1 Then
        If Shift = 2 Then '按Ctrl键
            With VBFlexGrid1
                If .CellBackColor = &H8000000D Then
                    '取消选择这行
                    RowBackColor VBFlexGrid1, VBFlexGrid1.Row, IIf((i Mod 2) <> 0, &H80000005, RGB(227, 239, 218)) '修正点击后颜色不正确问题
                    RowForeColor VBFlexGrid1, VBFlexGrid1.Row, &H80000008
                    .RowData(.Row) = 0
                Else
                    '选择这行
                    RowBackColor VBFlexGrid1, VBFlexGrid1.Row
                    RowForeColor VBFlexGrid1, VBFlexGrid1.Row
                    .RowData(.Row) = 1
                End If
            End With
        ElseIf Shift = 1 Then '按Shift键
            With VBFlexGrid1
                If .Row <= .RowSel Then
                    For i = .Row To .RowSel
                        RowBackColor VBFlexGrid1, i
                        RowForeColor VBFlexGrid1, i
                        .RowData(i) = 1
                    Next
                Else
                    For i = .Row To .RowSel Step -1
                        RowBackColor VBFlexGrid1, i
                        RowForeColor VBFlexGrid1, i
                        .RowData(i) = 1
                    Next
                End If
            End With
        Else
        '正常点击
        End If
    End If
End Sub

Private Sub VBFlexGrid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Integer
    Dim lngRow As Long, lngRowSel As Long
    
    If Shift = 0 Then
        With VBFlexGrid1
            .Redraw = False
            lngRow = .Row
            lngRowSel = .RowSel
            For i = 1 To .Rows - 1
                If i <> lngRowSel And .RowData(i) = 1 Then
                    RowBackColor VBFlexGrid1, i, IIf((i Mod 2) <> 0, &H80000005, RGB(227, 239, 218)) '修正点击后颜色不正确问题
                    RowForeColor VBFlexGrid1, i, &H80000008
                    .RowData(i) = 0
                End If
            Next
            
            .Row = lngRow
            
            If .Row <= lngRowSel Then
                For i = lngRow To lngRowSel
                    .RowData(i) = 1
                    RowBackColor VBFlexGrid1, i
                    RowForeColor VBFlexGrid1, i
                Next
            Else
                For i = lngRow To lngRowSel Step -1
                    .RowData(i) = 1
                    RowBackColor VBFlexGrid1, i
                    RowForeColor VBFlexGrid1, i
                Next
            End If
            .Redraw = True
        End With
    End If
End Sub

Public Sub RowBackColor(ByVal FlexGrid As VBFlexGrid, ByVal iRow As Long, Optional ByVal lColor As Long = &H8000000D)
    Dim OldFillStyle As FlexFillStyleConstants
    With FlexGrid
        OldFillStyle = .FillStyle
        .FillStyle = FlexFillStyleRepeat
        .Cell(FlexCellBackColor, iRow, .FixedCols, , .Cols - 1) = lColor
        .FillStyle = OldFillStyle
    End With
End Sub

Public Sub RowForeColor(ByVal FlexGrid As VBFlexGrid, ByVal iRow As Long, Optional ByVal lColor As Long = &H8000000E)
    Dim OldFillStyle As FlexFillStyleConstants
    With FlexGrid
        OldFillStyle = .FillStyle
        .FillStyle = FlexFillStyleRepeat
        .Cell(FlexCellForeColor, iRow, .FixedCols, , .Cols - 1) = lColor
        .FillStyle = OldFillStyle
    End With
End Sub

[ChenLin]

Who has a good sorting method, please? I used to use it on Mshflexgrid, but I can't use it normally. Is it because I use Chinese characters?

[ChenLin]

TopRow Add a New line to prevent errors when the mouse is rolled up.
Do not know if my method is wrong or a bug?

Public Property Let TopRow(ByVal Value As Long)
    If Value < 0 Then Value = 0 'Add
    If Value < 0 Or Value > (PropRows - 1) Then
        err.Raise Number:=30009, Description:="Invalid Row value"
    End If

    Dim RCP As TROWCOLPARAMS
    With RCP
        .Mask = RCPM_TOPROW
        .Flags = RCPF_CHECKTOPROW
        .TopRow = Value
        Call SetRowColParams(RCP)
    End With
End Property

[Krool]

Who has a good sorting method, please? I used to use it on Mshflexgrid, but I can't use it normally. Is it because I use Chinese characters?

When you use any of FlexSortString... constants it should work as Wide API lstrcmp/lstrcmpi is used. What kind of problem do you have?

[gibra]

Downloaded and briefly fiddled with this - looks very promising. Do you plan to support in-cell editing?

See this project with in-cell editing and formulas (Excel-like):
http://www.vbforums.com/showthread.p...=1#post5290223

P.S. VBFlexGrid OCX version

[ChenLin]

When you use any of FlexSortString... constants it should work as Wide API lstrcmp/lstrcmpi is used. What kind of problem do you have?

example code:

The problem is solved, the use is FlexSortStringNoCaseAscending, it is recommended that Chinese characters use this, numbers and money to use FlexSortCurrencyAscending

'排序函数
Public Sub Sort(Sgrd As VBFlexGrid)
    IntSort = IntSort + 1
    With Sgrd
        If .MouseRow <> 0 Then Exit Sub '如果不是标题行就不排序
        .Col = .MouseCol
        Dim i As Integer
        If IsNumeric(Sgrd.TextMatrix(1, Sgrd.MouseCol)) = True Then
            .Sort = FlexSortCurrencyAscending + IntSort Mod 2  '按金额排序
        Else
            .Sort = FlexSortStringNoCaseAscending + IntSort Mod 2 '按字符排序
        End If
        .Col = 0 '这个为0避免排序后当前列之前为白色……
    End With
End Sub

Welcome everyone to propose a better way!

[Karl77]

Basic question

In a populated grid, a left mouse click fires a SelChange.
Is there a simple way to fire the Selchange with the right mouse button as well?


Thanks
Karl

[Krool]

Basic question

In a populated grid, a left mouse click fires a SelChange.
Is there a simple way to fire the Selchange with the right mouse button as well?

I'm not sure what your goal is but it looks like you want to have a convenient way of span selection ranges with the right mouse button (?)
If yes here is a proposal:

Private Sub VBFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
    With VBFlexGrid1
    .HitTest X, Y
    If .HitResult = FlexHitResultCell Then
        If .HitRow > (.FixedRows - 1) And .HitCol > (.FixedCols - 1) Then
            .RowSel = .HitRow
            .ColSel = .HitCol
        End If
    End If
    End With
End If
End Sub

If not, please advise.

[Karl77]

Sorry for the unclear description.

It is about a single cell only.
I want to invoke a context menu.
This works ok now when I first select the cell by left click, and then do a right click.

If I right click only, then I get my context menu, but the cell where the click happened doesn't get selected before.

[dreammanor]

In Farpoint Spread and my own Spread control, I can achieve Karl77's purpose by the following method:

Private Sub fpSpread1_RightClick(ByVal ClickType As Integer, ByVal Col As Long, ByVal Row As Long, ByVal MouseX As Long, ByVal MouseY As Long)
    
    If ClickType = 1 Then       '--- 0: MouseDown,  1: MouseUp ---
        fpSpread1.SetActiveCell Col, Row
        
        PopupMenu MnuTools
        
    End If
    
End Sub

Maybe Krool could add the RightClick event for VBFlexGrid.

[Arnoutdv]

The MS(H)FlexGrid control has MouseRow/MouseCol properties, these return the row/col which the mouse is hovering, without the need for a click or selecting the cells.

[Krool]

Just replaced RowSel to Row and ColSel to Col to get behavior of right click activating cell.
Also MouseUp instead MouseDown.

This should work, please try:

Private Sub VBFlexGrid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
    With VBFlexGrid1
    .HitTest X, Y
    If .HitResult = FlexHitResultCell Then
        If .HitRow > (.FixedRows - 1) And .HitCol > (.FixedCols - 1) Then
            .Row = .HitRow
            .Col = .HitCol
            PopupMenu MnuTools
        End If
    End If
    End With
End If
End Sub

[Karl77]

This should work, please try:

        If .HitRow > (.FixedRows - 1) And .HitCol > (.FixedCols - 1) Then
            .Row = .HitRow
            .Col = .HitCol

Perfect.
Thank you.

[ChenLin]

Can anyone have a way to convert this to a VB.NET version? My VB.NET is still learning and currently has no ability to solve the problems that arise in the conversion.

[Karl77]

Before I add the functionality by myself, a question.

Is there an edit function in the works?
I mean a textbox in a cell.

If not, it is ok.
To make the edit function is not so much effort.
I only don't want to re-invent the wheel if it's already in Krool's garage.