• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 277
  • Last Modified:

Coping the paragraph that a certain word appears in (500 points)

When a certain word appears in the text of Memo1, I want just the paragraph to be copied to Memo2.  I am using Delphi 6.  

I am giving 500 points as this code is required urgently. Many thanks for your help.
0
rincewind666
Asked:
rincewind666
1 Solution
 
rincewind666Author Commented:
Almost forgot. I need ALL the paragraphs that this word appears in, not just the first.  Thanks.
0
 
FarajLYCommented:
procedure TForm1.Memo1Change(Sender: TObject);
begin
Memo2.Text:=Memo1.Text;
end;
0
 
kfoster11CEOCommented:
I would think the best way to do this is to break the paragraphs up into a TStringlist, and then iterate through the list and check each paragraph for the word.

The first issue is how to tell where a paragraph ends.  I will assume that a carriage return marks the end of a paragraph.

I added the lines below to a TMemo names mmoSrc, and 2 buttons 'Find  Frank' and 'Find Bob', the results are placed into a TMemo named mmoDest.
------------
Paragraph 1 contains the names Bob and Frank as well as other text and other
textand other textand other textand other textand other textand other textand other
text.

Paragraph 2 contains the name Bob as well as other text and other textand other
textand other textand other textand other textand other textand other text.

Paragraph 3 contains the name Frank as well as other text and other textand other
textand other textand other textand other textand other textand other text.
-----------

heres a link to a zip file containing my test project
www.certss.com\Downloads\ExpertExchange\FindParagraphsInMemo.zip

heres the source.  In order to find whole words 'bob' and not 'bobby' i pad the word with spaces as well as the paragraph.  The issue here is that if the paragraph ends in the word Bob. or Bob! or Bob, then it will not find.  You can easily fix this.  I added the check for 'Bob.' add what you like.  this should give you an idea though.

---------------

procedure TForm1.BreakIntoParagraphs(s:String;sl:TStringlist);
var
    src     : String;
    tmp     : String;
    iPos    : Integer;
begin
     sl.Clear;

    src     := s;
    iPos    := Pos(#13#10#13#10,src);
    while iPos>0 do begin
        tmp := LeftStr(src,iPos+3);
        sl.Add(tmp);
        src := RightStr(src,length(src)-iPos-3);

        iPos    := Pos(#13#10#13#10,src);
    end;
    if length(src)>0 then
        sl.Add(src);
end;

procedure TForm1.GetParagraphsWithWord(sWord:String;s:String;sl:TStringlist);
var
    sPar    : String;
    ndx     : Integer;
begin
    BreakIntoParagraphs(s,sl);

    for ndx := sl.Count-1 downto 0 do begin
        sPar := ' '+sl[ndx]+' ';
        if not (AnsiContainsText(sPar,' '+sWord+' ') or AnsiContainsText(sPar,' '+sWord+'.')) then
            sl.Delete(ndx)
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    sl : TStringlist;
begin
    sl := TStringlist.Create;
    try
       GetParagraphsWithWord('Bob',mmoSrc.Text,sl);
       mmoDest.Lines.Assign(sl);
    finally
        sl.Free;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
    sl : TStringlist;
begin
    sl := TStringlist.Create;
    try
       GetParagraphsWithWord('Frank',mmoSrc.Text,sl);
       mmoDest.Lines.Assign(sl);
    finally
        sl.Free;
    end;
end;


-----------------------------

Someone thats good with RegEx could probably do this with much less code, but I like to do things the old fashion way!  :)


0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now