RichTextBox, I need help

[mosses]

I am trying to get the output of a string "A B C D E" etc to output to a label or a text box to have different colors for each character, for a kids learning program. I have just learned about the richtextbox, but I do not know how to use it, rtb.selcolor = vbRed will not work:
'=============================================
Private Sub Command1_Click()
Dim a1 As String
Dim a2 As String
a1 = "a b c "
a2 = "d e f"
RichTextBox1.SelColor = vbRed 'this does not work, the output is still black

RichTextBox1.Text = a1

End Sub
'============================================
I am about to pull out my hair, I just need "A" to be one color, "B" to be another color etc, it can not be that difficult can it? (obviously I want the sequence of the output to be different each run)

STRING1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

LABEL1.CAPTION = MID(STRING1,1,1)

'NEW COLOR AND DO AGAIN: "THIS IS AN EXAMPLE OF THE SORT OF THING I AM TRYING TO DO"
Many thanks if you can help, I have been on the web all day.

[kb.net]

Hi,

Below is a sample code for what you are trying to do. I know it is not complete but it works and it is something to start with.

Dim ColQu(200) As String

Private Sub Command1_Click()
Dim Index As Integer
Dim Rand As Integer

For i = 1 To Len(Me.RichTextBox1)

Back:   Rand = Round(Rnd * 10, 0)
        If Rand = 0 Or Rand > 8 Then GoTo Back
    
    Me.RichTextBox1.SelStart = i
    Me.RichTextBox1.SelLength = 1
    Me.RichTextBox1.SelColor = ColQu(Rand)

Next

End Sub

Private Sub Form_Load()

Dim Index As Integer

    ColQu(1) = vbBlack
    ColQu(2) = vbBlue
    ColQu(3) = vbCyan
    ColQu(4) = vbGreen
    ColQu(5) = vbMagenta
    ColQu(6) = vbYellow
    ColQu(7) = vbRed
    ColQu(8) = vbRed
    
    Me.RichTextBox1.Text = "abcdefghij"

End Sub

I hope this will work for you.

[mosses]

Thank you Very, Very much, it works very well. I can now finish the presentation part of the program. Unfortunately I will not be able to send the finished program to you as Microsoft will not allow exe files to be emailed. But thank you again. best wishes

[kb.net]

Hi,

Glad it worked. If you want to forward an exe file try to zip it first I think it will work.

[mosses]

I tried to zip it and send it to a friend, but he said that it would not run. I would like to try again when it's finished. Do you know about the "sleep(100)" function to slow down the program not using the time? I tried it and it did not recognize it.Do you know how I could do it? Once again, many thanks.

[QVeen72]

Hi,

"Sleep" is a Windows API u need to Declare it.

Copy this code and paste it at the Top of ur Form Code window:
(or Declare as Public and paste it in .bas Module)

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Regards
Veena

[mosses]

Thank you again, however, I did this to try it out:

label1.caption = "Hello"
sleep(1000)
label1.caption = "World"

And after a second all I got was "World" the Hello did not show. thats a bit strange?
Thank you very much for your help. Best wishes

[kb.net]

Hi,
That is becuase you placed all your code on load event. In your case you don't need external API just add a timer in your form and paste the following code:

Private Sub Form_Load()

    Me.Label1.Caption = "Hello"
    Me.Timer1.Interval = 1000
    Me.Timer1.Enabled = True
    
End Sub

Private Sub Timer1_Timer()

    Me.Label1.Caption = "World"
    Me.Timer1.Enabled = False
 
End Sub

I hope this is what you were looking for.

[QVeen72]

Hi,

In Sleep Function, u pass the Variable in "MilliSeconds". So if u want a 10 Second Gap, u pass 10000.

If u call for 1000, it is eqvivalent to 1 sec.
I hope it is clear...

REgards
Veena

[mosses]

Yes you are right, thats exactly what I should do, it is a bit obvious. Sorry for waisting your time. Thank you very much for your help. You have been very nice to help. Best wishes.

