Delphi - string manipulation

procedure fillstringlist;
var memoline: TStringList; fulltext, wrd: String;
begin
memoline:=TStringList.Create;
while AnsiPos(' ',fulltext)>0 do begin
///while there are spaces continue
wrd:=copy(fulltext,1,Ansipos(' ',fulltext)-1);
///get first word 
memoline.Add(Wrd);
///add it to the TString list
fulltext:=Copy(fulltext,AnsiPos(' ',fulltext)+1,Length(fulltext)-Length(Wrd)+1); 
//take the first word out of the main text
 end;
 if Length(fulltext)>0 then memoline.Add(fulltext);
///check to see nothing is left
end;
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

function FindPhrasePlusTwoWords(aText, aPhrase: string; FoundStart, FoundEnd: integer; StartAt: integer = 1): Boolean;
var p, n: integer;
begin
  Result := False;
  p := PosEx(aPhrase, aText, StartAt);
  if p > 0 then  
  begin
    FoundStart := p;
    n := PosEx(' ', aText, p + Length(aPhrase));
    if n > 0 then 
      begin
        FoundEnd := Pos(' ', aText, n+1); 
        Result := True;
      end;
    else
     FoundEnd := p + Length(aPhrase);
  end;
end; 
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

Procedure Deletion;
var  fullstring, wrd: String; ILine: Integer; memoline: TStringList;
begin
for iLine := Form1.Memo1.Lines.Count-1 downto 0 do begin
   fullstring:=TrimLeft(Form1.Memo1.Lines[iLine]);
  if AnsiContainsStr(fullstring,'passed by') then begin
   memoline:=TStringList.Create;
    while (Pos(' ',fullstring)>0) do begin
   wrd:=copy(fullstring,1,Pos(' ',fullstring)-1);
   Memoline.Add(Wrd);
   fullstring:=Copy(fullstring,Pos(' ',fullstring)+1,Length(fullstring)-Length(Wrd)+1);
end;

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

function PhraseStart(aPhrase, aHaystack: string; aStartAt: Integer = 1): integer;
begin
  Result := PosEx(UpperCase(aPhrase), UpperCase(aHaystack), aStartAt);
end;
 
function PhraseEnd(aPhrase: string; aStartAt: Integer = 1): integer;
begin
  if aStartAt < 1 then
    aStartAt := 1;
  Result := aStartAt + Length(aPhrase) -1;
end;
 
function NextWordEnd(aText: string; aStartAt: integer = 1): integer;
var n, l: Integer;
  IsLetter: Boolean;
begin
  Result := 0;
  if aStartAt < 1 then
    aStartAt := 1;
  n := 0;
  l := Length(aText);
  repeat
    IsLetter := False;
    if n + aStartAt < l then
    begin
      if Pos(aText[n + aStartAt], WordLetters) > 0 then
        IsLetter := True;
    end;
    if IsLetter then
      n := n + 1;
  until not IsLetter;
end;
 
function NextWordBegin(aText: string; aStartAt: integer = 1): integer;
var n, l: Integer;
  IsLetter, EndOfLine: Boolean;
begin
  Result := 0;
  if aStartAt < 1 then
    aStartAt := 1;
  n := 0;
  l := Length(aText);
  EndOfLine := False;
  repeat
    IsLetter := False;
    if n + aStartAt < l then
    begin
      if Pos(aText[n + aStartAt], WordLetters) > 0 then
        IsLetter := True;
    end else EndOfLine := True;
    if not IsLetter then
      n := n + 1;
  until IsLetter or EndOfLine;
end;

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    btnSearch: TButton;
    memLines: TMemo;
    edSearch: TEdit;
    memTests: TMemo;
    edStartAt: TEdit;
    procedure btnSearchClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses StrUtils;
 
{$R *.dfm}
 
const WordLetters = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZéèçàùâêûîôäëüïöÿáúíóàèùìò';
 
function PhraseStart(aPhrase, aHaystack: string; aStartAt: Integer = 1): integer;
begin
  Result := PosEx(aPhrase, aHaystack, aStartAt);
