ParseOCX

Dim Parsed As Sentence
Dim Symbol As Punct
Public Event KeyUp()
'Check for the only coded event
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        If Text1 <> "" Then
            RaiseEvent KeyUp
        End If
    End If
End Sub

Private Sub UserControl_Initialize()
    'Get the Parser ready and fill the symbol array
    '(you might want to try a dynamic array, or just
    'change the dimensions to your needs)
    Dim i As Integer
    ReDim Parsed.Operator(256, 8)
    ReDim Parsed.Word(256)
    Symbol.Mark(0) = " "
    Symbol.Mark(1) = "."
    Symbol.Mark(2) = "?"
    Symbol.Mark(3) = "!"
    Symbol.Mark(4) = ":"
    Symbol.Mark(5) = ";"
    Symbol.Mark(6) = ","
    Symbol.Mark(7) = "("
    Symbol.Mark(8) = ")"
    Symbol.Mark(9) = "{"
    Symbol.Mark(10) = "}"
    Symbol.Mark(11) = "["
    Symbol.Mark(12) = "]"
    Symbol.Mark(13) = "|"
    Symbol.Mark(14) = "\"
    Symbol.Mark(15) = "/"
    Symbol.Mark(16) = "@"
    Symbol.Mark(17) = "#"
    Symbol.Mark(18) = "$"
    Symbol.Mark(19) = "%"
    Symbol.Mark(20) = "^"
    Symbol.Mark(21) = "&"
    Symbol.Mark(22) = "_"
    Symbol.Mark(23) = "`"
    Symbol.Mark(24) = "~"
    Symbol.Mark(25) = "+"
    Symbol.Mark(26) = "-"
    Symbol.Mark(27) = ">"
    Symbol.Mark(28) = "<"
    Symbol.Mark(29) = "="
    Symbol.Mark(30) = "*"
    prvIndexCount = 0
    prvstrText = ""
End Sub

Private Sub UserControl_InitProperties()
    'Just setting a few properties
    mTextColor = &H0&
    mTextBack = &HFFFFFF
    Text1.Text = Extender.Name
    Text1.Font = Ambient.Font
    Text1.ForeColor = mTextColor
    Text1.BackColor = mTextBack
    mTextFont = "MS Sans Serif"
    mText = "This is a Sample Sentence"
End Sub

Private Sub UserControl_Resize()
    'Make the textbox fit the control
    Text1.Text = Text
    Text1.Move 0, 0, ScaleWidth, ScaleHeight
    Text1.Font = Font
End Sub

Private Sub UserControl_ReadProperties(PropBag As _
        PropertyBag)
    On Error Resume Next
    Set mTextFont = PropBag.ReadProperty("Font", "MS Sans Serif")
    Set Text1.Font = mTextFont
    mText = PropBag.ReadProperty("Text", _
        "This is a sample sentance.")
    mTextColor = PropBag.ReadProperty("ForeColor", &H80C0FF)
    Text1.ForeColor = mTextColor
    mTextBack = PropBag.ReadProperty("BackColor", &HFFFFFF)
    Text1.BackColor = mTextBack
End Sub

Private Sub UserControl_WriteProperties(PropBag _
        As PropertyBag)
    Call PropBag.WriteProperty("Text", mText, _
        "This is a sample sentance.")
    Call PropBag.WriteProperty("Font", Font, "MS Sans Serif")
    Call PropBag.WriteProperty("ForeColor", ForeColor, &H80C0FF)
    Call PropBag.WriteProperty("BackColor", BackColor, &HFFFFFF)
End Sub