[mosses]

what I was trying to do was:

mystring = "ABCDEFGHIJKL ~Z"

for a = 1 to len(mystring)
label1.caption = label1.caption & mid(mystring,a,1)
sleep(10000)
next a

so that I would get a slow out put to label1, purely for graphic, display purposes. It would look nice for the user. I was also hoping for the target letters, say G T L to be different colors from the whole string of ABCDEFGHIJKLMNOP~Z

The idea is that the user has to decide which letter is closest to the target letter, "which is closest to I? F or M?"
This would help people who have a little problem with there alphabet.
The program works fine I'm just trying to make it a attractive for the user, who would be children.

[kb.net]

Hi,
For the first problem simply use DoEvents which will force displaying the letters one by one, your code will then look like:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim mystring As String

Private Sub Command1_Click()

    For a = 1 To Len(mystring)
        Label1.Caption = Label1.Caption & Mid(mystring, a, 1)
        DoEvents
        Sleep (100)
    Next

End Sub

Private Sub Form_Load()
    
    mystring = "ABCDEFGHIJKL"
    Me.Label1.Caption = ""

End Sub

As for the second issue of which is closest to the letter I really didn't get it, will the user choose a letter or what?? please provide further information and a more detailed example. In all cases you have to show it in the rich text box in order to be able to color only part of the string.

I hope I will be able to help you.

[mosses]

Which is closer to K?
H or P?
"the user must select command label H or P"
[H] [P] these are command buttons

' these were actual questions asked at a job interview, I once went to, a whole paper page of them.

[H]-[K]-[P]
I had to select [H]. as H is 3 away from K and P is 5 away from K.

The only problem is it looks so dull and I wanted to add some graphics to make it look more fun.

I know a Head Master at a school who teach kids with learning difficulties and offered this program.
So the out put to a correct or incorrect answer would show the location of H K P like:
Obviously with different colors I cant seem to select any thing but "red" on this quick reply.
ABCDEFGHIJKLMNOPQRSTUVWXYZ

I could do some animation like have an arrow move over the correct letter and count to the middle letter, or stuff like that, but I got stumped with the RichTextBox as I have never done graphics before. Once again thank you for your help, I have already taken to long to do this but I want it to look nice. Best wishes.

[kb.net]

Hi,

I have created you an alternative that depends on an array of labels. I have attached a zip file with the form but if it doesn't work create an empty form and place the below controls (just change the properties I have mentioned) any place in the form:

