⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 embeddedtablesmain.pas

📁 一个后成PDF文件的控件
💻 PAS
字号:
unit EmbeddedTablesMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  QuickPdf, StdCtrls, QPDFRender, ShellAPI, Math, ExtCtrls, Grids, DBGrids,
  Db, DBTables, ComCtrls;

type
  TMainForm = class(TForm)
    QuickPdf1: TQuickPdf;
    Panel1: TPanel;
    Button: TButton;
    Label1: TLabel;
    InvoiceNumber: TEdit;
    Label2: TLabel;
    Name: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Address1: TEdit;
    Address2: TEdit;
    Phone: TEdit;
    Email: TEdit;
    Fax: TEdit;
    ItemsGroupBox: TGroupBox;
    DataSource1: TDataSource;
    Table1: TTable;
    ItemsListView: TListView;
    SaveDialog1: TSaveDialog;
    procedure GenerateInvoice(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ItemsListViewCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure ItemsListViewCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  private
    TableHeaderFont: TFont;
    DocumentHeaderFont: TFont;
    TextFont: TFont;
    BoldTextFont: TFont;

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

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

const
  Names: Array[0..9] of String =
    ('SAMSUNG HPN6339 63in Plasma TV',
     'Zenith D60W26 60 IN Plasma Display',
     'JVC DLA-HX1U',
     'Sony PFM50C1 Plasma Display',
     'Pioneer PDP-5040HD Plasma TV',
     'JVC DLA-SX21',
     'PHILLIPS 50FD9955 Plasma Display',
     'JVC GDV-501U Plasma TV',
     'ZENITH P50W28 Plasma TV',
     'SHARP PZ50HV2U 50in Plasma Display');

  Prices: Array[0..9] of Double =
    (14575.000,
     10655.000,
     8060.000,
     7490.000,
     7390.000,
     7265.000,
     7220.000,
     6925.000,
     6665.000,
     6315.000);

  ExchangeRate: Double = 1.209;

procedure TMainForm.CreateFonts;
begin
  // Creating a font for a table header
  TableHeaderFont := TFont.Create();
  with TableHeaderFont do
    begin
      Color := clBlack;
      Size := 8;
      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 bold text
  BoldTextFont := TFont.Create();
  with BoldTextFont do
    begin
      Color := clBlack;
      Style := Style + [fsBold];
      Size := 10;
      Name := 'Times New Roman';
    end;

  // Creating a font for a document header
  DocumentHeaderFont := TFont.Create();
  with DocumentHeaderFont do
    begin
      Color := clBlack;
      Size := 12;
      Style := Style + [fsBold];
      Name := 'Times New Roman';
    end;
end;

procedure TMainForm.DestroyFonts;
begin
  TableHeaderFont.Free;
  DocumentHeaderFont.Free;
  TextFont.Free;
  BoldTextFont.Free;
end;

procedure TMainForm.GenerateInvoice(Sender: TObject);
var Table,
    Table1: TRenderTable;
    DocumentWidth,
    i: Integer;
    AName,
    APriceUSD,
    APriceEURO: string;
begin
  // Receiving a file name
  if SaveDialog1.Execute then
    QuickPDF1.FileName := SaveDialog1.FileName
  else Exit;
  // Creating fonts
  CreateFonts;
  try
    // Adding a document header and receiving a document width without padding
    with QuickPDF1.Document do begin
      Header.AddText('Invoice No. #' + InvoiceNumber.Text, DocumentHeaderFont,
        rtaCenter);
      DocumentWidth := MainTable.Cell[0, 0].InternalWidth;
    end;

    // Creating a table with customer's name and address
    Table1 := TRenderTable.Create([95, DocumentWidth div 2 - 95]);
    with Table1 do begin
      Border := -1;
      Padding.Top := 6;
      Cell[0, 0].AddText('Name: ', BoldTextFont, rtaLeft);
      Cell[1, 0].AddText(Name.Text, TextFont, rtaLeft);
      Cell[1, 0].BorderBottom := 0;
      Cell[0, 1].AddText('Address1: ', BoldTextFont, rtaLeft);
      Cell[1, 1].AddText(Address1.Text, TextFont, rtaLeft);
      Cell[1, 1].BorderBottom := 0;
      Cell[0, 2].AddText('Address2: ', BoldTextFont, rtaLeft);
      Cell[1, 2].AddText(Address2.Text, TextFont, rtaLeft);
      Cell[1, 2].BorderBottom := 0;
    end;
    QuickPDF1.Document.Section[0].AddParagraph.AddItem(0, 0, Table1);

    // Creating a table with customer's phone number,
    // fax number, and e-mail address
    Table1 := TRenderTable.Create([95, DocumentWidth div 3 - 95]);
    with Table1 do begin
      Border := -1;
      Padding.Top := 6;
      Cell[0, 0].AddText('Phone Number: ', BoldTextFont, rtaLeft);
      Cell[1, 0].AddText(Phone.Text, TextFont, rtaLeft);
      Cell[1, 0].BorderBottom := 0;
      Cell[0, 1].AddText('Fax Number: ', BoldTextFont, rtaLeft);
      Cell[1, 1].AddText(Fax.Text, TextFont, rtaLeft);
      Cell[1, 1].BorderBottom := 0;
      Cell[0, 2].AddText('E-mail Address: ', BoldTextFont, rtaLeft);
      Cell[1, 2].AddText(Email.Text, TextFont, rtaLeft);
      Cell[1, 2].BorderBottom := 0;
    end;
    QuickPDF1.Document.Section[0].AddParagraph.AddItem(0, 0, Table1);

    // Inserting an empty line
    QuickPDF1.Document.Section[0].AddParagraph.AddText(#10#10, BoldTextFont, rtaLeft);;

    // Creating a table header
    Table := TRenderTable.Create([DocumentWidth div 2, DocumentWidth - DocumentWidth div 2]);
    with Table do begin
      HasHeader := True;
      AddRow;
      Rows[0].BgColor := clSilver;
      Cell[0, 0].Padding := Rect(0, 10, 0, 0);
      Cell[0, 0].AddText('Product Name', TableHeaderFont, rtaCenter);

      // Splitting the header cell of the Price column to two paragraph to avoid
      // errors in rendering a mixed content (a text and a table) in the table
      // cell.
      with Cell[1, 0].AddParagraph do begin
        Padding := Rect(2, 2, 2, 2);
        AddText('Price', TableHeaderFont, rtaCenter);
      end;
    end;

    // Creating a table that visually splits the header cell in the Price column
    // to two columns for prices in USD and in Euro.
    Table1 := TRenderTable.Create([Table.Cell[1, 0].Width div 2,
          Table.Cell[1, 0].Width - Table.Cell[1, 0].Width div 2]);
    with Table1 do begin
      Padding := Rect(2, 2, 2, 2);
      AddRow;
      Cell[0, 0].AddText('USD', TableHeaderFont, rtaCenter);
      Cell[1, 0].AddText('EURO', TableHeaderFont, rtaCenter);
    end;
    // Adding the created table to a new paragraph in the header cell of the
    // Price column
    Table.Cell[1, 0].AddParagraph.AddItem(0, 0, Table1);

    for i := 0 to ItemsListView.Items.Count - 2 do
    begin
      AName := ItemsListView.Items.Item[i].Caption;
      APriceUSD := ItemsListView.Items.Item[i].SubItems.Strings[0];
      APriceEURO := ItemsListView.Items.Item[i].SubItems.Strings[1];

      // Adding a row to the table
      with Table.AddRow do begin
        if (i mod 2) = 1
          then BgColor := $e0e0e0;
        Cell[0].Padding := Rect(2, 2, 2, 2);
        Cell[0].AddText(AName, TextFont, rtaLeft);
        with Cell[1].AddParagraph do begin
          // Creating a table that splits the current cell in the Price product
          // to two columns. Adding prices in USD and EURO to the propert
          // columns of the new table.
          Table1 := TRenderTable.Create([Width div 2, Width - Width div 2]);
          Table1.Padding := Rect(2, 2, 2, 2);
          Table1.Cell[0, 0].AddText(APriceUSD, TextFont, rtaRight);
          Table1.Cell[1, 0].AddText(APriceEURO, TextFont, rtaRight);
          // Adding the table to the cell
          AddItem(0, 0, Table1);
        end;
      end;
    end;

    // Creating the 'Total' line
    with Table.AddRow do begin
      Cell[0].Padding := Rect(2, 2, 2, 2);
      Cell[0].BorderLeft := -1;
      Cell[0].BorderBottom := -1;
      Cell[0].AddText('Total:', BoldTextFont, rtaRight);
      with Cell[1].AddParagraph do begin
        Table1 := TRenderTable.Create([Width div 2, Width - Width div 2]);
        Table1.Padding := Rect(2, 2, 2, 2);
        Table1.Cell[0, 0].AddText(FormatFloat('### ###.00', Sum(Prices)), BoldTextFont, rtaRight);
        Table1.Cell[1, 0].AddText(FormatFloat('### ###.00', Sum(Prices) / ExchangeRate), BoldTextFont, rtaRight);
        AddItem(0, 0, Table1);
      end;
    end;

    // Adding a main table of the invoice to the main table of the entire
    // document
    QuickPDF1.Document.Section[0].AddParagraph.AddItem(0, 0, Table);

    // Generating document
    QuickPDF1.GenerateToFile;

    // Opening the result document
    ShellExecute(0, 'open', PChar(QuickPDF1.FileName), '', '', SW_SHOWNORMAL);
  finally
    DestroyFonts;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var i: Integer;
    Item: TListItem;
begin
  ItemsListView.GridLines := True;
  for i:=0  to 9 do
  begin
    Item := ItemsListView.Items.Add;
    Item.Caption := Names[i];
    Item.SubItems.Add(FormatFloat('### ###.00',Prices[i]));
    Item.SubItems.Add(FormatFloat('### ###.00',Prices[i] / ExchangeRate));
  end;
  Item := ItemsListView.Items.Add;
  Item.Caption := 'Total:';
  Item.SubItems.Add(FormatFloat('### ###.00',Sum(Prices)));
  Item.SubItems.Add(FormatFloat('### ###.00',Sum(Prices) / ExchangeRate));
end;

procedure TMainForm.ItemsListViewCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
var
  Canvas: TCanvas;
begin
  if (SubItem = 1) and (Item.Caption = 'Total:') then begin
    Canvas := ItemsListView.Canvas;
    Canvas.Brush.Color := clGray;
    Canvas.Font.Color := clWhite;
    Canvas.Font.Style := Canvas.Font.Style + [fsBold];
  end
end;

procedure TMainForm.ItemsListViewCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
var
  Canvas: TCanvas;
begin
  Canvas := ItemsListView.Canvas;
  if Item.Caption = 'Total:' then begin
    Canvas.Brush.Color := clGray;
    Canvas.Font.Color := clWhite;
    Canvas.Font.Style := Canvas.Font.Style + [fsBold];
  end
  else begin
    if Item.Index mod 2 = 1 then
      Canvas.Brush.Color := $e0e0e0;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -