Solved

Word replacer

Posted on 2000-03-14
10
290 Views
Last Modified: 2010-05-02
I want to build a program that is basically just a text editor, but will flag(?) certain words that I define, so they could be replaced by other words.Example, if you typed "it was a good day", when you typed the word "good", you would get a spellcheck type popup that would give you different words you could use like, "fantastic", "wonderful" and so on. I want to define these words also.
How can I do this?
0
Comment
Question by:Ginger16
  • 4
  • 3
  • 2
  • +1
10 Comments
 
LVL 14

Accepted Solution

by:
wsh2 earned 50 total points
ID: 2618649
An example.. <smile>.

<----- Code Begin ----->

Dim colPhrases As New Collection
Dim varReplace() As Variant
ReDim varReplace(4)
varReplace(0) = "it was a good day"
varReplace(1) = "1st Replacement"
varReplace(2) = "2nd Replacement"
varReplace(3) = "3nd Replacement"
colPhrases.Add varReplace()

Dim strWork As String
Dim strText As String
strText = "Today, it was a good day.. <smile>"

Dim lngFind As Long
Dim varPhrase As Variant
For Each varPhrase In colPhrases
  lngFind = 1
  Do Until lngFind = 0
    varReplace() = varPhrase
    lngFind = InStr(lngFind, LCase(strText), LCase(varReplace(0)))
    If lngFind > 0 _
    Then
      strWork = Left(strText, lngFind - 1) _
        & Replace(strText, varReplace(0), varReplace(2), lngFind, 1)
      MsgBox strWork
      lngFind = lngFind + Len(varReplace(2))
    End If
  Loop
Next varPhrase

<----- Code End ----->

Naturally, instead of strText you would use Text1.Text.. and in place of the Msgbox a form with a combobox.. <smile>

0
 
LVL 3

Expert Comment

by:Foyal
ID: 2618658
This needs a ton of refinement but I think you will get the gist of it:

Dim WordLoc as Long

WordLoc is where the beginning of the detected word would be located in the text string.

Dim TextToCheck as string

TextToCheck is the text string.

Dim WordArray() as String

WordArray is an array of words to test for.

Loop the following as needed to get through the list of words in the array.
As you go through the list just check the value of WordLoc... If it is greater than 0 then the word found is the Index and the location of that word is the value of WordLoc.
When you detect one then use the WordLoc to know where to excise the unwanted word and replace it.

WordLoc = Instr(TextToCheck,WordArray(Index))
0
 
LVL 14

Expert Comment

by:wsh2
ID: 2618663
Foyal:
How the heck could you lock a question with an answer like that?.. Refinement?.. "Oil" be d*mned, you gotta dig the whole stinkin' well.. <lol>.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 28

Expert Comment

by:Ark
ID: 2618953
Hi
wsh2: I agree
About code - IMHO, its better to use 2-dimension array, like this:
'Ginger, you need for this code form with text box (multiline).
'In menu editor add menu named mnu (uncheck Visible check box) and submenu named submnu. Paste this code into form code, run and tipe your frase

Option Explicit
'It's only to display popup at appropriate position
Const EM_POSFROMCHAR = &HD6
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim dic() As String

Private Sub Form_Load()
  FillDictionary
  Load submnu(1)
  submnu(1).Caption = "-"
End Sub

Private Sub submnu_Click(Index As Integer)
   Text1 = Left$(Text1, Len(Text1) - Len(submnu(0).Caption)) & submnu(Index).Caption
End Sub

Private Sub Text1_Change()
'Ginger, you can replace this code at Text1_Keypress or other event as you want
  Dim sWord As String, i As Integer
  Dim x As Long, y As Long, pos As Long
  sWord = GetLastWord(Text1)
  If CheckDic(sWord) Then
     pos = SendMessage(Text1.hwnd, EM_POSFROMCHAR, Len(Text1.Text) - 1, 0&)
     x = Text1.Left + GetLoWord(pos) * Screen.TwipsPerPixelX
     y = Text1.Top + (GetHiWord(pos) + Text1.Font.Size * 1.8) * Screen.TwipsPerPixelY
     PopupMenu mnu, , x, y
  End If
End Sub

Private Sub FillDictionary()
   ReDim dic(1, 3)
   dic(0, 0) = "good"
   dic(1, 0) = "day"
   dic(0, 1) = "fantastic"
   dic(0, 2) = "wonderfull"
   dic(0, 3) = "fine"
   dic(1, 1) = "month"
   dic(1, 3) = "night"
End Sub

Private Function GetLastWord(sText As String) As String
  Dim i As Long, p As Long
  If sText = "" Then Exit Function
  For i = Len(sText) To 1 Step -1
      If Mid$(sText, i, 1) = " " Then
         GetLastWord = Right$(sText, Len(sText) - i)
         Exit Function
      End If
  Next i
End Function

Private Function CheckDic(sText As String) As Boolean
  Dim i As Integer, j As Integer
  submnu(0).Caption = sText
  For i = 0 To UBound(dic, 1)
     If dic(i, 0) = sText Then
        CheckDic = True
        For j = 1 To UBound(dic, 2)
          If dic(i, j) <> "" Then
             If submnu.Count < j + 2 Then Load submnu(j + 2)
             submnu(j + 2).Caption = dic(i, j)
          End If
        Next j
      End If
  Next i