Private Sub Parse(lclText As String)
    'This is the main routine
    'Start by declaring and initialising a few needed varables
    Dim lclIndexI As Integer
    Dim lclLastIndexI As Integer
    Dim lclstrLastStr As Integer
    Dim lclintStart As Integer
    Dim lclintDiff As Integer
    Dim intK As Integer
    Dim lclintSkip As Integer
    Dim lclintPunct As Integer
    Dim lclJump As Integer
    Dim lclJ As Integer
    Dim lclStop As Boolean
    Dim lclK As Integer
    Dim lclM As Integer
    Dim lclP As Integer
    Dim lclN As Integer
    Dim Tag1 As Integer
    Dim Hit1 As Boolean
    Dim OldP As Integer
    
    lclStop = False
    intK = 0
    lclstrLastStr = 0
    m_Result = ""
    lclIndexI = 1
    lclLastIndexI = 1
    lclintStart = 1
    lclText = Trim(lclText)
    'discern Stement type and remove marker
    If Right(lclText, 1) = Symbol.Mark(1) Then
        mQualify = 1
        mQualString = "Declairative"
    ElseIf Right(lclText, 1) = Symbol.Mark(2) Then
        mQualify = 1
        mQualString = "Interogative"
    ElseIf Right(lclText, 1) = Symbol.Mark(3) Then
        mQualify = 1
        mQualString = "Exclamative"
    Else
        mQualify = 0
        mQualString = "Un-qualified"
    End If
    If mQualify <> 0 Then
        lclText = Trim(Left(lclText, Len(lclText) - 1))
    End If
    For lclIndexI = 1 To Len(lclText)
        'Look for symbols inside string
        For lclJ = 0 To 30
            If Mid(lclText, lclIndexI, 1) = Symbol.Mark(lclJ) Then
                lclM = lclJ
                lclStop = True
            End If
        Next
        'Symbol found...
        If lclStop = True Then
            lclStop = False
            'if Symbol is not a space character...
            If lclM <> 0 Then
                'Mark its location by word number and order
                If Tag1 = intK Then
                    lclN = intK
                    lclP = 0
                ElseIf Hit1 = True Then
                    Hit1 = False
                    lclN = intK - 1
                    lclP = 1
                Else
                    lclN = intK - 1
                End If
                Parsed.Operator(lclN, lclP) = Symbol.Mark(lclM)
                lclP = lclP + 1
                OldP = lclP
                If lclP > 8 Then lclP = 8
                m_Operator = lclN 'intK
                lclM = 0
            End If
            lclintSkip = lclintSkip + 1
            If lclintSkip > 1 Then
                lclintStart = lclintStart + 1
            End If
        Else
            Tag1 = intK
            lclintSkip = 0
        End If
        'Clip out a word and increment word count, reset op order
        If lclintSkip = 1 Then
            Hit1 = True
            'lclP = 0
            lclintDiff = lclIndexI - lclintStart
            Parsed.Word(intK) = Mid(lclText, lclintStart, lclintDiff)
            intK = intK + 1
            m_Words = intK
            m_Result = m_Result + Mid(lclText, lclintStart, _
                lclintDiff) + Chr(13)
            lclintStart = lclIndexI + 1
        End If
    Next
    'Check remaining string for straggling word
    If lclIndexI > lclintStart Then
        lclintDiff = lclIndexI - lclintStart
        Parsed.Word(intK) = Mid(lclText, lclintStart, lclintDiff)
        m_Result = m_Result + Mid(lclText, lclintStart, _
            lclintDiff) + Chr(13)
        m_Words = intK
    End If
    For lclIndexI = 0 To lclN
        For lclJ = 0 To 7
            If Parsed.Operator(lclIndexI, lclJ) = "" Then
                If Parsed.Operator(lclIndexI, lclJ + 1) <> "" Then
                    Parsed.Operator(lclIndexI, lclJ) = _
                        Parsed.Operator(lclIndexI, lclJ + 1)
                    Parsed.Operator(lclIndexI, lclJ + 1) = ""
                End If
            End If
        Next
    Next
End Sub

Public Property Get WordLim() As Variant
    WordLim = m_Words
End Property

Public Property Get Word(intIndex As Integer) As Variant
    Word = Parsed.Word(intIndex)
End Property

Public Property Get OperatorLim() As Variant
    OperatorLim = m_Operator
End Property

Public Property Get Operator(intIndex1 As Integer, _
        intIndex2 As Integer) As String
    Operator = Parsed.Operator(intIndex1, intIndex2)
