unit stgGclExcelExport; interface uses Classes, OExport, OExport_Vcl, OExport_VclForms, stgGatherGclDm, sdDB, stgGatherGclCacheData, Graphics; type TstgGclExcelExport = class private FTempFile: string; FGatherData: TstgGatherGclData; 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: TstgGatherGclData); property GatherData: TstgGatherData read FGatherData; property OExport: TOExport read FOExport; end; TstgGatherGclExcelExport = class(TstgGclExcelExport) private procedure InitSheet(ASheet: TExportWorkSheet); procedure ExportGclToSheet(AGcl: TstgGatherGcl; ASheet: TExportWorkSheet); procedure ExportGatherToSheet(ASheet: TExportWorkSheet); public procedure ExportGather(const AFileName: string); end; implementation uses SysUtils, UtilMethods, ZhAPI; { TstgGclExcelExport } function TstgGclExcelExport.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 TstgGclExcelExport.AfterExport; begin FOExport.Free; if Assigned(FOExportor) then FOExportor.Free; if FileExists(FTempFile) then DeleteFile(FTempFile); end; procedure TstgGclExcelExport.BeforeExport; begin FOExport := TOExport.Create; FOExport.UseProgress := False; FTempFile := GetTempFileName; end; constructor TstgGclExcelExport.Create(AGatherData: TstgGatherData); begin FGatherData := AGatherData; end; function TstgGclExcelExport.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 TstgGclExcelExport.SaveFile(const AFileName: string); begin FOExport.SaveToFile(FTempFile, FOExportor); if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then CopyFileOrFolder(FTempFile, AFileName); end; { TstgGatherGclExcelExport } procedure TstgGatherGclExcelExport.ExportGather(const AFileName: string); begin BeforeExport; try GetExportor(ExtractFileExt(AFileName)); ExportGatherToSheet(OExport.AddWorkSheet('分包数据汇总')); SaveFile(AFileName); finally AfterExport; end; end; procedure TstgGatherGclExcelExport.ExportGatherToSheet( ASheet: TExportWorkSheet); var i: Integer; begin InitSheet(ASheet); try for (i := 0 to FGatherData.GatherGclCount - 1) do ExportGclToSheet(FGatherData.GatherGcl[i], ASheet); finally vTree.Free; end; end; procedure TstgGatherGclExcelExport.ExportGclToSheet(AGcl: TstgGatherGcl; 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; vColor := clWindowText; vRow := ASheet.AddRow; AddCellString(vRow, AGcl.Rec.ValueByName('B_Code').AsString, vColor); AddCellString(vRow, AGcl.Rec.ValueByName('Name').AsString, vColor); AddCellString(vRow, AGcl.Rec.ValueByName('Units').AsString, vColor); AddCellNumber(vRow, AGcl.Rec.ValueByName('Price').AsFloat, vColor); AddCellNumber(vRow, AGcl.Rec.ValueByName('DealQuantity').AsFloat, vColor); AddCellNumber(vRow, AGcl.Rec.ValueByName('QcQuantity').AsFloat, vColor); end; procedure TstgGatherGclExcelExport.InitSheet(ASheet: TExportWorkSheet); var vRow: TExportRow; begin vRow := ASheet.AddRow; AddHeadCell(vRow, '清单编号', 120); AddHeadCell(vRow, '名称', 250); AddHeadCell(vRow, '单位', 60); AddHeadCell(vRow, '单价', 80); AddHeadCell(vRow, '合同计量', 100); AddHeadCell(vRow, '数量变更计量', 100); end; end.