Gerar combinações possiveis em lista

[luizf]

É o seguinte, para explicar, vamos supor que haja um memo.

Nesse memo, cada linha é um valor ordinal, ex:

1

2

3

...

...

...

N

Gostaria de gerar um lista com todos cominações possiveis, exemplo, se fosse somente 3 linhas no memo

1

12

123

13

132

2

21

213

23

231

3

31

312

32

321

Só que essas linhas do memo são variaveis, uma hora pode ter 3, depois 30, depois 100, não é fixo.

Estou quebrando a cabeça com o laço for, mas não tá dando certo.

[Jhonas]

Qual é a finalidade disso ... visto que cada numero adicionado a lista, fara crescer em progressão geométrica as combinações ??

[luizf]

O que pretendo fazer é o seguinte, tenho muitos arquivos grandes no HD, arquivos particulares, do serviço, e só vai acumulando...

Vou fazer bkp de quase tudo e limpar.

Comecei gravando em DVD, mas o problema é que sempre sobra um espaço bom no DVD, por exemplo, as vezes sobra 1GB vazio, e como estava testando tudo a mão até encontrar um arquivo que encaixe no espaço iria tomar muito tempo. Então resolvi fazer um programa para isso, mas no fim o programa tambem esta tomando um certo tempo, o bom é que depois de feito, posso usar de novo quando tiver outro acumulo.

Mas quando aos numeros (1,2,3,...), são index de banco de dados, o que fiz, fiz um pequeno banco de dados e o primeiro item, por exemplo, a primeira coluna de um DBGrid, chama-se index.

Por exemplo, no DBGrid:

Index | Nome | Tamanho (MB)

------------------------------------------

1 | Nononono | 2800

2 | Nononono | 2900

3 | Nononono | 2500

4 | Nononono | ......

5 | Nononono | ......

... | Nononono | ......

... | Nononono | ......

N | Nononono | ......

------------------------------------------

Então essa lista que falei no começo do tópico, são os index, gerando as combinações possiveis, vou com outro código, testar se o soma (Tamanho MB) dos index não ultrapassa o que um DVD suporta, se não estourar, pretendo jogar essa combinação em um banco de dados, junto com o resultado da soma, depois de pronto, ordenar o banco de dados, para mostrar os resultados em ordem decrescente, com relação ao Tamanho (MB). Então, é só ver quais arquivos que se refere a lista com os index e jogar nos DVDs.

Deu pra entender a finalidade, ou complique mais ainda.

[Jhonas]

Acho que voce esta complicndo muito, mas de qualquer forma veja este exemplo:

rotina para fazer combinações de numeros e jogar dentro de um Memo

procedure TForm1.Button1Click(Sender: TObject);
var
  i, y : Integer;
  vlrs : array [1..5] of Byte;
  S : string;
  vList : TStrings;
begin
  if Button1.Tag = 1 then
  begin
    Button1.Tag := 0;
    Exit;
  end;

  FillChar(vlrs, SizeOf(vlrs), 0); 
  vlrs[1] := 1; 
  y := 0;
  Memo1.Clear; 
  vList := TStringList.Create; 
  try 
    Button1.Tag := 1; 

    repeat 
      S := '';
      for i := 1 to High(vlrs) do 
        if not (vlrs[i] = 0) then //o forum não aceita diferente 
          S := ' - ' + IntToStr(vlrs[i]) + S; 

      Delete(S, 1, 3); 
      vList.Add(S); 


      for i := 1 to High(vlrs) do 
      begin
        if 25 > vlrs[i] then 
        begin
          Inc(vlrs[i]); 
          Break; 
        end 
        else if i = High(vlrs) then 
          Exit 
        else 
          vlrs[i] := 1; 
      end; 

      Inc(Y); 
      if Y >= 1007 then 
      begin
        Memo1.Lines.AddStrings(vList);
       // Memo1.CaretPos := Point(0, Memo1.Lines.Count - 1);
        SendMessage(Memo1.Handle, EM_SCROLLCARET, 0,0); 
        vList.Clear; 
        Y := 0; 
        Application.ProcessMessages; 
      end; 
    until Button1.Tag = 0;
    Memo1.Lines.AddStrings(vList); 
  finally
    vList.Free;
    Button1.Tag := 0;
  end; 
