Приветик всем как мне сравнить например два предложения в мемо и вывести результат схожести(тоесть одинаковые сорва в Лабел)!!!!!!!!

Просто!

Код

var s1,s2,s:string; i:integer; begin s1:=Memo1.Lines.Text; s2:=Memo1.Lines.Text; Label1.Caption:=''; while s1 <> '' do  begin   while (s1[1] = ' ') and (s1 <> '') do    Delete(s1, 1, 1);   if s1 <> '' then begin   i:=Pos(' ', s1);   s:=' ' + Copy(s1, 1, i);   Delete(s1, 1, i);   if Pos(s, s2) <> 0    then     Label1.Caption:=Label1.Caption + s;   end;  end; end;

Что-то в этом духе...

Цитата(Pakshin @ 12.1.2005, 13:23)

Просто! Код var s1,s2,s:string; i:integer; begin s1:=Memo1.Lines.Text; s2:=Memo1.Lines.Text; Label1.Caption:=''; while s1 <> '' do  begin   while (s1[1] = ' ') and (s1 <> '') do    Delete(s1, 1, 1);   if s1 <> '' then begin   i:=Pos(' ', s1);   s:=' ' + Copy(s1, 1, i);   Delete(s1, 1, i);   if Pos(s, s2) <> 0    then     Label1.Caption:=Label1.Caption + s;   end;  end; end; Что-то в этом духе...

Заранее спасибо за код еще не пробывал!!!!!!!!

Можно просматривать темы хотябы в пределах одной страницы? Соседний топик

Цитата(Pakshin @ 12.1.2005, 13:23)

Просто! Код var s1,s2,s:string; i:integer; begin s1:=Memo1.Lines.Text; s2:=Memo1.Lines.Text; Label1.Caption:=''; while s1 <> '' do  begin   while (s1[1] = ' ') and (s1 <> '') do    Delete(s1, 1, 1);   if s1 <> '' then begin   i:=Pos(' ', s1);   s:=' ' + Copy(s1, 1, i);   Delete(s1, 1, i);   if Pos(s, s2) <> 0    then     Label1.Caption:=Label1.Caption + s;   end;  end; end; Что-то в этом духе...

После того когда я ввожу текст в мемо и сравниваю его программа зависает!!

Цитата(Alex103 @ 14.1.2005, 06:54)

После того когда я ввожу текст в мемо и сравниваю его программа зависает!!

А это потому что там написана полная чушь... i по умолчанию как есть ноль так и остаётся. Строки s1, s2 копируются обсалётно одинаковыми. Карочи ничего логичного, Pakshin A. S. я же говорил тебе, ты проверяй код прежде чем выслать. Такой чуши я ещё не видел.
Ладно, вот др. вариант

Код

procedure TForm1.Button1Click(Sender: TObject); var  s1,s2:string;  i:integer; begin  s1:=memo1.Lines.Strings[0];  s2:=memo1.Lines.Strings[1];  if length(s1)<>length(s2) then    begin      showmessage('кол-во символов в строках не совпадает!');      exit    end;  label1.Caption:='';  for i:=1 to length(s1) do    if s1[i]=s2[i] then label1.Caption:=label1.Caption+s1[i]; end;

Кол-во символов должно быть равно в обеих строках.

Zero а кто сказал, что одна строка Мемо это одно предложение? и читай вопрос

Цитата(Alex103 @ 12.1.2005, 07:36)

тоесть одинаковые сорва

. Предлагаю копировать строки из Мемо до точки ( это и будет слово ) в s1, s2, s3, s4, s5, а потом проверять схожесть этих слов путем сравнения. Или запихивать в массивы ( 1 и 2 строка), где элементы есть слова.

Ну что за люди пошли.... трудно даже по данной ссылке перейти и разобрать данный там мною пример. Вот держи примерчик(Брось на форму 2 TMemo, TListBox и TButton, ну и настрой клик по Button1):

