Measure/Units/ExportExcel.pas

unit ExportExcel;

interface

uses
  Classes, ZjGrid, ScXlsOutput, ScXlsCustomUD, Windows, StdCtrls,
  sdIDTree, sdDB, Graphics, SysUtils, ProgressHintFrm, Forms, Controls;

type
  TExcelExportor = class
  private
    FXlsOutPut: TXlsOutPut;
    FGrid: TZJGrid;
    FTempFile: string;
    FFileName: string;

    procedure InitialPage(AGrid: TZJGrid; AXlsPage: TXlsCustomPage);
  protected
    procedure BeforeExport;
    procedure EndExport;
  public
    constructor Create;
    destructor Destroy; override;
    procedure ExportToXlsPage(AGrid: TZJGrid; AXlsPage: TXlsCustomPage);
    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: TUDHTextAlign;
    //VerTextAlign: TUDVTextAlign;
  end;

  PColInfos = ^TColInfos;

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

  // 仿照DataSet的Lookup以及数据库的AutoUpdate已达到关于sdIDTree导出数据至Excel的普适性
  // 导出前须根据所需列信息，以及查询数据库（列信息须与查询数据库对等，否则将会报错，并不检查列与数据库是否匹配）
  TIDTreeExcelExportor = class
  private
    FXlsOutPut: TXlsOutPut;
    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; AXlsPage: TXlsCustomPage; const ALevelCode: string);
    procedure ExportTreeNode(ANode: TsdIDTreeNode; AXlsPage: TXlsCustomPage; const ALevelCode: string);
    procedure DefineHeader(AXlsPage: TXlsCustomPage);
  protected
    procedure BeforeExport;
    procedure EndExport;
  public
    constructor Create;
    destructor Destroy; override;

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

    procedure ExportToXlsPage(ATree: TsdIDTree; AXlsPage: TXlsCustomPage);
    procedure ExportToFile(ATree: TsdIDTree; const AFileName: string);

    property HasLevelCode: Boolean read FHasLevelCode write FHasLevelCode;
  end;

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

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

implementation

uses
  ZhAPI, Variants, UtilMethods;

{ TExcelExportor }

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

constructor TExcelExportor.Create;
begin
  FXlsOutPut := TXlsOutPut.Create;
  FTempFile := GetTempFileName;
end;

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

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

procedure TExcelExportor.ExportToFile(AGrid: TZJGrid;
  const AFileName: string);
begin
  FFileName := AFileName;
  FGrid := AGrid;
  BeforeExport;
  try
    ExportToXlsPage(AGrid, FXlsOutPut.AddPage);
    FXlsOutPut.SaveToFile(FTempFile);
    if not FileExists(FFileName) or QuestMessage('存在同名文件，是否替换？') then
      CopyFile(PChar(FTempFile), PChar(FFileName), False);
  finally
    EndExport;
  end;
end;

procedure TExcelExportor.ExportToXlsPage(AGrid: TZJGrid;
  AXlsPage: TXlsCustomPage);

  procedure SetXlsCellTextAlign(AXlsCell: TXlsCustomCell; AGridCell: TzjCell);
  begin
    case AGridCell.TextAlign of
      gaTopLeft:
      begin
        AXlsCell.VTextAlign := vtaTop;
        AXlsCell.HTextAlign := htaLeft;
      end;
      gaTopCenter:
      begin
        AXlsCell.VTextAlign := vtaTop;
        AXlsCell.HTextAlign := htaCenter;
      end;
      gaTopRight:
      begin
        AXlsCell.VTextAlign := vtaTop;
        AXlsCell.HTextAlign := htaRight;
      end;
      gaCenterLeft:
      begin
        AXlsCell.VTextAlign := vtaCenter;
        AXlsCell.HTextAlign := htaLeft;
      end;
      gaCenterCenter:
      begin
        AXlsCell.VTextAlign := vtaCenter;
        AXlsCell.HTextAlign := htaCenter;
      end;
      gaCenterRight:
      begin
        AXlsCell.VTextAlign := vtaCenter;
        AXlsCell.HTextAlign := htaRight;
      end;
      gaBottomLeft:
      begin
        AXlsCell.VTextAlign := vtaBottom;
        AXlsCell.HTextAlign := htaLeft;
      end;
      gaBottomCenter:
      begin
        AXlsCell.VTextAlign := vtaBottom;
        AXlsCell.HTextAlign := htaCenter;
      end;
      gaBottomRight:
      begin
        AXlsCell.VTextAlign := vtaBottom;
        AXlsCell.HTextAlign := htaRight;
      end;
    end;
    if goWarpText in AGridCell.Grid.Options then
      AXlsCell.WartText := True;
  end;

  procedure ExportGridCell(AGridCell: TzjCell);
  var
    XlsCell: TXlsCustomCell;
  begin
    if AGridCell = nil then Exit;
    XlsCell := AXlsPage.AddCell(AGridCell.Col, AGridCell.Row, AGridCell.Text);
    SetXlsCellTextAlign(XlsCell, AGridCell);
    XlsCell.Font.Name := AGridCell.Font.Name;
    XlsCell.Font.Size := AGridCell.Font.Size;
    XlsCell.Width := AGridCell.Width;
    XlsCell.Height := AGridCell.Height;
  end;

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