Textbox (name: txtcmp1) for the first compare letter
Textbox (name: txtcmp2) for the second compare letter
Textbox (name: txtinp) for the letter you need to check
3 Buttons (don't change any property)
Label (name: lbl , index = 0) to be the first label in the array

After this paste the below code in the form:

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim Cnt As Integer
Dim Pause As Boolean
Dim Lb1 As Integer, Lb2 As Integer, Lb3 As Integer

Private Sub Command1_Click()

    If Me.txtCmp1 = "" Or Me.txtCmp2 = "" Or Me.txtInp = "" Then
        MsgBox "Please fill the letters first"
        Exit Sub
    End If

    Cnt = 0
    Fill
    Cnt = 0
    For Cnt = 0 To 25
        If Me.lbl(Cnt) = Me.txtCmp1 Then
            Me.lbl(Cnt).ForeColor = vbRed
            Lb2 = Cnt
        End If
        If Me.lbl(Cnt) = Me.txtCmp2 Then
            Me.lbl(Cnt).ForeColor = vbRed
            Lb3 = Cnt
        End If
        If Me.lbl(Cnt) = Me.txtInp Then
            Me.lbl(Cnt).ForeColor = vbRed
            Lb1 = Cnt
        End If

    Next

End Sub

Private Sub Command2_Click()

    Cnt = 0
    Clear
    Me.txtCmp1 = ""
    Me.txtCmp2 = ""
    Me.txtInp = ""
    
End Sub

Private Sub Fill()
On Error Resume Next

    If Pause = False Then
    
        Pause = True
        
    For Cnt = 0 To 25
    Beep
        If Cnt = 0 Then
        
            With Me.lbl(0)
                .Left = 120
                .Top = 2400
                .Height = 375
                .Width = 375
                .Caption = "A"
                .Alignment = 2
                .FontName = "Tahoma"
                .FontSize = 10
                .FontBold = True
                .ForeColor = vbBlack
                .Visible = True
            End With
        
        Else
        
            Load lbl(Cnt)
            lbl(Cnt).Visible = True
            lbl(Cnt).Caption = Chr(Cnt + 65)
            lbl(Cnt).ForeColor = vbBlack
            lbl(Cnt).Left = lbl(Cnt - 1).Left + lbl(Cnt - 1).Width
            
        End If
        
            Sleep (50)
            DoEvents
    
        Next
        
        Pause = False
        
    End If

End Sub

Sub Clear()
On Error Resume Next

    If Me.lbl(0).Visible = False Then Exit Sub

    If Pause = False Then
    
        Pause = True
        
        For Cnt = 0 To 25
        Beep
            If Cnt > 0 Then
                Unload Me.lbl(Cnt)
                Sleep (20)
                DoEvents
            Else
                Me.lbl(Cnt).Visible = False
            End If
        Next
        
        Pause = False
    
    End If

End Sub

Private Sub Command3_Click()

    If Me.lbl(0).Visible = False Then Exit Sub
    
    Dim Inp As Integer, Cmp1 As Integer, Cmp2 As Integer, Dif1 As Integer, Dif2 As Integer
     
    Cnt = 0
    For Cnt = 0 To 25
        lbl(Cnt).ForeColor = &H80000011
    Next
        
    Inp = Asc(Me.txtInp)
    Cmp1 = Asc(Me.txtCmp1)
    Cmp2 = Asc(Me.txtCmp2)
    Dif1 = Abs(Inp - Cmp1)
    Dif2 = Abs(Cmp2 - Inp)
    
    If Dif1 < Dif2 Then
    
        Me.txtCmp1.ForeColor = vbRed
        Me.txtInp.ForeColor = vbGreen
        Me.txtCmp2.ForeColor = vbBlue
        Me.lbl(Lb1).ForeColor = vbGreen
        Me.lbl(Lb3).ForeColor = vbBlue
        Me.lbl(Lb2).ForeColor = vbRed
        MsgBox "The letter " & Me.txtCmp1 & " is closer to " & Me.txtInp & " than " & Me.txtCmp2
        Exit Sub
        
    End If
    
    If Dif1 > Dif2 Then
    
        Me.txtCmp2.ForeColor = vbRed
        Me.txtInp.ForeColor = vbGreen
        Me.txtCmp1.ForeColor = vbBlue
        Me.lbl(Lb1).ForeColor = vbGreen
        Me.lbl(Lb2).ForeColor = vbBlue
        Me.lbl(Lb3).ForeColor = vbRed
        MsgBox "The letter " & Me.txtCmp2 & " is closer to " & Me.txtInp & " than " & Me.txtCmp1
        Exit Sub
    
    End If
    
    If Dif1 = Dif2 Then
    
        Me.txtCmp2.ForeColor = vbRed
        Me.txtInp.ForeColor = vbGreen
        Me.txtCmp1.ForeColor = vbRed
        Me.lbl(Lb1).ForeColor = vbGreen
        Me.lbl(Lb2).ForeColor = vbRed
        Me.lbl(Lb3).ForeColor = vbRed
        MsgBox "The letter " & Me.txtCmp2 & " is on the same distance from " & Me.txtInp & " as " & Me.txtCmp1
        Exit Sub
    
    End If
    
End Sub

Private Sub Form_Load()

    Me.lbl(0).Visible = False
    
    Me.txtCmp1.Left = 3600
    Me.txtCmp1.Top = 120
    Me.txtCmp1.Width = 495
    Me.txtCmp1.Height = 375
    
    Me.txtCmp2.Left = 4800
    Me.txtCmp2.Top = 120
    Me.txtCmp2.Width = 495
    Me.txtCmp2.Height = 375
    
    Me.txtInp.Left = 4200
    Me.txtInp.Top = 120
    Me.txtInp.Width = 495
    Me.txtInp.Height = 375
    
    Me.Command1.Left = 120
    Me.Command1.Top = 120
    Me.Command1.Width = 975
    Me.Command1.Height = 375
    Me.Command1.Caption = "Fill"
    
    Me.Command2.Left = 120
    Me.Command2.Top = 600
    Me.Command2.Width = 975
    Me.Command2.Height = 375
    Me.Command2.Caption = "Clear"
    
    Me.Command3.Left = 120
    Me.Command3.Top = 1080
    Me.Command3.Width = 975
    Me.Command3.Height = 375
    Me.Command3.Caption = "Check"
    
End Sub

Private Sub txtCmp1_Change()

    If Len(Me.txtCmp1 & "") = 0 Then Exit Sub
    If Len(Me.txtCmp1 & "") > 1 Then MsgBox "Please fill only one letter": Exit Sub
    If Asc(Me.txtCmp1) < 65 Or Asc(Me.txtCmp1) > 90 Then MsgBox "Please fill a capital letter": Exit Sub
    
End Sub

Private Sub txtCmp2_Change()

    If Len(Me.txtCmp2 & "") = 0 Then Exit Sub
    If Len(Me.txtCmp2 & "") > 1 Then MsgBox "Please fill only one letter": Exit Sub
    If Asc(Me.txtCmp2) < 65 Or Asc(Me.txtCmp2) > 90 Then MsgBox "Please fill a capital letter": Me.txtCmp2.SetFocus: Exit Sub

End Sub

Private Sub txtInp_Change()

    If Len(Me.txtInp & "") = 0 Then Exit Sub
    If Len(Me.txtInp & "") > 1 Then MsgBox "Please fill only one letter": Exit Sub
    If Asc(Me.txtInp) < 65 Or Asc(Me.txtInp) > 90 Then MsgBox "Please fill a capital letter": Exit Sub

End Sub

I hope you will like it :)

