Hi moeur,
I think you can solve a little problem for me, back in May last year and in another Forum, I was struggling to help someone who wanted something like a ProgressBar but with text inside it (they were building a Browser and wanted to do like Firefox, I think, the Progress was displayed where the URL was typed.) Anyway, I came up with a RichTextBox solution:
Code:
Option Explicit
'
' Example of manipulating RTF in a RichTextBox
' to simulate a 'ProgressBar' with imbedded text
' (Based on some code I found on the Internet somewhere)
'
' Requires:
' Command Button (cmdGo)
' RichTextBox (rtb1)
' Timer (Timer1)
'
' Tested on XP SP2 and it seems to work OK
' Tested on Windows ME and doesn't work
'
Private boFinished As Boolean
Private strOriginalRTF As String
Private Sub cmdGo_Click()
'
' Simulates starting something going
'
Timer1.Enabled = True
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 500
rtb1.Text = "This is some text"
End Sub
Private Sub Timer1_Timer()
'
' Simulates 'progress'
' Triggers once every half second
'
boFinished = UpdateProgress(1)
If boFinished = True Then
Timer1.Enabled = False
rtb1.TextRTF = strOriginalRTF
rtb1.SelStart = 0
rtb1.SelLength = 0
End If
End Sub
Private Function UpdateProgress(intColour As Integer) As Boolean
'
' Progressively change the background colour of
' each character in the RichTextBox to intColour
' Achieved by inserting RTF codes to define a ColorTable
' and highlight the selected text.
'
' Returns True when all characters have been processed
'
Dim strColour As String
Dim strRTF As String
Static intEnd As Integer
UpdateProgress = False
'
' Save the original TextRTF so it can be
' re-set later, increment the character position
' and check if we've finsihed yet
'
If intEnd = 0 Then strOriginalRTF = rtb1.TextRTF
intEnd = intEnd + 1
If intEnd <= Len(rtb1.Text) Then
'
' Select the appropriate number of characters
' and make sure they don't appear highlighted
' by the selection
'
rtb1.SelStart = 0
rtb1.SelLength = intEnd
rtb1.SelColor = rtb1.BackColor
'
' Convert the colour to RGB form
' and insert leading zeros if required
'
strColour = Hex(QBColor(intColour))
strColour = String(6 - Len(strColour), "0") & strColour
'
' Now build our RTF:
'
' ColorTable:
'
strRTF = "{{\colortbl;"
strRTF = strRTF & "\red" & CInt("&H" & Right(strColour, 2))
strRTF = strRTF & "\green" & CInt("&H" & Mid(strColour, 3, 2))
strRTF = strRTF & "\blue" & CInt("&H" & Left(strColour, 2))
strRTF = strRTF & ";}"
'
' Highlight:
' This is the RTF Code used to cause the change in
' colour. It uses our ColorTable (Number 1)
' (I can't seem to find any documentation on this
' code but if it works then ....)
'
strRTF = strRTF & "\highlight1 "
'
' Finally the actual text and closing RTF brackets
'
strRTF = strRTF & Mid(rtb1.Text, 1, intEnd)
strRTF = strRTF & "}}"
'
' Set the RTF of the selected characters to our
' codes
'
rtb1.SelRTF = strRTF
Else
'
' We've finished
'
UpdateProgress = True
intEnd = 0
End If
End Function
Was it, perhaps some of your code I stumbled upon. The 'highlight' thing has had me confused for a long time !!
Reply With Quote
2009 - 2013
Originally Posted by moeur
