Uma pequena rotina que imprime etiquetas buscando registros de um BD Access usando o Rave 5.0 e modo Code-Based

unit Labesl1; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, RpDefine, RpBase, RpSystem, StdCtrls, rpDevice, DB, ADODB,   Grids, DBGrids, jpeg, ExtCtrls, ShellApi; type   TForm1 = class(TForm)     RvSystem1: TRvSystem;     Button1: TButton;     ADOConnection1: TADOConnection;     ADOQuery1: TADOQuery;     Label1: TLabel;     Edit1: TEdit;     Label2: TLabel;     Edit2: TEdit;     Label3: TLabel;     Edit3: TEdit;     Label4: TLabel;     Edit4: TEdit;     Label5: TLabel;     Edit5: TEdit;     Label6: TLabel;     Edit6: TEdit;     Image1: TImage;     Label7: TLabel;     procedure Button1Click(Sender: TObject);     procedure RvSystem1Print(Sender: TObject);     procedure Label7Click(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end; var   Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin    RVSystem1.SystemPrinter.MarginBottom  := 1;    RVSystem1.SystemPrinter.MarginLeft    := 1;    RVSystem1.SystemPrinter.MarginTop     := 1;    RVSystem1.SystemPrinter.MarginBottom  := 1;    RVSystem1.SystemPrinter.Units         := unCM;    RVSystem1.SystemPrinter.UnitsFactor   := 2.54;    rpDev.Copies                          := 1;    RVSystem1.SystemPrinter.Copies        := rpDev.Copies;    rpDev.Orientation                     := poPortrait;    RVSystem1.SystemPrinter.Orientation   := rpDev.Orientation;    RVSystem1.SystemPreview.FormState     := wsMaximized;    RVSystem1.SystemSetups := RVSystem1.SystemSetups - [ssAllowSetup];    rpDev.SelectPaper('A4',false);    RVSystem1.SystemPreview.RulerType     := rtBothCm;    RVSystem1.Execute; end; procedure TForm1.RvSystem1Print(Sender: TObject); Var Factor      : Double;     CurLabel    : Integer;     CurCol      : Double;     CurRow      : Double;     MarginTop   : Double;     MarginLeft  : Double;     LabelRow    : Integer;     LabelRows   : Integer;     LabelCols   : Integer;     LabelWidth  : Double;     LabelHeight : Double; begin    //---------------------------------------------------------------------------    // Configurações externas do formulario de Etiquetas    //---------------------------------------------------------------------------    MarginLeft  := StrToFloat(Edit1.Text);// Margem esquerda para impressao da primeira etiqueta    MarginTop   := StrToFloat(Edit2.Text);// Margem superior para impressao da primeira etiqueta    LabelWidth  := StrToFloat(Edit3.Text);// Largura da Etiqueta    LabelHeight := StrToFloat(Edit4.Text);// Altura da Etiqueta    LabelRows   := StrToInt(Edit5.Text);  // Numero de linhas de etiquetas    LabelCols   := StrToInt(Edit6.Text);  // Numero de colunas de etiquetas    //---------------------------------------------------------------------------    CurLabel := 0;        // Retorna o numero da etiqueta que está sendo impressa    LabelRow := 0;        // Retorna o numero atual da linha de etiquetas em impressao    ADOQuery1.Close;    ADOQuery1.SQL.Text := 'SELECT * FROM CLIENTES';    ADOQuery1.Open;    RVSystem1.BaseReport.SetFont('Arial',10);    While not ADOQuery1.Eof do Begin        Factor   := (CurLabel Mod LabelCols);        // um pequeno artificio matematico pra calcular        CurCol   := (Factor*LabelWidth)+MarginLeft;  // a posicao de cada etiqueta dinamicamente.        CurRow   := (LabelRow * LabelHeight) + MarginTop;        RVSystem1.BaseReport.GotoXY(CurCol,CurRow);  // Imprime na posicao calculada acima        RVSystem1.BaseReport.Bold := True;        RVSystem1.BaseReport.PrintLeft( ADOQuery1.FieldByName('NOME').AsString,CurCol); RVSystem1.BaseReport.NewLine;        RVSystem1.BaseReport.Bold := False;        RVSystem1.BaseReport.PrintLeft( ADOQuery1.FieldByName('ENDERECO').AsString,CurCol); RVSystem1.BaseReport.NewLine;        RVSystem1.BaseReport.PrintLeft( ADOQuery1.FieldByName('BAIRRO').AsString+' - CEP '+ADOQuery1.FieldByName('CEP').AsString,CurCol); RVSystem1.BaseReport.NewLine;        RVSystem1.BaseReport.PrintLeft( ADOQuery1.FieldByName('CIDADE').AsString+' / '+ADOQuery1.FieldByName('ESTADO').AsString,CurCol); RVSystem1.BaseReport.NewLine;        RVSystem1.BaseReport.PrintLeft( 'NUMERO: '+Format('%0.5d',[Curlabel]),CurCol); RVSystem1.BaseReport.NewLine;        Inc(CurLabel);        //TROCA DE LINHA DE ETIQUETA        // Se preencheu uma linha de etiquetas, reposiciona na margem e calcula a posicao da proxima etiqueta        If Factor=LabelCols-1 Then Inc(LabelRow);        // TROCA DE PAGINA        // Se preencheu uma pagina de etiquetas, reinicializa a impressao        If LabelRow>=LabelRows Then Begin           LabelRow := 0;           RVSystem1.BaseReport.NewPage;        End;        ADOQuery1.Next;    End; end; procedure TForm1.Label7Click(Sender: TObject); begin    ShellExecute(0,'open','http://www.aden.com.br','',nil,sw_shownormal); end; end.

Quebra-Linha

Colaborador..: Adenilton Rodrigues
Categoria(s).: Delphi;
Data.........: 21/03/2004 21:24:15
Visualizado..: 3164 vezes
Fonte........: AdeN Knowledge DB