Word and Character counter in VB6?

I'm currently working on rich text editor, which I'm planning to add loads of functions into it. I'm just not sure on how to make a Word and Character counter for it. Not sure why I want it; but it just looks cool.

Any help would be appreciated, and thanks in advance.

Umm im gussing ur making like a program that counts words and spaces like teachers for typing classes have ur use thats actualy a simple program to make i already made one for my sisster inlaw for her when she was learning to type for work. Is this what ur looking to do?

I made a quick example:

vb Code:

Option Explicit
 
Private Sub Command1_Click()
 
    Dim tempArray()     As String
    Dim lngWordCount    As Long
    Dim lngCharCount    As Long
    Dim lngCharCountS    As Long
    
    tempArray = Split(Trim$(RichTextBox1.Text), " ")
    
    lngWordCount = UBound(tempArray) + 1    '~~~ Number of words. ie, delimited by a single space
    lngCharCount = Len(RichTextBox1.Text)   '~~~ Number of characters including spaces
    lngCharCountS = Len(Replace(RichTextBox1.Text, " ", "")) '~~~ Number of characters (excludes white spaces)
    
    '~~~ Display it
    MsgBox "Word Count = " & lngWordCount & vbNewLine & _
            "Character count(includes white spaces) = " & lngCharCount & vbNewLine & _
            "Character count(without white spaces) = " & lngCharCountS
            
End Sub

You could additional things or alter it suit your needs. :wave:

This is what I use on my improved NotePad app.

Code:

---

Private Sub mnuCharCount_Click()

Dim Chars As Long
Dim I As Long

Chars = 0
For I = 0 To Len(rtbText.Text) - 1
    rtbText.SelStart = I
    rtbText.SelLength = 1
    If Asc(rtbText.SelText) > 32 And Asc(rtbText.SelText) <= 126 Then
        Chars = Chars + 1
    End If
Next
MsgBox "The number of CHARACTERS is:" & vbCrLf & Chars, vbInformation, "Character Count"

End Sub

---

And a Word count.

Code:

---

Private Sub mnuWordCount_Click()

Dim AsciiThisChar As Integer
Dim AsciiLastChar As Integer
Dim Words As Long
Dim I As Long
Dim LastChar As String * 1
Dim ThisChar As String * 1
   
rtbText.SelStart = 0
rtbText.SelLength = 1
LastChar = rtbText.SelText
   
Words = 0
For I = 1 To Len(rtbText.Text)
    rtbText.SelStart = I
    rtbText.SelLength = 1
    ThisChar = rtbText.SelText
    AsciiThisChar = Asc(ThisChar)
    AsciiLastChar = Asc(LastChar)
    If ((AsciiThisChar = 13 Or AsciiThisChar = 10) Or (AsciiThisChar >= 32 And AsciiThisChar <= 47) Or (AsciiThisChar >= 58 And AsciiThisChar <= 64) Or (AsciiThisChar >= 91 And AsciiThisChar <= 96) Or (AsciiThisChar >= 123 And AsciiThisChar <= 126)) And ((AsciiLastChar >= 48 And AsciiLastChar <= 57) Or (AsciiLastChar >= 65 And AsciiLastChar <= 90) Or (AsciiLastChar >= 97 And AsciiLastChar <= 122)) Then
        Words = Words + 1
    End If
    LastChar = ThisChar
Next
   
MsgBox "The number of WORDS is: " & vbCrLf & Words, vbInformation, "Number of Words"

End Sub

---

Yes yours is pretty quick akhileshbc.

I did mine 13 years ago but I've never bothered with it since.

Quote:

---

Originally Posted by akhileshbc

I made a quick example:

vb Code:

Option Explicit
 
Private Sub Command1_Click()
 
    Dim tempArray()     As String
    Dim lngWordCount    As Long
    Dim lngCharCount    As Long
    Dim lngCharCountS    As Long
    
    tempArray = Split(Trim$(RichTextBox1.Text), " ")
    
    lngWordCount = UBound(tempArray) + 1    '~~~ Number of words. ie, delimited by a single space
    lngCharCount = Len(RichTextBox1.Text)   '~~~ Number of characters including spaces
    lngCharCountS = Len(Replace(RichTextBox1.Text, " ", "")) '~~~ Number of characters (excludes white spaces)
    
    '~~~ Display it
    MsgBox "Word Count = " & lngWordCount & vbNewLine & _
            "Character count(includes white spaces) = " & lngCharCount & vbNewLine & _
            "Character count(without white spaces) = " & lngCharCountS
            