end;
 
function PhraseEnd(aPhrase: string; aStartAt: Integer = 1): integer;
begin
  if aStartAt < 1 then
    aStartAt := 1;
  Result := aStartAt + Length(aPhrase) -1;
end;
 
function NextWordEnd(aText: string; aStartAt: integer = 1): integer;
var n, l: Integer;
  IsLetter: Boolean;
begin
  Result := 0;
  if aStartAt < 1 then
    aStartAt := 1;
  n := 0;
  l := Length(aText);
  repeat
    IsLetter := False;
    if n + aStartAt < l then
    begin
      if Pos(aText[n + aStartAt], WordLetters) > 0 then
        IsLetter := True;
    end;
    if IsLetter then
      n := n + 1;
  until not IsLetter;
  if n > 0 then
    Result := aStartAt + n;
end;
 
function NextWordBegin(aText: string; aStartAt: integer = 1): integer;
var n, l: Integer;
  IsLetter, EndOfLine: Boolean;
begin
  Result := 0;
  if aStartAt < 1 then
    aStartAt := 1;
  n := 0;
  l := Length(aText);
  EndOfLine := False;
  repeat
    IsLetter := False;
    if n + aStartAt < l then
    begin
      if Pos(aText[n + aStartAt], WordLetters) > 0 then
        IsLetter := True;
    end else EndOfLine := True;
    if not IsLetter then
      n := n + 1;
  until IsLetter or EndOfLine;
  if EndOfLine then
    Result := -1
  else if n > 0 then
    Result := aStartAt + n;
end;
 
procedure TForm1.btnSearchClick(Sender: TObject);
var searchText, memText, origText: string;
  sa: integer; // start at
  ps: integer; // start of phrase
  pe: integer; // end of phrase (last letter pos)
  wb, wb2: integer; // beginning of first and second word
  we, we2: integer; // end of first and second word
begin
  searchText := UpperCase(Trim(edSearch.Text)); // Make all uppercase (has no bearings on positions)
  origText := memLines.Lines.Text;
  memText := UpperCase(origText);
  sa := StrToInt(edStartAt.Text);
  if searchText <> '' then
  begin
    ps := PhraseStart(searchText, memText, sa);
    pe := PhraseEnd(searchText, ps);
    // now we need to find the beginning of the next word
    // it's possibly on the next line
    wb := NextWordBegin(memText, pe+1);
    // if we found a word, let's continue
    if wb > 0 then
    begin
      we := NextWordEnd(memText, wb);
      if we > 0 then
      begin
        wb2 := NextWordBegin(memText, we);
        if wb2 > 0 then
        begin
          we2 := NextWordEnd(memText, wb2);
          if we2 > 0 then
          begin
            // now we have all needed positions ...
            // Extract all items to other memo and delete in original memo
 
            memTests.Lines.Add('phrase: "' + Copy(origText, ps, pe-ps+1) + '"');
            memTests.Lines.Add('word 1 after phrase : "' + Copy(origText, wb, we-wb) + '"');
            memTests.Lines.Add('word 2 after phrase : "' + Copy(origText, wb2, we2-wb2) + '"');
            memTests.Lines.Add('phrase + 2 words : "' + Copy(origText, ps, we2-ps) + '"');
            memTests.Lines.Add('------ modified text below ------');
            Delete(origText, ps, we2-ps);
            memTests.Lines.Add(origText);
            memTests.Lines.Add('------ modified text above ------');
            edStartAt.Text := IntToStr(we2);
 
            // you would only need the following code
            // Delete(origText, ps, we2-ps);
            // memTests.Lines.Add(origText);
          end;
        end;
      end;
    end;
  end else
    ShowMessage('Look for an empty string in the wardrobe ... !');
end;
 
