Solved

Word replacer

Posted on 2000-03-14
10
285 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
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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

Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

Question has a verified solution.

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

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

840 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