Impressao - formatando colunas para matricial

Top  Previous  Next

// formatar colunas para impressao

{ Esta rotina separa formata uma string list em colunas usadas principalmente para impressão

  desenvolvida por Flávio Junior em 13/03/2003 das 10h30 - 16h20 (tive a idéia da var sobra

  enquanto estava cagando no banheiro na market)

 

  Exemplo:

 

  Original = [1,2,3,4]

  Linhas   = 6

  Colunas  = 3

  TamCol   = 4

 

  AjustarColunas = true      AjustarColunas = false

 

   1   3   4                   1    3

   2                           2    4

 

}

procedure FormataColunas(Original, Resultado: TStrings; const Linhas, Colunas, TamCol: Integer; AjustarColunas: Boolean = True; LinhaEntreBlocos: Boolean = False);

var

  I, X, P, Z, Vezes: Integer;

  Tmp : TStringList;

 

  // esta rotina é que é o cérebro. funciona sozinha sem a mais externa.

  // a rotina mais externa é usada só para separar os blocos de colunas foi por isso

  // que eu deixei ela com parametros ao invés de usar os parametros da rotina externa

  // caso precise só dessa.

  procedure FmtColunas(Original, Resultado: TStrings; const Colunas, TamCol: Integer; AjustarColunas: Boolean = True);

  var

    I: Integer;

    QIt, MaxL, L, C, Sobra, MaxLCompl: Integer;

    S: string;

    M: array of array of string;  // matriz multidimensional --- uau!

  begin

    MaxL      := Ceil(Original.Count / Colunas);     // max de linhas da matriz temp. 18/3 = 6,  17/3 = 6

    QIt       := MaxL * Colunas;                     // qtde de itens

    Sobra     := (Original.Count mod Colunas)-1;     // qtde de itens que "sobram" na linha não completamente preenchida

    MaxLCompl := Trunc(Original.Count / Colunas)-1;  // qtde de linhas completamente preenchidas

 

    SetLength(M, QIt);           // seta max da matriz.

    for I := 0 to MaxL-1 do

      SetLength(M[I], Colunas);  // seta size de cada "linha" da matriz

 

    C := 0; L := 0;              // Linha e Colunas = 0

    for I := 0 to Original.Count - 1 do   // percorre todos os itens da matriz original

    begin

      M[L, C] := Original[I];             // coloca na matriz dinamica

      Inc(L);                             // proxima linha

 

      if AjustarColunas then     // aqui está o pulo do gato

        if C > Sobra then        // existem itens sobrantes na ultima linha (ela está incompleta?) e está na coluna que nao tem iten (na ultima linha)

          if L > MaxLCompl then  // a linha atual é a ultima linha?

          begin

            L := 0;              // volta pra primeira linha

            Inc(C);              // incrementa a coluna

            Continue;

          end;

 

      if L > MaxL-1 then         // passou a ultima linha?

      begin

        L := 0;                  // volta pra primeira linha

        Inc(C);                  // incrementa a coluna

      end;

    end;

    // transfere a matriz da memória para a stringlist de resultado, já formatado no tamanho da coluna

    Resultado.Clear;

    for L := 0 to MaxL-1 do

    begin

      S := '';

      for C := 0 to Colunas-1 do

        S := S + AlinhaEsq(M[L, C], TamCol);   // usa a função alinha com o tamanha passado por parametro

      Resultado.Add(S);

    end;

  end;

 

begin

  Resultado.Clear;                                     // limpa a matriz de saida

  Tmp   := TStringList.Create;                         // cria matriz temporaria auxiliar

  Vezes := Ceil(Original.Count / (Linhas * Colunas));  // quantas vezes vai ter que chamar a rotinas para formatar colunas

  P     := 0;

  // vezes identifica quantos grupos existem, tipo eu crio uma matrix 6 linhas 3 colunas, mas envio 19 itens.

  // neste caso tem que processar os 18 primeiros itens e formatá-los e depois mandar o décimo nono separadamente.

  for I := 1 to Vezes do

  begin

    Tmp.Clear;                      // limpa uma matriz temporária

    if I = Vezes then               // se for o último item...

      Z := P + (Original.Count - P) // ...vai percorrer só até onde tem itens

    else

      Z := P + (Linhas * Colunas);  // se não, vai mandar todos que preencham a matriz.

 

    for X := P to Z - 1 do Tmp.Add(Original[X]);           // transfere da original para tmp os itens requeridos

    P := Z;                                                // incrementa o offset do P (para pegar os itens certos na proxima vez)

    FmtColunas(Tmp, Tmp, Colunas, TamCol, AjustarColunas); // formata as colunas e retorna em tmp

    for X := 0 to Tmp.Count-1 do Resultado.Add(Tmp[X]);    // transfere tmp para a matriz-parametro Result

    if LinhaEntreBlocos then Resultado.Add('');            // coloca um espaço entre os blocos de colunas

  end;

  Tmp.Free;

end;

 

================== rotina original, ela tem bug, exemplo: col=3, lin=6, itens=7

 

procedure FormataColunas(Original, Resultado: TStrings; const Linhas, Colunas, TamanhoCol: Integer; Ajustar: Boolean = True);

var

  LimitCol, LimitLin, I, LinAtual, ColAtual, Offset, Itens_Restantes, Itens_Pagina: Integer;

  Original2: TStringList;

begin

  Original2 := TStringList.Create;

  // arruma os tamanhos da original

  for I := 0 to Original.Count-1 do

    Original2.Add( AlinhaEsq( Original[I], TamanhoCol ) );

  // só pra matar ratão...

  LimitCol := Colunas; if Colunas < 1 then LimitCol := 1;

  LimitLin := linhas;  if linhas  < 1 then LimitLin := 1;

  // então posso limpar a lista Resultado caso tenha algum lixo:

  Resultado.Clear;

  // inicializar umas variáveis...

  Offset       := 0;  // Numero da pagina

  LinAtual     := 0;

  ColAtual     := 0;

  Itens_Pagina := (LimitLin * LimitCol);

  // aí é só carregar a lista:

  for I := 0 to Original2.Count-1 do

  begin

    // Caso o numero de itens da ultima pagina for menor que o total de itens por pagina

    // ajusta o total de linhas para que os itens sejam alocados nas primeiras linhas da pagina

    if Ajustar then

    begin

      Itens_Restantes := (Original2.Count - (Offset * LimitCol));

      if Itens_Restantes < Itens_Pagina then

        LimitLin := Ceil(Itens_Restantes / LimitCol);

    end;

    // Caso ultrapasse o limite de linhas

    if LinAtual >= LimitLin then

      // Caso ultrapasse o limite de colunas

      if ColAtual = (LimitCol -1) then

      begin

        Offset := Offset + LimitLin;

        LinAtual := 0;

        ColAtual := 0;

      end

      else

      begin

        Inc(ColAtual);

        LinAtual := 0;

      end;

 

    if ColAtual = 0 then

    begin

      if (Offset > 0and (LinAtual = 0) then Resultado.Add('');

      Resultado.Add('');

    end;

    Resultado[LinAtual + Offset] := Resultado[LinAtual + Offset] + Original2[I];

    Inc(LinAtual);

  end;

  Original2.Free;

end;