end;

abraço

[luizf]

Pois é, ontem dando uma fuçada na net, a encontrei e ia postar agora pra te mostrar.

Mas não gostei dela, demorou muito para gera as combinações, tive até de cancelar o processo.

Mas o problema maior,pra mim, não é a demora, é que ela tambem, repete os numeros nas combinações.

Exemplo:

Na linha 504791, gerou o código:

1 - 7 - 7 - 16 - 16

Um 1, dois 7 e dois 16

Para o problema da demora, pensei que poderia fazer as combinações dando um intervalo para elas.

O quero dizer, é o seguinte, não vou usar todas as combinacões, então pra que ficar esperando para gerar, sei lá, mais ou menos 350.000..... combinações. Mas estipular um intervalo, por exemplo.

Gerar combinações de 4 index até 8 index, entendeu. Provavelmente as combinações abaixo de 4 de acima 8 não seriam usadas.

Então gostei de um outro código que encontrei hoje. Dá uma olhada.

function GeraCombinacoes(S: string; NumDig: Integer): TStrings;
   var I, J: Integer;
          X: Char;
         TS: TStrings;
         S1: string;
   begin
     Result := TStringList.Create;
     TS     := TStringList.Create;
   
     for I := 1 to Length(S) do Result.Add(S[I]);
   
     while Length(Result.Strings[0]) < NumDig do
       begin
         for I := 0 to (Result.Count - 1) do
           begin
             S1 := '';
             for J := 1 to Length(S) do
               begin
                 X := S[J];
                 if Pos(X, Result.Strings[I]) = 0 then S1 := S1 + X;
               end;
   
             for J := 1 to Length(S1) do
               begin
                 X := S1[J];
                 TS.Add(Result.Strings[I] + X);
               end;
           end;
         Result.Text := TS.Text;
         TS.Clear;
       end;
   
     TS.Free;
   end;

Para testar:

procedure TForm1.Button1Click(Sender: TObject);
 begin
   Memo1.Lines.Assign(GeraCombinacoes('ABCDEFGHIJKLMNOPQRSTUVWXYZ', 3));  
 end;

Com o teste acima, gerou 15600 combinações, sem repetir item na mesma combinação.

Outros exemplos

Para um string '123', gerar com 2 digitos, resultou em:

12

13

21

23

31

32

Para um string '123', gerar com 3 digitos, resultou em:

123

132

213

231

312

321

Para um string '1234', gerar com 3 digitos, resultou em:

123

124

132

134

142

143

213

214

231

234

241

243

312

314

321

324

341

342

412

413

421

423

431

432

Para esta rotina, o que preciso é que gere e coloque um separador, por exemplo:

Ao invés de mostrar 123, mostrar: 1-2-3, ou 1,2,3 ou 1 - 2 - 3, para quando tiver numero grande, poder diferenciar, se o resultado for: 4358946, poderia ser 43-58-9-46, apenas como exemplo.

E tambem, acho que falta ordenar o resultado para comparar se não há repetido, por exemplo, 123 será o mesmo que 321, ou 231, ou 132. Então ordenando 321, esta ficaria 123, podendo comparar.

O que achou da rotina melhor que a primeira? Dá pra melhorar?

[Jhonas]

Para esta rotina, o que preciso é que gere e coloque um separador, por exemplo:

Ao invés de mostrar 123, mostrar: 1-2-3

é só fazer esta modificação

function GeraCombinacoes(S: string; NumDig: Integer): TStrings;
   var I, J: Integer;
          X: Char;
         TS: TStrings;
         S1: string;
   begin
     Result := TStringList.Create;
     TS     := TStringList.Create;

     for I := 1 to Length(S) do Result.Add(S[I]);

     while Length(Result.Strings[0]) < NumDig do
       begin
         for I := 0 to (Result.Count - 1) do
           begin
             S1 := '';
             for J := 1 to Length(S) do
               begin
                 X := S[J];
                 if Pos(X, Result.Strings[I]) = 0 then S1 := S1 + X;
               end;

             for J := 1 to Length(S1) do
               begin
                 X := S1[J];
                 TS.Add(Result.Strings[I] + '-' + X);
               end;
           end;
         Result.Text := TS.Text;

         TS.Clear;
       end;

     TS.Free;
   end;


