stgGclExcelExport.pas 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172
  1. unit stgGclExcelExport;
  2. interface
  3. uses
  4. Classes, OExport, OExport_Vcl, OExport_VclForms, stgGatherGclDm, sdDB,
  5. stgGatherGclCacheData, Graphics;
  6. type
  7. TstgGclExcelExport = class
  8. private
  9. FTempFile: string;
  10. FGatherData: TstgGatherGclData;
  11. FOExport: TOExport;
  12. FOExportor: TOCustomExporter;
  13. protected
  14. function AddHeadCell(ARow: TExportRow; const AHead: string; AWidth: Integer): TExportCellString;
  15. function GetExportor(const AFileType: string): TOCustomExporter;
  16. procedure SaveFile(const AFileName: string);
  17. procedure BeforeExport;
  18. procedure AfterExport;
  19. public
  20. constructor Create(AGatherData: TstgGatherGclData);
  21. property GatherData: TstgGatherData read FGatherData;
  22. property OExport: TOExport read FOExport;
  23. end;
  24. TstgGatherGclExcelExport = class(TstgGclExcelExport)
  25. private
  26. procedure InitSheet(ASheet: TExportWorkSheet);
  27. procedure ExportGclToSheet(AGcl: TstgGatherGcl; ASheet: TExportWorkSheet);
  28. procedure ExportGatherToSheet(ASheet: TExportWorkSheet);
  29. public
  30. procedure ExportGather(const AFileName: string);
  31. end;
  32. implementation
  33. uses SysUtils, UtilMethods, ZhAPI;
  34. { TstgGclExcelExport }
  35. function TstgGclExcelExport.AddHeadCell(ARow: TExportRow; const AHead: string;
  36. AWidth: Integer): TExportCellString;
  37. begin
  38. Result := ARow.AddCellString(AHead);
  39. Result.SetAlignment(cahCenter);
  40. Result.SetVAlignment(cavCenter);
  41. Result.Font.Name := '黑体';
  42. Result.Font.Size := 10;
  43. Result.Width := AWidth;
  44. end;
  45. procedure TstgGclExcelExport.AfterExport;
  46. begin
  47. FOExport.Free;
  48. if Assigned(FOExportor) then
  49. FOExportor.Free;
  50. if FileExists(FTempFile) then
  51. DeleteFile(FTempFile);
  52. end;
  53. procedure TstgGclExcelExport.BeforeExport;
  54. begin
  55. FOExport := TOExport.Create;
  56. FOExport.UseProgress := False;
  57. FTempFile := GetTempFileName;
  58. end;
  59. constructor TstgGclExcelExport.Create(AGatherData: TstgGatherData);
  60. begin
  61. FGatherData := AGatherData;
  62. end;
  63. function TstgGclExcelExport.GetExportor(
  64. const AFileType: string): TOCustomExporter;
  65. begin
  66. if SameText(AFileType, '.xls') then
  67. FOExportor := TOCustomExporterXLS.Create
  68. else //if SameText(AFileType, '.xlsx') then
  69. FOExportor := TOCustomExporterXLSX.Create;
  70. end;
  71. procedure TstgGclExcelExport.SaveFile(const AFileName: string);
  72. begin
  73. FOExport.SaveToFile(FTempFile, FOExportor);
  74. if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
  75. CopyFileOrFolder(FTempFile, AFileName);
  76. end;
  77. { TstgGatherGclExcelExport }
  78. procedure TstgGatherGclExcelExport.ExportGather(const AFileName: string);
  79. begin
  80. BeforeExport;
  81. try
  82. GetExportor(ExtractFileExt(AFileName));
  83. ExportGatherToSheet(OExport.AddWorkSheet('分包数据汇总'));
  84. SaveFile(AFileName);
  85. finally
  86. AfterExport;
  87. end;
  88. end;
  89. procedure TstgGatherGclExcelExport.ExportGatherToSheet(
  90. ASheet: TExportWorkSheet);
  91. var
  92. i: Integer;
  93. begin
  94. InitSheet(ASheet);
  95. try
  96. for (i := 0 to FGatherData.GatherGclCount - 1) do
  97. ExportGclToSheet(FGatherData.GatherGcl[i], ASheet);
  98. finally
  99. vTree.Free;
  100. end;
  101. end;
  102. procedure TstgGatherGclExcelExport.ExportGclToSheet(AGcl: TstgGatherGcl;
  103. ASheet: TExportWorkSheet);
  104. procedure AddCellString(ARow: TExportRow; const AStr: string; AColor: TColor);
  105. var
  106. vCell: TExportCellString;
  107. begin
  108. vCell := ARow.AddCellString(AStr);
  109. vCell.Font.Color := AColor;
  110. end;
  111. procedure AddCellNumber(ARow: TExportRow; const ANum: Double; AColor: TColor);
  112. var
  113. vCell: TExportCellNumber;
  114. begin
  115. vCell := ARow.AddCellNumber(ANum);
  116. vCell.Font.Color := AColor;
  117. vCell.EmptyIfZero := True;
  118. end;
  119. var
  120. vColor: TColor;
  121. vRow: TExportRow;
  122. vCell: TExportCellNumber;
  123. begin
  124. if not Assigned(ANode) then Exit;
  125. vColor := clWindowText;
  126. vRow := ASheet.AddRow;
  127. AddCellString(vRow, AGcl.Rec.ValueByName('B_Code').AsString, vColor);
  128. AddCellString(vRow, AGcl.Rec.ValueByName('Name').AsString, vColor);
  129. AddCellString(vRow, AGcl.Rec.ValueByName('Units').AsString, vColor);
  130. AddCellNumber(vRow, AGcl.Rec.ValueByName('Price').AsFloat, vColor);
  131. AddCellNumber(vRow, AGcl.Rec.ValueByName('DealQuantity').AsFloat, vColor);
  132. AddCellNumber(vRow, AGcl.Rec.ValueByName('QcQuantity').AsFloat, vColor);
  133. end;
  134. procedure TstgGatherGclExcelExport.InitSheet(ASheet: TExportWorkSheet);
  135. var
  136. vRow: TExportRow;
  137. begin
  138. vRow := ASheet.AddRow;
  139. AddHeadCell(vRow, '清单编号', 120);
  140. AddHeadCell(vRow, '名称', 250);
  141. AddHeadCell(vRow, '单位', 60);
  142. AddHeadCell(vRow, '单价', 80);
  143. AddHeadCell(vRow, '合同计量', 100);
  144. AddHeadCell(vRow, '数量变更计量', 100);
  145. end;
  146. end.