End Property

Public Sub ParseIt()
    Dim lclstrDummy As String
    If Text1.Text <> "" Then
        prvstrText = Text1.Text
        Text1.SelStart = 0
        Text1.SelLength = Len(Text1.Text)
        Text1.SelText = Text1.Text
    End If
    lclstrDummy = Text1.Text
    Parse (lclstrDummy)
End Sub

Public Property Get Text() As String
    Text = mText
    'Text = Text1.Text
End Property

Public Property Let Text(ByVal vNewValue As String)
    mText = vNewValue
    Text1.Text = mText
    PropertyChanged "Text"
End Property

Public Property Get Font() As StdFont
    Set Font = mTextFont
End Property

Public Property Set Font(ByVal NewFont As StdFont)
    Set mTextFont = NewFont
    Set Text1.Font = mTextFont
    PropertyChanged "Font"
End Property

Public Property Get ForeColor() As OLE_COLOR
    ForeColor = mTextColor
End Property

Public Property Set ForeColor(ByVal NewColor As OLE_COLOR)
    mTextColor = NewColor
    Text1.ForeColor = mTextColor
    PropertyChanged "ForeColor"
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = mTextBack
End Property

Public Property Set BackColor(ByVal NewColor As OLE_COLOR)
    mTextBack = NewColor
    Text1.BackColor = mTextBack
    PropertyChanged "BackColor"
End Property

Public Property Get Qualify() As Integer
    Qualify = mQualify
End Property

Public Property Let Qualify(lclintQ As Integer)
End Property

Public Property Get QualString() As String
    QualString = mQualString
End Property

Public Property Let QualString(lclstrQ As String)
End Property

Public Sub Clean()
    ReDim Parsed.Operator(256, 8)
    ReDim Parsed.Word(256)
End Sub

'Property pages supported: Font, Color
'Add these through the controls propertypage propery
'
'Below is an additional property page for the control
'to set the initial text
'Paste this code into the PropertyPage Form after adding
'the form from the Project menu
'
'Dont forget to associate the properties from tne tools menu
'i.e. Tools > Procedure Attributes
' Name: BackColor, click the <Advanced> button
' Procedure ID: BackColor
'
'Requires a text box called txtText
'and a commandbutton called ...Command1?
'
Private Sub Command1_Click()
    txtText = "This is a Sample Sentence"
End Sub

Private Sub txtText_Change()
    Changed = True
End Sub

Private Sub PropertyPage_ApplyChanges()
    SelectedControls(0).Text = txtText.Text
End Sub

Private Sub PropertyPage_SelectionChanged()
    txtText.Text = SelectedControls(0).Text
End Sub

For your processing needs.
Note On use:
Use the ParseIt method to parse the string.
Use the Clean method to Get rid of old data.

By: Robert Spoons

Inputs:'txtTxt as String

Returns:
' Access to String atoms through Word() property
' Access to Symbol atoms through Operator() property

' Assumes:'Requires an ActiveX project
' Requires a TextBox control
' PropertyPage: Requires adding a property page
' Also Requires a TextBox control

' Title: Parser
' Author: Robert Spoons
' Development System: P166, Win95B
' Development Software VB5 PRO
'
' Requires an ActiveXControl Project
' Put a textbox on the form and leave the name as Text1
' Requires Control Name to be Parser (for convienence)
' Requires ocx to names SpoonsParser (please)
' 
' This is a small control that I made and have found useful.
' Throw it on a form and either enter text directly, or redirect
' the text to the control from another source.
' I hope you get some use from the code.
'
' Use Notes:
' explicitly dimension any varables used to access the
' parser as Integer
' Symbols, by default, are associated with the previous word
'
' example: Parser1.Text="How mush is that &$#@ dog?"
' Parser1.WordLim returns 4
' Parser1.OperatorLim returns 4
' Parser1.Word(0) returns "How"
' Parser1.Word(3) returns "that"
' Parser1.Operator(3,3)returns "#"
'
' Have fun.
'