Код

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, Math, StdCtrls; type  TForm1 = class(TForm)    Memo1: TMemo;    Memo2: TMemo;    ListBox1: TListBox;    Button1: TButton;    procedure Button1Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end;  TCompareInfo = record    StartPos, EndPos: integer;    Value: string;  end;  TCompareInfoArr = array of TCompareInfo; var  Form1: TForm1; implementation {$R *.dfm} function CompareStrings(const Value1, Value2: string): TCompareInfoArr; function Explode(const Value: string; const Delimiter: Char): TCompareInfoArr;   procedure TryAddString(var CompareInfoArr: TCompareInfoArr; const AddValue: string;     const CopyStartPos, Count: integer);   var     NewString: string;   begin     NewString := Trim(Copy(AddValue, CopyStartPos, Count));     if Length(NewString) > 0 then     begin       SetLength(CompareInfoArr, Length(CompareInfoArr) + 1);       with CompareInfoArr[High(CompareInfoArr)] do       begin         Value := NewString;         StartPos := CopyStartPos;         EndPos := CopyStartPos + Count;       end;     end;   end; var   CharPos, ValueLen,   StartPos, EndPos: integer; begin   SetLength(Result, 0);   CharPos := 1;   StartPos := 1;   EndPos := 1;   ValueLen := Length(Value);   while CharPos <= ValueLen do   begin     if Value[CharPos] = ' ' then     begin       StartPos := CharPos;       TryAddString(Result, Value, EndPos, StartPos - EndPos);       Inc(CharPos);       while (CharPos <= ValueLen) and         (Value[CharPos] = ' ') do         Inc(CharPos);       EndPos := CharPos;     end;     Inc(CharPos);   end;   if CharPos > EndPos then     TryAddString(Result, Value, EndPos, CharPos - EndPos + 1); end; var CompArr1, CompArr2: TCompareInfoArr; Counter1, Counter2: integer; begin SetLength(Result, 0); //Ðåçóëüòàòîì ðàáîòû ôóíêöèè ÿâëÿåòñÿ èíôîðìàöèÿ î ïåðâîì íàéäåííîì ñëîâå. //òóò ìîæåøü ìåíÿòü ÷òî õî÷åøü òàê êàê òåáå íóæíî(ïîä òâîè óñëîâèÿ) CompArr1 := Explode(Value1, ' '); CompArr2 := Explode(Value2, ' '); for Counter1 := 0 to High(CompArr1) do   for Counter2 := 0 to High(CompArr2) do     if AnsiCompareText(CompArr1[Counter1].Value, CompArr2[Counter2].Value) = 0 then     begin       SetLength(Result, Length(Result) + 1);       Result[High(Result)] := CompArr1[Counter1];     end; end; procedure TForm1.Button1Click(Sender: TObject); var  EqualWords: TCompareInfoArr;  i: integer; begin  ListBox1.Items.Clear;  EqualWords := CompareStrings(Memo1.Text, Memo2.Text);  for i := 0 to High(EqualWords) do    ListBox1.Items.Add(Format('%s [Позиция в Memo1: %d]', [EqualWords[i].Value, EqualWords[i].StartPos])); end; end.

Цитата(Zero @ 14.1.2005, 11:15)

Цитата(Alex103 @ 14.1.2005, 06:54) После того когда я ввожу текст в мемо и сравниваю его программа зависает!! А это потому что там написана полная чушь... i по умолчанию как есть ноль так и остаётся. Строки s1, s2 копируются обсалётно одинаковыми. Карочи ничего логичного, Pakshin A. S. я же говорил тебе, ты проверяй код прежде чем выслать. Такой чуши я ещё не видел. Ладно, вот др. вариант Код procedure TForm1.Button1Click(Sender: TObject); var  s1,s2:string;  i:integer; begin  s1:=memo1.Lines.Strings[0];  s2:=memo1.Lines.Strings[1];  if length(s1)<>length(s2) then    begin      showmessage('кол-во символов в строках не совпадает!');      exit    end;  label1.Caption:='';  for i:=1 to length(s1) do    if s1[i]=s2[i] then label1.Caption:=label1.Caption+s1[i]; end; Кол-во символов должно быть равно в обеих строках.

Что то не то прога постоянно говорит что количество символов не совпадает

Цитата(Alex103 @ 15.1.2005, 07:30)

Что то не то прога постоянно говорит что количество символов не совпадает

Возможно ты их вводишь в разном кол-ве.
Ты должен сделать след.:
1. Кинуть на форму Memo
2. Кнопку на которую написать код, преведённый выше.

Вводить в перевой строке Memo, столькоже символов что и во 2-ой строке того же Memo.

P.S. но я действительно плохо прочитал задание, тут сравниваются символы, а не одинаковые слова. Для сравнения слов предлагаю алгаритм:
1. Записать все слова 1-ой строки в строковый массив.
2. Переписать в др. массив уникальные строки (т.е. не совподающие)
3. Тоже самое и для др. строки.
4. Каждый элемент 1-го массива сравнить с каждым элементом второго массива (общие переписать в 3-ий массив)
5. Вывести третий массив куда хочишь.

а заморочек то сколько!!!
1)копирование слов 1 предложения в массив_строк_1
2) -//- -//- 2 предложения в массив_строк2
3)прогонкой по элементам 2 массива находим одинаковые слова ( сравнение А[1] со всеми элементами B[i]).
4) результат пишем куда угодно: строка, массив...