procedure TForm1.Button1Click(Sender: TObject);
var i: integer; lin : string;
begin
   Memo1.Lines.Assign(GeraCombinacoes('1234', 5));
end;

O resultado será: 1-2-3 1-2-4 1-3-2 1-3-4 1-4-2 1-4-3 2-1-3 2-1-4 2-3-1 2-3-4 2-4-1 2-4-3 3-1-2 3-1-4 3-2-1 3-2-4 3-4-1 3-4-2 4-1-2 4-1-3 4-2-1 4-2-3 4-3-1 4-3-2 OBS: outros exemplos :

Memo1.Lines.Assign(GeraCombinacoes('12', 3));

Memo1.Lines.Assign(GeraCombinacoes('123', 4));

Memo1.Lines.Assign(GeraCombinacoes('1234', 5));

Memo1.Lines.Assign(GeraCombinacoes('12345', 6));

por ai vai ....

abraço

[luizf]

Na verdade, não irei precisar do '-' só na resposta.

Preciso de algo mais ou menos assim:

var
   Str, Str1: String;
   N: Integer;
 begin
   N:= IntToStr(Edit1.Text);
   Str:= '1-5-13-9-10-32'; // caso contrario ficaria 151391032

   // ou

   Str1:= '1-2-3-4-5-6-7-8-9-10-11-12'; // .... 13-14-15...
   // caso contrario ficaria 12345678910111213
   // mas as combinanaçõe tem de ser feita somente com os numeros, 10, 5, 13, 7, etc

   // Daí
   Memo1.Lines.Assign(GeraCombinacoes(Str, N)); // para Str ou Str1

 end;

Para gerar as combinações não usar separadore, somente os numeros, e a resposta usar o separador.

Para gerar:

1

2

3

4

.....

10

11

12

Resposta (5 numeros), por exemplo:

5-8-10-11-12

Dá para fazer com essa mesma rotina?

[Jhonas]

Vou dar o exemplo ... voce tenta melhorar

function GeraCombinacoes(S: string; NumDig: Integer): TStrings;
   var I, J: Integer;
          X,Y: Char;
         TS: TStrings;
         S1: string;
   begin
     Result := TStringList.Create;
     TS     := TStringList.Create;

     for I := 1 to Length(S) do Result.Add(S[I]);

     while Length(Result.Strings[0]) < NumDig do
       begin
         for I := 0 to (Result.Count - 1) do
           begin
             S1 := '';
             for J := 1 to Length(S) do
               begin
                 X := S[J];
                 if Pos(X, Result.Strings[I]) = 0 then S1 := S1 + X;
               end;

             for J := 1 to Length(S1) do
               begin
                 X := S1[J];
                 Y := S[J+1];
                 TS.Add(Result.Strings[I] + '-' + X + y);
               end;
           end;
         Result.Text := TS.Text;

         TS.Clear;
       end;

     TS.Free;
   end;


procedure TForm1.Button1Click(Sender: TObject);
var i: integer; lin : string;
begin
   Memo1.Lines.Assign(GeraCombinacoes('12345678', 10));
end;

abraço

[luizf]

Valeu pela ajuda, vou tentar agora mesmo.

[luizf]

Cara, estou fazendo um balaio de gato aqui.

No exemplo, pega os dados de string (S: string). Eu vou precisar pegar os dados de um TStringList, estou tentando adaptar, mas tá meio confuso para mim.

//=======================================================================
  function TForm1.CriaLista(Str, StrIgnora: String): TStringList;
  // A partir de uma string, cria uma StringList
  // Excluindo os caracteres referente a StrIgnora
  var
    S: String;
  begin
    Result := TStringList.Create;
    try
  
      while Str <> '' do
      begin
  
        // enquanto a posição da string a ignorar não for 1   
        while (Pos(StrIgnora, Str) <> 1) do
        begin
          S:= S + Copy(Str,1,1); // vai adicionando a S o primeiro  caracter de Str
          Delete(Str,1,1);       // e apagando o primeiro de Str
  
          if Str = '' then       // se Str tornar vazia quebra o loop
            Break;  
        end;
  
        if (Pos(StrIgnora, Str) = 1) then
        begin
          Delete(Str,1,Length(StrIgnora)); // Exclui StrIgnora
        end;
  
        Result.Add(S);
        S:= '';
      end;
  
    finally
    //  Result.Free;
    end;
  end; // Fim CriaLista
  //=======================================================================