procedure TExcelExportor.InitialPage(AGrid: TZJGrid;
  AXlsPage: TXlsCustomPage);

  procedure InitialColumnWidth;
  var
    iColumn: Integer;
  begin
    for iColumn := 0 to AGrid.ColCount - 1 do
      AXlsPage.Widths[iColumn] := AGrid.ColWidths[iColumn];
  end;

  procedure InitialRowHeight;
  var
    iRow: Integer;
  begin
    for iRow := 0 to AGrid.RowCount - 1 do
      AXlsPage.Heights.Items[iRow] := AGrid.RowHeights[iRow];
  end;

begin
  InitialColumnWidth;
  InitialRowHeight;
end;

{ TIDTreeExcelExportor }

constructor TIDTreeExcelExportor.Create;
begin
  FXlsOutPut := TXlsOutPut.Create;
  FDataSetList := TList.Create;
  FTempFile := GetTempFileName;
end;

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

procedure TIDTreeExcelExportor.ExportToFile(ATree: TsdIDTree;
  const AFileName: string);
begin
  FTree := ATree;
  BeforeExport;
  try
    ExportToXlsPage(ATree, FXlsOutPut.AddPage);
    UpdateProgressHint('保存0号台账Excel数据');
    FXlsOutPut.SaveToFile(FTempFile);
    if not FileExists(AFileName) or QuestMessage('存在同名文件，是否替换？') then
      CopyFile(PChar(FTempFile), PChar(AFileName), False);
  finally
    EndExport;
  end;
end;

procedure TIDTreeExcelExportor.ExportTreeNode(ANode: TsdIDTreeNode;
  AXlsPage: TXlsCustomPage; 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, AXlsPage, ALevelCode);
  ExportTreeNode(ANode.FirstChild, AXlsPage, GetFirstChildLevelCode(ALevelCode));
  ExportTreeNode(ANode.NextSibling, AXlsPage, GetNextSiblingLevelCode(ALevelCode));
end;

procedure TIDTreeExcelExportor.ExportNodeData(ANode: TsdIDTreeNode;
  AXlsPage: TXlsCustomPage; const ALevelCode: string);

  function ExportCell(ACol, ARow: Integer; AValue: Variant): TXlsCustomCell;
  begin
    Result := nil;

    // -----------
    if VarIsNull(AValue) then Exit;
    // -----------
    // 当数据超过3w3k行时，运行至某行时，AddCell会内存溢出
    // 可能是Cell的数目超过某个限度时，报错
    // 如果AValue为Null时不AddCell，则3w3k行可以安全度过

    case VarType(AValue) of
      varSmallInt, varInteger, varSingle, varDouble,
      varCurrency, varShortInt, varByte, varWord,
      varLongWord, varInt64:
      begin
        if AValue <> 0 then
          Result := AXlsPage.AddCell(ACol, ARow, AValue);
      end
      else Result := AXlsPage.AddCell(ACol, ARow, AValue);
    end;
  end;

var
  iCol: Integer;
  ColInfo: TColInfo;
  XlsCell: TXlsCustomCell;
  sStr: string;
begin
  if not Assigned(ANode) then Exit;
  for iCol := 0 to FColCount - 1 do
  begin
    ColInfo := FColInfos[iCol];
    XlsCell := ExportCell(iCol, ANode.MajorIndex + 1, GetCellValue(ANode, ColInfo));
    {sStr := GetCellStr(ANode, ColInfo);
    if sStr = '' then Continue;
    XlsCell := AXlsPage.AddCell(iCol, ANode.MajorIndex + 1, sStr);}
    if Assigned(XlsCell) then
    begin
      XlsCell.HTextAlign := ColInfo.HorTextAlign;
      //XlsCell.VTextAlign := ColInfo.VerTextAlign;
      XlsCell.Font.Name := 'SmartSimSun';
      XlsCell.Font.Size := 9;
    end;
  end;
  if HasLevelCode then
  begin
    XlsCell := ExportCell(FColCount, ANode.MajorIndex + 1, ALevelCode);
    XlsCell.Font.Name := 'SmartSimSun';
    XlsCell.Font.Size := 9;
  end;
end;

procedure TIDTreeExcelExportor.ExportToXlsPage(ATree: TsdIDTree;
  AXlsPage: TXlsCustomPage);
begin
  DefineHeader(AXlsPage);
  ExportTreeNode(ATree.FirstNode, AXlsPage, '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(AXlsPage: TXlsCustomPage);
var
  iCol: Integer;
  ColInfo: TColInfo;
  XlsCell: TXlsCustomCell;
begin
  for iCol := 0 to FColCount - 1 do
  begin
    ColInfo := FColInfos[iCol];
    XlsCell := AXlsPage.AddCell(iCol, 0, ColInfo.TitleCaption);
    XlsCell.HTextAlign := htaCenter;
    XlsCell.Font.Name := '黑体';
    XlsCell.Font.Size := 10;
    XlsCell.Font.Style := [fsBold];
    AXlsPage.Widths[iCol] := ColInfo.Width;
  end;
  if HasLevelCode then
  begin
    XlsCell := AXlsPage.AddCell(iCol, 0, '层次编号');
    XlsCell.HTextAlign := htaCenter;
    XlsCell.Font.Name := '黑体';
    XlsCell.Font.Size := 10;
    XlsCell.Font.Style := [fsBold];
  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.EndExport;
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;

end.