Um exemplo mais complexo do Rave Code-Based. Aprenda a fazer relatorios com banco de dados, quebras, totalizadores, imagens, desenhos e exportação pra PDF e HTML

Escrevi um exemplo mais complexo que demonstra algumas técnicas avançadas da escrita de relatorios em Rave Code Based. Aprenda nesse sample a usar graficos, imagens, bancos de dados com quebras, contagem de paginas, exportação pra PDF e HTML. Um verdadeiro Workshop. unit Unit1; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   StdCtrls, RpDefine, RpBase,RPRender, RPRenderPDF,RPRenderHTML,RpSystem, Db, ADODB, ShellApi,   jpeg, ExtCtrls, RPDevice; type   TForm1 = class(TForm)     RvSystem1: TRvSystem;     Button1: TButton;     ADOConnection1: TADOConnection;     Button2: TButton;     Button3: TButton;     Image1: TImage;     ADOQuery: TADOQuery;     Button4: TButton;     procedure Button1Click(Sender: TObject);     procedure RvSystem1Print(Sender: TObject);     procedure Button2Click(Sender: TObject);     procedure Button3Click(Sender: TObject);     procedure RvSystem1NewPage(Sender: TObject);     procedure Button4Click(Sender: TObject);   private     { Private declarations }     Procedure Relatorio1;     Procedure CabecalhoRelatorio1;     Procedure Relatorio2;     Procedure CabecalhoRelatorio2;     Procedure InitializeReport(ReportNumber:Byte);   public     { Public declarations }   end; var   Form1: TForm1; implementation {$R *.DFM} //============================================================================== // Controla o salto da página todas as vezes que chegar ao final. //============================================================================== Procedure NextLine(RVSystem:TRVSystem); Begin   RVSystem.BaseReport.NewLine;   If RVSystem.BaseReport.LinesLeft=0 Then RVSystem.BaseReport.NewPage; End; //============================================================================== // Inicializa o relatorio configurando alguns parametros básicos //============================================================================== Procedure TForm1.InitializeReport(ReportNumber:Byte); 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.SelectPaper('A4',false);    rpDev.Copies                          := 1;    RVSystem1.SystemPrinter.Copies        := rpDev.Copies;    rpDev.Orientation                     := poPortrait;    RVSystem1.SystemPrinter.Orientation   := rpDev.Orientation;    RVSystem1.SystemPreview.RulerType     := rtBothCm;    RVSystem1.SystemSetups := RVSystem1.SystemSetups - [ssAllowSetup];    RVSystem1.SystemPreview.FormState     := wsMaximized;    RVSystem1.Tag := ReportNumber;    RVSystem1.Execute; End; //============================================================================== // Definicao procedural do relatorio 1 //============================================================================== Procedure TForm1.Relatorio1; Var SomaTotal : Double; Begin    SomaTotal := 0;    ADOQuery.Close;    ADOQuery.SQL.Text := 'SELECT * From Vendas Order by Categoria,Produto';    ADOQuery.Open;    While not ADOQuery.Eof do Begin       RVSystem1.BaseReport.PrintLeft(ADOQuery.FieldByName('Categoria').AsString,1);       RVSystem1.BaseReport.PrintLeft(ADOQuery.FieldByName('Produto').AsString,6);       RVSystem1.BaseReport.PrintLeft(ADOQuery.FieldByName('Cidade').AsString,12);       If ADOQuery.FieldByName('Vendas').asFloat<2000 Then RVSystem1.BaseReport.FontColor := clRed;       RVSystem1.BaseReport.PrintRight( FormatFloat('#,##0.00',ADOQuery.FieldByName('Vendas').asFloat),19);       RVSystem1.BaseReport.FontColor := clBlack;       RVSystem1.BaseReport.NewLine;       SomaTotal := SomaTotal + ADOQuery.FieldByName('Vendas').AsFloat;       If RVSystem1.BaseReport.LinesLeft=0 Then RVSystem1.BaseReport.NewPage;       ADOQuery.Next;    End;    // Imprime o Total Geral de Vendas    With RVSystem1.BaseReport do Begin       GotoFooter;       Canvas.Pen.Width := 5;       Canvas.Pen.Color := clBlack;       MoveTo(MarginLeft,YPos-LineHeight);       LineTo(PageWidth-MarginRight,YPos-LineHeight);       Bold := True;       PrintLeft( 'Total de Vendas',MarginLeft);       PrintRight( FormatFloat('#,##0.00',SomaTotal),19);       Bold := False;    End; End; //============================================================================== // Exporta o relatorio para PDF //============================================================================== procedure TForm1.Button2Click(Sender: TObject); Var RPRenderPDF1 : TRPRenderPDF; begin   RPRenderPDF1 := TRPRenderPDF.Create(nil);   Try      RVSystem1.DefaultDest := rdFile;      RVSystem1.DoNativeOutput := false;      RVSystem1.RenderObject := RPRenderPDF1;      RVSystem1.OutputFileName := '.\\teste.pdf';      RVSystem1.SystemSetups := RVSystem1.SystemSetups - [ssAllowSetup];      RVSystem1.Execute;      ShellExecute(0,'open','.\\teste.pdf','',nil,sw_shownormal);   Finally      RPRenderPDF1.Free;   End; end; //============================================================================== // Exporta o relatorio para HTML //============================================================================== procedure TForm1.Button3Click(Sender: TObject); Var RPRenderHtml1 : TRPRenderHtml; begin    RPRenderHtml1 := TRPRenderHtml.Create(nil);    Try       RvSystem1.DefaultDest := rdFile;       RvSystem1.DoNativeOutput := false;       RvSystem1.RenderObject := RPRenderHtml1;       RvSystem1.OutputFileName := 'teste.htm';       RvSystem1.SystemSetups := RvSystem1.SystemSetups - [ssAllowSetup];       rvSystem1.Execute;       ShellExecute(0,'open','Teste.htm','',nil,sw_shownormal);    Finally      RPRenderHtml1.Free;    End; End; //============================================================================== // Definicao procedural do cabecalho do relatorio 1 //============================================================================== Procedure TForm1.CabecalhoRelatorio1; Begin    with RVSystem1.BaseReport do begin       PrintBitmapRect(1,1,4.5,2,Image1.Picture.Bitmap);       SetFont('Arial',16);       MarginTop := 0.5;       Home;       PrintHeader('Relatorio de Vendas', pjCenter);       SetFont('Arial',12);       MarginTop := MarginTop+LineHeight;       Home;       PrintHeader('Relatório Anual', pjCenter);       PrintHeader('Página '+Macro(midCurrentPage)+' de '+Macro(midTotalPages),pjRight);       MarginTop := MarginTop+LineHeight;       Home;       SetFont('Arial',8);       PrintHeader('Ano 2003', pjCenter);       SetFont('Arial',12);       PrintHeader('Data '+FormatDateTime('dd/mm/yyyy',now()),pjRight);       // Traca uma linha       Canvas.Pen.Width := 7;       Canvas.Pen.Color := clBlack;       MoveTo(MarginLeft,YPos+0.3);       LineTo(PageWidth-MarginRight,YPos+0.3);       SetFont('Arial',12);       Bold := True;       MarginTop := MarginTop+LineHeight+0.5;       Home;       PrintLeft('Categoria',1);       PrintLeft('Produto',6);       PrintLeft('Cidade',12);       PrintRight('Vendas',19);       // Traca uma linha       Canvas.Pen.Width := 2;       Canvas.Pen.Color := clBlack;       MoveTo(MarginLeft,YPos+0.1);       LineTo(PageWidth-MarginRight,YPos+0.1);       SetFont('Arial',12);       Bold := False;       MarginTop := MarginTop+LineHeight+0.2;       Home;       AdjustLine;    end; { with } End; Procedure TForm1.CabecalhoRelatorio2; Begin    with RVSystem1.BaseReport do begin       PrintBitmapRect(1,1,4.5,2,Image1.Picture.Bitmap);       SetFont('Arial',16);       MarginTop := 0.5;       Home;       PrintHeader('Relatorio de Vendas por Categoria', pjCenter);       SetFont('Arial',12);       MarginTop := MarginTop+LineHeight;       Home;       PrintHeader('Relatório Anual', pjCenter);       PrintHeader('Página '+Macro(midCurrentPage)+' de '+Macro(midTotalPages),pjRight);       MarginTop := MarginTop+LineHeight;       Home;       SetFont('Arial',8);       PrintHeader('Ano 2003', pjCenter);       SetFont('Arial',12);       PrintHeader('Data '+FormatDateTime('dd/mm/yyyy',now()),pjRight);       // Traca uma linha       Canvas.Pen.Width := 7;       Canvas.Pen.Color := clBlack;       MoveTo(MarginLeft,YPos+0.3);       LineTo(PageWidth-MarginRight,YPos+0.3);       SetFont('Arial',12);       Bold := True;       MarginTop := MarginTop+LineHeight+0.5;       Home;       PrintLeft('Categoria',1);       PrintLeft('Produtos',6);       PrintLeft('Cidade',12);       PrintRight('Vendas',19);       // Traca uma linha       Canvas.Pen.Width := 2;       Canvas.Pen.Color := clBlack;       MoveTo(MarginLeft,YPos+0.1);       LineTo(PageWidth-MarginRight,YPos+0.1);       SetFont('Arial',12);       Bold := False;       MarginTop := MarginTop+LineHeight+0.2;       Home;       AdjustLine;    end; { with } End; Procedure TForm1.Relatorio2; Var SomaTotal : Double;     SomaCategoria, SomaProduto, SomaCidade : Double;     Categoria : String;     Produto   : String;     Cidade    : String; Begin    SomaTotal := 0;    ADOQuery.Close;    ADOQuery.SQL.Text := 'SELECT * From Vendas Order by Categoria,Produto,Cidade';    ADOQuery.Open;    While not ADOQuery.Eof do Begin       // Grupo por Categoria       SomaCategoria := 0;       Categoria := ADOQuery.FieldByName('Categoria').AsString;       RVSystem1.BaseReport.PrintLeft(Categoria,1);       While (Categoria=ADOQuery.FieldByName('Categoria').AsString) and (not ADOQuery.Eof) do Begin          // Grupo por Produto          SomaProduto := 0;          Produto := ADOQuery.FieldByName('Produto').AsString;          RVSystem1.BaseReport.PrintLeft(Produto,6);          While (Produto= ADOQuery.FieldByName('Produto').AsString) and (Categoria=ADOQuery.FieldByName('Categoria').AsString) and (not ADOQuery.Eof) do Begin             // Grupo por Cidade             SomaCidade := 0;             Cidade := ADOQuery.FieldByName('Cidade').AsString;             RVSystem1.BaseReport.PrintLeft(Cidade,12);             While (Cidade=ADOQuery.FieldByName('Cidade').AsString) and (Produto= ADOQuery.FieldByName('Produto').AsString) and (Categoria=ADOQuery.FieldByName('Categoria').AsString) and (not ADOQuery.Eof) do Begin                SomaCidade    := SomaCidade + ADOQuery.FieldByName('Vendas').asFloat;                SomaProduto   := SomaCidade  + SomaProduto;                SomaCategoria := SomaCidade  + SomaCategoria;                SomaTotal     := SomaCidade  + SomaTotal;                ADOQuery.Next;             End;             // Total do Grupo Cidade             RVSystem1.BaseReport.PrintRight( FormatFloat('#,##0.00',SomaCidade),19);             NextLine(RVSystem1);          End;          // Total do Grupo Produto          RVSystem1.BaseReport.Bold := True;          RVSystem1.BaseReport.PrintLeft( 'Soma '+Produto,6);          RVSystem1.BaseReport.PrintRight( FormatFloat('#,##0.00',SomaProduto),19);          RVSystem1.BaseReport.Bold := False;          NextLine(RVSystem1);          With RVSystem1.BaseReport do begin          Canvas.Pen.Style := psDot;          Canvas.Pen.Width := 1;          Canvas.Pen.Color := clBlack;          MoveTo(6,YPos-LineHeight+0.1);          LineTo(19,YPos-LineHeight+0.1);          Canvas.Pen.Style := psSolid;          End;       End;       // Total do Grupo Categoria       With RVSystem1.BaseReport do Begin          SetBrush(ShadeToColor(clBlack,20),bsSolid,nil);          FillRect(CreateRect(MarginLeft-0.1,YPos+LineHeight-1+0.1,19,YPos+0.1));       End;       RVSystem1.BaseReport.Bold := True;       RVSystem1.BaseReport.PrintLeft( 'Soma '+Categoria,1);       RVSystem1.BaseReport.PrintRight( FormatFloat('#,##0.00',SomaCategoria),19);       RVSystem1.BaseReport.Bold := False;       NextLine(RVSystem1);    End;    // Imprime o Total Geral de Vendas    With RVSystem1.BaseReport do Begin       GotoFooter;       Canvas.Pen.Width := 5;       Canvas.Pen.Color := clBlack;       MoveTo(MarginLeft,YPos-LineHeight);       LineTo(PageWidth-MarginRight,YPos-LineHeight);       Bold := True;       PrintLeft( 'Total de Vendas',MarginLeft);       PrintRight( FormatFloat('#,##0.00',SomaTotal),19);       Bold := False;    End; End; //============================================================================== // Impressão do cabecalho dos relatorios //============================================================================== procedure TForm1.RvSystem1NewPage(Sender: TObject); begin    Case RVSystem1.Tag of    1 : CabecalhoRelatorio1;    2 : CabecalhoRelatorio2;    End; end; //============================================================================== // Impressao do corpo dos relatorios //============================================================================== procedure TForm1.RvSystem1Print(Sender: TObject); begin    Case RVSystem1.Tag of    1 : Relatorio1;    2 : Relatorio2;    End; end; //============================================================================== // //============================================================================== procedure TForm1.Button1Click(Sender: TObject); begin    InitializeReport(1); end; procedure TForm1.Button4Click(Sender: TObject); begin    InitializeReport(2); end; end.

Quebra-Linha

Colaborador..: Adenilton Rodrigues
Categoria(s).: Delphi;
Data.........: 19/03/2004 23:35:41
Visualizado..: 6372 vezes
Fonte........: AdeN Knowledge DB