[mosses]

Wow, I can not believe you did all this, Thank you, Amazing, I will give it a try tonight. What can I say, I am amazed. Thank you!

[mosses]

I put all the code in the form and run the program, I get:
1st command button reads "Fill"
2nd command button reads "Clear"
3ed command button reads "Check"
there are 3 text boxes.
I tried to enter a a letter in text box1 and hit the "check" button; nothing happens.
I tried to enter a letter in text box2 and I got an error "only comments may appear after end sub, functions or property". at the private sub txtinp_change.
Any ideas? Thank you.

[kb.net]

Hi,

I have recheck the code and its OK and working normaly, Try to download the attached zip file in my previous post, or try to redo what I said noting that you should change the names of the text boxes as previously mentioned.
When you run the system fill 3 letters in the 3 text boxes (only capital letters are allowed and you should receive a notefication if not). Press "Fill" to generate all the alphabits with the ones filled in the text box colored. Then press check to find which letter is closer.

[mosses]

Sorry I am an Idiot. Yet it works perfectly and is wonderful. You are clearly very talented, I wish I had your skill, I just opened the attachment as you suggested and it worked. I have attached my program for your inspection, please don't :icon_lol: to much I know its crude, but at lest you will see what it is meant to do. Thank you very much. Best wishes.

[kb.net]

Hi,
Please resend the project as you justt zipped the vbp (project) file without the frm (frm) files so it will not work. Or try to zip the whole folder that contains the application (if it doesn't contain any thing else).

Glad you like it.

[mosses]

Sorry here it is. Thank you.