[lkz_07]

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


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

Код:

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

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

[Alegun]

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

Код:

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]

Код:

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

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

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

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

Код:

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

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

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

[lmikle]

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

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

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

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

[lkz_07]

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

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

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

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

Код:

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

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

[Alegun]

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

Код:

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>

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

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

Код:

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]

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

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

Код:

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;

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