Etiqueta com Fast Report

//-----------------------------------------TABELA COM AS ETIQUETAS--------------------------------------------//  
type
  TEtiquetas = array of array of string;

//-----------------------------------------ROTINA DE IMPRESSÃO----------------------------------------------//  
procedure EtiquetaPimacoFast(Etiquetas: TEtiquetas);
{
uses DateUtils, frxClass, Math;
}
const
  TamFonte: Byte = 10;
  AlturaLinha: Byte = 15; // pixels // menor que 15 depende da fonte
  InchToPixel: Byte = 96; // 1 polegada
var
  x, y: Byte;
  i, j: Byte; 
  LinhaAtual: Byte;
  TotLinha, TotColuna: Byte;
  AlturaEtiqueta, LarguraEtiqueta: Double;
  MargemEsquerda, MargemDireita: Double;
  MargemSuperior, MargemInferior: Double;
  AlturaFolha, LarguraFolha: Double;
  Report: TfrxReport;
  Page: TfrxReportPage;
  Band: TfrxBand;
  Memo: TfrxMemoView;

  procedure novaPagina;
  begin
    // lendo ini // valores alternativos são de modelo A4->2x6 // valores em milímetros
    LarguraEtiqueta := (IniReadFlt('REPORT', 'LARGURA_ETIQUETA', 90.00));
    AlturaEtiqueta := (IniReadFlt('REPORT', 'ALTURA_ETIQUETA', 45.00));
    MargemSuperior := (IniReadFlt('REPORT', 'MARGEM_SUPERIOR', 10.00));
    MargemInferior := (IniReadFlt('REPORT', 'MARGEM_INFERIOR', 10.00));
    MargemEsquerda := (IniReadFlt('REPORT', 'MARGEM_ESQUERDA', 10.00));
    MargemDireita := (IniReadFlt('REPORT', 'MARGEM_DIREITA', 10.00));
    LarguraFolha := (IniReadFlt('REPORT', 'LARGURA_FOLHA', 210.00));
    AlturaFolha := (IniReadFlt('REPORT', 'ALTURA_FOLHA', 290.70));
    TotColuna := Floor(LarguraFolha - MargemEsquerda - MargemDireita) / LarguraEtiqueta);
    TotLinha := Floor((AlturaFolha - MargemSuperior - MargemInferior) / AlturaEtiqueta);
    // cria página
    Page := TfrxReportPage.Create(Report);
    Page.CreateUniqueName;
    Page.SetDefaults;
    // configura página
    Page.Width := LarguraFolha;
    Page.Height := AlturaFolha;
    Page.TopMargin := MargemSuperior;
    Page.BottomMargin := MargemInferior;
    Page.LeftMargin := MargemEsquerda;
    Page.RightMargin := MargemDireita;
    // converte pra pixels pra posicionar os MemoViews
    MargemEsquerda := MmToInch(MargemEsquerda) * InchToPixel;
    MargemSuperior := MmToInch(MargemSuperior) * InchToPixel;
    LarguraEtiqueta := MmToInch(LarguraEtiqueta) * InchToPixel;
    AlturaEtiqueta := MmToInch(AlturaEtiqueta) * InchToPixel;
    // cria banda na página
    Band := TfrxReportTitle.Create(Page);
    Band.CreateUniqueName;
    Band.Top := 0;
    Band.Height := Page.Height;
  end;

  procedure GravaMemo(Valor: string; Alinhamento: TfrxHAlign; Fonte: TFontStyles);
  begin
    // cria memo na banda da página
    Memo := TfrxMemoView.Create(Band);
    Memo.CreateUniqueName;
    // configura memo
    Memo.Text := Valor;
    Memo.Font.Size := TamFonte;
    Memo.Font.Style := Fonte;
    Memo.HAlign := Alinhamento;
    Memo.WordWrap := False;
    // memo é posicionado abaixo do memo anterior ((LinhaAtual - 1) * AlturaLinha)
    Inc(LinhaAtual);
    // primeira linha/coluna posiciona em margemesquerda/margemsuperior
    // demais linhas/colunas posicionam em margemesquerda+larguraetiqueta/margemsuperior+alturaetiqueta
    Memo.SetBounds(IfThen(j = 1, MargemEsquerda * j, MargemEsquerda + ((j - 1) * LarguraEtiqueta)), IfThen(i = 1, MargemSuperior + (i *
      LinhaAtual) + ((LinhaAtual - 1) * AlturaLinha), MargemSuperior + ((i - 1) * AlturaEtiqueta) + ((LinhaAtual - 1) * AlturaLinha)),
      LarguraEtiqueta, AlturaLinha);
  end;

begin
  try
    // cria report
    Report := TfrxReport.Create(Self);
    // configura preview do report
    with Report do
    begin
      Clear;
      PreviewOptions.ThumbnailVisible := True;
      PreviewOptions.ZoomMode := zmWholePage
    end;
    // pagina inicial
    novaPagina;
    x := 0;
    while x < Length(Etiquetas) do
    begin
      for i := 1 to TotLinha do
      begin
        if x = Length(Etiquetas) then
          Break;
        for j := 1 to TotColuna do
        begin
          if x = Length(Etiquetas) then
            Break;
          LinhaAtual := 0;
          for y := 0 to Length(Etiquetas[x]) - 1 do
          begin
            if y = 0 then // haCenter, fdBold
              GravaMemo(Etiquetas[x][y], haCenter, [fsBold])
            else // haLeft
              GravaMemo(Etiquetas[x][y], haLeft, []);
          end;
          Inc(x);
        end;
      end;
      Inc(x);
      // mais de uma página
      if x < Length(Etiquetas) then
        novaPagina;
    end;
    Report.ShowReport;
  finally
    Report.Free;
  end;
end;

procedure TForm1.btnTesteEtiquetaPimacoClick(Sender: TObject);
var
  i, pos: Byte;
  etiquetas: TEtiquetas;
begin
  SQLExecute('select nome, telefone, email from pessoas where (telefone is not null) and (email is not null)');
  SetLength(etiquetas, SQLCount);
  // posição cima pra baixo, esquerda pra direita, começa de 1
  pos := StrToIntDef(InputBox('Etiqueta', 'Posição Inicial da Etiqueta:', '1'), 1) - 1;
  if pos < 0 then
    Exit;
  // adiciona qtd de registros vazios antes da posição inicial
  SetLength(etiquetas, Length(etiquetas) + pos);
  for i := 1 to pos do
    SetLength(etiquetas[i-1], SQLFieldCount);
  // começa a alimentar a partir da posição inicial informada
  for i := pos to Length(etiquetas) - 1 do
  begin
    SetLength(etiquetas[i], SQLFieldCount);
    etiquetas[i][0] := 'TITULO DA ETIQUETA';
    etiquetas[i][1] := 'Nome:     ' + SQLFields('nome').AsString;
    etiquetas[i][2] := 'Telefone: ' + SQLFields('telefone').AsString;
    etiquetas[i][3] := 'Email:    ' + SQLFields('email').AsString;
    SQLNext;
  end;
  // executando preview
  EtiquetaPimacoFast(etiquetas);
end;

function IniReadFlt(Chave, Variavel: string; Retorno: Double): Double;
begin
  with TIniFile.Create(DirExe + 'arquivo.ini') do
  try
    result := ReadFloat(Chave, Variavel, Retorno);
  finally
    Free;
  end;
end;

uses Math;

function mmToInch(Mm: double): double;
begin
  Result := Mm / 25.4;
end;