Originally Posted by
zynder
Fast Populate Flexgrid from Database
VB Code:
Private Sub Command1_Click()
Screen.MousePointer = vbHourglass
Set rs = New ADODB.Recordset
strsearch = "SELECT * FROM TblName ORDER BY AnyField"
rs.Open strsearch, adoc, adOpenDynamic, adLockOptimistic
rs.Requery
If rs.RecordCount = 0 Then
MSFlexGrid1.Clear
MsgBox "No record found"
Screen.MousePointer = vbNormal
Exit Sub
ElseIf rs.RecordCount >= 1 Then
'populate flexgrid box
With MSFlexGrid1
.Clear
.Rows = rs.RecordCount + 1
.Cols = rs.Fields.Count - 1
.Row = 1
.Col = 0
.RowSel = .Rows - 1
.ColSel = .Cols - 1
.Clip = UCase(rs.GetString(adClipString, -1, Chr(9), Chr(13), vbNullString))
.Row = 1
End With
End If
Screen.MousePointer = vbNormal
End Sub
The GetString method returns the specified Recordset as a string so there's no loop needed.
Hi Zander, only one problem with this is what if the recordset cant return a correct count, you see sometimes i get a recordset that has "-1" for the record count. So i use the following code: -
VB Code:
Public Function PopFlex(RSdb As ADODB.Recordset, Grid As MSFlexGrid, fixed As Integer) As Integer
Dim i As Integer, j As Integer, sizer() As Variant
Grid.FixedRows = 1
Grid.FixedCols = fixed
RSdb.MoveFirst
ReDim sizer(RSdb.Fields.Count)
For i = 0 To RSdb.Fields.Count - 1
sizer(i) = 0
Next
If Not RSdb.EOF Then
Grid.Rows = 1
Grid.cols = RSdb.Fields.Count
For i = 0 To RSdb.Fields.Count - 1
Grid.TextMatrix(0, i) = RSdb.Fields(i).Name
If sizer(i) < (GetTextWidth(RSdb.Fields(i).Name) + 100) Then
sizer(i) = (GetTextWidth(RSdb.Fields(i).Name) + 100)
End If
Next
Dim teststr As String, testarr As Variant, initval As String
initval = RSdb.GetString(adClipString, 1, Chr(9), ";", "")
Do While Not RSdb.EOF
For i = 0 To RSdb.Fields.Count - 1
If sizer(i)<(GetTextWidth(RSdb(RSdb.Fields(i).Name)) + 100) Then
sizer(i)=(GetTextWidth(RSdb(RSdb.Fields(i).Name)) + 100)
End If
Next
RSdb.MoveNext
Loop
testarr = split(initval,";")
For i = 0 to UBound(testarr)
Grid.AddItem testarr(i)
Next
For i = 0 to UBound(sizer)
Grid.ColWidth(i) = sizer(i)
Next
i = Grid.Rows
Grid.RemoveItem i
End If
PopFlex = Grid.Rows - 1
End Function
ok it is not brilliant but it always works.
also the function GetTextWidth is used to autosize the column widths.
VB Code:
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Public Function GetTextWidth(ByRef Frm as Form, ByVal Value As String) As Long
Dim hFont As Long
Dim hFontOrig As Long
Dim lWidth As Long
Dim hdc As Long
Dim sTemp As String
Dim sz As SIZE
hdc = GetDC(Frm.hWnd)
hFont = GetStockObject(ANSI_VAR_FONT)
hFontOrig = SelectObject(hdc, hFont&)
GetTextExtentPoint32 hdc, Value, Len(Value), sz
lWidth = sz.cx
SelectObject hdc, hFontOrig
DeleteObject (hFont)
ReleaseDC Frm.hWnd, hdc
GetTextWidth = lWidth * 15
End Function
This function can be used to resize any control correctly, so long as you take the padding into account for each control.
Reply With Quote
Re: something color with MSFlexGrid
Re: something color with MSFlexGrid
