unit stgExcelExport; interface uses Classes, OExport, OExport_Vcl, OExport_VclForms, stgGatherDm, sdDB, stgGatherCacheData, stgGatherUtils, sdIDTree, Graphics; type TstgExcelExport = class private FTempFile: string; FGatherData: TstgGatherData; FOExport: TOExport; FOExportor: TOCustomExporter; protected function AddHeadCell(ARow: TExportRow; const AHead: string; AWidth: Integer): TExportCellString; function GetExportor(const AFileType: string): TOCustomExporter; procedure SaveFile(const AFileName: string); procedure BeforeExport; procedure AfterExport; public constructor Create(AGatherData: TstgGatherData); property GatherData: TstgGatherData read FGatherData; property OExport: TOExport read FOExport; end; TstgErrorExcelExport = class(TstgExcelExport) private procedure InitSheet(ASheet: TExportWorkSheet); procedure ExportSubTenderToSheet(ATenderID: Integer; ASheet: TExportWorkSheet); public procedure ExportSubTender(ARec: TsdDataRecord; const AFileName: string); procedure ExportAll(const AFileName: string); end; TstgGatherExcelExport = class(TstgExcelExport) private procedure InitSheet(ASheet: TExportWorkSheet); procedure ExportTreeNodeToSheet(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet); procedure ExportGatherToSheet(ASheet: TExportWorkSheet); public procedure ExportGather(const AFileName: string); end; implementation uses SysUtils, UtilMethods, ZhAPI; { TstgErrorExcelExport } procedure TstgErrorExcelExport.ExportAll(const AFileName: string); var i: Integer; vRec: TsdDataRecord; begin BeforeExport; try GetExportor(ExtractFileExt(AFileName)); for i := 0 to FGatherData.sddSubTenders.RecordCount - 1 do begin vRec := FGatherData.sddSubTenders.Records[i]; ExportSubTenderToSheet(vRec.ValueByName('ID').AsInteger, FOExport.AddWorkSheet(vRec.ValueByName('Name').AsString)); end; SaveFile(AFileName); finally AfterExport; end; end; procedure TstgErrorExcelExport.ExportSubTender(ARec: TsdDataRecord; const AFileName: string); begin BeforeExport; try GetExportor(ExtractFileExt(AFileName)); ExportSubTenderToSheet(ARec.ValueByName('ID').AsInteger, FOExport.AddWorkSheet(ARec.ValueByName('Name').AsString)); SaveFile(AFileName); finally AfterExport; end; end; procedure TstgErrorExcelExport.ExportSubTenderToSheet(ATenderID: Integer; ASheet: TExportWorkSheet); procedure ExportErrorRecord(ARec: TsdDataRecord); var vRow: TExportRow; vCell: TExportCell; begin vRow := ASheet.AddRow; vCell := vRow.AddCellString(ARec.ValueByName('RelaCode').AsString); vCell := vRow.AddCellString(ARec.ValueByName('RelaSerialNo').AsString); vCell.SetAlignment(cahCenter); vCell := vRow.AddCellString(ARec.ValueByName('DetailCode').AsString); vCell := vRow.AddCellString(ARec.ValueByName('DetailSerialNo').AsString); vCell.SetAlignment(cahCenter); vCell := vRow.AddCellString(GetErrorTypeText(ARec.ValueByName('ErrorType').AsInteger)); end; var vIdx: TsdIndex; i, iBegin, iEnd: Integer; vRec: TsdDataRecord; begin InitSheet(ASheet); vIdx := GatherData.sddErrorDetail.FindIndex('idxTenderID'); iBegin := vIdx.FindKeyIndex(ATenderID); iEnd := vIdx.FindKeyLastIndex(ATenderID); if iBegin = -1 then Exit; for i := iBegin to iEnd do ExportErrorRecord(vIdx.Records[i]); end; procedure TstgErrorExcelExport.InitSheet(ASheet: TExportWorkSheet); var vRow: TExportRow; vCell: TExportCellString; begin vRow := ASheet.AddRow; vCell := AddHeadCell(vRow, '出错源', 120); vCell.ColSpan := 2; vCell := AddHeadCell(vRow, '可计量清单', 80); vCell.ColSpan := 2; vCell := AddHeadCell(vRow, '错误原因', 200); vCell.RowSpan := 2; vRow := ASheet.Rows.Items[vRow.RowIndex + 1]; vCell := AddHeadCell(vRow, '编号', 120); vCell := AddHeadCell(vRow, '行号', 50); vCell := AddHeadCell(vRow, '编号', 80); vCell := AddHeadCell(vRow, '行号', 50); end; { TstgExcelExport } function TstgExcelExport.AddHeadCell(ARow: TExportRow; const AHead: string; AWidth: Integer): TExportCellString; begin Result := ARow.AddCellString(AHead); Result.SetAlignment(cahCenter); Result.SetVAlignment(cavCenter); Result.Font.Name := '黑体'; Result.Font.Size := 10; Result.Width := AWidth; end; procedure TstgExcelExport.AfterExport; begin FOExport.Free; if Assigned(FOExportor) then FOExportor.Free; if FileExists(FTempFile) then DeleteFile(FTempFile); end; procedure TstgExcelExport.BeforeExport; begin FOExport := TOExport.Create; FOExport.UseProgress := False; FTempFile := GetTempFileName; end; constructor TstgExcelExport.Create(AGatherData: TstgGatherData); begin FGatherData := AGatherData; end; function TstgExcelExport.GetExportor( const AFileType: string): TOCustomExporter; begin if SameText(AFileType, '.xls') then FOExportor := TOCustomExporterXLS.Create else //if SameText(AFileType, '.xlsx') then FOExportor := TOCustomExporterXLSX.Create; end; procedure TstgExcelExport.SaveFile(const AFileName: string); begin FOExport.SaveToFile(FTempFile, FOExportor); if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then CopyFileOrFolder(FTempFile, AFileName); end; { TstgGatherExcelExport } procedure TstgGatherExcelExport.ExportGather(const AFileName: string); begin BeforeExport; try GetExportor(ExtractFileExt(AFileName)); ExportGatherToSheet(OExport.AddWorkSheet('分包数据汇总')); SaveFile(AFileName); finally AfterExport; end; end; procedure TstgGatherExcelExport.ExportGatherToSheet( ASheet: TExportWorkSheet); var vTree: TsdIDTree; begin InitSheet(ASheet); vTree := TsdIDTree.Create; try vTree.KeyFieldName := 'ID'; vTree.ParentFieldName := 'ParentID'; vTree.NextSiblingFieldName := 'NextSiblingID'; vTree.DataView := GatherData.sdvGatherTree; ExportTreeNodeToSheet(vTree.FirstNode, ASheet); finally vTree.Free; end; end; procedure TstgGatherExcelExport.ExportTreeNodeToSheet(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet); procedure AddCellString(ARow: TExportRow; const AStr: string; AColor: TColor); var vCell: TExportCellString; begin vCell := ARow.AddCellString(AStr); vCell.Font.Color := AColor; end; procedure AddCellNumber(ARow: TExportRow; const ANum: Double; AColor: TColor); var vCell: TExportCellNumber; begin vCell := ARow.AddCellNumber(ANum); vCell.Font.Color := AColor; vCell.EmptyIfZero := True; end; var vColor: TColor; vRow: TExportRow; vCell: TExportCellNumber; begin if not Assigned(ANode) then Exit; if ANode.Rec.ValueByName('IsSubTender').AsBoolean then vColor := $00D5D5D5 else vColor := clWindowText; vRow := ASheet.AddRow; AddCellString(vRow, ANode.Rec.ValueByName('Code').AsString, vColor); AddCellString(vRow, ANode.Rec.ValueByName('B_Code').AsString, vColor); AddCellString(vRow, ANode.Rec.ValueByName('Name').AsString, vColor); AddCellString(vRow, ANode.Rec.ValueByName('Units').AsString, vColor); AddCellNumber(vRow, ANode.Rec.ValueByName('DealQuantity').AsFloat, vColor); AddCellNumber(vRow, ANode.Rec.ValueByName('QcQuantity').AsFloat, vColor); ExportTreeNodeToSheet(ANode.FirstChild, ASheet); ExportTreeNodeToSheet(ANode.NextSibling, ASheet); end; procedure TstgGatherExcelExport.InitSheet(ASheet: TExportWorkSheet); var vRow: TExportRow; begin vRow := ASheet.AddRow; AddHeadCell(vRow, '项目节编号', 180); AddHeadCell(vRow, '清单编号', 80); AddHeadCell(vRow, '名称', 240); AddHeadCell(vRow, '单位', 50); AddHeadCell(vRow, '合同计量', 100); AddHeadCell(vRow, '数量变更计量', 100); end; end.