Option Explicit
'All the required preamble

Private prvstrText As String
Private prvIndexCount As Integer
Private m_Result As String
Private m_Final As String
Private m_Words As Integer
Private m_Index As Integer
Private mTextFont As New StdFont
Private mTextColor As OLE_COLOR
Private mTextBack As OLE_COLOR
Private mQualify As Integer
Private mQualString As String
Private mText As String
Private m_Operator As Integer
Private Type Sentence
Word() As String
Operator() As String
End Type
Private Type Punct
Mark(30) As String
End Type

Dim Parsed As Sentence
Dim Symbol As Punct
Public Event KeyUp()
'Check for the only coded event

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
If Text1 <> "" Then
RaiseEvent KeyUp
End If
End If
End Sub

Private Sub UserControl_Initialize()
'Get the Parser ready and fill the symbol array

'(you might want to try a dynamic array, or just

'change the dimensions to your needs)

Dim i As Integer
ReDim Parsed.Operator(256, 8)
ReDim Parsed.Word(256)
Symbol.Mark(0) = " "
Symbol.Mark(1) = "."
Symbol.Mark(2) = "?"
Symbol.Mark(3) = "!"
Symbol.Mark(4) = ":"
Symbol.Mark(5) = ";"
Symbol.Mark(6) = ","
Symbol.Mark(7) = "("
Symbol.Mark(8) = ")"
Symbol.Mark(9) = "{"
Symbol.Mark(10) = "}"
Symbol.Mark(11) = "["
Symbol.Mark(12) = "]"
Symbol.Mark(13) = "|"
Symbol.Mark(14) = "\"
Symbol.Mark(15) = "/"
Symbol.Mark(16) = "@"
Symbol.Mark(17) = "#"
Symbol.Mark(18) = "$"
Symbol.Mark(19) = "%"
Symbol.Mark(20) = "^"
Symbol.Mark(21) = "&"
Symbol.Mark(22) = "_"
Symbol.Mark(23) = "`"
Symbol.Mark(24) = "~"
Symbol.Mark(25) = "+"
Symbol.Mark(26) = "-"
Symbol.Mark(27) = ">"
Symbol.Mark(28) = "<"
Symbol.Mark(29) = "="
Symbol.Mark(30) = "*"
prvIndexCount = 0
prvstrText = ""
End Sub

Private Sub UserControl_InitProperties()
'Just setting a few properties

mTextColor = &H0&
mTextBack = &HFFFFFF
Text1.Text = Extender.Name
Text1.Font = Ambient.Font
Text1.ForeColor = mTextColor
Text1.BackColor = mTextBack
mTextFont = "MS Sans Serif"
mText = "This is a Sample Sentence"
End Sub

Private Sub UserControl_Resize()
'Make the textbox fit the control

Text1.Text = Text
Text1.Move 0, 0, ScaleWidth, ScaleHeight
Text1.Font = Font
End Sub

Private Sub UserControl_ReadProperties(PropBag As _
PropertyBag)
On Error Resume Next
Set mTextFont = PropBag.ReadProperty("Font", "MS Sans Serif")
Set Text1.Font = mTextFont
mText = PropBag.ReadProperty("Text", _
"This is a sample sentance.")
mTextColor = PropBag.ReadProperty("ForeColor", &H80C0FF)
Text1.ForeColor = mTextColor
mTextBack = PropBag.ReadProperty("BackColor", &HFFFFFF)
Text1.BackColor = mTextBack
End Sub

Private Sub UserControl_WriteProperties(PropBag _
As PropertyBag)
Call PropBag.WriteProperty("Text", mText, _
"This is a sample sentance.")
Call PropBag.WriteProperty("Font", Font, "MS Sans Serif")
Call PropBag.WriteProperty("ForeColor", ForeColor, &H80C0FF)
Call PropBag.WriteProperty("BackColor", BackColor, &HFFFFFF)
End Sub

Private Sub Parse(lclText As String)
'This is the main routine