End Function

Private Function GetHiWord(dw As Long) As Long
  If dw And &H80000000 Then
     GetHiWord = (dw \ 65535) - 1
  Else
     GetHiWord = dw \ 65535
  End If
End Function

Private Function GetLoWord(dw As Long) As Long
   If dw And &H8000& Then
      GetLoWord = &H8000 Or (dw And &H7FFF&)
   Else
      GetLoWord = dw And &HFFFF&
   End If
End Function

Cheers
0
 
LVL 28

Expert Comment

by:Ark
ID: 2619029
Oops, sorry some correction:
Find some bugs, it's better paste new code then describe each
Option Explicit
Const EM_POSFROMCHAR = &HD6
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim dic() As String


Private Sub Form_Load()
  FillDictionary
  Load submnu(1)
  submnu(1).Caption = "-"
End Sub

Private Sub submnu_Click(Index As Integer)
   Text1 = Left$(Text1, Len(Text1) - Len(submnu(0).Caption)) & submnu(Index).Caption
End Sub

Private Sub Text1_Change()
  Dim sWord As String, i As Integer
  Dim x As Long, y As Long, pos As Long
  sWord = GetLastWord(Text1)
  If CheckDic(sWord) Then
     pos = SendMessage(Text1.hwnd, EM_POSFROMCHAR, Len(Text1.Text) - 1, 0&)
     x = Text1.Left + GetLoWord(pos) * Screen.TwipsPerPixelX
     y = Text1.Top + (GetHiWord(pos) + Text1.Font.Size * 1.8) * Screen.TwipsPerPixelY
     PopupMenu mnu, , x, y
     ClearMenu
     Text1.SelStart = Len(Text1)
  End If
End Sub

Private Sub FillDictionary()
   ReDim dic(1, 3)
   dic(0, 0) = "good"
   dic(1, 0) = "day"
   dic(0, 1) = "fantastic"
   dic(0, 2) = "wonderfull"
   dic(0, 3) = "fine"
   dic(1, 1) = "month"
   dic(1, 2) = "night"
End Sub

Private Function GetLastWord(sText As String) As String
  Dim i As Long, p As Boolean
  If sText = "" Then Exit Function
  For i = Len(sText) To 1 Step -1
      If Mid$(sText, i, 1) = " " Then
         GetLastWord = Right$(sText, Len(sText) - i)
         p = True
         Exit For
      End If
  Next i
  If Not p Then GetLastWord = sText
End Function

Private Function CheckDic(sText As String) As Boolean
  Dim i As Integer, j As Integer
  submnu(0).Caption = sText
  For i = 0 To UBound(dic, 1)
     If dic(i, 0) = sText Then
        CheckDic = True
        For j = 1 To UBound(dic, 2)
          If dic(i, j) <> "" Then
             Load submnu(j + 1)
             submnu(j + 1).Caption = dic(i, j)
          End If
        Next j
      End If
  Next i
End Function

Private Function GetHiWord(dw As Long) As Long
  If dw And &H80000000 Then
     GetHiWord = (dw \ 65535) - 1
  Else
     GetHiWord = dw \ 65535
  End If
End Function

Private Function GetLoWord(dw As Long) As Long
   If dw And &H8000& Then
      GetLoWord = &H8000 Or (dw And &H7FFF&)
   Else
      GetLoWord = dw And &HFFFF&
   End If
End Function

Private Sub ClearMenu()
  Dim i As Integer
  For i = submnu.Count - 1 To 2 Step -1
      Unload submnu(i)
  Next i
End Sub
Cheers
0
 
LVL 14

Expert Comment

by:wsh2
ID: 2619042
Ark:
I gotta tell you, you are the first I've seen use the new VB6 Dictionary function.. although I haven't used it yet, I look forward to doing so.. <smile>. However, let me also point out that rather than writing a GetLastWord function, reading your code you could have just as easily used the new VB6 INSTRREV function.. <wink>.

A design note.. I don't know that a Popup Menu is the best solution here.. as it only allows the user a fixed set of options. Doing a small modal with a Combo Box allows the user to select one of the suggestions.. or.. if they like.. type in one of their own. Hmmm.. now there is a thought.. if the user keys in their own response, code should be added to store the data back into my collection or back into your dictionary list.. but as it is now 4:30am here.. to hell with it... LOL.

Anyhow, All in all, as usual, a great big Well Done, to our expert Ark !!!

B.

0
 
LVL 28

Expert Comment

by:Ark
ID: 2619133
Hi again
Ginger: wsh2 is right (as usual). You can simplify my code using new VB6 functions (Instrrev and Replace). About collection - not bad idea. But it's better to use array collection:
varReplace(0)=Array("good","nice","wonderfull")
varReplace(1)=Array("day","night","month")
with this collection code will be more flexible - you can access any word and show other from array
Cheers
0
 
LVL 3

Expert Comment

by:Foyal
ID: 2620983
I thought you all might get a kick out of that...sorry ;>)
0
 
LVL 14

Expert Comment

by:wsh2
ID: 2621101
Foyal:
Your comments are well appreciated.. <smile>.
0
 

Author Comment

by:Ginger16
ID: 2621810
another good job
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

685 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question