chartdemo.pas

一个后成PDF文件的控件

unit ChartDemo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, TeeProcs, TeEngine, Chart, ExtCtrls, QuickPdf, Series, QPDFRender, ShellAPI,
  Grids, DBGrids, Db, DBTables, DBChart, TeeFunci;

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    QuickPdf1: TQuickPdf;
    DBGrid1: TDBGrid;
    Button2: TButton;
    DataSource1: TDataSource;
    Table1: TTable;
    GroupBox2: TGroupBox;
    DBChart1: TDBChart;
    Series1: TBarSeries;
    TeeFunction1: TLowTeeFunction;
    Table1Name: TStringField;
    Table1Capital: TStringField;
    Table1Continent: TStringField;
    Table1Area: TFloatField;
    Table1Population: TFloatField;
    Image1: TImage;
    SaveDialog1: TSaveDialog;
    procedure Button2Click(Sender: TObject);
  private
    DocHeaderFont: TFont;
    TableHeaderFont: TFont;
    TextFont: TFont;
    StripTextFont: TFont;

    procedure CreateFonts;
    procedure DestroyFonts;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.CreateFonts;
begin
  // Creating a font for a document header
  DocHeaderFont := TFont.Create();
  with DocHeaderFont do begin
    Color := clNavy;
    Size := 14;
    Name := 'Times Now Roman';
  end;

  // Creating a font for a table header
  TableHeaderFont := TFont.Create();
  with TableHeaderFont do begin
    Color := clWhite;
    Size := 10;
    Name := 'Impact';
  end;

  // Creating a font for a simple text
  TextFont := TFont.Create();
  with TextFont do begin
    Color := clBlack;
    Size := 8;
    Name := 'Times New Roman';
  end;

  // Creating a font for a strip text
  StripTextFont := TFont.Create();
  with StripTextFont do begin
    Color := clNavy;
    Size := 8;
    Name := 'Times New Roman';
  end;
end;

procedure TMainForm.DestroyFonts;
begin
  DocHeaderFont.Free;
  TableHeaderFont.Free;
  TextFont.Free;
  StripTextFont.Free;
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
  Font: TFont;
  ATable, DataTable: TRenderTable;
  i: integer;
  Country, Population, Area: string;
  Path: string;
begin
  // Creating fonts
  CreateFonts;
  try
    // Receiving a file name
    if SaveDialog1.Execute
      then QuickPDF1.Filename := SaveDialog1.FileName
      else Exit;

    with QuickPDF1.Document do begin
      // Defining a left margin of the document
      MainTable.Padding.Left := 28;
      // Defining a document header
      Header.AddText('QuickPDF Chart Demo'#10#10, DocHeaderFont, rtaCenter);
    end;

    // Splitting a page to two parts.
    // Left part is used to place a data table.
    // Right part is nedded to place a chart image.
    ATable := TRenderTable.Create(
      [QuickPDF1.Document.Section[0].InternalWidth div 2,
       QuickPDF1.Document.Section[0].InternalWidth div 2]);
    QuickPDF1.Document.Section[0].AddItem(0, 0, ATable);
    ATable.Border := -1;
    ATable.AddRow;

    // Adding data table with tree columns and defining its padding intervals
    DataTable := TRenderTable.Create(
      [(ATable.Cell[0, 0].InternalWidth - 1) div 2,
       (ATable.Cell[0, 0].InternalWidth) div 4,
       (ATable.Cell[0, 0].InternalWidth) div 4]);
    DataTable.Padding := Rect(2, 2, 2, 2);

    // Adding a caption for the table
    DataTable.AddRow;
    DataTable.Rows[0].BgColor := clNavy;
    DataTable.Cell[0, 0].AddText('Name', TableHeaderFont, rtaCenter);
    DataTable.Cell[1, 0].AddText('Area', TableHeaderFont, rtaCenter);
    DataTable.Cell[2, 0].AddText('Population', TableHeaderFont, rtaCenter);

    Table1.First;
    for i := 0 to Table1.RecordCount - 1 do begin
      DataTable.AddRow;
      if i mod 2 = 1 then begin
        DataTable.Rows[i + 1].BgColor := clSilver;
        Font := StripTextFont;
      end
      else Font := TextFont;

      Country := Table1.FieldByName('Name').AsString;
      Area := FormatFloat('### ### ###', Table1.FieldByName('Area').AsInteger);
      Population := FormatFloat('### ### ###',
        Table1.FieldByName('Population').AsInteger);

      // Adding data to cells
      DataTable.Cell[0, i + 1].AddText(Country, Font, rtaLeft);
      DataTable.Cell[1, i + 1].AddText(Area, Font, rtaRight);
      DataTable.Cell[2, i + 1].AddText(Population, Font, rtaRight);

      Table1.Next;
    end;

    // Adding the data table to the left part of the page
    ATable.Cell[0, 0].AddItem(0, 0, DataTable);

    //Preparing an image
    Path := ExtractFilePath(Application.ExeName);
    DBChart1.SaveToMetafileEnh(Path + 'temp.emf');
    Image1.Picture.LoadFromFile(Path + 'temp.emf');

    // Adding a chart image
    ATable.Cell[1, 0].AddItem(0, 0,
      TRenderImage.Create(ATable.Cell[1, 0].Width, Image1.Picture.Graphic));

    // Generating a PDF file
    QuickPDF1.GenerateToFile;

    // Opening a file
    ShellExecute(0, 'open', PChar(QuickPDF1.FileName), '', '', SW_SHOWNORMAL);
  finally
    if FileExists(Path + 'temp.emf') then
      DeleteFile(Path + 'temp.emf');
    DestroyFonts;
  end;
end;

end.