Fiz essa rotina acima, para caso for pegar os dados de um edit. Por exemplo, um edit com os dados: A-B-CD-E-F-JKL-O Chamando com: Memo1.Lines.AddStrings (CriaLista (Edit1.Text, '-' )); Retorna: A B CD E F JKL O Até aqui, tudo bem. ---------------------------------------------------------------------------------------- Mas estou quebrando a cabeça para converter a rotina do exemplo, a trabalhar com TStringList.

//=======================================================================
  function TForm1.GeraCombinacoes(StringFonte: TStringList; Separador:  string; NumeroComb: Integer): TStringList;
  var
    I, J: Integer;
    X, Y: string;
    TS: TStrings;
    S1: string;
  begin
    Result := TStringList.Create;
    TS     := TStringList.Create;
  
    try
  
      // numero de combinações não pode ser maior que as strings
      if NumeroComb < StringFonte.Count then
      begin
  
        Result.AddStrings(StringFonte);
  
        while Length(Result.Strings[0] < NumeroComb do
        begin
  
          for I := 0 to (Result.Count - 1) do
          begin
            S1 := '';
  
            for J := 0 to StringFonte.Count -1 do
            begin
              X := StringFonte.ValueFromIndex[J];
              if Pos(X, Result.Strings[I]) = 0 then
                //S1 := S1 + '-' + X;
                S1 := S1 + X;
            end;
  
  
            for J := 1 to Length(S1) do
            begin
              X := S1[J];
              Y := StringFonte[J+1];
              TS.Add(Result.Strings[I] + '-' + X + y);
            end;
  
          end;
          Result.Text := TS.Text;
  
          TS.Clear;
        end; // WHILE
  
      end else
      begin
        Result.Clear;
      end; // IF
  
    finally
      TS.Free;
      ListaTemp.Free;
  
    end;
  end;
  //=======================================================================

Chamando:

Memo2.Lines.AddStrings (GeraCombinacoes (Memo1.Lines, '-', 5 ));

Esperava que retornasse, algo como:

A-B-CD-E-F

A-B-CD-E-JKL

A-B-CD-E-O

A-B-CD-F-JKL

A-B-CD-E-O

....

....

....

F...

O...

Mas, quando clico em gerar, dá erro.

----------------------------------------------------------------------------------------

*** Só um pouco de comentário.

Desculpa a minha ignorância, mas não sou programador, sou hobbista em delphi, gosto muito de "programar", o pouco que sei, aprendi de curioso, fuçando o próprio delphi, vasculhando com o google (que foi onde encontrei este forum) e com a ajuda deste forum. Mas, não tenho muito tempo de ficar programando por gosto, tenho muito trabalho e também estudo, é mais nas férias da faculdade que dou uns pega, este mesmo se eu não conseguir terminar dentro de mais ou menos 10 dias, vai ficar só pro final do ano, volta as aulas, daí é trabalho e mais trabalho.

Mas eu gosto de aprender, aos poucos vou conhecendo mais sobre o delphi. Este programa é para uso pessoal, mas com certeza vou precisar fazer alguma coisa na faculdade, em curso técnico que fiz, fiz um programinha (com a ajuda da net), para enviar sinal pela porta paralela para acionamento de motor, quero tentar fazer agora pela porta usb, mas ainda não tenho material suficiente para isso, e provavelmente na facu terei de fazer algo parecido, mas vai ser em grupo, já ajuda, mas talvez tenha de ser em C.

Abraço...

Editado Julho 15, 2010 por luizf

[Jhonas]

ainda acho que voce esta complicando muito

function GeraCombinacoes(S: string; NumDig: Integer): TStrings;
   var I, J: Integer;
          X,Y: Char;
         TS: TStrings;
         S1: string;
   begin
     Result := TStringList.Create;
     TS     := TStringList.Create;

     for I := 1 to Length(S) do Result.Add(S[I]);

     while Length(Result.Strings[0]) < NumDig do
       begin
         for I := 0 to (Result.Count - 1) do
           begin
             S1 := '';
             for J := 1 to Length(S) do
               begin
                 X := S[J];
                 if Pos(X, Result.Strings[I]) = 0 then S1 := S1 + X;
               end;

             for J := 1 to Length(S1) do
               begin
                 X := S1[J];
                 Y := S[J+1];
                 TS.Add(Result.Strings[I]+ '-'+ X + y);
               end;
           end;
         Result.Text := TS.Text;

         TS.Clear;
       end;

     TS.Free;
   end;


procedure TForm1.Button1Click(Sender: TObject);
var i: integer; lin : string;
begin
   Memo1.Lines.Assign(GeraCombinacoes('A-B-CD-E-F-JKL-O', 12));
end;

fiz um programinha (com a ajuda da net), para enviar sinal pela porta paralela para acionamento de motor, quero tentar fazer agora pela porta usb, mas ainda não tenho material suficiente para isso

Na net tem muito material sobre isso e no forum procure pela palavra sensor ou sensores

abraço

[luizf]

Usando,

Memo1.Lines.Assign(GeraCombinacoes('A-B-CD-E-F-JKL-O', 12));

gerou 70033 combinações.

Mas com o sinal '-' seguido e as vezes no final e valor repetido. Por exemplo, na linha 70009

O--O-LF-C--D-

ainda acho que voce esta complicando muito

Não é a minha intensão complicar, mas eu estava tentando fazer com StringList ao invés de string, pelos seguinte.

As combinações que quero gerar, são de index de banco de dados, supondo que eu tenha um banco de dados com 300 index e gere uma string para poder chamar na função acima, ficaria mais ou menos assim:

1-2-3-4-5-...........-298-299-300

Achei numa StringList ficaria melhor e achei que trabalhar com as linhas do StringList acabasse sendo mais facil.

[luizf]

Descupa, mas se não for abuso, gostaria de pedir se poderia usar comentários nos códigos.

Me ajudaria a entender, obrigado.

[luizf]

Bom, tive um progresso ao meu modo de ver.

Dá uma olhada na Unit abaixo.

unit U_Fat_Comb;

                
interface

uses
  Forms, SysUtils, Classes, StrUtils, StdCtrls;



  function CalcFatorial(NumFat: Integer): String;
  function CalcComb(NumElem, LimInf, LimSup: Integer): String;
  procedure GeraComb(Taxa: Integer; Elementos, ListaDeRetorno: TStringList; Separador: String); Overload;
  procedure GeraComb(Taxa: Integer; PegaElemDe, DevolveElemEm: TMemo; Separador: String); Overload;



var
  LOOP: Boolean;

implementation

//=======================================================================
//=======================================================================
// Calcula o Fatorial de um numero inteiro positivo
// maior que zero e menor que 1755, por causa do limite de Extended
function CalcFatorial(NumFat: Integer): String;
// NumFat: Valor a ser fatorado
var
  Resp: Extended;
  I: Integer;
begin

  if NumFat < 1755 then
  begin

    if NumFat > 0 then
    begin
      Resp:= 1;

       for I:= NumFat downto 1 do
        Resp:= Resp * I;

      Result:= FloatToStr(Resp);

    end else

      if NumFat < 0 then
        Result:= '-1' // -1 = (NumFat não pode ser menor que zero)
      else
        Result:= '0'; // 0 = (NumFat não pode ser zero)

  end else
    // Número a fatorar, não pode ser maior que 1754
    // 1754! = 1,97926189010501E4930
    Result:= '-2'; // -2 = (NumFat não pode ser maior que 1755)

end;

//=======================================================================
//=======================================================================
{ "Denominam-se combinações simples de n elementos distintos tomados
  k a k (taxa k) aos subconjuntos formados por k elementos distintos
  escolhidos entre os n elementos dados." }

function CalcComb(NumElem, LimInf, LimSup: Integer): String;
{ Parametros:
NumElem: Numero de Elementos
LimInf: Limite Inferior
LimSup: Limite Superior

Obs: Para apenas um calculo, usar mesmo valor para LimInf e LimSup }
var
  I, R: Integer;
  Elem, Taxa: Extended;
begin
  // Atribui o valor calculado do Fatorial
  Elem:= StrToFloat( CalcFatorial(NumElem) );


  if (NumElem > 0) and (LimInf > 0) then
  begin

    Result:= '0';
    R:= 0;

    if NumElem = LimSup then
    begin
      LimSup:= LimSup -1;
      R:= 1;
    end;

    for I:= LimInf to LimSup do
    begin
      if I = NumElem then
        Break;
            
      Taxa:= StrToFloat( CalcFatorial(I)) * StrToFloat( CalcFatorial(NumElem - I) );
      Result:= FloatToStr( Trunc((Elem / Taxa) + StrToFloat(Result)) );
    end;


    if R = 1 then
      Result:= FloatToStr( StrToFloat (Result) +1);

  end else
    Result:= '-1';
end;

//=======================================================================
//=======================================================================
// Gera uma lista das combinações possíves, de n (elementos), k a k (taxa)
// A partir de uma lista de Elementos (Elementos)
// Devolve uma Lista (ListaDeRetorno) com as combinações

procedure GeraComb(Taxa: Integer; Elementos, ListaDeRetorno: TStringList; Separador: String); Overload;
{ Parametros:
Taxa: Numero de Elementos que se deseja para as combinações
Elementos: Lista de onde se tira os elementos a combinar
ListaDeRetorno: Lista com as combinações resolvidas
Separador: Uma string que irá separar um elemento do outro,
por exemplo: '-' , para 123 fica 1-2-3 }
var
  ListaIni: TStringList;
  StrAddLinha, Str: String;
  I, J, K, W, X: Integer;
  N: array of Integer;
  Comb, Total: Extended;
begin
  // Se a Taxa for menor ou igual que o total de elementos, continua
  if Taxa <= Elementos.Count then
  begin
    ListaIni := TStringList.Create;

    try

      if Elementos.Count > 1 then
      begin

        for I:= 0 to Taxa -2 do
        begin
          ListaIni.Add(Elementos[I]); // Cria um Lista Inicial dos elementos, do primeiro
        end;                          // até o penultimo elemento possivel no tamanho Taxa


        // Define o tamanho de N, com o tamanho de ListaIni
        SetLength (N, ListaIni.Count);
        for I:= 0  to ListaIni.Count -1 do
        begin
          N[I]:= I; // Guarda em N[I], os index iniciais da Lista Inicial,
        end;         // que irão ser incrementados até Elementos.Count


        // Calcula quantas combinações podem ocorrer
        Comb:= StrToFloat(CalcComb(Elementos.Count, Taxa, Taxa));

        Total:= 0; // Inicia a variavel com zero
        K:= Taxa;  // Inicia a variavel com o valor da Taxa
        W:= 1;     // Inicia a variavel com 2


        // Prossegue num loop até Total chegar no numero de
        // combinações possíves, ou o loop for cancelado
        while (Total < Comb) and (LOOP = True) do
        begin

          if Total > 0 then
          begin

            for I:= Taxa -2 downto 0 do
            begin

              // Obs. Comparação de N, é para o valor do index
              if (N[I]+1 <= Elementos.Count - W) and (W = 1) then
              begin
                if N[I]+1 < Elementos.Count - W then
                begin

                  X:= N[I]+1;
                  N[I]:= N[I] +1; // Incrementa os index iniciais
                  ListaIni.Delete(I); //Deleta valor na posição I
                  ListaIni.Insert(I, Elementos.Strings[ N[I] ]); // Insere novo valor,

                  K:= X+2;
                  Break; // Quebra o loop

                end else
                begin
                  W:= W +1; // Incrementa W
                end;

              end else

                if ( N[I]+1 < Elementos.Count -W) and
                   ( I < Taxa -2) then
                begin
                  N[I]:= N[I] +1;
                  ListaIni.Delete(I);
                  ListaIni.Insert(I, Elementos.Strings[ N[I] ]);
                  X:= N[I]+1;

                  for J:= I+1 to Taxa -2 do
                  begin
                    N[J]:= X;
                    ListaIni.Delete(J);
                    ListaIni.Insert(J, Elementos.Strings[ N[J] ]);
                    X:= X + 1;
                  end;

                  K:= X+1;
                  W:= 1;
                  Break; // Quebra o loop

                end else
                begin
                  W:= W+1;
                end;

            end; // FOR I
          end;

          //----------------------------------------------
          Str:= ''; // Limpa a variavel
          // Se houver um separador...
          if Separador <> '' then
            for I:= 0 to ListaIni.Count -1 do
            begin
              // Cria um String no indice I + o separador
              Str:= Str + ListaIni.Strings[I] + Separador;
            end
          else // senão

            for I:= 0 to ListaIni.Count -1 do
            begin
              // Cria um String no indice I
              Str:= Str + ListaIni.Strings[I];
            end;


          for I:= K to Elementos.Count do
          begin
            StrAddLinha:= Str + Elementos.Strings[I-1];

            ListaDeRetorno.Add(StrAddLinha);
            Total:= Total +1;

            if Total = Comb then
              Break;
          end;
          //----------------------------------------------

          Application.ProcessMessages;  
        end; // WHILE

      end
      else
      begin
        ListaDeRetorno.AddStrings(Elementos);
      end; // IF

    finally
      FreeAndNil(ListaIni);
    end;
  end;
end;

//=======================================================================  
//=======================================================================
// Gera uma lista das combinações possíves, de n (elementos), k a k (taxa)
// A partir de uma lista de Elementos (Elementos)
// Devolve uma Lista (ListaDeRetorno) com as combinações

procedure GeraComb(Taxa: Integer; PegaElemDe, DevolveElemEm: TMemo; Separador: String); Overload;
{ Parametros:
Taxa: Numero de Elementos que se deseja para as combinações
Elementos: Lista de onde se tira os elementos a combinar
ListaDeRetorno: Lista com as combinações resolvidas
Separador: Uma string que irá separar um elemento do outro,
por exemplo: '-' , para 123 fica 1-2-3 }
var
  ListaIni: TStringList;
  StrAddLinha, Str: String;
  I, J, K, W, X: Integer;
  N: array of Integer;
  Comb, Total: Extended;
begin
  // Se a Taxa for menor ou igual que o total de elementos, continua
  if Taxa <= PegaElemDe.Lines.Count then
  begin
    ListaIni := TStringList.Create;

    try

      if PegaElemDe.Lines.Count > 1 then
      begin

        for I:= 0 to Taxa -2 do
        begin
          ListaIni.Add(PegaElemDe.Lines.Strings[I]); // Cria um Lista Inicial dos elementos, do primeiro
        end;                                         // até o penultimo elemento possivel no tamanho Taxa


        // Define o tamanho de N, com o tamanho de ListaIni
        SetLength (N, ListaIni.Count);
        for I:= 0  to ListaIni.Count -1 do
        begin
          N[I]:= I; // Guarda em N[I], os index iniciais da Lista Inicial,
        end;         // que irão ser incrementados até PegaElemDe.Lines.Count


        // Calcula quantas combinações podem ocorrer
        Comb:= StrToFloat(CalcComb(PegaElemDe.Lines.Count, Taxa, Taxa));

        Total:= 0; // Inicia a variavel com zero
        K:= Taxa;  // Inicia a variavel com o valor da Taxa
        W:= 1;     // Inicia a variavel com 2


        // Prossegue num loop até Total chegar no numero de
        // combinações possíves, ou o loop for cancelado
        while (Total < Comb) and (LOOP = True) do
        begin

          if Total > 0 then
          begin

            for I:= Taxa -2 downto 0 do
            begin

              // Obs. Comparação de N, é para o valor do index
              if (N[I]+1 <= PegaElemDe.Lines.Count - W) and (W = 1) then
              begin
                if N[I]+1 < PegaElemDe.Lines.Count - W then
                begin

                  X:= N[I]+1;
                  N[I]:= N[I] +1; // Incrementa os index iniciais
                  ListaIni.Delete(I); //Deleta valor na posição I
                  ListaIni.Insert(I, PegaElemDe.Lines.Strings[ N[I] ]); // Insere novo valor,

                  K:= X+2;
                  Break; // Quebra o loop

                end else
                begin
                  W:= W +1; // Incrementa W
                end;

              end else

                if ( N[I]+1 < PegaElemDe.Lines.Count -W) and
                   ( I < Taxa -2) then
                begin
                  N[I]:= N[I] +1;
                  ListaIni.Delete(I);
                  ListaIni.Insert(I, PegaElemDe.Lines.Strings[ N[I] ]);
                  X:= N[I]+1;

                  for J:= I+1 to Taxa -2 do
                  begin
                    N[J]:= X;
                    ListaIni.Delete(J);
                    ListaIni.Insert(J, PegaElemDe.Lines.Strings[ N[J] ]);
                    X:= X + 1;
                  end;

                  K:= X+1;
                  W:= 1;
                  Break; // Quebra o loop

                end else
                begin
                  W:= W+1;
                end;

            end; // FOR I
          end;

          //----------------------------------------------
          Str:= ''; // Limpa a variavel
          // Se houver um separador...
          if Separador <> '' then
            for I:= 0 to ListaIni.Count -1 do
            begin
              // Cria um String no indice I + o separador
              Str:= Str + ListaIni.Strings[I] + Separador;
            end
          else // senão

            for I:= 0 to ListaIni.Count -1 do
            begin
              // Cria um String no indice I
              Str:= Str + ListaIni.Strings[I];
            end;

          for I:= K to PegaElemDe.Lines.Count do
          begin
            StrAddLinha:= Str + PegaElemDe.Lines.Strings[I-1];
            DevolveElemEm.Lines.Add(StrAddLinha);

            Total:= Total +1;
            if Total = Comb then
              Break;
          end;
          //----------------------------------------------

          Application.ProcessMessages;  
        end; // WHILE

      end
      else
      begin
        DevolveElemEm.Lines.AddStrings(PegaElemDe.Lines);
      end; // IF

    finally
      FreeAndNil(ListaIni);
    end;
  end;
end;

//=======================================================================  
//=======================================================================

end.

E para chamar, fiz assim:

...
type
  TForm1 = class(TForm)
    Btn_Gerar: TSpeedButton;
    CB_Separador: TCheckBox; 
    Ed_Inferior: TEdit;
    Ed_Separador: TEdit;
    Ed_Superior: TEdit;
    Lb_LstGerada2: TLabel; 
    Me_LstGerada: TMemo;
    Me_StrFonte: TMemo; 
  ... 
  end;
  
...
...

var
  Form1: TForm1;

implementation

uses
  U_Fat_Comb;

{$R *.dfm}
...
...
//=======================================================================
//=======================================================================
procedure TForm1.Btn_GerarClick(Sender: TObject);
var
  L_Inf, L_Sup: Integer; // Limites
  I: Integer; // contador
  TamLstFonte: Integer; // Tamanho da lista fonte
  ListaFonte, ListaGerada: TStringList; // Listas, de envio e retorno
  Sep: String; // Separador
begin

  if Btn_Gerar.Caption = '&Parar' then
  begin
    LOOP:= False;
    Btn_Gerar.Caption:= '&Gerar';
  end
  else
  begin

    LOOP:= True;
    Btn_Gerar.Caption:= '&Parar';
                                           
    L_Inf:= StrToInt(Ed_Inferior.Text);
    L_Sup:= StrToInt(Ed_Superior.Text);

    ListaFonte := TStringList.Create;
    ListaGerada := TStringList.Create;

    try
      ListaFonte.AddStrings(Me_StrFonte.Lines);
      TamLstFonte:= ListaFonte.Count; // Tamanho da Lista Fonte

      for I:= L_Inf to L_Sup do
      begin
        // Se Lista Fonte menor que I, quebra o loop
        if TamLstFonte < I then
          Break;

        ListaGerada.Clear; // Limpa a lista de String

        if CB_Separador.Checked then
          Sep:= Ed_Separador.Text
        else
          Sep:= '';

        // Chamada 1
        // Demora um pouco mais, acredito que seja por trabalhar com Listas
        // GeraComb(I, ListaFonte, ListaGerada, Sep);

        // Chamada 2
        // Mais rapida, acredito que seja diretamente com componentes
        GeraComb(I, Me_StrFonte, Me_LstGerada, Sep);

      end; // FOR I

      Me_LstGerada.Lines.AddStrings(ListaGerada);

    finally
      FreeAndNil(ListaFonte);
      FreeAndNil(ListaGerada);
    end;

    Lb_LstGerada2.Caption:= IntToStr(Me_LstGerada.Lines.Count);

    LOOP:= False;
    Btn_Gerar.Caption:= '&Gerar';
  end;
end;
//=======================================================================
//=======================================================================
...
...
end.

E então?

Editado Julho 24, 2010 por luizf