Xtreme Visual Basic Talk

Xtreme Visual Basic Talk (http://www.xtremevbtalk.com/)
-   Code Library (http://www.xtremevbtalk.com/code-library/)
-   -   Flexgrid functions (http://www.xtremevbtalk.com/code-library/35110-flexgrid-functions.html)

Flyguy 08-06-2002 09:49 AM

Flexgrid functions
 
Edit: Most samples in this complete thread can also be used for the MSHFlexGrid, in the functions just change the As MSFlexGrid to As MSHFlexGrid

Edit: To autosize the columns of a MSHFlexGrid with multiple bands go to this post


Autosize the columns or rows in a MSFlexGrid:

Code:
Public Function FG_AutosizeRows(myGrid As MSFlexGrid, _ Optional ByVal lFirstRow As Long = -1, _ Optional ByVal lLastRow As Long = -1, _ Optional bCheckFont As Boolean = False) ' This will only work for Cells with a Chr(13) ' To have it working with WordWrap enabled ' you need some other routine ' Which has been added too Dim lCol As Long, lRow As Long, lCurCol As Long, lCurRow As Long Dim lCellHeight As Long, lRowHeight As Long Dim bFontBold As Boolean Dim dFontSize As Double Dim sFontName As String If bCheckFont Then ' save the forms font settings bFontBold = Me.FontBold sFontName = Me.FontName dFontSize = Me.FontSize End If With myGrid If bCheckFont Then lCurCol = .Col lCurRow = .Row End If If lFirstRow = -1 Then lFirstRow = 0 If lLastRow = -1 Then lLastRow = .Rows - 1 For lRow = lFirstRow To lLastRow lRowHeight = 0 If bCheckFont Then .Row = lRow For lCol = 0 To .Cols - 1 If bCheckFont Then .Col = lCol Me.FontBold = .CellFontBold Me.FontName = .CellFontName Me.FontSize = .CellFontSize End If lCellHeight = Me.TextHeight(.TextMatrix(lRow, lCol)) If lCellHeight > lRowHeight Then lRowHeight = lCellHeight Next lCol .RowHeight(lRow) = lRowHeight + Me.TextHeight("Wg") / 5 Next lRow If bCheckFont Then .Row = lCurRow .Col = lCurCol End If End With If bCheckFont Then ' restore the forms font settings Me.FontBold = bFontBold Me.FontName = sFontName Me.FontSize = dFontSize End If End Function Public Function FG_AutosizeCols(myGrid As MSFlexGrid, _ Optional ByVal lFirstCol As Long = -1, _ Optional ByVal lLastCol As Long = -1, _ Optional bCheckFont As Boolean = False) Dim lCol As Long, lRow As Long, lCurCol As Long, lCurRow As Long Dim lCellWidth As Long, lColWidth As Long Dim bFontBold As Boolean Dim dFontSize As Double Dim sFontName As String If bCheckFont Then ' save the forms font settings bFontBold = Me.FontBold sFontName = Me.FontName dFontSize = Me.FontSize End If With myGrid If bCheckFont Then lCurRow = .Row lCurCol = .Col End If If lFirstCol = -1 Then lFirstCol = 0 If lLastCol = -1 Then lLastCol = .Cols - 1 For lCol = lFirstCol To lLastCol lColWidth = 0 If bCheckFont Then .Col = lCol For lRow = 0 To .Rows - 1 If bCheckFont Then .Row = lRow Me.FontBold = .CellFontBold Me.FontName = .CellFontName Me.FontSize = .CellFontSize End If lCellWidth = Me.TextWidth(.TextMatrix(lRow, lCol)) If lCellWidth > lColWidth Then lColWidth = lCellWidth Next lRow .ColWidth(lCol) = lColWidth + Me.TextWidth("W") Next lCol If bCheckFont Then .Row = lCurRow .Col = lCurCol End If End With If bCheckFont Then ' restore the forms font settings Me.FontBold = bFontBold Me.FontName = sFontName Me.FontSize = dFontSize End If End Function

Flyguy 08-06-2002 09:51 AM

Drag and drop between 2 flexgrids
 
Needed controls for this example:
MSFlexGrid1, MSFlexGrid2 and txtDrag (textbox)

Code:
Private Sub Form_Load() Dim lCol As Long Dim lRow As Long With MSFlexGrid1 .Rows = 10 .Cols = 9 For lRow = 0 To .Rows - 1 For lCol = 0 To .Cols - 1 .TextMatrix(lRow, lCol) = "Src: " & lRow & ";" & lCol Next lCol Next lRow End With With MSFlexGrid2 .Rows = 10 .Cols = 9 For lRow = 0 To .Rows - 1 For lCol = 0 To .Cols - 1 .TextMatrix(lRow, lCol) = "Dst: " & lRow & ";" & lCol Next lCol Next lRow End With End Sub Private Sub MSFlexGrid1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) If Button = vbLeftButton Then With MSFlexGrid1 .Col = .MouseCol .Row = .MouseRow txtDrag.Move .CellLeft, .CellTop, .CellWidth, .CellHeight txtDrag.Text = .Text txtDrag.Drag vbBeginDrag End With End If End Sub Private Sub MSFlexGrid2_DragDrop(Source As Control, x As Single, y As Single) Dim lCol As Long Dim lRow As Long Dim curX As Single Dim curY As Single With MSFlexGrid2 For lRow = 0 To .Rows - 1 .Row = lRow .Col = 0 If y > .CellTop And y < .CellTop + .CellHeight Then For lCol = 0 To .Cols - 1 .Col = lCol If x > .CellLeft And x < .CellLeft + .CellWidth Then .Text = txtDrag.Text Exit For End If Next lCol End If Next lRow End With End Sub

Flyguy 08-06-2002 10:08 AM

Save grid to excel sheet
 
1 Attachment(s)
Code:

Public Function FG_SaveAsExcel(FG As MSFlexGrid, sFileName As String, Optional sHeader As String = "", Optional sFooter As String = "")
  Dim myExcel As ExcelFileV2
  Dim lRow As Integer, lCol As Integer
  Dim excelDouble As Double
  Dim rowOffset As Long
  Dim aTemp() As String
 
  If Len(sHeader) > 0 Then
    aTemp = Split(sHeader, vbTab)
    rowOffset = UBound(aTemp) + 1
  End If
 
  Set myExcel = New ExcelFileV2
 
  With myExcel
 
    .OpenFile sFileName
   
    ' Heading
    For lRow = 1 To rowOffset
      .eWritestring lRow, 1, aTemp(lRow - 1)
    Next lRow

    ' FlexGrid -> Fixedrows
    For lRow = 1 To FG.FixedRows
      For lCol = 1 To FG.Cols
        .eWritestring lRow + rowOffset, lCol, FG.textmatrix(lRow - 1, lCol - 1)
      Next lCol
    Next lRow
 
    ' Data
    For lRow = FG.FixedRows + 1 To FG.Rows
     
      ' FlexGrid -> Fixedcols
      For lCol = 1 To FG.FixedCols
        .eWritestring lRow + rowOffset, lCol, FG.textmatrix(lRow - 1, lCol - 1)
      Next lCol
     
      ' FlexGrid -> Data
      For lCol = FG.FixedCols + 1 To FG.Cols
        If IsNumeric(FG.textmatrix(lRow - 1, lCol - 1)) Then
          excelDouble = CDbl(FG.textmatrix(lRow - 1, lCol - 1)) + 0
          .EWriteDouble lRow + rowOffset, lCol, excelDouble
        Else
          .eWritestring lRow + rowOffset, lCol, FG.textmatrix(lRow - 1, lCol - 1)
        End If
      Next lCol
    Next lRow
   
    ' Footer
    If Len(sFooter) > 0 Then
      aTemp = Split(sFooter, vbTab)
      For lRow = 0 To UBound(aTemp)
        .eWritestring lRow + rowOffset + FG.Rows + 1, 1, aTemp(lRow)
      Next lRow
    End If
   
    .CloseFile
  End With
 
End Function

Edit: The lines in bold were missing or incorrect

Flyguy 08-06-2002 10:55 AM

Autosize RowHeight with WordWrap = True
 
For this example you need a Form with 2 controls:
1. MSFlexGrid1
2. Label1

The Label1 control will be used the determine the correct height of the cell.
Code:
Option Explicit Private Sub Form_Load() Dim lCol As Long, lRow As Long ' just add some data With MSFlexGrid1 .Cols = 8 .Rows = 8 .WordWrap = True For lRow = 1 To .Rows - 1 For lCol = 1 To .Cols - 1 .TextMatrix(lRow, lCol) = "This line is to long and should wrap to the next line" Next lCol Next lRow End With FG_AutosizeRows MSFlexGrid1, Label1 End Sub Public Function FG_AutosizeRows(myGrid As MSFlexGrid, _ myLabel As Label, _ Optional ByVal lFirstRow As Long = -1, _ Optional ByVal lLastRow As Long = -1, _ Optional bCheckFont As Boolean = False) Dim lCol As Long, lRow As Long, lCurCol As Long, lCurRow As Long Dim lCellHeight As Long, lRowHeight As Long Dim bFontBold As Boolean Dim dFontSize As Double Dim sFontName As String With myLabel .AutoSize = True .WordWrap = True End With With myGrid If bCheckFont Then lCurCol = .Col lCurRow = .Row End If If lFirstRow = -1 Then lFirstRow = 0 If lLastRow = -1 Then lLastRow = .Rows - 1 For lRow = lFirstRow To lLastRow lRowHeight = 0 If bCheckFont Then .Row = lRow For lCol = 0 To .Cols - 1 If bCheckFont Then .Col = lCol myLabel.FontBold = .CellFontBold myLabel.FontName = .CellFontName myLabel.FontSize = .CellFontSize End If myLabel.Width = .ColWidth(lCol) myLabel.Caption = .TextMatrix(lRow, lCol) lCellHeight = myLabel.Height If lCellHeight > lRowHeight Then lRowHeight = lCellHeight Next lCol .RowHeight(lRow) = lRowHeight + Me.TextHeight("Wg") / 5 Next lRow If bCheckFont Then .Row = lCurRow .Col = lCurCol End If End With End Function

Flyguy 08-07-2002 08:30 AM

User input the simple way
 
Code:
Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer) Dim sTemp As String With MSFlexGrid1 sTemp = .TextMatrix(.Row, .Col) Select Case KeyAscii Case 8 ' backspace If Len(sTemp) > 0 Then sTemp = Left$(sTemp, Len(sTemp) - 1) End If Case 27 ' escape sTemp = "" Case 0 To 31 KeyAscii = 0 Case Else sTemp = sTemp & Chr$(KeyAscii) End Select .TextMatrix(.Row, .Col) = sTemp End With End Sub

Flyguy 08-07-2002 08:55 AM

Rotating a grid, swapping rows/cols
 
Code:
Public Sub FG_Rotate(FG As MSFlexGrid) Dim lRow As Long, lCol As Long Dim fgText() As String, fgCellAlignment() As Long Dim fgColHidden() As Boolean, fgRowHidden() As Boolean Dim fgCols As Long, fgRows As Long Dim fgFixedCols As Long, fgFixedRows As Long Dim iMergeCells As Integer, fgMergeRows() As Boolean, fgMergeCols() As Boolean With FG ' store data fgRows = .Rows fgCols = .Cols fgFixedCols = .FixedCols fgFixedRows = .FixedRows iMergeCells = .MergeCells ReDim fgText(fgRows - 1, fgCols - 1) ReDim fgCellAlignment(fgRows - 1, fgCols - 1) ReDim fgRowHidden(fgRows - 1) ReDim fgColHidden(fgCols - 1) ReDim fgMergeRows(fgRows - 1) ReDim fgMergeCols(fgCols - 1) For lRow = 0 To fgRows - 1 fgRowHidden(lRow) = (.RowHeight(lRow) = 0) fgMergeRows(lRow) = .MergeRow(lRow) .Row = lRow For lCol = 0 To fgCols - 1 If lRow = 0 Then fgColHidden(lCol) = (.ColWidth(lCol) = 0) fgMergeCols(lCol) = .MergeCol(lCol) End If fgText(lRow, lCol) = .TextMatrix(lRow, lCol) .Col = lCol fgCellAlignment(lRow, lCol) = .CellAlignment Next lCol Next lRow ' rebuild grid and swap columns/rows .Redraw = False .Clear .Rows = fgCols .Cols = fgRows .FixedRows = fgFixedCols .FixedCols = fgFixedRows For lRow = 0 To fgRows - 1 .Col = lRow For lCol = 0 To fgCols - 1 .Row = lCol .TextMatrix(lCol, lRow) = fgText(lRow, lCol) .CellAlignment = fgCellAlignment(lRow, lCol) Next lCol Next lRow .MergeCells = iMergeCells ' set hidden columns/rows and merge settings For lRow = 0 To fgRows - 1 If fgRowHidden(lRow) Then .ColWidth(lRow) = 0 .MergeCol(lRow) = fgMergeRows(lRow) Next lRow For lCol = 0 To fgCols - 1 If fgColHidden(lCol) Then .RowHeight(lCol) = 0 .MergeRow(lCol) = fgMergeCols(lCol) Next lCol .Redraw = True End With End Sub

Flyguy 08-16-2002 10:05 AM

Sorting multiple columns
 
1 Attachment(s)
The MSFlexgrid does have some capabilities for sorting.
It works great if you want to sort 1 column.
If you want to sort multiple columns the flexgrid always sorts them from left to right and all in the same order (ascending/descending).

That's why I wrote a new module to provide a more flexible way of sorting.
It can sort on every column in any order and any direction, both numeric and text.

Flyguy 08-20-2002 03:22 AM

More advanced in cell editing
 
For this code example you need a form with 2 controls:
1. MSFlexGrid1
2. txtCell (a normal textbox)

Code:
Option Explicit ' to store the row/column of the cell ' being edited Dim m_lCellCol As Long Dim m_lCellRow As Long Private Sub Form_Load() m_lCellRow = -1 m_lCellCol = -1 txtCell.BorderStyle = 0 txtCell.Visible = False ' set the text background color to the ' backcolor of the tooltip text to make ' the cell being edited having a different color txtCell.BackColor = vbInfoBackground MSFlexGrid1.Cols = 10 MSFlexGrid1.Rows = 10 End Sub Private Sub MSFlexGrid1_DblClick() showTxtCell End Sub Private Sub MSFlexGrid1_RowColChange() removeTxtCell End Sub Private Sub MSFlexGrid1_Scroll() removeTxtCell End Sub Private Sub MSFlexGrid1_SelChange() removeTxtCell End Sub Private Sub txtCell_Change() MSFlexGrid1.Text = txtCell.Text End Sub Private Sub showTxtCell() If m_lCellRow = -1 Then With MSFlexGrid1 ' store the current row and column m_lCellRow = .Row m_lCellCol = .Col ' move the textbox to the correct cell txtCell.Move .Left + .CellLeft, .Top + .CellTop, .CellWidth, .CellHeight txtCell.Text = .Text ' select all text txtCell.SelLength = Len(.Text) End With txtCell.Visible = True txtCell.SetFocus End If End Sub Private Sub removeTxtCell() If m_lCellRow <> -1 Then MSFlexGrid1.TextMatrix(m_lCellRow, m_lCellCol) = txtCell.Text m_lCellRow = -1 m_lCellCol = -1 txtCell.Visible = False End If End Sub Private Sub txtCell_Validate(Cancel As Boolean) removeTxtCell End Sub

Flyguy 08-20-2002 06:02 AM

Alternate row colors
 
For readability it can be a wise decission to have different colors for the even and odd rows.

For this example you need a form 2 controls:
1. MSFlexGrid1 (msflexgrid control)
2. Command1 (command button)

Code:
Option Explicit Private Sub Command1_Click() FG_AlternateRowColors MSFlexGrid1, RGB(255, 255, 192), RGB(255, 255, 255) End Sub Private Sub Form_Load() Dim lCol As Long, lRow As Long ' just fill the grid with some dummy data With MSFlexGrid1 .Cols = 10 .Rows = 10 For lRow = 0 To .Rows - 1 For lCol = 0 To .Cols - 1 .TextMatrix(lRow, lCol) = "R" & lRow & "C" & lCol Next lCol Next lRow End With End Sub Public Sub FG_AlternateRowColors(FG As MSFlexGrid, lColor1 As Long, lcolor2 As Long) Dim lRow As Long, lCol As Long Dim lOrgRow As Long, lOrgCol As Long Dim lColor As Long With FG ' MSFlexGrid1 <- Bugfix as stated by Trivium .Redraw = False ' save the current cell position lOrgRow = .Row lOrgCol = .Col ' only the data rows For lRow = .FixedRows To .Rows - 1 .Row = lRow If lRow / 2 = lRow \ 2 Then lColor = lColor1 Else lColor = lcolor2 End If ' only the data columns For lCol = .FixedCols To .Cols - 1 .Col = lCol .CellBackColor = lColor Next lCol Next lRow ' restore the orginal cell position .Row = lOrgRow .Col = lOrgCol .Redraw = True End With End Sub

Flyguy 08-21-2002 04:52 PM

Auto Filter (like in Excel)
 
1 Attachment(s)
The next sample project is an Auto Filter button.

Activating the Auto Filter will add a combobox to all columns with all unique items per column.

Almost the same as in Excel ;)

