Measure/Units/ExportExcel.pas

unit ExportExcel;

interface

uses
  Classes, ZjGrid, ScXlsOutput, ScXlsCustomUD, Windows, StdCtrls,
  sdIDTree, sdDB, Graphics, SysUtils, ProgressHintFrm, Forms, Controls,
  OExport, OExport_Vcl, OExport_VclForms, BillsPosTree, BillsTree;

type
  TExcelExportor = class
  private
    FOExport: TOExport;
    FGrid: TZJGrid;
    FTempFile: string;
    FFileName: string;

    procedure InitialPage(AGrid: TZJGrid; ASheet: TExportWorkSheet);
  protected
    procedure BeforeExport;
    procedure EndExport;
  public
    constructor Create;
    destructor Destroy; override;

    procedure ExportToSheet(AGrid: TZJGrid; ASheet: TExportWorkSheet);
    procedure ExportToFile(AGrid: TZJGrid; const AFileName: string);
  end;

  PColInfo = ^TColInfo;

  TColInfo = record
    // 字段名
    FieldName: string;
    // 查询字段名，应用于联合几个数据库的情况，参照dataset的Lookup方式
    KeyField: string;
    LookupKeyField: string;
    // 查询数据库ID
    LookupDataSetIndex: Integer;
    // 列名
    TitleCaption: string;
    // 列宽
    Width: Integer;
    // 对齐方式
    HorTextAlign: TCellHAlignment;
    //VerTextAlign: TUDVTextAlign;
  end;

  PColInfos = ^TColInfos;

  TColInfos = array [0..30] of TColInfo;

  // 仿照DataSet的Lookup以及数据库的AutoUpdate, 以达到关于sdIDTree导出数据至Excel的普适性
  // 导出前须根据所需列信息，以及查询数据库（列信息须与查询数据库对等，否则将会报错，并不检查列与数据库是否匹配）
  TIDTreeExcelExportor = class
  private
    FOExport: TOExport;
    FDataSetList: TList;
    FColInfos: PColInfos;
    FColCount: Integer;
    FHasLevelCode: Boolean;
    FTree: TsdIDTree;
    FTempFile: string;

    // 当清单数超过3w3k行时，使用Variant会内存溢出
    function GetCellValue(ANode: TsdIDTreeNode; ColInfo: TColInfo): Variant;
    // 故换成直接使用String
    function GetCellStr(ANode: TsdIDTreeNode; ColInfo: TColInfo): string;
    procedure ExportNodeData(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet; const ALevelCode: string);
    procedure ExportTreeNode(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet; const ALevelCode: string);
    procedure DefineHeader(ASheet: TExportWorkSheet);
  protected
    procedure BeforeExport;
    procedure AfterExport;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddLookupDataSet(ADataSet: TsdDataSet);
    procedure DefineCol(AColInfos: PColInfos; AColCount: Integer);

    procedure ExportToSheet(ATree: TsdIDTree; ASheet: TExportWorkSheet);
    procedure ExportToFile(ATree: TsdIDTree; const AFileName: string);

    property HasLevelCode: Boolean read FHasLevelCode write FHasLevelCode;
  end;

  TMasterExcelExportor = class
  private
    FOExport: TOExport;
    FColInfos: PColInfos;
    FRelaColInfos: PColInfos;
    FColCount: Integer;
    FTempFile: string;

    FMasterDataSet: TsdDataSet;
    FKeyFieldName: string;
    FRelaDataSet: TsdDataSet;
    FMasterFieldName: string;

    function GetCellValue(ARec: TsdDataRecord; ColInfo: TColInfo): Variant;
    procedure ExportRecord(ARec: TsdDataRecord; ASheet: TExportWorkSheet; AColInfos: PColInfos);
    procedure ExportData(ASheet: TExportWorkSheet);
    procedure DefineHeader(ASheet: TExportWorkSheet);
  protected
    procedure BeforeExport;
    procedure AfterExport;
  public
    constructor Create;
    destructor Destroy; override;

    procedure DefineCol(AColInfos: PColInfos; AColCount: Integer; ARelaColInfo: PColInfos = nil);
    procedure DefineMasterDataSet(ADataSet: TsdDataSet; const AKeyFieldName: string);
    procedure DefineRelaDataSet(ADataSet: TsdDataSet; const AMasterFieldName: string);

    procedure ExportToSheet(ASheet: TExportWorkSheet);
    procedure ExportToFile(const AFileName: string);
  end;

  TBillsPosExcelExportor = class
  private
    FOExport: TOExport;
    FTempFile: string;

    FTree: TBillsPosTree;
    FCodeCol: Integer;
    FB_CodeCol: Integer;
    FP_CodeCol: Integer;
    FNameCol: Integer;
    FUnitsCol: Integer;
    FQuantityCol: Integer;
    FDgnQty1: Integer;
    FDgnQty2: Integer;
    FPriceCol: Integer;
    FTotalPriceCol: Integer;
    FDrawingCodeCol: Integer;
    FMemoStrCol: Integer;

    procedure DefineHeader(ASheet: TExportWorkSheet);

    function HasGclChild(ANode: TBillsIDTreeNode): Boolean;
    function FindNode(AParent: TBillsPosTreeNode; AMatch: TBillsIDTreeNode): TBillsPosTreeNode;
    procedure ConversePosNode(ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode = nil);
    function ConverseNodeData(ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode = nil): TBillsPosTreeNode;
    procedure ConverseTreeNode(ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode = nil);

    procedure ExportPos(ASheet: TExportWorkSheet; ANode: TBillsPosTreeNode);
    procedure ExportNode(ASheet: TExportWorkSheet; ANode: TBillsPosTreeNode);
    procedure ExportData(ASheet: TExportWorkSheet);
  protected
    procedure BeforeExport;
    procedure AfterExport;
  public
    constructor Create;
    destructor Destroy; override;

    procedure ExportToSheet(ABillsIDTree: TBillsIDTree; ASheet: TExportWorkSheet);
    procedure ExportToFile(ABillsIDTree: TBillsIDTree; const AFileName: string);
  end;

