[Arlain]

Помогите пожалуйста, надо срочно сделать до конца выходных...
В программе, в мемо выводится текст вида:
МДОУ №1 МДОУ №11
МДОУ №1 МДОУ №12
МДОУ №1 МДОУ №14
МДОУ №10 МДОУ №54
МДОУ №11 МДОУ №1
МДОУ №11 МДОУ №12
МДОУ №11 МДОУ №14 и т.д.
мне надо чтоб небыло повторов одинаковых МДОУ
(например чтоб было так -
МДОУ №1 МДОУ №11 МДОУ №12 МДОУ №14
МДОУ №10 МДОУ №54
и т.д.)
я знаю что это надо делать через функции Pos, Copy и Delete, но у меня не получается... - вот мой код если это необходимо.

Код:

var n,ps,i,j:integer; s2,s1,s,cp1,cp2:string;
begin
n:=Memo2.Lines.Count;
For i:=0 to n-1 do begin
  s:=Memo2.Lines[i];
  cp1:=Copy(s,1,8); // копируем первые 8 символов
  s2:='';
  for j:=0 to n-1 do begin
    s1:=Memo2.Lines[j];
    cp2:=Copy(s1,1,8);
    if (cp2=cp1) and (j>i) then begin
    PS:=AnsiPos(cp1,s1);  //ищем совпадение в строке
    If (PS<>0) and (s1<>s) then begin Delete(s1,ps,8); s2:=s2+' '+s1; end;
    end;
    end;
  Memo2.Lines[i]:=s+' '+s2;
end;

n:=Memo2.Lines.Count; //пересчёт количества строк
for i:=0 to n-1 do begin
  s:=Memo2.Lines[i];
  cp1:=Copy(s,1,8);
  for j:=0 to n-1 do begin
    s1:=Memo2.Lines[j];
    cp2:=Copy(s1,1,8);
    PS:=AnsiPos(cp1,s1);
    if (j>i) and (cp1=cp2) then begin memo2.Lines.Delete(j); end;
  end;
end;

[cotseec]

лучше использовать Pos(), а не AnsiPos() (если в среде string==WideString, то все функции "переведены" на unicodn'ые)
еще можно посмотреть в сторону TStrings.Duplicates

[Arlain]

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

лучше использовать Pos(), а не AnsiPos() (если в среде string==WideString, то все функции "переведены" на unicodn'ые)
еще можно посмотреть в сторону TStrings.Duplicates

ну думаю от pos() вместо ansipos() мало что изменится, а на счёт TStrings.Duplicates я непонял как она мне поможет...

[cotseec]

Код:

procedure TForm2.Button1Click(Sender: TObject);
var
  tmpList:TStringList;
  i:integer;
begin
  tmpList:=TStringList.Create;
  tmpList.Delimiter:=' ';
  tmpList.Sorted:=true;
  tmpList.Duplicates:=dupIgnore;
  tmpList.DelimitedText:=Memo1.Lines.Text;

  Memo1.Clear;
  for i:=0 to tmpList.Count - 2 do
    Memo1.Lines.Add(tmpList[tmpList.Count-1]+tmpList.Delimiter+tmpList[i]);

  tmpList.Free;
end;

З.Ы. свойство Lines в TMemo также имеет тип TStrings

[Arlain]

Спасибо за разъяснение, но это не работает... мой вариант почти рабочий только вот незнаю как убрать повторяющиеся записи, в которых просто другой порядок учреждений( ну т.е. строка МДОУ1 МДОУ11 и строка МДОУ11 МДОУ1 идентичны одну из них надо убрать...)

[PS11011010]

Попробуй сделать цикл.

Код:

For i:=1 to 1000 do
begin
 s:='МДОУ №'+IntToStr(i);
 n:=pos(Memo1.Text);// кажется, так ко всему тексту обращаться.
 if n<>o then
  s:=copy(Memo1.Text, n, Length(s)); //копируем строку
 Memo2.Lines.Add(s);
end;

Код, конечно, надо оптимизировать, но вот так с ходу сообразить не могу.

[cotseec]

Код:

procedure TForm2.Button2Click(Sender: TObject);
var
  i,k:integer;
  tmp:string;
  BeginString,
  EndString:string;
  tmpListLines:TStringList;
begin
  tmpListLines:=TStringList.Create;
  tmpListLines.Delimiter:=' ';

  i:=0;
  while i<=Memo1.Lines.Count - 1 do
  begin
    tmp:=Memo1.Lines.Strings[i];
    k:=i+1;
    while k<=Memo1.Lines.Count - 1 do
    begin
      tmpListLines.Clear;
      tmpListLines.DelimitedText:=Memo1.Lines.Strings[k];

      BeginString:=tmpListLines.Strings[0]+tmpListLines.Delimiter+tmpListLines.Strings[1] ;
      EndString:=tmpListLines.Strings[2]+tmpListLines.Delimiter+tmpListLines.Strings[3];

      if (Pos(BeginString,tmp)>0) and
         (Pos(EndString,tmp)>0) then
         begin
          Memo1.Lines.Delete(i);
          break;
         end;
      inc(k);
    end;
    inc(i);
  end;

  tmpListLines.Free;
end;

Ограничение: строка обязательно должна быть вида ХХХХ ХХХХ ХХХХ ХХХХ, т.е. иметь минимум три пробела (чтобы заполнить четыре строки стринглиста)

[lmikle]

Вообще, в этом случае нужны регэкспы для разбиения строки.
Но можно и самому написать, хотя это будет слишком "прибито гвоздями".
Допустим, все записи в нашем случае имеют формат:

Код:

МДОУ №#(#)

Т.е. фиксированная строка "МДОУ №" и далее следует номер.

Тогда делаем так.
Берем строку и заменяем все "МДОУ №" на #13#10.
Результат записываем в TStringList.
Далее выкидываем все пустые строки.
Теперь проходимся по листу и выкидываем все повторы.
Ну и последний шаг - переносим все в Memo добавляя нужную нам строку.

Примерно будет выглядеть так:

Код:

var
  I,J : Integer;
  Buf : TStringList;
begin
  Buf := TSTringList.Create;
  Buf.Text := StringReplace(Memo1.Lines.Text,'МДОУ №',#13#10,[rfReplaceAll]);
  For I := Buf.Count-1 DownTo 0 Do
    If Trim(Buf[i]) = '' Then Buf.Delete(I) Else Buf[i] := Trim(Buf[i]);
  For I := Buf.Count-1 DownTo 1 Do
    Begin
      For J := I-1 DownTo  0 Do
        If Buf[i] = Buf[J] Then 
          Begin
            Buf.Delete(I);
            Break;
          End;
    End;

  For I := 0 To Buf.Count-1 Do
    Memo2.Lines.Add('МДОУ №' + Buf[i]);

  Buf.Free;
end;