-
Mar 2nd, 2021, 07:24 AM
#1
Thread Starter
Addicted Member
[RESOLVED] RowHeight in MsFlexGrid
How can you adjust the height (rowheight) of a MSFLEXGRID cell based on the size or length of a text?
In all the ways I've tried some of the text sometimes doesn't appear.
-
Mar 2nd, 2021, 08:03 AM
#2
Re: RowHeight in MsFlexGrid
http://web.archive.org/web/201503220...ad.php?t=35110
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
You can also switch to the VBFlexGrid created by Krool, you can find it in the Codebank
-
Mar 2nd, 2021, 10:28 AM
#3
Thread Starter
Addicted Member
Re: RowHeight in MsFlexGrid
I had already prepared a routine like in "Autosize RowHeight with WordWrap = True" (http://www.xtremevbtalk.com/showthread.php?t=35110)
Code:
Private Sub RowsAdapter(ByRef Grid As MSFlexGrid)
Dim Frml As Long
Dim Depth As Long
Dim TmpStr As String
Dim MyRow As Long
Dim X As Long
Dim RD As Boolean
Dim RHCell As Long
Dim VS As Boolean
With Grid
RD = .Redraw
VS = .Visible
.Redraw = False
.Visible = False
ScaleMode = vbTwips
For MyRow = 1 To .Rows - 1
Depth = Me.TextHeight("Wg")
RHCell = IfLng(IsSchoolProv, ROWHGT + ROWHGT, ROWHGT) - Spessore
.Row = MyRow
If LenB(.TextMatrix(MyRow, PupilName)) Then
For X = 1& To .Cols - 1& 'Dividi_Da
Select Case X
Case PupilName
.Col = X
TmpStr = .Text
If LenB(TmpStr) Then
lBl.Width = 100
lBl.Caption = TmpStr '.Text
Frml = lBl.Height
If RHCell < Frml Then
RHCell = Frml 'FW_EXTRALIGHT '+ 500&
End If
End If
End Select
Next X
End If
.RowHeight(MyRow) = RHCell + Depth
Next MyRow
.Visible = VS
.Redraw = RD
.Refresh
End With
End Sub
sometimes it's not possible to make all the lines of text appear inside the MsFlexGrid cell. Additionally, Label1.Width does not keep the value you set; eg. Label1.Width = 100: Debug.Print Label1.Width
690
Why?
-
Mar 2nd, 2021, 12:52 PM
#4
Re: RowHeight in MsFlexGrid
-
Mar 2nd, 2021, 02:41 PM
#5
Thread Starter
Addicted Member
Re: RowHeight in MsFlexGrid
It doesn't play as I would like. If you look, you will notice that the last name is not displayed. Download the program from the link:
Last edited by Shaggy Hiker; Mar 2nd, 2021 at 05:28 PM.
Reason: Link removed
-
Mar 2nd, 2021, 03:53 PM
#6
Re: RowHeight in MsFlexGrid
Hello. I made some modifications to your form code. Now it measures the text with API (the label is no longer necessary):
Code:
Option Explicit
Private Type DRAWTEXTPARAMS
cbSize As Long
iTabLength As Long
iLeftmargin As Long
iRightMargin As Long
uiLengthDrawn As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const DT_EDITCONTROL As Long = &H2000&
Private Const DT_EXPANDTABS As Long = &H40
Private Const DT_LEFT As Long = &H0
Private Const DT_RIGHT As Long = &H2
Private Const DT_CENTER As Long = &H1
Private Const DT_NOPREFIX As Long = &H800
Private Const DT_TABSTOP As Long = &H80
Private Const DT_WORDBREAK As Long = &H10
Private Const DT_CALCRECT As Long = &H400
Private Const DT_RTLREADING As Long = &H20000
Private Declare Function DrawTextEx Lib "user32" Alias "DrawTextExW" (ByVal hDC As Long, ByVal lpsz As Long, ByVal N As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As DRAWTEXTPARAMS) As Long
Private Sub Form_Load()
MSFlexGrid1.TextMatrix(1, 1) = "Safa Heath, Fatimah Henson, Charly Kelley, Kirstie Hays, Lily-Anne Ferry, Allana Le, Lyla Hopper, Fathima Buckner, Parker Johnson, Keri"
Call FG_AutosizeRows(MSFlexGrid1)
End Sub
Public Function FG_AutosizeRows(myGrid As MSFlexGrid, _
Optional ByVal lFirstRow As Long = -1, _
Optional ByVal lLastRow As Long = -1, _
Optional bCheckFont As Boolean = True, _
Optional bExpandColumnsToFit As Boolean = True)
Dim lCol As Long, lRow As Long
Dim lCellHeight As Long, lRowHeight As Long
Dim bFontBold As Boolean
Dim dFontSize As Double
Dim sFontName As String
Dim iEP As DRAWTEXTPARAMS
Dim iRectCalc As RECT
Dim lColWidth As Long
Dim lCurRow As Long
Dim lCurRowSel As Long
Dim lCurCol As Long
Dim lCurColSel As Long
Dim iFontPrev As StdFont
iEP.cbSize = Len(iEP)
iEP.iLeftmargin = 3
iEP.iRightMargin = 3
With myGrid
If bCheckFont Then
.Redraw = False
lCurRow = .Row
lCurRowSel = .RowSel
lCurCol = .Col
lCurColSel = .ColSel
Set iFontPrev = Me.Font
Set Me.Font = New StdFont
End If
If lFirstRow = -1 Then lFirstRow = 0
If lLastRow = -1 Then lLastRow = .Rows - 1
For lRow = lFirstRow To lLastRow
lRowHeight = .RowHeight(lRow)
If bCheckFont Then .Row = lRow
For lCol = 0 To .Cols - 1
If bExpandColumnsToFit Then lColWidth = .ColWidth(lCol)
If bCheckFont Then
.Col = lCol
Me.FontBold = .CellFontBold
Me.FontName = .CellFontName
Me.FontSize = .CellFontSize
End If
iRectCalc.Right = ScaleX(.ColWidth(lCol), vbTwips, vbPixels)
Call DrawTextEx(Me.hDC, StrPtr(.TextMatrix(lRow, lCol)), Len(.TextMatrix(lRow, lCol)), iRectCalc, DT_WORDBREAK Or DT_EXPANDTABS Or DT_TABSTOP Or DT_NOPREFIX Or DT_CALCRECT, iEP)
lCellHeight = ScaleY(iRectCalc.Bottom, vbPixels, vbTwips)
If lCellHeight > lRowHeight Then lRowHeight = lCellHeight
If bExpandColumnsToFit Then
lColWidth = ScaleY(iRectCalc.Right, vbPixels, vbTwips)
If lColWidth > .ColWidth(lCol) Then .ColWidth(lCol) = lColWidth
End If
Next lCol
.RowHeight(lRow) = lRowHeight + Me.TextHeight("Wg") / 5
Next lRow
If bCheckFont Then
.Row = lCurRow
.RowSel = lCurRowSel
.Col = lCurCol
.ColSel = lCurColSel
.Redraw = True
Set Me.Font = iFontPrev
End If
End With
End Function
-
Mar 2nd, 2021, 05:29 PM
#7
Re: RowHeight in MsFlexGrid
Originally Posted by fabel358
It doesn't play as I would like. If you look, you will notice that the last name is not displayed. Download the program from the link:
Posting a link to a program in a zip file from an unknown site is not a good idea. It really isn't a good idea for somebody to run such a thing. If you have a working example, remove any compiled code and attach the remainder to a post.
My usual boring signature: Nothing
-
Mar 3rd, 2021, 10:44 AM
#8
Thread Starter
Addicted Member
Re: RowHeight in MsFlexGrid
I'm really sorry; I apologize
-
Mar 4th, 2021, 11:09 AM
#9
Thread Starter
Addicted Member
Re: RowHeight in MsFlexGrid
Hello. I made some modifications to your form code. Now it measures the text with API (the label is no longer necessary):
It works! Many thanks EDUARDO!
Last edited by fabel358; Mar 4th, 2021 at 11:13 AM.
Reason: [RESOLVED]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|