const
  ciLedger: array [0..8] of TColInfo =(
    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  );

  ciLedgerWithMis: array [0..10] of TColInfo =(
    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '施工图数量'; Width: 90; HorTextAlign: cahRight),
    (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
    (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  );

  ciFxBills: array [0..10] of TColInfo =(
    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
    (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  );

  ciFxBillsWithMis: array [0..12] of TColInfo =(
    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 90; HorTextAlign: cahRight),
    (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
    (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
    (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  );

  ciTpPegGcl: array [0..9] of TColInfo =(
    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
    (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  );

  ciTpGclPeg_Gcl: array [0..9] of TColInfo =(
    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
    (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  );

  ciTpGclPeg_Peg: array [0..9] of TColInfo =(
    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'PegXmjCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
    (FieldName: 'PegXmjName'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
    (FieldName: 'PegXmjUnits'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
    (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
    (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  );

implementation

uses
  ZhAPI, Variants, UtilMethods, Math, CacheTree, mDataRecord;

function GetExportor(const AFileType: string): TOCustomExporter;
begin
  if SameText(AFileType, '.xls') then
    Result := TOCustomExporterXLS.Create
  else if SameText(AFileType, '.xlsx') then
    Result := TOCustomExporterXLSX.Create;
end;

{ TExcelExportor }

procedure TExcelExportor.BeforeExport;
begin
  Screen.Cursor := crHourGlass;
  ShowProgressHint('导出Excel表格数据', FGrid.RowCount);
end;

constructor TExcelExportor.Create;
begin
  FOExport := TOExport.Create;
  FOExport.UseProgress := False;

  FTempFile := GetTempFileName;
end;

destructor TExcelExportor.Destroy;
begin
  if FileExists(FTempFile) then
    DeleteFileOrFolder(FTempFile);
  FOExport.Free;
  inherited;
end;

procedure TExcelExportor.EndExport;
begin
  CloseProgressHint;
  Screen.Cursor := crDefault;
end;

procedure TExcelExportor.ExportToFile(AGrid: TZJGrid;
  const AFileName: string);
var
  vExportor: TOCustomExporter;
begin
  FFileName := AFileName;
  FGrid := AGrid;
  BeforeExport;
  try
    vExportor := GetExportor(ExtractFileExt(AFileName));
    ExportToSheet(AGrid, FOExport.AddWorkSheet);
    FOExport.SaveToFile(FTempFile, vExportor);
    if not FileExists(FFileName) or QuestMessage('存在同名文件，是否替换？') then
      CopyFileOrFolder(FTempFile, FFileName);
  finally
    vExportor.Free;
    EndExport;
  end;
end;

procedure TExcelExportor.ExportToSheet(AGrid: TZJGrid;
  ASheet: TExportWorkSheet);

  procedure SetXlsCellTextAlign(ACell: TExportCell; AGridCell: TzjCell);
  begin
    case AGridCell.TextAlign of
      gaTopLeft:
      begin
        ACell.SetVAlignment(cavTop);
        ACell.SetAlignment(cahLeft);
      end;
      gaTopCenter:
      begin
        ACell.SetVAlignment(cavTop);
        ACell.SetAlignment(cahCenter);
      end;
      gaTopRight:
      begin
        ACell.SetVAlignment(cavTop);
        ACell.SetAlignment(cahRight);
      end;
      gaCenterLeft:
      begin
        ACell.SetVAlignment(cavCenter);
        ACell.SetAlignment(cahLeft);
      end;
      gaCenterCenter:
      begin
        ACell.SetVAlignment(cavCenter);
        ACell.SetAlignment(cahCenter);
      end;
      gaCenterRight:
      begin
        ACell.SetVAlignment(cavCenter);
        ACell.SetAlignment(cahRight);
      end;
      gaBottomLeft:
      begin
        ACell.SetVAlignment(cavBottom);
        ACell.SetAlignment(cahLeft);
      end;
      gaBottomCenter:
      begin
        ACell.SetVAlignment(cavBottom);
        ACell.SetAlignment(cahCenter);
      end;
      gaBottomRight:
      begin
        ACell.SetVAlignment(cavBottom);
        ACell.SetAlignment(cahRight);
      end;
    end;
    if goWarpText in AGridCell.Grid.Options then
      ACell.WrapText := True;
  end;

  procedure ExportGridCell(AGridCell: TzjCell; ARow: TExportRow);
  var
    vCell: TExportCell;
    XlsCell: TXlsCustomCell;
  begin
    if (AGridCell = nil) then Exit;
    if ARow.Cells.Count >= AGridCell.Col + 1 then
      vCell := ARow.Cells[AGridCell.Col]
    else
      vCell := ARow.AddCellString(AGridCell.Text);
    SetXlsCellTextAlign(vCell, AGridCell);
    vCell.Font.Name := AGridCell.Font.Name;
    vCell.Font.Size := AGridCell.Font.Size;
    vCell.RowSpan := AGridCell.Height;
    vCell.ColSpan := AGridCell.Width;
    vCell.Width := FGrid.ColWidths[AGridCell.Col];
    vCell.Height := FGrid.RowHeights[AGridCell.Row];
  end;

var
  iColumn, iRow: Integer;
  vRow: TExportRow;
begin
  for iRow := 0 to AGrid.RowCount - 1 do
  begin
    UpdateProgressHint(Format('导出第%d行数据', [iRow + 1]));
    UpdateProgressHint(1);
    vRow := ASheet.AddRow;
    for iColumn := 0 to AGrid.ColCount - 1 do
      ExportGridCell(AGrid.Cells[iColumn, iRow], vRow);
  end;
end;

procedure TExcelExportor.InitialPage(AGrid: TZJGrid;
  ASheet: TExportWorkSheet);

  procedure InitialColumnWidth;
  var
    iColumn: Integer;
  begin
    for iColumn := 0 to AGrid.ColCount - 1 do
      ASheet.Cols[iColumn].SetWidth(AGrid.ColWidths[iColumn]);
  end;

  procedure InitialRowHeight;
  var
    iRow: Integer;
  begin
    for iRow := 0 to AGrid.RowCount - 1 do
      ASheet.Rows[iRow].SetHeight(AGrid.RowHeights[iRow]);
  end;

begin
  InitialColumnWidth;
  InitialRowHeight;
end;

{ TIDTreeExcelExportor }

constructor TIDTreeExcelExportor.Create;
begin
  FOExport := TOExport.Create;
  FDataSetList := TList.Create;
  FTempFile := GetTempFileName;
end;

destructor TIDTreeExcelExportor.Destroy;
begin
  if FileExists(FTempFile) then
    DeleteFileOrFolder(FTempFile);
  FDataSetList.Free;
  FOExport.Free;
  inherited;
end;

procedure TIDTreeExcelExportor.ExportToFile(ATree: TsdIDTree;
  const AFileName: string);
var
  vExportor: TOCustomExporter;
begin
  FTree := ATree;
  BeforeExport;
  try
    vExportor := GetExportor(ExtractFileExt(AFileName));
    ExportToSheet(ATree, FOExport.AddWorkSheet);
    UpdateProgressHint('保存0号台账Excel数据');
    FOExport.SaveToFile(FTempFile, vExportor);
    if not FileExists(AFileName) or QuestMessage('存在同名文件，是否替换？') then
      CopyFileOrFolder(FTempFile, AFileName);
  finally
    vExportor.Free;
    AfterExport;
  end;
end;

procedure TIDTreeExcelExportor.ExportTreeNode(ANode: TsdIDTreeNode;
  ASheet: TExportWorkSheet; const ALevelCode: string);

  function GetFirstChildLevelCode(const ACode: string): string;
  begin
    Result := ACode + '.1';
  end;

  function GetNextSiblingLevelCode(const ACode: string): string;
  var
    strPreCode, strLastCode: string;
    iNextCode: Integer;
  begin
    if Pos('.', ACode) = 0 then
      Result := IntToStr(StrToIntDef(ACode, 1) + 1)
    else
    begin
      strPreCode := GetPrefixOfCode(ACode, '.');
      strLastCode := GetLastSetmentOfCode(ACode, '.');
      iNextCode := StrToIntDef(strLastCode, 1) + 1;
      Result := strPreCode + '.' + IntToStr(iNextCode);
    end;
  end;

var
  sHint: string;
begin
  if not Assigned(ANode) then Exit;

  if ANode.Rec.ValueByName('Code').AsString <> '' then
    sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Code').AsString
  else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
    sHint := '正在导出清单 ' + ANode.Rec.ValueByName('B_Code').AsString
  else
    sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Name').AsString;
  UpdateProgressHint(sHint);
  UpdateProgressHint(1);

  ExportNodeData(ANode, ASheet, ALevelCode);
  ExportTreeNode(ANode.FirstChild, ASheet, GetFirstChildLevelCode(ALevelCode));
  ExportTreeNode(ANode.NextSibling, ASheet, GetNextSiblingLevelCode(ALevelCode));
end;

procedure TIDTreeExcelExportor.ExportNodeData(ANode: TsdIDTreeNode;
  ASheet: TExportWorkSheet; const ALevelCode: string);
var
  iCol: Integer;
  ColInfo: TColInfo;
  vRow: TExportRow;
  vCell: TExportCell;
  XlsCell: TXlsCustomCell;
  sStr: string;
begin
  if not Assigned(ANode) then Exit;
  vRow := ASheet.AddRow;
  vRow.Height := 20;
  for iCol := 0 to FColCount - 1 do
  begin
    ColInfo := FColInfos[iCol];
    vCell := vRow.AddCellString(GetCellStr(ANode, ColInfo));
    vCell.Alignment := ColInfo.HorTextAlign;
    vCell.Font.Name := 'SmartSimSun';
    vCell.Font.Size := 9;
  end;
  if HasLevelCode then
  begin
    vCell := vRow.AddCellString(ALevelCode);
    vCell.Font.Name := 'SmartSimSun';
    vCell.Font.Size := 9;
  end;
end;

procedure TIDTreeExcelExportor.ExportToSheet(ATree: TsdIDTree;
  ASheet: TExportWorkSheet);
begin
  DefineHeader(ASheet);
  ExportTreeNode(ATree.FirstNode, ASheet, '1');
end;

function TIDTreeExcelExportor.GetCellValue(ANode: TsdIDTreeNode;
  ColInfo: TColInfo): Variant;

  function GetRec: TsdDataRecord;
  var
    DataSet: TsdDataSet;
  begin
    Result := nil;
    DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
    if not Assigned(DataSet) then Exit;
    Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
  end;

var
  ARec: TsdDataRecord;
begin
  Result := '';
  if not Assigned(ANode) then Exit;
  if ColInfo.LookupDataSetIndex = -1 then
    ARec := ANode.Rec
  else
    ARec := GetRec;
  if Assigned(ARec) then
    Result := ARec.ValueByName(ColInfo.FieldName).Value;
end;

procedure TIDTreeExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
var
  iCol: Integer;
  ColInfo: TColInfo;
  vRow: TExportRow;
  vCell: TExportCell;
  XlsCell: TXlsCustomCell;
begin
  vRow := ASheet.AddRow;
  vRow.Height := 20;
  for iCol := 0 to FColCount - 1 do
  begin
    ColInfo := FColInfos[iCol];
    vCell := vRow.AddCellString(ColInfo.TitleCaption);
    vCell.SetAlignment(cahCenter);
    vCell.SetVAlignment(cavCenter);
    vCell.Font.Name := '黑体';
    vCell.Font.Size := 10;
    vCell.Width := ColInfo.Width;
  end;
  if HasLevelCode then
  begin
    vCell := vRow.AddCellString('层次编号');
    vCell.SetAlignment(cahCenter);
    vCell.SetVAlignment(cavCenter);
    vCell.Font.Name := '黑体';
    vCell.Font.Size := 10;
  end;
end;

procedure TIDTreeExcelExportor.AddLookupDataSet(ADataSet: TsdDataSet);
begin
  FDataSetList.Add(ADataSet);
end;

procedure TIDTreeExcelExportor.DefineCol(AColInfos: PColInfos;
  AColCount: Integer);
begin
  FColInfos := AColInfos;
  FColCount := AColCount;
end;

procedure TIDTreeExcelExportor.BeforeExport;
begin
  Screen.Cursor := crHourGlass;
  ShowProgressHint('导出0号台账Excel数据', FTree.Count);
end;

procedure TIDTreeExcelExportor.AfterExport;
begin
  CloseProgressHint;
  Screen.Cursor := crDefault;
end;

function TIDTreeExcelExportor.GetCellStr(ANode: TsdIDTreeNode;
  ColInfo: TColInfo): string;

  function GetRec: TsdDataRecord;
  var
    DataSet: TsdDataSet;
  begin
    Result := nil;
    DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
    if not Assigned(DataSet) then Exit;
    Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
  end;

var
  ARec: TsdDataRecord;
begin
  Result := '';
  if not Assigned(ANode) then Exit;
  if ColInfo.LookupDataSetIndex = -1 then
    ARec := ANode.Rec
  else
    ARec := GetRec;
  if Assigned(ARec) then
    Result := ARec.ValueByName(ColInfo.FieldName).AsString;
  if SameText(Result, '0') then
    Result := '';
end;

{ TMasterExcelExportor }

procedure TMasterExcelExportor.BeforeExport;
begin
  Screen.Cursor := crHourGlass;
end;

constructor TMasterExcelExportor.Create;
begin
  FOExport := TOExport.Create;
  FTempFile := GetTempFileName;
end;

procedure TMasterExcelExportor.DefineCol(AColInfos: PColInfos;
  AColCount: Integer; ARelaColInfo: PColInfos);
begin
  FColInfos := AColInfos;
  FColCount := AColCount;
  FRelaColInfos := ARelaColInfo;
end;

procedure TMasterExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
var
  iCol: Integer;
  ColInfo: TColInfo;
  vRow: TExportRow;
  vCell: TExportCell;
begin
  vRow := ASheet.AddRow;
  vRow.Height := 20;
  for iCol := 0 to FColCount - 1 do
  begin
    ColInfo := FColInfos[iCol];
    vCell := vRow.AddCellString(ColInfo.TitleCaption);
    vCell.SetAlignment(cahCenter);
    vCell.SetVAlignment(cavCenter);
    vCell.Font.Name := '黑体';
    vCell.Font.Size := 10;
    vCell.Width := ColInfo.Width;
  end;
end;

procedure TMasterExcelExportor.DefineMasterDataSet(ADataSet: TsdDataSet;
  const AKeyFieldName: string);
begin
  FMasterDataSet := ADataSet;
  FKeyFieldName := AKeyFieldName;
end;

procedure TMasterExcelExportor.DefineRelaDataSet(ADataSet: TsdDataSet;
  const AMasterFieldName: string);
begin
  FRelaDataSet := ADataSet;
  FMasterFieldName := AMasterFieldName;
end;

destructor TMasterExcelExportor.Destroy;
begin
  if FileExists(FTempFile) then
    DeleteFileOrFolder(FTempFile);
  FOExport.Free;
  inherited;
end;

procedure TMasterExcelExportor.AfterExport;
begin
  Screen.Cursor := crDefault;
end;

procedure TMasterExcelExportor.ExportData(ASheet: TExportWorkSheet);
var
  i, j: Integer;
  Rec, RelaRec: TsdDataRecord;
begin
  for i := 0 to FMasterDataSet.RecordCount - 1 do
  begin
    Rec := FMasterDataSet.Records[i];
    ExportRecord(Rec, ASheet, FColInfos);
    for j := 0 to FRelaDataSet.RecordCount - 1 do
    begin
      RelaRec := FRelaDataSet.Records[j];
      if (RelaRec.ValueByName(FMasterFieldName).Value = Rec.ValueByName(FKeyFieldName).Value) then
      begin
        if Assigned(FRelaColInfos) then
          ExportRecord(RelaRec, ASheet, FRelaColInfos)
        else
          ExportRecord(RelaRec, ASheet, FColInfos);
      end;
    end;
  end;
end;

procedure TMasterExcelExportor.ExportRecord(ARec: TsdDataRecord;
  ASheet: TExportWorkSheet; AColInfos: PColInfos);
var
  iCol: Integer;
  ColInfo: TColInfo;
  vRow: TExportRow;
  vCell: TExportCell;
  sStr: string;
begin
  if not Assigned(ARec) then Exit;

  vRow := ASheet.AddRow;
  for iCol := 0 to FColCount - 1 do
  begin
    ColInfo := AColInfos[iCol];
    vCell := vRow.AddCellVariant(GetCellValue(ARec, ColInfo));
    vCell.Font.Name := 'SmartSimSun';
    vCell.Font.Size := 9;
  end;
end;

procedure TMasterExcelExportor.ExportToFile(const AFileName: string);
var
  vExportor: TOCustomExporter;
begin
  if not Assigned(FMasterDataSet) then Exit;

  BeforeExport;
  try
    vExportor := GetExportor(ExtractFileExt(AFileName));
    ExportToSheet(FOExport.AddWorkSheet);
    FOExport.SaveToFile(FTempFile, vExportor);
    if not FileExists(AFileName) or QuestMessage('存在同名文件，是否替换？') then
      CopyFile(PChar(FTempFile), PChar(AFileName), False);
  finally
    vExportor.Free;
    AfterExport;
  end;
end;

procedure TMasterExcelExportor.ExportToSheet(ASheet: TExportWorkSheet);
begin
  if not Assigned(FMasterDataSet) then Exit;

  DefineHeader(ASheet);
  ExportData(ASheet);
end;

function TMasterExcelExportor.GetCellValue(ARec: TsdDataRecord;
  ColInfo: TColInfo): Variant;
var
  Value: TsdValue;
begin
  Result := '';
  if Assigned(ARec) then
  begin
    Value := ARec.ValueByName(ColInfo.FieldName);
    if Assigned(Value) then
      Result := Value.AsVariant;
  end;
end;

{ TBillsPosExcelExportor }

procedure TBillsPosExcelExportor.AfterExport;
begin
  Screen.Cursor := crDefault;
end;

procedure TBillsPosExcelExportor.BeforeExport;
begin
  Screen.Cursor := crHourGlass;
end;

procedure TBillsPosExcelExportor.ConversePosNode(ANode: TBillsIDTreeNode;
  AParent: TBillsPosTreeNode);
var
  i: Integer;
  vChild: TBillsIDTreeNode;
  vCur: TBillsPosTreeNode;
  vPos: TPosNode;
begin
  if ANode.ChildCount = 0 then Exit;
  for i := 0 to ANode.ChildCount - 1 do
  begin
    vChild := TBillsIDTreeNode(ANode.ChildNodes[i]);
    if (vChild.Rec.B_Code.AsString <> '') then
    begin
      vCur := FindNode(AParent, vChild);
      if not Assigned(vCur) then
        vCur := ConverseNodeData(vChild, AParent);

      vPos := vCur.AddPos;
      vPos.Name := ANode.Rec.Name.AsString;
      vPos.Quantity := vChild.Rec.Quantity.AsFloat;
      vPos.MemoStr := ANode.Rec.MemoStr.AsString;
      vPos.DrawingCode := ANode.Rec.DrawingCode.AsString;
    end;
  end;
end;

procedure TBillsPosExcelExportor.ConverseTreeNode(
  ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode);
var
  vCur: TBillsPosTreeNode;
begin
  if not Assigned(ANode) then Exit;

  if (ANode.Rec.B_Code.AsString = '') then
  begin
    if (Pos('1-1-', ANode.Rec.Code.AsString) = 1) or (not HasGclChild(ANode)) then
    begin
      vCur := ConverseNodeData(ANode, AParent);
      ConverseTreeNode(TBillsIDTreeNode(ANode.FirstChild), vCur);
    end
    else
      ConversePosNode(ANode, AParent);
  end
  else if (Assigned(ANode.Parent) And (Pos('1-1-', TBillsIDTreeNode(ANode.Parent).Rec.Code.AsString) = 1)) then
  begin
    vCur := ConverseNodeData(ANode, AParent);
    vCur.Quantity := ANode.Rec.Quantity.AsFloat;
    ConverseTreeNode(TBillsIDTreeNode(ANode.FirstChild), vCur);
  end;
  ConverseTreeNode(TBillsIDTreeNode(ANode.NextSibling), AParent);
end;

function TBillsPosExcelExportor.ConverseNodeData(ANode: TBillsIDTreeNode;
  AParent: TBillsPosTreeNode): TBillsPosTreeNode;
begin
  Result := TBillsPosTreeNode(FTree.AddNode(AParent));
  Result.Code := ANode.Rec.Code.AsString;
  Result.B_Code := ANode.Rec.B_Code.AsString;
  Result.Name := ANode.Rec.Name.AsString;
  Result.Units := ANode.Rec.Units.AsString;
  Result.DrawingCode := ANode.Rec.DrawingCode.AsString;
  Result.MemoStr := ANode.Rec.MemoStr.AsString;
  Result.DgnQty1 := ANode.Rec.DgnQuantity1.AsFloat;
  Result.DgnQty2 := ANode.Rec.DgnQuantity2.AsFloat;
  Result.Price := ANode.Rec.Price.AsFloat;
  Result.TotalPrice := ANode.Rec.TotalPrice.AsFloat;
end;

constructor TBillsPosExcelExportor.Create;
begin
  FOExport := TOExport.Create;
  FTempFile := GetTempFileName;

  FCodeCol := 0;
  FB_CodeCol := 1;
  FP_COdeCol := 2;
  FNameCol := 3;
  FUnitsCol := 4;
  FQuantityCol := 5;
  FDgnQty1 := 6;
  FDgnQty2 := 7;
  FPriceCol := 8;
  FTotalPriceCol := 9;
  FDrawingCodeCol := 10;
  FMemoStrCol := 11;
end;

procedure TBillsPosExcelExportor.DefineHeader(ASheet: TExportWorkSheet);

  procedure AddHeaderCell(ARow: TExportRow; iCol: Integer; const AText: String; AWidth: Integer);
  var
    vCell: TExportCell;
  begin
    vCell := ARow.AddCellString(AText);
    vCell.SetAlignment(cahCenter);
    vCell.SetVAlignment(cavCenter);
    vCell.Font.Name := '黑体';
    vCell.Font.Size := 10;
    vCell.Width := AWidth;
  end;

var
  iCol: Integer;
  ColInfo: TColInfo;
  vRow: TExportRow;
  vCell: TExportCell;
begin
  vRow := ASheet.AddRow;
  vRow.Height := 20;
  AddHeaderCell(vRow, FCodeCol, '项目节编号', 100);
  AddHeaderCell(vRow, FB_CodeCol, '清单编号', 80);
  AddHeaderCell(vRow, FP_CodeCol, '计量单元', 80);
  AddHeaderCell(vRow, FNameCol, '名称', 300);
  AddHeaderCell(vRow, FUnitsCol, '单位', 60);
  AddHeaderCell(vRow, FQuantityCol, '清单数量', 70);
  AddHeaderCell(vRow, FDgnQty1, '设计数量1', 70);
  AddHeaderCell(vRow, FDgnQty2, '设计数量2', 70);
  AddHeaderCell(vRow, FPriceCol, '单价', 70);
  AddHeaderCell(vRow, FTotalPriceCol, '合价', 70);
  AddHeaderCell(vRow, FDrawingCodeCol, '图号', 85);
  AddHeaderCell(vRow, FMemoStrCol, '备注', 100);
end;

destructor TBillsPosExcelExportor.Destroy;
begin
  if FileExists(FTempFile) then
    DeleteFileOrFolder(FTempFile);
  FOExport.Free;
  inherited;
end;

procedure TBillsPosExcelExportor.ExportData(ASheet: TExportWorkSheet);
begin
  ExportNode(ASheet, TBillsPosTreeNode(FTree.FirstNode));
end;

procedure TBillsPosExcelExportor.ExportNode(ASheet: TExportWorkSheet;
  ANode: TBillsPosTreeNode);
var
  vRow: TExportRow;
  vCell: TExportCellNumber;
begin
  if not Assigned(ANode) then Exit;

  vRow := ASheet.AddRow;
  vRow.AddCellString(ANode.Code);
  vRow.AddCellString(ANode.B_Code);
  vRow.AddCellString('');
  vRow.AddCellString(ANode.Name);
  vRow.AddCellString(ANode.Units);
  vCell := vRow.AddCellNumber(ANode.Quantity);
  vCell.EmptyIfZero := True;
  vCell := vRow.AddCellNumber(ANode.DgnQty1);
  vCell.EmptyIfZero := True;
  vCell := vRow.AddCellNumber(ANode.DgnQty2);
  vCell.EmptyIfZero := True;
  vCell := vRow.AddCellNumber(ANode.Price);
  vCell.EmptyIfZero := True;
  vCell := vRow.AddCellNumber(ANode.TotalPrice);
  vCell.EmptyIfZero := True;
  vRow.AddCellString(ANode.DrawingCode);
  vRow.AddCellString(ANode.MemoStr);
  ExportPos(ASheet, ANode);

  ExportNode(ASheet, TBillsPosTreeNode(ANode.FirstChild));
  ExportNode(ASheet, TBillsPosTreeNode(ANode.NextSibling));
end;

procedure TBillsPosExcelExportor.ExportPos(ASheet: TExportWorkSheet;
  ANode: TBillsPosTreeNode);
var
  i: Integer;
  vPos: TPosNode;
  vRow: TExportRow;
  vCell: TExportCellNumber;
begin
  if not Assigned(ANode) then Exit;

  for i := 0 to ANode.PosCount - 1 do
  begin
    vPos := ANode.Pos[i];
    vRow := ASheet.AddRow;
    vRow.AddCellString();
    vRow.AddCellString();
    vRow.AddCellString(IntToStr(i+1));
    vRow.AddCellString(vPos.Name);
    vRow.AddCellString();
    vCell := vRow.AddCellNumber(vPos.Quantity);
    vCell.EmptyIfZero := True;
    vCell := vRow.AddCellNumber(); 
    vCell.EmptyIfZero := True;
    vCell := vRow.AddCellNumber(); 
    vCell.EmptyIfZero := True;
    vCell := vRow.AddCellNumber(); 
    vCell.EmptyIfZero := True;
    vCell := vRow.AddCellNumber(); 
    vCell.EmptyIfZero := True;
    vRow.AddCellString(vPos.DrawingCode);
    vRow.AddCellString(vPos.MemoStr);
  end;
end;

procedure TBillsPosExcelExportor.ExportToFile(ABillsIDTree: TBillsIDTree; const AFileName: string);
var
  vExportor: TOCustomExporter;
begin
  BeforeExport;
  try
    vExportor := GetExportor(ExtractFileExt(AFileName));
    ExportToSheet(ABillsIDTree, FOExport.AddWorkSheet);
    FOExport.SaveToFile(FTempFile, vExportor);
    if not FileExists(AFileName) or QuestMessage('存在同名文件，是否替换？') then
      CopyFile(PChar(FTempFile), PChar(AFileName), False);
  finally
    vExportor.Free;
    AfterExport;
  end;
end;

procedure TBillsPosExcelExportor.ExportToSheet(ABillsIDTree: TBillsIDTree; ASheet: TExportWorkSheet);
begin
  DefineHeader(ASheet);
  FTree := TBillsPosTree.Create;
  try
    ConverseTreeNode(TBillsIDTreeNode(ABillsIDTree.FirstNode));
    FTree.CalculateAll;
    ExportData(ASheet);
  finally
    FTree.Free;
  end;
end;

function TBillsPosExcelExportor.HasGclChild(
  ANode: TBillsIDTreeNode): Boolean;
var
  i: Integer;
  vChild: TBillsIDTreeNode;
begin
  Result := False;
  for i := 0 to ANode.ChildCount - 1 do
  begin
    vChild := TBillsIDTreeNode(ANode.ChildNodes[i]);
    if (vChild.Rec.B_Code.AsString <> '') then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

function TBillsPosExcelExportor.FindNode(AParent: TBillsPosTreeNode;
  AMatch: TBillsIDTreeNode): TBillsPosTreeNode;
var
  i: Integer;
  vChild: TBillsPosTreeNode;
begin
  Result := nil;
  if not Assigned(AParent) then Exit;
  for i := 0 to AParent.Children.Count - 1 do
  begin
    vChild := TBillsPosTreeNode(AParent.Children.Items[i]);
    if ((vChild.B_Code = AMatch.Rec.B_Code.AsString) And
        (vChild.Name = AMatch.Rec.Name.AsString) And
        (vChild.Units = AMatch.Rec.Units.AsString) And
        (PriceRoundTo(vChild.Price - AMatch.Rec.Price.AsFloat) = 0)) then
    begin
      Result := vChild;
      Break;
    end;
  end;
end;

end.