'Start by declaring and initialising a few needed varables

Dim lclIndexI As Integer
Dim lclLastIndexI As Integer
Dim lclstrLastStr As Integer
Dim lclintStart As Integer
Dim lclintDiff As Integer
Dim intK As Integer
Dim lclintSkip As Integer
Dim lclintPunct As Integer
Dim lclJump As Integer
Dim lclJ As Integer
Dim lclStop As Boolean
Dim lclK As Integer
Dim lclM As Integer
Dim lclP As Integer
Dim lclN As Integer
Dim Tag1 As Integer
Dim Hit1 As Boolean
Dim OldP As Integer

lclStop = False
intK = 0
lclstrLastStr = 0
m_Result = ""
lclIndexI = 1
lclLastIndexI = 1
lclintStart = 1
lclText = Trim(lclText)
'discern Stement type and remove marker

If Right(lclText, 1) = Symbol.Mark(1) Then
mQualify = 1
mQualString = "Declairative"
ElseIf Right(lclText, 1) = Symbol.Mark(2) Then
mQualify = 1
mQualString = "Interogative"
ElseIf Right(lclText, 1) = Symbol.Mark(3) Then
mQualify = 1
mQualString = "Exclamative"
Else
mQualify = 0
mQualString = "Un-qualified"
End If
If mQualify <> 0 Then
lclText = Trim(Left(lclText, Len(lclText) - 1))
End If
For lclIndexI = 1 To Len(lclText)
'Look for symbols inside string

For lclJ = 0 To 30
If Mid(lclText, lclIndexI, 1) = Symbol.Mark(lclJ) Then
lclM = lclJ
lclStop = True
End If
Next
'Symbol found...

If lclStop = True Then
lclStop = False
'if Symbol is not a space character...

If lclM <> 0 Then
'Mark its location by word number and order

If Tag1 = intK Then
lclN = intK
lclP = 0
ElseIf Hit1 = True Then
Hit1 = False
lclN = intK - 1
lclP = 1
Else
lclN = intK - 1
End If
Parsed.Operator(lclN, lclP) = Symbol.Mark(lclM)
lclP = lclP + 1
OldP = lclP
If lclP > 8 Then lclP = 8
m_Operator = lclN 'intK
lclM = 0
End If
lclintSkip = lclintSkip + 1
If lclintSkip > 1 Then
lclintStart = lclintStart + 1
End If
Else
Tag1 = intK
lclintSkip = 0
End If
'Clip out a word and increment word count, reset op order

If lclintSkip = 1 Then
Hit1 = True
'lclP = 0

lclintDiff = lclIndexI - lclintStart
Parsed.Word(intK) = Mid(lclText, lclintStart, lclintDiff)
intK = intK + 1
m_Words = intK
m_Result = m_Result + Mid(lclText, lclintStart, _
lclintDiff) + Chr(13)
lclintStart = lclIndexI + 1
End If
Next
'Check remaining string for straggling word

If lclIndexI > lclintStart Then
lclintDiff = lclIndexI - lclintStart
Parsed.Word(intK) = Mid(lclText, lclintStart, lclintDiff)
m_Result = m_Result + Mid(lclText, lclintStart, _
lclintDiff) + Chr(13)
m_Words = intK
End If
For lclIndexI = 0 To lclN
For lclJ = 0 To 7
If Parsed.Operator(lclIndexI, lclJ) = "" Then
If Parsed.Operator(lclIndexI, lclJ + 1) <> "" Then
Parsed.Operator(lclIndexI, lclJ) = _
Parsed.Operator(lclIndexI, lclJ + 1)
Parsed.Operator(lclIndexI, lclJ + 1) = ""
End If
End If
Next
Next
End Sub

Public Property Get WordLim() As Variant
WordLim = m_Words
End Property

Public Property Get Word(intIndex As Integer) As Variant
Word = Parsed.Word(intIndex)
End Property

Public Property Get OperatorLim() As Variant
OperatorLim = m_Operator
End Property

