TWCMIL
asked on
Different colored text in a single picturebox?
I'm using VB6 to load text from a SQL server to a string, then I continuously scroll this string in a PictureBox control. I know how to color all the text, but can I color only a portion of the string?
Im sure it's possible but i don't know how. It would be easier if you use a RichTextBox control instead
You could use the DrawText() and SetTextColor() API's. Each portion of the text that is to be a different color would have to be drawn separately.
Idle_Mind
Idle_Mind
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Sub Form_Paint()
Dim text As String
Dim r As RECT
r.Top = 0
r.Left = 0
r.Right = Me.Width
r.Bottom = Me.Height
text = "This is a long string of text with different colors"
For a = 1 To Len(text)
SetTextColor Me.hdc, QBColor(Int(Rnd * 15))
DrawText Me.hdc, Mid(text, a, 1), 1, r, 0
r.Left = r.Left + TextWidth(Mid(text, a, 1)) / Screen.TwipsPerPixelX
Next a
End Sub
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Sub Form_Paint()
Dim text As String
Dim r As RECT
r.Top = 0
r.Left = 0
r.Right = Me.Width
r.Bottom = Me.Height
text = "This is a long string of text with different colors"
For a = 1 To Len(text)
SetTextColor Me.hdc, QBColor(Int(Rnd * 15))
DrawText Me.hdc, Mid(text, a, 1), 1, r, 0
r.Left = r.Left + TextWidth(Mid(text, a, 1)) / Screen.TwipsPerPixelX
Next a
End Sub
Sure you can change the color of every word or even every character
with PictureBox1
.forecolor = vbyellow
.Print "Hello! "
.foreColor = vbred
.Print "How "
.forecolor = vbblue
.Print "do "
.forecolor = rgb(100,200,255)
.Print "you "
.forecolor = vbcyan
.Print "do "
end with
Gajendra
with PictureBox1
.forecolor = vbyellow
.Print "Hello! "
.foreColor = vbred
.Print "How "
.forecolor = vbblue
.Print "do "
.forecolor = rgb(100,200,255)
.Print "you "
.forecolor = vbcyan
.Print "do "
end with
Gajendra
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
The problem here is that I continuously scroll the string with a timer control.
So I have a string I need to break up into 4 colors, color each part, then scroll it continuosly (looped). I already have the code that scrolls the text (and loops it so it always filles the width of the picture box). I also give the user the option to scroll smoothly or by character (less CPU power and faster speeds).
I have a Timer that fires this repeatedly at increments of 20ms to 500ms, the user controls the speed:
Sub ShowMessage(SCRText As String, ScrollSmooth As Boolean)
If ScrollSmooth = False Then
Static MsgPtr As Integer
Static MyText As String
If Len(MyText) = 0 Then
MsgPtr = 1
MyText = SCRText
Else
MyText = SCRText & "¬"
End If
Picture1.Cls
Picture1.Print Mid$(MyText, MsgPtr); MyText;
'Don't move if the Scroll Lock Key is pressed
If (GetKeyState(vbKeyScrollLo ck) And &H1&) = 0 Then
MsgPtr = MsgPtr + 1
If MsgPtr > Len(MyText) Then
MsgPtr = 1
End If
End If
Else
Static ScrollOffset As Long
Dim LoopDraw As Long
Dim TextSize As Long
Dim TextPos As Long
' Get vertical text position and width
TextPos = Picture1.ScaleY(ScrollPos, vbPixels, Picture1.ScaleMode)
TextSize = Picture1.TextWidth(SCRText )
' Clear old drawing
Picture1.Line (0, TextPos)-(Picture1.ScaleWi dth, TextPos + Picture1.TextHeight(SCRTex t)), Picture1.BackColor, BF
' Draw the message enough times to fill the form
For LoopDraw = -ScrollOffset To Picture1.ScaleWidth Step TextSize
Picture1.CurrentX = LoopDraw
Picture1.CurrentY = TextPos
Picture1.Print SCRText
Next LoopDraw
' Increment scroller offset and wrap when needed
ScrollOffset = ScrollOffset + Picture1.ScaleX( _
ScrollStep, vbPixels, Picture1.ScaleMode)
If (ScrollOffset >= TextSize) Then _
ScrollOffset = ScrollOffset - TextSize
End If
End Sub
So I have a string I need to break up into 4 colors, color each part, then scroll it continuosly (looped). I already have the code that scrolls the text (and loops it so it always filles the width of the picture box). I also give the user the option to scroll smoothly or by character (less CPU power and faster speeds).
I have a Timer that fires this repeatedly at increments of 20ms to 500ms, the user controls the speed:
Sub ShowMessage(SCRText As String, ScrollSmooth As Boolean)
If ScrollSmooth = False Then
Static MsgPtr As Integer
Static MyText As String
If Len(MyText) = 0 Then
MsgPtr = 1
MyText = SCRText
Else
MyText = SCRText & "¬"
End If
Picture1.Cls
Picture1.Print Mid$(MyText, MsgPtr); MyText;
'Don't move if the Scroll Lock Key is pressed
If (GetKeyState(vbKeyScrollLo
MsgPtr = MsgPtr + 1
If MsgPtr > Len(MyText) Then
MsgPtr = 1
End If
End If
Else
Static ScrollOffset As Long
Dim LoopDraw As Long
Dim TextSize As Long
Dim TextPos As Long
' Get vertical text position and width
TextPos = Picture1.ScaleY(ScrollPos,
TextSize = Picture1.TextWidth(SCRText
' Clear old drawing
Picture1.Line (0, TextPos)-(Picture1.ScaleWi
' Draw the message enough times to fill the form
For LoopDraw = -ScrollOffset To Picture1.ScaleWidth Step TextSize
Picture1.CurrentX = LoopDraw
Picture1.CurrentY = TextPos
Picture1.Print SCRText
Next LoopDraw
' Increment scroller offset and wrap when needed
ScrollOffset = ScrollOffset + Picture1.ScaleX( _
ScrollStep, vbPixels, Picture1.ScaleMode)
If (ScrollOffset >= TextSize) Then _
ScrollOffset = ScrollOffset - TextSize
End If
End Sub