End Sub

You could additional things or alter it suit your needs. :wave:

---

I would modify that slightly in case there are extra spaces like the two spaces after periods that some people use.

VB Code:

Private Sub Command1_Click()
 
    Dim tempArray()     As String
    Dim lngWordCount    As Long
    Dim lngCharCount    As Long
    Dim lngCharCountS    As Long
    Dim strTemp1 As String
    Dim strTemp2 As String
    
    strTemp1 = RichTextBox1.Text
    Do Until LenB(strTemp1) = LenB(strTemp2)
        strTemp2 = Replace(strTemp1, "  ", " ") ' replace 2 spaces with 1 space
        strTemp1 = strTemp2
    Loop
    
    tempArray = Split(Trim$(strTemp1), " ")
    
    lngWordCount = UBound(tempArray) + 1    '~~~ Number of words. ie, delimited by a single space
    lngCharCount = Len(RichTextBox1.Text)   '~~~ Number of characters including spaces
    lngCharCountS = Len(Replace(RichTextBox1.Text, " ", "")) '~~~ Number of characters (excludes white spaces)
    
    '~~~ Display it
    MsgBox "Word Count = " & lngWordCount & vbNewLine & _
            "Character count(includes white spaces) = " & lngCharCount & vbNewLine & _
            "Character count(without white spaces) = " & lngCharCountS
            
End Sub

Here's a very fast method using the CopyMemory API:

In the Declarations section put:

Code:

---

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, _
    Source As Any, _
    ByVal Length As Long)

---

In a Module add this function:

Code:

---

Public Function WordCount(Text As String) As Long
    Dim dest() As Byte
    Dim i As Long

    If LenB(Text) Then
        ' Move the string's byte array into dest ()
        ReDim dest(LenB(Text))
        CopyMemory dest(0), ByVal StrPtr(Text), LenB(Text) - 1
     
      ' Now loop through the array and count the words
        For i = 0 To UBound(dest) Step 2

            If dest(i) > 32 Then

                Do Until dest(i) < 33
                    i = i + 2
                Loop
                WordCount = WordCount + 1
            End If
        Next i
        Erase dest
    Else
        WordCount = 0
    End If
End Function

---

Since Rich Text Editors have been done many times, you may benefit from downloading and viewing code on existing projects. The following editor project will not only generate Word Count but character count (different than word count) and line count... plus many other features good editors contain:

http://www.planet-source-code.com/vb...69067&lngWId=1

Good luck,

Tom

@Keithuk, @MartinLiss and @Tom Moran : Nice code :thumb:

:wave:

Quote:

---

Originally Posted by akhileshbc

@Keithuk, @MartinLiss and @Tom Moran : Nice code :thumb:

:wave:

---

Thanks, but my code was wrong. It only caught the first multiple space.

VB Code:

Private Sub Command1_Click()
 
    Dim tempArray()     As String
    Dim lngWordCount    As Long
    Dim lngCharCount    As Long
    Dim lngCharCountS    As Long
    Dim strTemp As String
    Dim intLen As Integer
    
    strTemp = RichTextBox1.Text
    Do Until Len(strTemp) = intLen
        intLen = Len(strTemp)
        strTemp = Replace(strTemp, "  ", " ")
    Loop
    tempArray = Split(Trim$(strTemp), " ")
    
    lngWordCount = UBound(tempArray) + 1    '~~~ Number of words. ie, delimited by a single space
    lngCharCount = Len(RichTextBox1.Text)   '~~~ Number of characters including spaces
    lngCharCountS = Len(Replace(RichTextBox1.Text, " ", "")) '~~~ Number of characters (excludes white spaces)
    
    '~~~ Display it
    MsgBox "Word Count = " & lngWordCount & vbNewLine & _
            "Character count(includes white spaces) = " & lngCharCount & vbNewLine & _
            "Character count(without white spaces) = " & lngCharCountS
            
End Sub

@akhileshbc: thanks for your help. By the way, I put your forum name into one of my vb comments.

hey there
I'm new here and this code trapped me, so I tried to make it show the number of word and number of letters for each word in the text, but I failed xD
can any one help.

First of all you should start a new thread for your question. This one is over a year old.
Second you need to tell us what you are trying to do and what problem(s) you are having.
Third you need to show us some of the code you used that is giving you the problem.

We can't help if we don't have any info on your problem.