Поиск и подсчет слов в memo

[Mik92]

Здравствуйте, пытаюсь организовать поиск слов в memo но что то неудачно.

for i:= 0 to Length(Memo1.Text) do begin
    if (Memo1.Text[i]= 'ct') then inc(ctn);
  end;

Такой вариант вообще не ищет, стоит только чуть изменить сравниваемую строку допустим на 'c' то есть оставить только один символ, тогда работает. Функция Pos вытваряет тоже самое -ищет только одну букву а целые слова нет. Почему оно не ищет полные слова?

[vlad1389]

ShowMessage(IntToStr(Length(Memo1.Text[1])));
ShowMessage(IntToStr(Length('ct')));

[zdus2757]

Сообщение от Mik92

Здравствуйте, пытаюсь организовать поиск слов в memo но что то неудачно.

for i:= 0 to Length(Memo1.Text) do begin
    if (Memo1.Text[i]= 'ct') then inc(ctn);
  end;

Такой вариант вообще не ищет, стоит только чуть изменить сравниваемую строку допустим на 'c' то есть оставить только один символ, тогда работает. Функция Pos вытваряет тоже самое -ищет только одну букву а целые слова нет. Почему оно не ищет полные слова?

судя по твоему коду ты "пытаешься" найти в Memo1 строку 'ct'

или мб ты хочешь вот это?

var I,N:integer;
begin
N:=0;
For I:=0 to Memo1.Lines.Count do
Begin
if Pos('ct',Memo1.Lines[I])>0 then
Begin N:=N+1;
Label1.Caption:='Количество строк со словом "ct" =' + IntToStr(N); End;
End;
end;

[Filka]

uses
  StrUtils;

function WordCount(AStrings: TStrings; const AWord: string): Integer;
var
  I, J: Integer;
begin
  Result := 0;
  for I := 0 to AStrings.Count - 1 do
  begin
    J := PosEx(AWord, AStrings[I]);
    while J > 0 do
    begin
      Inc(Result);
      J := PosEx(AWord, AStrings[I], J + Length(AWord));
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(WordCount(Memo1.Lines, Edit1.Text)));
end;

Или:

uses
  StrUtils;

function WordCount(const S, AWord: string): Integer; overload;
var
  I: Integer;
begin
  Result := 0;
  I := PosEx(AWord, S);
  while I > 0 do
  begin
    Inc(Result);
    I := PosEx(AWord, S, I + Length(AWord));
  end;
end;

function WordCount(AStrings: TStrings; const AWord: string): Integer; overload;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to AStrings.Count - 1 do
    Inc(Result, WordCount(AStrings[I], AWord));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(WordCount(Edit2.Text, Edit1.Text)));
  ShowMessage(IntToStr(WordCount(Memo1.Lines, Edit1.Text)));
end;

[Вадим Мошев]

Основная ошибка:

if (Memo1.Text[i]= 'ct') then inc(ctn);

При обращении к конкретному символу строки (Memo1.Text[i]) будет возвращаться символ, но не строка. ct является строкой, причём с двумя символами. В этом случае у вас равенство никогда не выполнится. Если вы хотите посчитать количество слов ct в memo, то делайте так:

if memo1.text[length(memo1.text)] <> ' ' then begin // если последний символ не пробел
	wordsAmount:=1;
end else begin
	wordsAmount:=0;
end;

for i:=1 to length(memo1.text)-2 do begin
	if (memo1.text[i] = 'c') AND
		 (memo1.text[i+1] = 't') and
		 (memo1.text[i+2] = ' ')  then begin
		    inc(wordsAmount);
	end;
end;

// wordsAmount - искомая величина

[Аватар]

пытаюсь организовать поиск слов в memo

Все выше приведенные примеры это не поиск слов, а поиск вхождений подстроки. Поиск слов это еще анализ разделителей

[Вадим Мошев]

Переписал свой код выше

[Filka]

function WordCount(const S, AWord: string; const Delims: TSysCharSet;
  IgnoreCase: Boolean): Integer; overload;
var
  I, L, Pos1, Pos2: Integer;

  function CmpStr(P1, P2: PChar; Len: Integer; IgnoreCase: Boolean): Boolean;
  var
    I: Integer;
    IsNotEqual: Boolean;
  begin
    Result := False;
    for I := 0 to Len - 1 do
    begin
      case IgnoreCase of
        True:  IsNotEqual := AnsiUpperCase(P1[I]) <> AnsiUpperCase(P2[I]);
        False: IsNotEqual := P1[I] <> P2[I];
      end;
      if IsNotEqual then
        Exit;
    end;
    Result := True;
  end;

begin
  Result := 0;
  Pos1 := 0;
  I := 1;
  L := Length(S);
  while I <= L do
  begin
    while (I <= L) and (S[I] in Delims) do
      Inc(I);

    if I <= L then
      Pos1 := I;

    while (I <= L) and not (S[I] in Delims) do
      Inc(I);
      
    Pos2 := I;
    
    if (Pos2 - Pos1) = Length(AWord) then
      Inc(Result, Integer(CmpStr(@S[Pos1], PChar(AWord), Length(AWord), IgnoreCase)));
  end;
end;

function WordCount(AStrings: TStrings; const AWord: string; const Delims: TSysCharSet;
  IgnoreCase: Boolean): Integer; overload;
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to AStrings.Count - 1 do
    Inc(Result, WordCount(AStrings[I], AWord, Delims, IgnoreCase));
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  Delims: TSysCharSet = [#32, #13, #10, #9];
begin
  ShowMessage(IntToStr(WordCount(Edit2.Text, Edit1.Text, Delims, CheckBox1.Checked)));
  ShowMessage(IntToStr(WordCount(Memo1.Lines, Edit1.Text, Delims, CheckBox1.Checked)));
end;

[Arigato]

Вариант решения с учетом разных разделителей между словами:

uses
  StrUtils;

function CountWords(substr,str: string): Integer;
const
  Delims: set of Char=[#10,#13,' ',',','.']; // разделители
var
  p: Integer;
begin
  Result:=0;
  str:=' '+str+' ';
  substr:=trim(substr);
  p:=1;
  repeat
    p:=PosEx(substr,str,p);
    if (p>0) and (str[p-1] in Delims) and (str[p+Length(substr)] in Delims)
      then Inc(Result);
    Inc(p);
  until p=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(CountWords('ct',Memo1.Text)));
end;