Solved

Word replacer

Posted on 2000-03-14
10
268 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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 27

Expert Comment

by:Ark
Comment Utility
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
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 14

Expert Comment

by:wsh2
Comment Utility
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 27

Expert Comment

by:Ark
Comment Utility
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
Comment Utility
I thought you all might get a kick out of that...sorry ;>)
0
 
LVL 14

Expert Comment

by:wsh2
Comment Utility
Foyal:
Your comments are well appreciated.. <smile>.
0
 

Author Comment

by:Ginger16
Comment Utility
another good job
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
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 utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

744 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now