Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > как сравнить две строки

Автор: BSOD 10.1.2005, 20:52

У меня есть две строки например:

У меня сгорел проц
и
Я купил новый проц

Можно ли сравнить эти две строки на предмет обнаружения одинаковых слов (здесь Проц, но могут быть любые), а потом в зависимости от результата что-нибудь сделать?

Автор: Satana 10.1.2005, 22:34

maximum ну можно только тебе нада будет писать парсер который будет выделять отдельные слова в одной строке и сравнивать pos'ом в другой

Автор: BSOD 10.1.2005, 22:38

Satana
1. Как его написать?
2. А если строки разной длины?
3. А нельзя как в PHP: загнать строки в массив (по пробелам) и сравнить массивы (если можно, то как?)?

Автор: dvs 10.1.2005, 22:41

Не ленись и пиши алгоритм, вреда не будет. Зато, если что-то не так, как надо - значит сам такой, а не дядя Borland виноват. smile

Автор: tcomponent 11.1.2005, 10:15

вот пример простого сравнения слов если не заработаеь то спрашивайте

описание
юнит с формой на ней батон и два едита
по нажатию на клавишу текст каждого
едита разделяется на слова и сравнивается "пословно"

если слово не совпадает то выводится сообщение с номером несовпадающего слова

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
words0,words1:array [0..50]of string;
wcounter,wposition,pposition:integer;
wcounter1,wposition1,pposition1:integer;
wpcount,wp:integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if edit1.text<>'' then
wcounter:=1;
if edit2.text<>''then
wcounter1:=1;

for pposition:=0 to Length(edit1.text) do begin

if (copy(edit1.text,pposition,1)<>' ')and(copy(edit1.text,pposition,1)<>'.')
and(copy(edit1.text,pposition,1)<>',')
and(copy(edit1.text,pposition,1)<>'!')and(copy(edit1.text,pposition,1)<>'?')then
words0[wcounter]:=words0[wcounter]+uppercase(copy(edit1.text,pposition,1));

if copy(edit1.text,pposition,1)=' ' then begin
wcounter:=wcounter+1;
end;

end;

for pposition1:=0 to Length(edit2.text) do begin

if (copy(edit2.text,pposition1,1)<>' ')and(copy(edit2.text,pposition1,1)<>'.')
and(copy(edit2.text,pposition1,1)<>',')
and(copy(edit2.text,pposition1,1)<>'!')and(copy(edit2.text,pposition1,1)<>'?')then
words1[wcounter1]:=words1[wcounter1]+uppercase(copy(edit2.text,pposition1,1));

if copy(edit2.text,pposition1,1)=' ' then begin
wcounter1:=wcounter1+1;
end;

end;

for wpcount:=0 to wcounter do
if words0[wpcount]<>words1[wpcount]then
showmessage('Различие в словах номер '+inttostr(wpcount));

end;

end.

Автор: <Spawn> 11.1.2005, 12:06

Набросал несложную функцию, с которой, я думаю, ты сможешь узнать о найденных словах все, что нужно:

Код


uses ..., Math;

type

  TCompareInfo = record
    StartPos, EndPos: integer;
    Value: string;
  end;

  TCompareInfoArr = array of TCompareInfo;

function CompareStrings(const Value1, Value2: string): TCompareInfo;

  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
  with Result do
  begin
    Value := '';
    StartPos := -1;
    EndPos := -1;
  end;
  //Результатом работы функции является информация о первом найденном слове.
  //тут можешь менять что хочешь так как тебе нужно(под твои условия)
  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
        Result := CompArr1[Counter1];
        Exit;
      end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  Info: TCompareInfo;
begin
  Info := CompareStrings('У меня сгорел проц', 'Я купил новый проц');
  ShowMessage(Format('Value - %s, StartPos - %d, EndPos - %d',
    [Info.Value, Info.StartPos, Info.EndPos]));
end;

Автор: BSOD 11.1.2005, 15:45

Всем спасибо, будем пробовать... smile