end.
 
 
-- dfm --
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 673
  ClientWidth = 726
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btnSearch: TButton
    Left = 24
    Top = 28
    Width = 75
    Height = 25
    Caption = 'btnSearch'
    TabOrder = 0
    OnClick = btnSearchClick
  end
  object memLines: TMemo
    Left = 112
    Top = 58
    Width = 585
    Height = 137
    Lines.Strings = (
      
        'Using TMemo I need to look for a phrase and delete the phrase pl' +
        'us two words after the phrase.'
      ''
      'So for instance if the phrase is The quick brown fox, the string'
      
        '"The quick brown fox jumps over the lazy dog"  becomes "the lazy' +
        ' dog"')
    TabOrder = 1
  end
  object edSearch: TEdit
    Left = 112
    Top = 32
    Width = 241
    Height = 21
    TabOrder = 2
    Text = 'The quick brown fox'
  end
  object memTests: TMemo
    Left = 112
    Top = 201
    Width = 585
    Height = 456
    TabOrder = 3
  end
  object edStartAt: TEdit
    Left = 576
    Top = 31
    Width = 121
    Height = 21
    Alignment = taRightJustify
    NumbersOnly = True
    TabOrder = 4
    Text = '1'
  end
end

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:

Procedure DeletePhrasePlusTwo;
var  oldtext, wrd, newtext: String; ILine, i, phraseposition: Integer; memoline: TStringList;
begin
for iLine := Form1.Memo1.Lines.Count-1 downto 0 do begin
   oldtext:=TrimLeft(Form1.Memo1.Lines[iLine]);
   ///look for phrase//
  if AnsiContainsStr(oldtext,'passed by') then begin  
   memoline:=TStringList.Create;
   ///if found, parse text to Stringlist
    while (Pos(' ',oldtext)>0) do begin     
   wrd:=copy(oldtext,1,Pos(' ',oldtext)-1);
   Memoline.Add(Wrd);
   oldtext:=Copy(oldtext,Pos(' ',oldtext)+1,Length(oldtext)-Length(Wrd)+1);
end;
 
   if Length(oldtext)>0 then memoline.Add(oldtext); //check text is //finished
 
  phraseposition:=Memoline.IndexOf('passed');   ///get position of //'passed'
  if Memoline[phraseposition+1]='by' then begin  ///check that ///'passed' is followed by 'by'
 
 for i:=  0 to 3 do
   Memoline.Delete(phraseposition);  ////delete 'passed', 'by' and two //words that follow
 
 for I := 0 to Memoline.Count - 1 do  ///get list back to string 
  newtext := newtext +' '+ memoline[i]; 
 
   memoline.Free;
 
  end;
 end;
  end;
end;
 
 
end.

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:

Procedure DeletePhrasePlusTwo;
var  oldtext, wrd, newtext: String; ILine, i, phraseposition: Integer; memoline: TStringList;
begin
  // indent = 1
  for iLine := Form1.Memo1.Lines.Count-1 downto 0 do
  begin
    // indent = 2
    oldtext:=TrimLeft(Form1.Memo1.Lines[iLine]);
    ///look for phrase//
    if AnsiContainsStr(oldtext,'passed by') then
    begin
      // indent = 3
      memoline:=TStringList.Create;
      ///if found, parse text to Stringlist
      while (Pos(' ',oldtext)>0) do
      begin
        wrd:=copy(oldtext,1,Pos(' ',oldtext)-1);
        Memoline.Add(Wrd);
        oldtext:=Copy(oldtext,Pos(' ',oldtext)+1,Length(oldtext)-Length(Wrd)+1);
      end;
 
      if Length(oldtext)>0 then
        memoline.Add(oldtext); //check text is //finished
 
      phraseposition:=Memoline.IndexOf('passed');   ///get position of //'passed'
 
      if Memoline[phraseposition+1]='by' then
      begin  ///check that ///'passed' is followed by 'by'
        // indent = 4
        for i:=  0 to 3 do
          Memoline.Delete(phraseposition);  ////delete 'passed', 'by' and two //words that follow
 
        for I := 0 to Memoline.Count - 1 do  ///get list back to string
          newtext := newtext +' '+ memoline[i];
 
        memoline.Free;
      end;
    end;
  end;
end;

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41: