[lkz_07]

Прошу помощи:
Как из строки типа:
[A-C][EF][K-PSZ]
получить список "слов":
AEK
AEL
AEM
AEO
AEP
AES
AEZ
AFK
AFL
AFM
AFO
AFP
AFS
AFZ
BEK
BEL
BEM
и так далее?


Я создал массив и заполнил его алфавитом:

Код:

1 2 3 4

i := 0; for c := 'A' to 'Z' do begin i := i+1; spAlfawEN[i] := c;     end;

Потом делал циклами с поиском, в итоге получалась пирамида циклов... , в общем так программа не работает!!!

[Alegun]

А так не проще?

Код:

1 2 3 4 5 6 7 8 9 10 11

const  s1 = 'ABC'; s2 = 'EF'; s3 = 'KLMNOPSZ'; procedure TForm1.Button1Click(Sender: TObject); var  i1, i2, i3: integer; begin  for i1:= 1 to Length(s1) do   for i2:= 1 to Length(s2) do    for i3:= 1 to Length(s3) do     Memo1.Lines.Add(s1[i1] + s2[i2] + s3[i3]); end;

[lmikle]

Код:

1 2 3

str := StringReplace(str,'[','',[rfReplaceAll]); str := StringReplace(str,']',#13#10,[rfReplaceAll]); memo1.lines.text := str;

Не эффективно, зато просто.

[Страдалецъ]

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

Код:

Не эффективно, зато просто.

Это явно не то, что хотел автор. Alegun дал вполне жизнеспособное решение.

[lmikle]

Сообщение от Страдалецъ

Это явно не то, что хотел автор. Alegun дал вполне жизнеспособное решение.

Да, сам дурак, не внимательно прочитал задачу.

Единственное, тут есть маленькая проблемка. Алеган дал решение для конкретной строки. Вопрос - как сделать для любой подобной строки. Надо более точно знать задание. Например, допустимы ли только заглавные латинские буквы или могут быть строчные русские буквы, например, или цифры.

[lkz_07]

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

Алеган дал решение для конкретной строки. Вопрос - как сделать для любой подобной строки. Надо более точно знать задание. Например, допустимы ли только заглавные латинские буквы или могут быть строчные русские буквы, например, или цифры.

Это да - для конкретного кол-ва скобок. Их может быть неопределнное кол-во: 2 или 4 или 6 и т.д. Я взял для примера - 3.
Пока только для прописных (заглавных) букв, один язык английский.
А строчные потом можно сделать из созданного списка: типа со 2-ого буквы и до конца слова переводить в нижний регистр.
Главное как создать список?

Alegun может и правильно подсказал начало:

Код:

1	s1 = 'ABC'; s2 = 'EF'; s3 = 'KLMNOPSZ';

допустим переведем скобку с тире с набором букв, а потом?
Если будет 4 скобки или больше - как сделать конкретное кол-во циклов для введенной строки?

[Alegun]

Для данной конкретной строки получился вот такой бред - компиляция из всего вышеприведённого кода

Код:

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

procedure TForm1.Button1Click(Sender: TObject);  function wr(c1,c2: char): string;  var   c: char;  begin   Result:='';   for c := 'A' to 'Z' do    begin     if c = c1 then Result:= c1 else      if Length(Result) > 0 then Result:= Result + c;    if c = c2 then exit;   end;  end;   var  c:  char;  s:  string;  sl: TStrings;  i,j,i1,i2,i3: integer;   begin  s:= Edit1.Text; // '[A-C][EF][K-PSZ]';    s:= StringReplace(s,'[','',[rfReplaceAll]);  s:= StringReplace(s,']',#13#10,[rfReplaceAll]);    sl:= TStringList.Create;  sl.Text:= s;    for i := 0 to sl.Count -1 do   if Pos('-', sl[i]) > 0 then    begin     s:= '';     j:= 1;     while j < Length(sl[i]) do      begin       s:=s+sl[i][j];       if (j+1 < Length(sl[i])) and (sl[i][j+1] = '-') then        begin         Delete(s,Length(s),1);         s:= s + wr(sl[i][j], sl[i][j+2]);         inc(j,2);        end;     inc(j);    end;   s:=s+sl[i][j];   sl[i]:=s;  end;    Memo1.Clear;    for i1:= 1 to Length(sl[0]) do   for i2:= 1 to Length(sl[1]) do    for i3:= 1 to Length(sl[2]) do     Memo1.Lines.Add(sl[0][i1] + sl[1][i2] + sl[2][i3]);    sl.Free; end;

<DELETED>

[Страдалецъ]

Забавная задачка. Так устроит?

Код:

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

procedure TForm28.Button1Click(Sender: TObject); var   i,j: Integer;   CharSet: String;   SL: TStringList;   procedure Eval(S: String; Level: Integer); var   i: Integer; begin  if Level > SL.Count - 1 then Exit;  for i := 1 to Length(SL.Strings[Level])  do begin     Eval(S + SL.Strings[Level][i], Level+1);     if Level = SL.Count - 1     then Memo1.Lines.Add(S + SL.Strings[Level][i]);     end; end;   begin  Memo1.Clear;  SL := TStringList.Create;  SL.Delimiter := '['; SL.DelimitedText := Edit1.Text;  SL.Delimiter := ']'; SL.DelimitedText := SL.Text;  for j := 0 to SL.Count - 1  do begin     i := 1;     CharSet := '';     while i <= Length(SL.Strings[j])     do begin        if SL.Strings[j][i] in ['A'..'Z']        then CharSet := CharSet + SL.Strings[j][i]        else begin             Inc(i);             while SL.Strings[j][i] <> CharSet[Length(CharSet)]             do CharSet := CharSet + Succ(CharSet[Length(CharSet)]);             end;        Inc(i);        end;     SL.Strings[j] := CharSet;     end;  Eval('', 0); end;

[Alegun]

Да уж, многоувж. товарищ Страдалецъ - браво!
Двое суток въезжал в твой пример: торжество рекурсии и разработчиков класса TStringList, мне пока, вот так сходу, такое не доступно, спсб за науку

[lkz_07]

Сообщение от Страдалецъ

Забавная задачка. Так устроит?

Код:

Огромное Вам СПАСИБО. Буду тестировать и дорабатывать под свою задачу.