E
eBob.com
I have some code which is trying to determine where text will wrap in a
custom text box (which Inherits from Control). It determines the number of
characters which will fit in the first line, but then encounters an
exception when it calls MeasureCharacterRanges to see if the next character,
i.e. the one destined to become the first character of the second line, will
fit. The message says only "Invalid parameter" - it does not say which
parameter it did not like. And I can't find any problem with any of the
parameters.
The code uses an If loop to step from line to line and a Do loop within the
If loop to test how many characters will fit on the line. This code occurs
within the Property Set routine for the Text property:
Public Overrides Property Text() As String
Get
End Get
Set(ByVal Value As String)
Dim nlo As Integer = 0 'Next Line Offset (from
the top of the control)
Dim ll As Integer 'line length
Dim lo As Integer 'line offset of next
line
Dim cr(1) As CharacterRange
Dim strformat As New StringFormat
strformat.Alignment = StringAlignment.Near
Dim strregion(1) As Region
Dim measure_rect As New RectangleF
Dim mcr_rect As New RectangleF
MyBase.Text = Value
'build LineInfo array to facilitate scrolling
Dim grfx As Graphics = MyBase.CreateGraphics
lo = 0 'next line offset is
initially 0
mcr_rect = New RectangleF(0, 0, Me.ClientRectangle.Width,
Me.ClientRectangle.Height) 'for call
' to MeasureCharacterRanges
strformat.FormatFlags = StringFormatFlags.MeasureTrailingSpaces
For i As Integer = 0 To LIA_MaxSize
If i > (LIA_CurSize - 1) Then 'expand LIA if necessary
ReDim Preserve LIA(LIA_CurSize + LIA_ChunkSize)
LIA_CurSize += LIA_ChunkSize
End If
LIA(i).offset = lo 'set line offset
ll = 1 'initially try a line
length of 1
Do
cr(0) = New CharacterRange(lo, ll)
'MsgBox("trying """ & MyBase.Text.Substring(lo, ll) &
"""")
strformat.SetMeasurableCharacterRanges(cr)
strregion =
grfx.MeasureCharacterRanges(MyBase.Text.Substring(lo, ll), MyBase.Font, _
mcr_rect, strformat)
measure_rect = strregion(0).GetBounds(grfx)
If measure_rect.Width > MyBase.Width Then Exit Do
If measure_rect.Height > MyBase.Font.Height Then Exit Do
ll += 1 'try one more character next time through Do
loop
If (ll + lo) > MyBase.Text.Length Then Exit Do 'exit Do
if we're out of text
Loop
LIA(i).length = ll - 1
lo = lo + ll - 1
LIA_LastIndex += 1
If lo >= MyBase.Text.Length Then Exit For
Next
MsgBox(LIA_LastIndex.ToString & " lines")
End Set
End Property
I've struggled with this for hours so I sure hope someone sees whatever it
is that I am not seeing.
If anyone is inclined to play with the code the whole thing is pasted below.
The form has two NumericUpDown controls, nudWidth and nudHeight, and a
"Draw" button, btnDraw. Note that the OnPaint code is way out of date.
Thanks, Bob
Option Strict On
Option Explicit On
Imports System.ComponentModel
Imports System.drawing.drawing2d
Imports System.io
Public Class Form1
Inherits System.Windows.Forms.Form
Public sampstring As String = "The quick brown fox jumped over the lazy
dog."
Dim stb As New SpecialTextBox
#Region " Windows Form Designer generated code "
#End Region
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles MyBase.Load
stb.Location = New Point(200, 100)
stb.Width = 60
nudWidth.Value = stb.Width
stb.Height = 200
nudHeight.Value = stb.Height
Dim tr As StreamReader
Dim tfn As String
dlgOpenTstFile.ShowDialog()
If dlgOpenTstFile.ShowDialog = DialogResult().OK Then
tfn = dlgOpenTstFile.FileName
End If
tr = New StreamReader(tfn)
'stb.Text = tr.ReadToEnd
stb.Text = sampstring
Controls.Add(stb)
End Sub
Private Sub btnDraw_Click(ByVal sender As Object, ByVal e As
System.EventArgs) Handles btnDraw.Click
'stb.Width = nudWidth.Value
'stb.Height = nudHeight.Value
stb.Refresh()
End Sub
End Class
Public Class SpecialTextBox
Inherits System.Windows.Forms.Control
Structure LineInfo
Public offset As Integer 'offset to first character in the line
Public length As Integer 'number of characters in the line
End Structure
Const LIA_ChunkSize As Integer = 5
Const LIA_MaxSize As Integer = 50000
Dim LIA_CurSize As Integer = LIA_ChunkSize
Dim LIA_ChunkNum As Integer = 1
Dim LIA_LastIndex As Integer = -1 'index of last line
in LIA
Private LIA(LIA_ChunkSize) As LineInfo 'LineInfo Array
Public Sub New()
MyBase.New()
End Sub
Public Overrides Property Text() As String
Get
End Get
Set(ByVal Value As String)
Dim nlo As Integer = 0 'Next Line Offset (from
the top of the control)
Dim ll As Integer 'line length
Dim lo As Integer 'line offset of next
line
Dim cr(1) As CharacterRange
Dim strformat As New StringFormat
strformat.Alignment = StringAlignment.Near
Dim strregion(1) As Region
Dim measure_rect As New RectangleF
Dim mcr_rect As New RectangleF
MyBase.Text = Value
'build LineInfo array to facilitate scrolling
Dim grfx As Graphics = MyBase.CreateGraphics
lo = 0 'next line offset is
initially 0
mcr_rect = New RectangleF(0, 0, Me.ClientRectangle.Width,
Me.ClientRectangle.Height) 'for call
' to MeasureCharacterRanges
strformat.FormatFlags = StringFormatFlags.MeasureTrailingSpaces
For i As Integer = 0 To LIA_MaxSize
If i > (LIA_CurSize - 1) Then 'expand LIA if necessary
ReDim Preserve LIA(LIA_CurSize + LIA_ChunkSize)
LIA_CurSize += LIA_ChunkSize
End If
LIA(i).offset = lo 'set line offset
ll = 1 'initially try a line
length of 1
Do
cr(0) = New CharacterRange(lo, ll)
'MsgBox("trying """ & MyBase.Text.Substring(lo, ll) &
"""")
strformat.SetMeasurableCharacterRanges(cr)
strregion =
grfx.MeasureCharacterRanges(MyBase.Text.Substring(lo, ll), MyBase.Font, _
mcr_rect, strformat)
measure_rect = strregion(0).GetBounds(grfx)
If measure_rect.Width > MyBase.Width Then Exit Do
If measure_rect.Height > MyBase.Font.Height Then Exit Do
ll += 1 'try one more character next time through Do
loop
If (ll + lo) > MyBase.Text.Length Then Exit Do 'exit Do
if we're out of text
Loop
LIA(i).length = ll - 1
lo = lo + ll - 1
LIA_LastIndex += 1
If lo >= MyBase.Text.Length Then Exit For
Next
MsgBox(LIA_LastIndex.ToString & " lines")
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim rectf As RectangleF
Dim grfx As Graphics = e.Graphics
grfx.FillRectangle(Brushes.LightGray, Me.ClientRectangle)
'grfx.FillRectangle(Brushes.Yellow, 0, 0, 90, 20)
'rectf = New RectangleF(New PointF(0, 0), New
SizeF(Me.ClientRectangle.Width, Me.ClientRectangle.Height))
Dim nextoff As Integer = 0
Dim fh As Integer = Font.Height
Dim msr As SizeF 'MeasureString Result
Dim nlo As Integer = 0 'Next Line Offset (from the
top of the control)
Dim length As Integer
'Dim textlength = MyBase.Text.Length
Dim debugstr As String
For i As Integer = 0 To LIA_MaxSize
nlo = i * fh
length = 1
Do
msr = grfx.MeasureString(MyBase.Text.Substring(nextoff,
length), Font)
If msr.Width > Width Then Exit Do
length += 1
If (length + nextoff) > MyBase.Text.Length Then Exit Do
Loop
length -= 1
msr = grfx.MeasureString(MyBase.Text.Substring(nextoff, length),
Font)
grfx.FillRectangle(Brushes.White, 0, nlo, msr.Width, msr.Height)
grfx.DrawString(MyBase.Text.Substring(nextoff, length), Font,
Brushes.Black, 0, nlo)
debugstr = MyBase.Text.Substring(nextoff, length)
nlo = nlo + fh
nextoff = nextoff + length
If nextoff >= MyBase.Text.Length Then Exit For
Next
MyBase.OnPaint(e)
End Sub
End Class
custom text box (which Inherits from Control). It determines the number of
characters which will fit in the first line, but then encounters an
exception when it calls MeasureCharacterRanges to see if the next character,
i.e. the one destined to become the first character of the second line, will
fit. The message says only "Invalid parameter" - it does not say which
parameter it did not like. And I can't find any problem with any of the
parameters.
The code uses an If loop to step from line to line and a Do loop within the
If loop to test how many characters will fit on the line. This code occurs
within the Property Set routine for the Text property:
Public Overrides Property Text() As String
Get
End Get
Set(ByVal Value As String)
Dim nlo As Integer = 0 'Next Line Offset (from
the top of the control)
Dim ll As Integer 'line length
Dim lo As Integer 'line offset of next
line
Dim cr(1) As CharacterRange
Dim strformat As New StringFormat
strformat.Alignment = StringAlignment.Near
Dim strregion(1) As Region
Dim measure_rect As New RectangleF
Dim mcr_rect As New RectangleF
MyBase.Text = Value
'build LineInfo array to facilitate scrolling
Dim grfx As Graphics = MyBase.CreateGraphics
lo = 0 'next line offset is
initially 0
mcr_rect = New RectangleF(0, 0, Me.ClientRectangle.Width,
Me.ClientRectangle.Height) 'for call
' to MeasureCharacterRanges
strformat.FormatFlags = StringFormatFlags.MeasureTrailingSpaces
For i As Integer = 0 To LIA_MaxSize
If i > (LIA_CurSize - 1) Then 'expand LIA if necessary
ReDim Preserve LIA(LIA_CurSize + LIA_ChunkSize)
LIA_CurSize += LIA_ChunkSize
End If
LIA(i).offset = lo 'set line offset
ll = 1 'initially try a line
length of 1
Do
cr(0) = New CharacterRange(lo, ll)
'MsgBox("trying """ & MyBase.Text.Substring(lo, ll) &
"""")
strformat.SetMeasurableCharacterRanges(cr)
strregion =
grfx.MeasureCharacterRanges(MyBase.Text.Substring(lo, ll), MyBase.Font, _
mcr_rect, strformat)
measure_rect = strregion(0).GetBounds(grfx)
If measure_rect.Width > MyBase.Width Then Exit Do
If measure_rect.Height > MyBase.Font.Height Then Exit Do
ll += 1 'try one more character next time through Do
loop
If (ll + lo) > MyBase.Text.Length Then Exit Do 'exit Do
if we're out of text
Loop
LIA(i).length = ll - 1
lo = lo + ll - 1
LIA_LastIndex += 1
If lo >= MyBase.Text.Length Then Exit For
Next
MsgBox(LIA_LastIndex.ToString & " lines")
End Set
End Property
I've struggled with this for hours so I sure hope someone sees whatever it
is that I am not seeing.
If anyone is inclined to play with the code the whole thing is pasted below.
The form has two NumericUpDown controls, nudWidth and nudHeight, and a
"Draw" button, btnDraw. Note that the OnPaint code is way out of date.
Thanks, Bob
Option Strict On
Option Explicit On
Imports System.ComponentModel
Imports System.drawing.drawing2d
Imports System.io
Public Class Form1
Inherits System.Windows.Forms.Form
Public sampstring As String = "The quick brown fox jumped over the lazy
dog."
Dim stb As New SpecialTextBox
#Region " Windows Form Designer generated code "
#End Region
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles MyBase.Load
stb.Location = New Point(200, 100)
stb.Width = 60
nudWidth.Value = stb.Width
stb.Height = 200
nudHeight.Value = stb.Height
Dim tr As StreamReader
Dim tfn As String
dlgOpenTstFile.ShowDialog()
If dlgOpenTstFile.ShowDialog = DialogResult().OK Then
tfn = dlgOpenTstFile.FileName
End If
tr = New StreamReader(tfn)
'stb.Text = tr.ReadToEnd
stb.Text = sampstring
Controls.Add(stb)
End Sub
Private Sub btnDraw_Click(ByVal sender As Object, ByVal e As
System.EventArgs) Handles btnDraw.Click
'stb.Width = nudWidth.Value
'stb.Height = nudHeight.Value
stb.Refresh()
End Sub
End Class
Public Class SpecialTextBox
Inherits System.Windows.Forms.Control
Structure LineInfo
Public offset As Integer 'offset to first character in the line
Public length As Integer 'number of characters in the line
End Structure
Const LIA_ChunkSize As Integer = 5
Const LIA_MaxSize As Integer = 50000
Dim LIA_CurSize As Integer = LIA_ChunkSize
Dim LIA_ChunkNum As Integer = 1
Dim LIA_LastIndex As Integer = -1 'index of last line
in LIA
Private LIA(LIA_ChunkSize) As LineInfo 'LineInfo Array
Public Sub New()
MyBase.New()
End Sub
Public Overrides Property Text() As String
Get
End Get
Set(ByVal Value As String)
Dim nlo As Integer = 0 'Next Line Offset (from
the top of the control)
Dim ll As Integer 'line length
Dim lo As Integer 'line offset of next
line
Dim cr(1) As CharacterRange
Dim strformat As New StringFormat
strformat.Alignment = StringAlignment.Near
Dim strregion(1) As Region
Dim measure_rect As New RectangleF
Dim mcr_rect As New RectangleF
MyBase.Text = Value
'build LineInfo array to facilitate scrolling
Dim grfx As Graphics = MyBase.CreateGraphics
lo = 0 'next line offset is
initially 0
mcr_rect = New RectangleF(0, 0, Me.ClientRectangle.Width,
Me.ClientRectangle.Height) 'for call
' to MeasureCharacterRanges
strformat.FormatFlags = StringFormatFlags.MeasureTrailingSpaces
For i As Integer = 0 To LIA_MaxSize
If i > (LIA_CurSize - 1) Then 'expand LIA if necessary
ReDim Preserve LIA(LIA_CurSize + LIA_ChunkSize)
LIA_CurSize += LIA_ChunkSize
End If
LIA(i).offset = lo 'set line offset
ll = 1 'initially try a line
length of 1
Do
cr(0) = New CharacterRange(lo, ll)
'MsgBox("trying """ & MyBase.Text.Substring(lo, ll) &
"""")
strformat.SetMeasurableCharacterRanges(cr)
strregion =
grfx.MeasureCharacterRanges(MyBase.Text.Substring(lo, ll), MyBase.Font, _
mcr_rect, strformat)
measure_rect = strregion(0).GetBounds(grfx)
If measure_rect.Width > MyBase.Width Then Exit Do
If measure_rect.Height > MyBase.Font.Height Then Exit Do
ll += 1 'try one more character next time through Do
loop
If (ll + lo) > MyBase.Text.Length Then Exit Do 'exit Do
if we're out of text
Loop
LIA(i).length = ll - 1
lo = lo + ll - 1
LIA_LastIndex += 1
If lo >= MyBase.Text.Length Then Exit For
Next
MsgBox(LIA_LastIndex.ToString & " lines")
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim rectf As RectangleF
Dim grfx As Graphics = e.Graphics
grfx.FillRectangle(Brushes.LightGray, Me.ClientRectangle)
'grfx.FillRectangle(Brushes.Yellow, 0, 0, 90, 20)
'rectf = New RectangleF(New PointF(0, 0), New
SizeF(Me.ClientRectangle.Width, Me.ClientRectangle.Height))
Dim nextoff As Integer = 0
Dim fh As Integer = Font.Height
Dim msr As SizeF 'MeasureString Result
Dim nlo As Integer = 0 'Next Line Offset (from the
top of the control)
Dim length As Integer
'Dim textlength = MyBase.Text.Length
Dim debugstr As String
For i As Integer = 0 To LIA_MaxSize
nlo = i * fh
length = 1
Do
msr = grfx.MeasureString(MyBase.Text.Substring(nextoff,
length), Font)
If msr.Width > Width Then Exit Do
length += 1
If (length + nextoff) > MyBase.Text.Length Then Exit Do
Loop
length -= 1
msr = grfx.MeasureString(MyBase.Text.Substring(nextoff, length),
Font)
grfx.FillRectangle(Brushes.White, 0, nlo, msr.Width, msr.Height)
grfx.DrawString(MyBase.Text.Substring(nextoff, length), Font,
Brushes.Black, 0, nlo)
debugstr = MyBase.Text.Substring(nextoff, length)
nlo = nlo + fh
nextoff = nextoff + length
If nextoff >= MyBase.Text.Length Then Exit For
Next
MyBase.OnPaint(e)
End Sub
End Class