memo word monitoring

message popup's on certain words entered into memo

as i want to check for about 7 different words i thought i would be able to do it like this

Function WordCount(Word,text: string): integer;
begin
  result:= 0;
  while pos(uppercase(Word),uppercase(text))<>0 do

  begin
     Result := Result+1;
     Delete(text,1,pos(Word,text)+length(Word)-1);
  end;
end;

Function WordCount1(Word,text: string): integer;
begin
  result:= 0;
  while pos(uppercase(Word),uppercase(text))<>0 do

  begin
     Result := Result+1;
     Delete(text,1,pos(Word,text)+length(Word)-1);
  end;
end;


procedure TKeylog.Memo1Change(Sender: TObject);
begin
   If WordCountformemo1<>WordCount(edit1.text,memo1.Text) then
   begin
      WordCountformemo1:= WordCount(edit1.text,memo1.Text);
      ShowMessage('A new '+edit1.text+' has been found');
           end;
            begin
      If WordCountformemo1<>WordCount1(edit2.text,memo1.Text) then
   begin
      WordCountformemo1:= WordCount1(edit2.text,memo1.Text);
      ShowMessage('A new '+edit2.text+' has been found');

            end;

             end;
            end;

but this then soon as 1 word is found it just repeats the popup messasge's . its fine if i just check the 1 word
would it be better to have the words in list seperated by commas as am not sure how to do it
LVL 1
peter2001Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

sas13Commented:
>would it be better to have the words in list seperated by commas as am not sure how to do it
var
  _str: TStringList;


_str.CommaText := ...
or
_str.Delimiter := ' ';
_str.DelimitedText := ...

and search
_str.IndexOf
DavidBirch2dotComCommented:
How about something like this:

const
  NumOfWords= 7;

Var
  Words: array[1..NumOfWords] of string;
  WordCountVar: array[1..NumOfWords] of integer;

Function WordCount(Word,text: string): integer;
begin
  result:= 0;
  while pos(uppercase(Word),uppercase(text))<>0 do

  begin
     Result := Result+1;
     Delete(text,1,pos(Word,text)+length(Word)-1);
  end;
end;

procedure TForm1.Memo1Change(Sender: TObject);
var
  K: integer;
begin
   for K:= 1 to NumOfWords do // load words into array where edit boxes are named edit1,edit2,edit3 ect
   begin
      If not (Trim(Words[K])='') then // if the word is not empty
      begin
         If WordCountVar[K]<>WordCount(Words[K],memo1.Text) then
         begin
            WordCountVar[K]:= WordCount(Words[K],memo1.Text);
            ShowMessage('A new '+Words[K]+' has been found');
         end;
      end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  K: integer; // load words into array where edit boxes are named edit1,edit2,edit3 ect

begin
   for K:= 1 to NumOfWords do    
   begin
      Words[K]:= (Form1.FindComponent('edit'+inttostr(K))as Tedit).Text;
   end;
end;

Alternativly you could load the words up simply by listing Words[1]:= 'myword';

The specific reason why your code above didnt work was that you didnt have different count varibles for different words.  Also it is uncessary to have two word count functions since the both do an identical job.

By the way I have noticed that the event will fire if a word is deleted, if you want to stop this then change the code like so:

         If WordCountVar[K]<WordCount(Words[K],memo1.Text) then   // only if word count has inceased
            ShowMessage('A new '+Words[K]+' has been found');
         WordCountVar[K]:= WordCount(Words[K],memo1.Text); // make sure that the number is updated anyway

David
BlackTigerXCommented:
Here is a completly different approach, I detect the words as they type
//Form declaration here...
...
  public
    { Public declarations }
    LookupWords:array[0..MAX_WORDS] of string;
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  LookupWords[0]:='Hello';
  LookupWords[1]:='World';
  LookupWords[2]:='Hola';
end;

procedure TForm2.CheckWord(const theWord:string);
var
  X:Integer;