Updated version
- Combobox height adapted to height of first row instead of row height adapted.
- Taking in account the vertical scrollbar

Flyguy 08-22-2002 03:22 AM

The Autofilter project
 
1 Attachment(s)
The AutoFilter project:

Flyguy 08-28-2002 02:32 AM

Printing the MSFlexgrid
 
1 Attachment(s)
Attach a small demo project to demonstrate my new printgrid class.

Things not included in the class:
- Cell merging
- Printing cell pictures

Flyguy 09-18-2002 01:01 PM

1 Attachment(s)
Small update of PrintGrid class.

New properties:
- PrintForeColor
- PrintBackColor

To print in black & white on color printers.

Flyguy 09-25-2002 02:21 PM

Deleting a column
 
It's quite obvious how to delete a row from a MS(H)FlexGrid using the .RemoveItem method.
To delete a column we have to use a little trick by using a powerful feature of the flexgrid, moving columns (rows can be moved too). When you move the unwanted column to last column you can just lower the number of columns to get rid of it.

Code:
' To remove a column of a MSHFlexGrid Public Function HFG_RemoveColumn(myGrid As MSHFlexGrid, ByVal lColumn As Long) With myGrid .Redraw = False If lColumn < .Cols Then .ColPosition(lColumn) = .Cols - 1 .Cols = .Cols - 1 End If .Redraw = True End With End Function