Public Property Get Operator(intIndex1 As Integer, _
intIndex2 As Integer) As String
Operator = Parsed.Operator(intIndex1, intIndex2)
End Property

Public Sub ParseIt()
Dim lclstrDummy As String
If Text1.Text <> "" Then
prvstrText = Text1.Text
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Text1.SelText = Text1.Text
End If
lclstrDummy = Text1.Text
Parse (lclstrDummy)
End Sub

Public Property Get Text() As String
Text = mText
'Text = Text1.Text

End Property

Public Property Let Text(ByVal vNewValue As String)
mText = vNewValue
Text1.Text = mText
PropertyChanged "Text"
End Property

Public Property Get Font() As StdFont
Set Font = mTextFont
End Property

Public Property Set Font(ByVal NewFont As StdFont)
Set mTextFont = NewFont
Set Text1.Font = mTextFont
PropertyChanged "Font"
End Property

Public Property Get ForeColor() As OLE_COLOR
ForeColor = mTextColor
End Property

Public Property Set ForeColor(ByVal NewColor As OLE_COLOR)
mTextColor = NewColor
Text1.ForeColor = mTextColor
PropertyChanged "ForeColor"
End Property

Public Property Get BackColor() As OLE_COLOR
BackColor = mTextBack
End Property

Public Property Set BackColor(ByVal NewColor As OLE_COLOR)
mTextBack = NewColor
Text1.BackColor = mTextBack
PropertyChanged "BackColor"
End Property

Public Property Get Qualify() As Integer
Qualify = mQualify
End Property

Public Property Let Qualify(lclintQ As Integer)
End Property

Public Property Get QualString() As String
QualString = mQualString
End Property

Public Property Let QualString(lclstrQ As String)
End Property

Public Sub Clean()
ReDim Parsed.Operator(256, 8)
ReDim Parsed.Word(256)
End Sub

'Property pages supported: Font, Color

'Add these through the controls propertypage propery

'

'Below is an additional property page for the control

'to set the initial text

'Paste this code into the PropertyPage Form after adding

'the form from the Project menu

'

'Dont forget to associate the properties from tne tools menu

'i.e. Tools > Procedure Attributes

' Name: BackColor, click the <Advanced> button

' Procedure ID: BackColor

'

'Requires a text box called txtText

'and a commandbutton called ...Command1?

'

Private Sub Command1_Click()
txtText = "This is a Sample Sentence"
End Sub

Private Sub txtText_Change()
Changed = True
End Sub

Private Sub PropertyPage_ApplyChanges()
SelectedControls(0).Text = txtText.Text
End Sub

Private Sub PropertyPage_SelectionChanged()
txtText.Text = SelectedControls(0).Text
End Sub

For your processing needs.
Note On use:
Use the ParseIt method to parse the string.
Use the Clean method to Get rid of old data.

By: Robert Spoons

Inputs:'txtTxt as String

Returns:
' Access to String atoms through Word() property

' Access to Symbol atoms through Operator() property

' Assumes:'Requires an ActiveX project

' Requires a TextBox control

' PropertyPage: Requires adding a property page

' Also Requires a TextBox control

' Title: Parser

' Author: Robert Spoons

' Development System: P166, Win95B

' Development Software VB5 PRO

'

' Requires an ActiveXControl Project

' Put a textbox on the form and leave the name as Text1

' Requires Control Name to be Parser (for convienence)

' Requires ocx to names SpoonsParser (please)

'

' This is a small control that I made and have found useful.

' Throw it on a form and either enter text directly, or redirect

' the text to the control from another source.

' I hope you get some use from the code.

'

' Use Notes:

' explicitly dimension any varables used to access the

' parser as Integer

' Symbols, by default, are associated with the previous word

'

' example: Parser1.Text="How mush is that &$#@ dog?"

' Parser1.WordLim returns 4

' Parser1.OperatorLim returns 4

' Parser1.Word(0) returns "How"

' Parser1.Word(3) returns "that"

' Parser1.Operator(3,3)returns "#"

'

' Have fun.

'