begin
  for X:=0 to MAX_WORDS do
    if (LookupWords[X] = theWord) then
    begin
      ShowMessage('Word ['+theWord+'] was typed.');
      Exit
    end
end;

procedure TForm2.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  LastWord:string;
  start:Integer;
begin
  if (Key in [VK_SPACE, VK_BACK]) then
    Exit;
  start:=Memo1.SelStart;
  LastWord:=Copy(Memo1.Lines.Text, start-4, 5); //5, because that's the maximum length for any of our words, change this value!!!
  for start:=Length(LastWord) downto 1 do
    if (LastWord[start] <= ' ') then
    begin
      LastWord:=Copy(LastWord, start+1, 5);
      Break
    end;
  CheckWord(LastWord)
end;
Announcing the Winners!

The results are in for the 15th Annual Expert Awards! Congratulations to the winners, and thank you to everyone who participated in the nominations. We are so grateful for the valuable contributions experts make on a daily basis. Click to read more about this year’s recipients!

peter2001Author Commented:
hi

having a few problems with that code

when you say "The specific reason why your code above didnt work was that you didnt have different count varibles for different words." what do you mean?

i dont mind listing all the edit1 edit2 edit3 ect

if i could get that first code to work and just list them all and stop the pop up if the word gets deleted that would be great

thank you so much for you time and help
DavidBirch2dotComCommented:
WordCountformemo1  was origonaly the number of times a certain word appeared in the text.  If you are looking for another word in the text it will most likely appear a different number of times so you will need to have a different varible to keep track on how many times that word appears.

So if for word one you have a varible WordCountforWord1 and for the second word you have a varible WordCountforWord2 your code would work.  
Or alternativly you could use an array as BlacktigerX & myself do since it is easier to code, instead of writing the code out again for each word.

In your origonal code, to stop the message popping up you need to change

If WordCountformemo1<>WordCount(edit1.text,memo1.Text) then
   begin
      WordCountformemo1:= WordCount(edit1.text,memo1.Text);
      ShowMessage('A new '+edit1.text+' has been found');
           end;

to some thing like

        If WordCountVar[K]<WordCount(Words[K],memo1.Text) then   // only if word count has inceased
            ShowMessage('A new '+Words[K]+' has been found');
         WordCountVar[K]:= WordCount(Words[K],memo1.Text); // make sure that the number is updated anyway regardless on whether the word count has increased or decreased {or stayed the same}

you may put in your varibles to make the code work in you application

David
BlackTigerXCommented:
you can combine DavidBirch2dotcom word count function with my code to get what you need, simply by doing something like:

procedure TForm2.CheckWord(const theWord:string);
var
  X:Integer;
begin
  for X:=0 to MAX_WORDS do
    if (LookupWords[X] = theWord) then
    begin
      ShowMessage('Word ['+theWord+'] has been typed '+IntToStr(WordCount(theWord, Memo1.Text))+' times.');
      Exit
    end
end;
peter2001Author Commented:
@DavidBirch2dotCom

how would i use the varable WordCountforWord2



procedure TForm1.Memo1Change(Sender: TObject);
begin
   If WordCountformemo1<>WordCount(edit1.text,memo1.Text) then
   begin
      WordCountformemo1:= WordCount(edit1.text,memo1.Text);
      ShowMessage('A new '+edit1.text+' has been found');
           end;
            begin

as i tried WordCount(edit1.text,memo1.Text); and then WordCount1(edit1.text,memo1.Text);

how do i implement it

@BlackTigerX
thanks i will have a go with that aswell


DavidBirch2dotComCommented:
To correct your origonal code,

Function WordCount(Word,text: string): integer;
begin
  result:= 0;
  while pos(uppercase(Word),uppercase(text))<>0 do

  begin
     Result := Result+1;
     Delete(text,1,pos(Word,text)+length(Word)-1);
  end;
end;