Code:
' To remove a column of a MSFlexGrid Public Function FG_RemoveColumn(myGrid As MSFlexGrid, ByVal lColumn As Long) With myGrid .Redraw = False If lColumn < .Cols Then .ColPosition(lColumn) = .Cols - 1 .Cols = .Cols - 1 End If .Redraw = True End With End Function

Flyguy 11-04-2002 02:44 PM

Notification when a column/row is resized
 
Get a notification when a column/row in a flexgrid is resized:

I didn't write this code myself!

In a module:
Code:
' B Chernyachuk 1999 - [email]BodyaC@hotmail.com[/email] ' Option Explicit Public g_lngDefaultHandler As Long ' Original handler of the grid events Private m_bLMousePressed As Boolean 'true if the left button is pressed Private m_bLMouseClicked As Boolean 'true just after the click (i.e. just after the left button is released) 'API declarations ============================================================ ' Function to retrieve the address of the current Message-Handling routine Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long ' Function to define the address of the Message-Handling routine Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long ' Function to execute a function residing at a specific memory address Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 'Windows messages constants Public Const WM_LBUTTONUP = &H202 Public Const WM_LBUTTONDOWN = &H201 Public Const WM_ERASEBKGND = &H14 '============================================================================== 'this is our event handler Public Function GridMessage(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long If m_bLMousePressed And Msg = WM_LBUTTONUP Then 'button have been just released m_bLMousePressed = False m_bLMouseClicked = True End If If Not (m_bLMousePressed) And Msg = WM_LBUTTONDOWN Then 'button have been just pressed m_bLMousePressed = True m_bLMouseClicked = False End If If m_bLMouseClicked And (Msg = WM_ERASEBKGND) Then 'Only when resize happens this event may occur after releasing the button ! 'When user is making a simple click on grid, 'the WM_ERASEBKGND event occurs before WM_LBUTTONUP, 'and therefore will not be handled there Debug.Print "Grid message: ", "Resized !" 'TO DO: Replace this futile code 'with something usefull m_bLMouseClicked = False End If 'call the default message handler GridMessage = CallWindowProc(g_lngDefaultHandler, hwnd, Msg, wp, lp) End Function

In a form:
Code:
Option Explicit ' This constant is used to refer to the Message Handling function in a given window Private Const GWL_WNDPROC = (-4) Private Sub Form_Load() 'Save the address of the existing Message Handler g_lngDefaultHandler = GetWindowLong(Me.MSFlexGrid1.hwnd, GWL_WNDPROC) 'Define new message handler routine Call SetWindowLong(Me.MSFlexGrid1.hwnd, GWL_WNDPROC, AddressOf GridMessage) End Sub Private Sub Form_Unload(Cancel As Integer) 'Return the old handler back Call SetWindowLong(Me.MSFlexGrid1.hwnd, GWL_WNDPROC, g_lngDefaultHandler) End Sub

Flyguy 01-09-2003 07:35 AM

Selecting rows like in Listbox
 
Code:
Option Explicit ' variable to hold our selected rows Private m_cSelectedRows As Collection Private m_lForeColorSel As Long ' Our forecolor for selections Private m_lBackColorSel As Long ' Our backcolor for selections Private Sub Form_Load() Dim lCol As Long, lRow As Long ' initialise our "selection" settings Set m_cSelectedRows = New Collection m_lBackColorSel = vbHighlight m_lForeColorSel = vbHighlightText ' initialise the grid With MSFlexGrid1 .Redraw = False .Cols = 10 .Rows = 10 .AllowBigSelection = False .SelectionMode = flexSelectionFree .ForeColorSel = .ForeColor .BackColorSel = .BackColor .FocusRect = flexFocusLight ' fill the grid with some data For lRow = .FixedRows To .Rows - 1 .TextMatrix(lRow, 0) = "Row: " & lRow For lCol = .FixedCols To .Cols - 1 .TextMatrix(lRow, lCol) = "R" & lRow & "C" & lCol Next lCol Next lRow ' .Redraw = True End With End Sub Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) ' going to check whether a (new) row is selected ' If CTRL is pressed we add the row to the selection ' otherwise we clear the previous selection With MSFlexGrid1 If .MouseCol >= .FixedCols Then ' not clicked on a fixed column Exit Sub End If If .MouseRow < .FixedRows - 1 Then ' clicked on a fixed row Exit Sub End If If Shift <> vbCtrlMask Then ClearSelectedRows End If AddSelectedRow .MouseRow End With End Sub Private Sub ClearSelectedRows() Dim lCol As Long, lRow As Long Dim lColSel As Long, lRowSel As Long Dim lFillStyle As Long If m_cSelectedRows.Count = 0 Then ' no previous selected rows Exit Sub End If With MSFlexGrid1 .Redraw = False ' store the original settings lCol = .Col lRow = .Row lColSel = .ColSel lRowSel = .RowSel lFillStyle = .FillStyle ' clear the selection .FillStyle = flexFillRepeat .Col = .FixedCols .Row = .FixedRows .ColSel = .Cols - 1 .RowSel = .Rows - 1 .CellBackColor = .BackColor .CellForeColor = .ForeColor ' restore the settings .Col = lCol .Row = lRow .ColSel = lColSel .RowSel = lRowSel .FillStyle = lFillStyle .Redraw = True .Refresh End With ' clear our collection Do While m_cSelectedRows.Count > 0 m_cSelectedRows.Remove 1 Loop End Sub Private Sub AddSelectedRow(lCurRow As Long) Dim sKey As String Dim lCol As Long, lRow As Long Dim lColSel As Long, lRowSel As Long Dim lFillStyle As Long ' keys in a collection can't be numeric sKey = "row" & CStr(lCurRow) With MSFlexGrid1 .Redraw = False ' store the original settings lCol = .Col lRow = .Row lColSel = .ColSel lRowSel = .RowSel lFillStyle = .FillStyle ' highlight the selection .FillStyle = flexFillRepeat .Col = .FixedCols .Row = lCurRow .ColSel = .Cols - 1 .RowSel = lCurRow .CellBackColor = m_lBackColorSel .CellForeColor = m_lForeColorSel .Redraw = True ' restore the settings .Col = lCol .Row = lRow .ColSel = lColSel .RowSel = lRowSel .FillStyle = lFillStyle End With ' some error handling for using collections On Error Resume Next m_cSelectedRows.Add lCurRow, sKey End Sub

Flyguy 02-13-2003 01:18 PM

Fake checkboxes
 
1 Attachment(s)
Edit: Updated: see post -> Version 2: Checkboxes using Wingdings


A simple way to display checkboxes in the MS(H)Flexgrid is by using the special characterset Wingdings.

Code:
Option Explicit Private Const fgChecked As Byte = 253 Private Const fgUnChecked As Byte = 168 Private Sub Form_Load() Dim lRow As Long Dim lHeight As Long With MSFlexGrid1 lHeight = .RowHeight(0) .Cols = 4 .Rows = 25 .ColAlignment(2) = flexAlignCenterCenter .Col = 2 For lRow = .FixedRows To .Rows - 1 .Row = lRow .Font.Size = 12 .Font.Bold = False .Font = "Wingdings" .Text = Chr$(fgUnChecked) Next lRow .RowHeight(-1) = lHeight End With End Sub Private Sub MSFlexGrid1_Click() With MSFlexGrid1 If .Col = 2 Then If .Text = Chr$(fgUnChecked) Then .Text = Chr$(fgChecked) ElseIf .Text = Chr$(fgChecked) Then .Text = Chr$(fgUnChecked) End If End If End With End Sub

Flyguy 02-17-2003 10:06 AM

Show Table data in MSFlexgrid
 
For this code sample place a MSFlexGrid control (MSFlexGrid1) and a command button (Command1) on your form and make a reference to "Microsoft ActiveX Data Object 2.x Library"
Code:
Option Explicit Dim m_sDBPath As String Private Sub Command1_Click() Dim adoConn As ADODB.Connection Dim adoRST As ADODB.Recordset On Error Goto errHandler ' open the connection Set adoConn = New ADODB.Connection adoConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & m_sDBPath ' get a recordset Set adoRST = New ADODB.Recordset adoRST.Open "Titles", adoConn, adOpenForwardOnly, , adCmdTable With adoRST If Not .EOF Then FG_ShowRecordset MSFlexGrid1, adoRST End If .Close End With adoConn.Close Set adoConn = Nothing Set adoRST = Nothing Exit Sub errHandler: MsgBox "An error occured." & vbLf & Err.Number & ": " & Err.Description, vbCritical Set adoConn = Nothing Set adoRST = Nothing End Sub Private Sub FG_ShowRecordset(myFG As MSFlexGrid, myRST As ADODB.Recordset) Dim iField As Integer, iNofFields As Integer Dim lRow As Long Screen.MousePointer = vbHourglass With myRST .MoveFirst iNofFields = .Fields.Count End With With myFG .Redraw = False .AllowUserResizing = flexResizeColumns .ScrollTrack = True .FixedCols = 0 .FixedRows = 0 .Cols = iNofFields .Rows = 1 ' setup the header For iField = 0 To iNofFields - 1 .TextMatrix(0, iField) = myRST.Fields(iField).Name Next iField End With With myRST Do ' increase the number of rows lRow = myFG.Rows myFG.Rows = myFG.Rows + 1 ' add the values to the current row For iField = 0 To iNofFields - 1 If Not IsNull(.Fields(iField).Value) Then myFG.TextMatrix(lRow, iField) = .Fields(iField).Value End If Next iField ' proceed to the next record .MoveNext Loop Until .EOF End With With myFG .FixedRows = 1 .Redraw = True End With Screen.MousePointer = vbNormal End Sub Private Sub Form_Load() m_sDBPath = "C:\Program Files\Microsoft Visual Studio\VB98\Biblio.MDB" Me.Caption = m_sDBPath End Sub

Flyguy 02-19-2003 11:51 AM

(Imperfect) sample of using real checkbox
 
1 Attachment(s)
An almost perfect sample how to use real checkboxes in the MSFlexgrid control.

Flyguy 02-26-2003 07:01 AM

Version 2: Checkboxes using Wingdings
 
The previous version did change the font for the complete MSFlexgrid, ofcourse it is better to only change the font for the needed cells.
Code:
Option Explicit Private Const fgChecked As Byte = 253 Private Const fgUnChecked As Byte = 168 Private Sub Form_Load() Dim lRow As Long With MSFlexGrid1 .Cols = 4 .Rows = 25 .ColAlignment(2) = flexAlignCenterCenter .Col = 2 For lRow = .FixedRows To .Rows - 1 .Row = lRow [b] .CellFontName = "Wingdings" .CellFontSize = 12 .CellFontBold = False[/b] .Text = Chr$(fgUnChecked) Next lRow End With End Sub Private Sub MSFlexGrid1_Click() With MSFlexGrid1 If .Col = 2 Then If .Text = Chr$(fgUnChecked) Then .Text = Chr$(fgChecked) ElseIf .Text = Chr$(fgChecked) Then .Text = Chr$(fgUnChecked) End If End If End With End Sub


All times are GMT -6. The time now is 04:22 AM.

Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Search Engine Optimisation provided by DragonByte SEO v2.0.15 (Lite) - vBulletin Mods & Addons Copyright © 2017 DragonByte Technologies Ltd.
All site content is protected by the Digital Millenium Act of 1998. Copyright©2001-2011 MAS Media Inc. and Extreme Visual Basic Forum. All rights reserved.
You may not copy or reproduce any portion of this site without written consent.