procedure TKeylog.Memo1Change(Sender: TObject);
begin

   If WordCountformemo1<>WordCount(edit1.text,memo1.Text) then
   begin
      WordCountformemo1:= WordCount(edit1.text,memo1.Text);
      ShowMessage('A new '+edit1.text+' has been found');
   end;

   If WordCountformemo2<>WordCount(edit2.text,memo1.Text) then
   begin
      WordCountformemo2:= WordCount(edit2.text,memo1.Text);
      ShowMessage('A new '+edit2.text+' has been found');
    end;

end;

works correctly
However to stop the event being triggered when a word is deleted the following code will work

procedure TKeylog.Memo1Change(Sender: TObject);
begin
   If WordCountformemo1<>WordCount(edit1.text,memo1.Text) then
      ShowMessage('A new '+edit1.text+' has been found');

   WordCountformemo1:= WordCount(edit1.text,memo1.Text);

   If WordCountformemo2<>WordCount(edit2.text,memo1.Text) then
      ShowMessage('A new '+edit2.text+' has been found');

   WordCountformemo2:= WordCount(edit2.text,memo1.Text);
end;

However the code BlackTiger and myself have provided will also work and would be easier to use than doing a new block of code for each word.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
peter2001Author Commented:
hi

yes i see the light now it all becomes clear

that was some great help there
thankyou
peter2001Author Commented:
when i used this way

 If WordCountformemo4<>WordCount(edit1.text,memo1.Text) then
      ShowMessage('The word '+edit1.text+' has been found');

   WordCountformemo4:= WordCount(edit1.text,memo1.Text);



If WordCountformemo5<>WordCount(edit2.text,memo1.Text) then
      ShowMessage('The word'+edit2.text+' has been found');

   WordCountformemo5:= WordCount(edit2.text,memo1.Text);


it worked for both no problem





what is wrong with this

this works fine for the first WordCountformemo1 it detects the word and pops the message up
but does not detect the second WordCountformemo2 it does nothing for that word




 Var

  WordCountformemo1: integer;
  WordCountformemo2: integer;




Function WordCount(Word,text: string): integer;
begin
  result:= 0;
  while pos(uppercase(Word),uppercase(text))<>0  do

  begin
     Result := Result+1;
     Delete(text,1,pos(Word,text)+length(Word)-1);
  end;
end;




 procedure TKey.Memo1Change(Sender: TObject);
    var
    WordPopup: TWordPopup;
begin
    WordPopup := TWordPopup.Create(Application);

   If memo1.Lines.Count>19 then
      Memo1.ScrollBars:=ssVertical;
    ScrollMemoDown(Memo1);
   
   If WordCountformemo1<>WordCount(edit1.text,memo1.Text) then
      begin
     WordPopup.BANWord := edit1.text;   //puts the word in a lable in the popup
     WordCountformemo1:= WordCount(edit1.text,memo1.Text);
     WordPopup.Show;  //pops up a little box like msn messenger


   If WordCountformemo2<>WordCount(edit2.text,memo1.Text) then
      begin
     WordPopup.BANWord := edit2.text;
     WordCountformemo2:= WordCount(edit2.text,memo1.Text);
     WordPopup.Show;
   
     end;
      end;
       end;
DavidBirch2dotComCommented:
your begin and ends are in the wrong place

begin
    WordPopup := TWordPopup.Create(Application);

   If memo1.Lines.Count>19 then
      Memo1.ScrollBars:=ssVertical;
    ScrollMemoDown(Memo1);
   
   If WordCountformemo1<>WordCount(edit1.text,memo1.Text) then
      begin
     WordPopup.BANWord := edit1.text;   //puts the word in a lable in the popup
     WordCountformemo1:= WordCount(edit1.text,memo1.Text);
     WordPopup.Show;  //pops up a little box like msn messenger
     end;


   If WordCountformemo2<>WordCount(edit2.text,memo1.Text) then
      begin
     WordPopup.BANWord := edit2.text;
     WordCountformemo2:= WordCount(edit2.text,memo1.Text);
     WordPopup.Show;
      end;
   

 end;
peter2001Author Commented:
thanks that sorted it :)
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.