ExportExcel.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771
  1. unit ExportExcel;
  2. interface
  3. uses
  4. Classes, ZjGrid, ScXlsOutput, ScXlsCustomUD, Windows, StdCtrls,
  5. sdIDTree, sdDB, Graphics, SysUtils, ProgressHintFrm, Forms, Controls,
  6. OExport, OExport_Vcl, OExport_VclForms;
  7. type
  8. TExcelExportor = class
  9. private
  10. FOExport: TOExport;
  11. FGrid: TZJGrid;
  12. FTempFile: string;
  13. FFileName: string;
  14. procedure InitialPage(AGrid: TZJGrid; ASheet: TExportWorkSheet);
  15. protected
  16. procedure BeforeExport;
  17. procedure EndExport;
  18. public
  19. constructor Create;
  20. destructor Destroy; override;
  21. procedure ExportToSheet(AGrid: TZJGrid; ASheet: TExportWorkSheet);
  22. procedure ExportToFile(AGrid: TZJGrid; const AFileName: string);
  23. end;
  24. PColInfo = ^TColInfo;
  25. TColInfo = record
  26. // 字段名
  27. FieldName: string;
  28. // 查询字段名,应用于联合几个数据库的情况,参照dataset的Lookup方式
  29. KeyField: string;
  30. LookupKeyField: string;
  31. // 查询数据库ID
  32. LookupDataSetIndex: Integer;
  33. // 列名
  34. TitleCaption: string;
  35. // 列宽
  36. Width: Integer;
  37. // 对齐方式
  38. HorTextAlign: TCellHAlignment;
  39. //VerTextAlign: TUDVTextAlign;
  40. end;
  41. PColInfos = ^TColInfos;
  42. TColInfos = array [0..30] of TColInfo;
  43. // 仿照DataSet的Lookup以及数据库的AutoUpdate, 以达到关于sdIDTree导出数据至Excel的普适性
  44. // 导出前须根据所需列信息,以及查询数据库(列信息须与查询数据库对等,否则将会报错,并不检查列与数据库是否匹配)
  45. TIDTreeExcelExportor = class
  46. private
  47. FOExport: TOExport;
  48. FDataSetList: TList;
  49. FColInfos: PColInfos;
  50. FColCount: Integer;
  51. FHasLevelCode: Boolean;
  52. FTree: TsdIDTree;
  53. FTempFile: string;
  54. // 当清单数超过3w3k行时,使用Variant会内存溢出
  55. function GetCellValue(ANode: TsdIDTreeNode; ColInfo: TColInfo): Variant;
  56. // 故换成直接使用String
  57. function GetCellStr(ANode: TsdIDTreeNode; ColInfo: TColInfo): string;
  58. procedure ExportNodeData(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet; const ALevelCode: string);
  59. procedure ExportTreeNode(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet; const ALevelCode: string);
  60. procedure DefineHeader(ASheet: TExportWorkSheet);
  61. protected
  62. procedure BeforeExport;
  63. procedure AfterExport;
  64. public
  65. constructor Create;
  66. destructor Destroy; override;
  67. procedure AddLookupDataSet(ADataSet: TsdDataSet);
  68. procedure DefineCol(AColInfos: PColInfos; AColCount: Integer);
  69. procedure ExportToSheet(ATree: TsdIDTree; ASheet: TExportWorkSheet);
  70. procedure ExportToFile(ATree: TsdIDTree; const AFileName: string);
  71. property HasLevelCode: Boolean read FHasLevelCode write FHasLevelCode;
  72. end;
  73. TMasterExcelExportor = class
  74. private
  75. FOExport: TOExport;
  76. FColInfos: PColInfos;
  77. FRelaColInfos: PColInfos;
  78. FColCount: Integer;
  79. FTempFile: string;
  80. FMasterDataSet: TsdDataSet;
  81. FKeyFieldName: string;
  82. FRelaDataSet: TsdDataSet;
  83. FMasterFieldName: string;
  84. function GetCellValue(ARec: TsdDataRecord; ColInfo: TColInfo): Variant;
  85. procedure ExportRecord(ARec: TsdDataRecord; ASheet: TExportWorkSheet; AColInfos: PColInfos);
  86. procedure ExportData(ASheet: TExportWorkSheet);
  87. procedure DefineHeader(ASheet: TExportWorkSheet);
  88. protected
  89. procedure BeforeExport;
  90. procedure AfterExport;
  91. public
  92. constructor Create;
  93. destructor Destroy; override;
  94. procedure DefineCol(AColInfos: PColInfos; AColCount: Integer; ARelaColInfo: PColInfos = nil);
  95. procedure DefineMasterDataSet(ADataSet: TsdDataSet; const AKeyFieldName: string);
  96. procedure DefineRelaDataSet(ADataSet: TsdDataSet; const AMasterFieldName: string);
  97. procedure ExportToSheet(ASheet: TExportWorkSheet);
  98. procedure ExportToFile(const AFileName: string);
  99. end;
  100. const
  101. ciLedger: array [0..8] of TColInfo =(
  102. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  103. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  104. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  105. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  106. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  107. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 80; HorTextAlign: cahRight),
  108. (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  109. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
  110. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  111. );
  112. ciLedgerWithMis: array [0..10] of TColInfo =(
  113. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  114. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  115. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  116. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  117. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  118. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '施工图数量'; Width: 90; HorTextAlign: cahRight),
  119. (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
  120. (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
  121. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  122. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
  123. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  124. );
  125. ciFxBills: array [0..10] of TColInfo =(
  126. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
  127. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
  128. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  129. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  130. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 80; HorTextAlign: cahRight),
  131. (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
  132. (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
  133. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  134. (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
  135. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
  136. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  137. );
  138. ciFxBillsWithMis: array [0..12] of TColInfo =(
  139. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
  140. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
  141. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  142. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  143. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 90; HorTextAlign: cahRight),
  144. (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
  145. (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
  146. (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
  147. (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
  148. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  149. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
  150. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
  151. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  152. );
  153. ciTpPegGcl: array [0..9] of TColInfo =(
  154. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  155. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  156. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  157. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  158. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  159. (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
  160. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  161. (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
  162. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
  163. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  164. );
  165. ciTpGclPeg_Gcl: array [0..9] of TColInfo =(
  166. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  167. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  168. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  169. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  170. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  171. (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
  172. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  173. (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
  174. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
  175. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  176. );
  177. ciTpGclPeg_Peg: array [0..9] of TColInfo =(
  178. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  179. (FieldName: 'PegXmjCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  180. (FieldName: 'PegXmjName'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  181. (FieldName: 'PegXmjUnits'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  182. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  183. (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
  184. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  185. (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
  186. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
  187. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  188. );
  189. implementation
  190. uses
  191. ZhAPI, Variants, UtilMethods, Math;
  192. function GetExportor(const AFileType: string): TOCustomExporter;
  193. begin
  194. if SameText(AFileType, '.xls') then
  195. Result := TOCustomExporterXLS.Create
  196. else if SameText(AFileType, '.xlsx') then
  197. Result := TOCustomExporterXLSX.Create;
  198. end;
  199. { TExcelExportor }
  200. procedure TExcelExportor.BeforeExport;
  201. begin
  202. Screen.Cursor := crHourGlass;
  203. ShowProgressHint('导出Excel表格数据', FGrid.RowCount);
  204. end;
  205. constructor TExcelExportor.Create;
  206. begin
  207. FOExport := TOExport.Create;
  208. FOExport.UseProgress := False;
  209. FTempFile := GetTempFileName;
  210. end;
  211. destructor TExcelExportor.Destroy;
  212. begin
  213. if FileExists(FTempFile) then
  214. DeleteFileOrFolder(FTempFile);
  215. FOExport.Free;
  216. inherited;
  217. end;
  218. procedure TExcelExportor.EndExport;
  219. begin
  220. CloseProgressHint;
  221. Screen.Cursor := crDefault;
  222. end;
  223. procedure TExcelExportor.ExportToFile(AGrid: TZJGrid;
  224. const AFileName: string);
  225. var
  226. vExportor: TOCustomExporter;
  227. begin
  228. FFileName := AFileName;
  229. FGrid := AGrid;
  230. BeforeExport;
  231. try
  232. vExportor := GetExportor(ExtractFileExt(AFileName));
  233. ExportToSheet(AGrid, FOExport.AddWorkSheet);
  234. FOExport.SaveToFile(FTempFile, vExportor);
  235. if not FileExists(FFileName) or QuestMessage('存在同名文件,是否替换?') then
  236. CopyFileOrFolder(FTempFile, FFileName);
  237. finally
  238. vExportor.Free;
  239. EndExport;
  240. end;
  241. end;
  242. procedure TExcelExportor.ExportToSheet(AGrid: TZJGrid;
  243. ASheet: TExportWorkSheet);
  244. procedure SetXlsCellTextAlign(ACell: TExportCell; AGridCell: TzjCell);
  245. begin
  246. case AGridCell.TextAlign of
  247. gaTopLeft:
  248. begin
  249. ACell.SetVAlignment(cavTop);
  250. ACell.SetAlignment(cahLeft);
  251. end;
  252. gaTopCenter:
  253. begin
  254. ACell.SetVAlignment(cavTop);
  255. ACell.SetAlignment(cahCenter);
  256. end;
  257. gaTopRight:
  258. begin
  259. ACell.SetVAlignment(cavTop);
  260. ACell.SetAlignment(cahRight);
  261. end;
  262. gaCenterLeft:
  263. begin
  264. ACell.SetVAlignment(cavCenter);
  265. ACell.SetAlignment(cahLeft);
  266. end;
  267. gaCenterCenter:
  268. begin
  269. ACell.SetVAlignment(cavCenter);
  270. ACell.SetAlignment(cahCenter);
  271. end;
  272. gaCenterRight:
  273. begin
  274. ACell.SetVAlignment(cavCenter);
  275. ACell.SetAlignment(cahRight);
  276. end;
  277. gaBottomLeft:
  278. begin
  279. ACell.SetVAlignment(cavBottom);
  280. ACell.SetAlignment(cahLeft);
  281. end;
  282. gaBottomCenter:
  283. begin
  284. ACell.SetVAlignment(cavBottom);
  285. ACell.SetAlignment(cahCenter);
  286. end;
  287. gaBottomRight:
  288. begin
  289. ACell.SetVAlignment(cavBottom);
  290. ACell.SetAlignment(cahRight);
  291. end;
  292. end;
  293. if goWarpText in AGridCell.Grid.Options then
  294. ACell.WrapText := True;
  295. end;
  296. procedure ExportGridCell(AGridCell: TzjCell; ARow: TExportRow);
  297. var
  298. vCell: TExportCell;
  299. XlsCell: TXlsCustomCell;
  300. begin
  301. if (AGridCell = nil) then Exit;
  302. if ARow.Cells.Count >= AGridCell.Col + 1 then
  303. vCell := ARow.Cells[AGridCell.Col]
  304. else
  305. vCell := ARow.AddCellString(AGridCell.Text);
  306. SetXlsCellTextAlign(vCell, AGridCell);
  307. vCell.Font.Name := AGridCell.Font.Name;
  308. vCell.Font.Size := AGridCell.Font.Size;
  309. vCell.RowSpan := AGridCell.Height;
  310. vCell.ColSpan := AGridCell.Width;
  311. vCell.Width := FGrid.ColWidths[AGridCell.Col];
  312. vCell.Height := FGrid.RowHeights[AGridCell.Row];
  313. end;
  314. var
  315. iColumn, iRow: Integer;
  316. vRow: TExportRow;
  317. begin
  318. for iRow := 0 to AGrid.RowCount - 1 do
  319. begin
  320. UpdateProgressHint(Format('导出第%d行数据', [iRow + 1]));
  321. UpdateProgressHint(1);
  322. vRow := ASheet.AddRow;
  323. for iColumn := 0 to AGrid.ColCount - 1 do
  324. ExportGridCell(AGrid.Cells[iColumn, iRow], vRow);
  325. end;
  326. end;
  327. procedure TExcelExportor.InitialPage(AGrid: TZJGrid;
  328. ASheet: TExportWorkSheet);
  329. procedure InitialColumnWidth;
  330. var
  331. iColumn: Integer;
  332. begin
  333. for iColumn := 0 to AGrid.ColCount - 1 do
  334. ASheet.Cols[iColumn].SetWidth(AGrid.ColWidths[iColumn]);
  335. end;
  336. procedure InitialRowHeight;
  337. var
  338. iRow: Integer;
  339. begin
  340. for iRow := 0 to AGrid.RowCount - 1 do
  341. ASheet.Rows[iRow].SetHeight(AGrid.RowHeights[iRow]);
  342. end;
  343. begin
  344. InitialColumnWidth;
  345. InitialRowHeight;
  346. end;
  347. { TIDTreeExcelExportor }
  348. constructor TIDTreeExcelExportor.Create;
  349. begin
  350. FOExport := TOExport.Create;
  351. FDataSetList := TList.Create;
  352. FTempFile := GetTempFileName;
  353. end;
  354. destructor TIDTreeExcelExportor.Destroy;
  355. begin
  356. if FileExists(FTempFile) then
  357. DeleteFileOrFolder(FTempFile);
  358. FDataSetList.Free;
  359. FOExport.Free;
  360. inherited;
  361. end;
  362. procedure TIDTreeExcelExportor.ExportToFile(ATree: TsdIDTree;
  363. const AFileName: string);
  364. var
  365. vExportor: TOCustomExporter;
  366. begin
  367. FTree := ATree;
  368. BeforeExport;
  369. try
  370. vExportor := GetExportor(ExtractFileExt(AFileName));
  371. ExportToSheet(ATree, FOExport.AddWorkSheet);
  372. UpdateProgressHint('保存0号台账Excel数据');
  373. FOExport.SaveToFile(FTempFile, vExportor);
  374. if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
  375. CopyFileOrFolder(FTempFile, AFileName);
  376. finally
  377. vExportor.Free;
  378. AfterExport;
  379. end;
  380. end;
  381. procedure TIDTreeExcelExportor.ExportTreeNode(ANode: TsdIDTreeNode;
  382. ASheet: TExportWorkSheet; const ALevelCode: string);
  383. function GetFirstChildLevelCode(const ACode: string): string;
  384. begin
  385. Result := ACode + '.1';
  386. end;
  387. function GetNextSiblingLevelCode(const ACode: string): string;
  388. var
  389. strPreCode, strLastCode: string;
  390. iNextCode: Integer;
  391. begin
  392. if Pos('.', ACode) = 0 then
  393. Result := IntToStr(StrToIntDef(ACode, 1) + 1)
  394. else
  395. begin
  396. strPreCode := GetPrefixOfCode(ACode, '.');
  397. strLastCode := GetLastSetmentOfCode(ACode, '.');
  398. iNextCode := StrToIntDef(strLastCode, 1) + 1;
  399. Result := strPreCode + '.' + IntToStr(iNextCode);
  400. end;
  401. end;
  402. var
  403. sHint: string;
  404. begin
  405. if not Assigned(ANode) then Exit;
  406. if ANode.Rec.ValueByName('Code').AsString <> '' then
  407. sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Code').AsString
  408. else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
  409. sHint := '正在导出清单 ' + ANode.Rec.ValueByName('B_Code').AsString
  410. else
  411. sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Name').AsString;
  412. UpdateProgressHint(sHint);
  413. UpdateProgressHint(1);
  414. ExportNodeData(ANode, ASheet, ALevelCode);
  415. ExportTreeNode(ANode.FirstChild, ASheet, GetFirstChildLevelCode(ALevelCode));
  416. ExportTreeNode(ANode.NextSibling, ASheet, GetNextSiblingLevelCode(ALevelCode));
  417. end;
  418. procedure TIDTreeExcelExportor.ExportNodeData(ANode: TsdIDTreeNode;
  419. ASheet: TExportWorkSheet; const ALevelCode: string);
  420. var
  421. iCol: Integer;
  422. ColInfo: TColInfo;
  423. vRow: TExportRow;
  424. vCell: TExportCell;
  425. XlsCell: TXlsCustomCell;
  426. sStr: string;
  427. begin
  428. if not Assigned(ANode) then Exit;
  429. vRow := ASheet.AddRow;
  430. vRow.Height := 20;
  431. for iCol := 0 to FColCount - 1 do
  432. begin
  433. ColInfo := FColInfos[iCol];
  434. vCell := vRow.AddCellString(GetCellStr(ANode, ColInfo));
  435. vCell.Alignment := ColInfo.HorTextAlign;
  436. vCell.Font.Name := 'SmartSimSun';
  437. vCell.Font.Size := 9;
  438. end;
  439. if HasLevelCode then
  440. begin
  441. vCell := vRow.AddCellString(ALevelCode);
  442. vCell.Font.Name := 'SmartSimSun';
  443. vCell.Font.Size := 9;
  444. end;
  445. end;
  446. procedure TIDTreeExcelExportor.ExportToSheet(ATree: TsdIDTree;
  447. ASheet: TExportWorkSheet);
  448. begin
  449. DefineHeader(ASheet);
  450. ExportTreeNode(ATree.FirstNode, ASheet, '1');
  451. end;
  452. function TIDTreeExcelExportor.GetCellValue(ANode: TsdIDTreeNode;
  453. ColInfo: TColInfo): Variant;
  454. function GetRec: TsdDataRecord;
  455. var
  456. DataSet: TsdDataSet;
  457. begin
  458. Result := nil;
  459. DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
  460. if not Assigned(DataSet) then Exit;
  461. Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
  462. end;
  463. var
  464. ARec: TsdDataRecord;
  465. begin
  466. Result := '';
  467. if not Assigned(ANode) then Exit;
  468. if ColInfo.LookupDataSetIndex = -1 then
  469. ARec := ANode.Rec
  470. else
  471. ARec := GetRec;
  472. if Assigned(ARec) then
  473. Result := ARec.ValueByName(ColInfo.FieldName).Value;
  474. end;
  475. procedure TIDTreeExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
  476. var
  477. iCol: Integer;
  478. ColInfo: TColInfo;
  479. vRow: TExportRow;
  480. vCell: TExportCell;
  481. XlsCell: TXlsCustomCell;
  482. begin
  483. vRow := ASheet.AddRow;
  484. vRow.Height := 20;
  485. for iCol := 0 to FColCount - 1 do
  486. begin
  487. ColInfo := FColInfos[iCol];
  488. vCell := vRow.AddCellString(ColInfo.TitleCaption);
  489. vCell.SetAlignment(cahCenter);
  490. vCell.SetVAlignment(cavCenter);
  491. vCell.Font.Name := '黑体';
  492. vCell.Font.Size := 10;
  493. vCell.Width := ColInfo.Width;
  494. end;
  495. if HasLevelCode then
  496. begin
  497. vCell := vRow.AddCellString('层次编号');
  498. vCell.SetAlignment(cahCenter);
  499. vCell.SetVAlignment(cavCenter);
  500. vCell.Font.Name := '黑体';
  501. vCell.Font.Size := 10;
  502. end;
  503. end;
  504. procedure TIDTreeExcelExportor.AddLookupDataSet(ADataSet: TsdDataSet);
  505. begin
  506. FDataSetList.Add(ADataSet);
  507. end;
  508. procedure TIDTreeExcelExportor.DefineCol(AColInfos: PColInfos;
  509. AColCount: Integer);
  510. begin
  511. FColInfos := AColInfos;
  512. FColCount := AColCount;
  513. end;
  514. procedure TIDTreeExcelExportor.BeforeExport;
  515. begin
  516. Screen.Cursor := crHourGlass;
  517. ShowProgressHint('导出0号台账Excel数据', FTree.Count);
  518. end;
  519. procedure TIDTreeExcelExportor.AfterExport;
  520. begin
  521. CloseProgressHint;
  522. Screen.Cursor := crDefault;
  523. end;
  524. function TIDTreeExcelExportor.GetCellStr(ANode: TsdIDTreeNode;
  525. ColInfo: TColInfo): string;
  526. function GetRec: TsdDataRecord;
  527. var
  528. DataSet: TsdDataSet;
  529. begin
  530. Result := nil;
  531. DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
  532. if not Assigned(DataSet) then Exit;
  533. Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
  534. end;
  535. var
  536. ARec: TsdDataRecord;
  537. begin
  538. Result := '';
  539. if not Assigned(ANode) then Exit;
  540. if ColInfo.LookupDataSetIndex = -1 then
  541. ARec := ANode.Rec
  542. else
  543. ARec := GetRec;
  544. if Assigned(ARec) then
  545. Result := ARec.ValueByName(ColInfo.FieldName).AsString;
  546. if SameText(Result, '0') then
  547. Result := '';
  548. end;
  549. { TMasterExcelExportor }
  550. procedure TMasterExcelExportor.BeforeExport;
  551. begin
  552. Screen.Cursor := crHourGlass;
  553. end;
  554. constructor TMasterExcelExportor.Create;
  555. begin
  556. FOExport := TOExport.Create;
  557. FTempFile := GetTempFileName;
  558. end;
  559. procedure TMasterExcelExportor.DefineCol(AColInfos: PColInfos;
  560. AColCount: Integer; ARelaColInfo: PColInfos);
  561. begin
  562. FColInfos := AColInfos;
  563. FColCount := AColCount;
  564. FRelaColInfos := ARelaColInfo;
  565. end;
  566. procedure TMasterExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
  567. var
  568. iCol: Integer;
  569. ColInfo: TColInfo;
  570. vRow: TExportRow;
  571. vCell: TExportCell;
  572. begin
  573. vRow := ASheet.AddRow;
  574. vRow.Height := 20;
  575. for iCol := 0 to FColCount - 1 do
  576. begin
  577. ColInfo := FColInfos[iCol];
  578. vCell := vRow.AddCellString(ColInfo.TitleCaption);
  579. vCell.SetAlignment(cahCenter);
  580. vCell.SetVAlignment(cavCenter);
  581. vCell.Font.Name := '黑体';
  582. vCell.Font.Size := 10;
  583. vCell.Width := ColInfo.Width;
  584. end;
  585. end;
  586. procedure TMasterExcelExportor.DefineMasterDataSet(ADataSet: TsdDataSet;
  587. const AKeyFieldName: string);
  588. begin
  589. FMasterDataSet := ADataSet;
  590. FKeyFieldName := AKeyFieldName;
  591. end;
  592. procedure TMasterExcelExportor.DefineRelaDataSet(ADataSet: TsdDataSet;
  593. const AMasterFieldName: string);
  594. begin
  595. FRelaDataSet := ADataSet;
  596. FMasterFieldName := AMasterFieldName;
  597. end;
  598. destructor TMasterExcelExportor.Destroy;
  599. begin
  600. if FileExists(FTempFile) then
  601. DeleteFileOrFolder(FTempFile);
  602. FOExport.Free;
  603. inherited;
  604. end;
  605. procedure TMasterExcelExportor.AfterExport;
  606. begin
  607. Screen.Cursor := crDefault;
  608. end;
  609. procedure TMasterExcelExportor.ExportData(ASheet: TExportWorkSheet);
  610. var
  611. i, j: Integer;
  612. Rec, RelaRec: TsdDataRecord;
  613. begin
  614. for i := 0 to FMasterDataSet.RecordCount - 1 do
  615. begin
  616. Rec := FMasterDataSet.Records[i];
  617. ExportRecord(Rec, ASheet, FColInfos);
  618. for j := 0 to FRelaDataSet.RecordCount - 1 do
  619. begin
  620. RelaRec := FRelaDataSet.Records[j];
  621. if (RelaRec.ValueByName(FMasterFieldName).Value = Rec.ValueByName(FKeyFieldName).Value) then
  622. begin
  623. if Assigned(FRelaColInfos) then
  624. ExportRecord(RelaRec, ASheet, FRelaColInfos)
  625. else
  626. ExportRecord(RelaRec, ASheet, FColInfos);
  627. end;
  628. end;
  629. end;
  630. end;
  631. procedure TMasterExcelExportor.ExportRecord(ARec: TsdDataRecord;
  632. ASheet: TExportWorkSheet; AColInfos: PColInfos);
  633. var
  634. iCol: Integer;
  635. ColInfo: TColInfo;
  636. vRow: TExportRow;
  637. vCell: TExportCell;
  638. sStr: string;
  639. begin
  640. if not Assigned(ARec) then Exit;
  641. vRow := ASheet.AddRow;
  642. for iCol := 0 to FColCount - 1 do
  643. begin
  644. ColInfo := AColInfos[iCol];
  645. vCell := vRow.AddCellVariant(GetCellValue(ARec, ColInfo));
  646. vCell.Font.Name := 'SmartSimSun';
  647. vCell.Font.Size := 9;
  648. end;
  649. end;
  650. procedure TMasterExcelExportor.ExportToFile(const AFileName: string);
  651. var
  652. vExportor: TOCustomExporter;
  653. begin
  654. if not Assigned(FMasterDataSet) then Exit;
  655. BeforeExport;
  656. try
  657. vExportor := GetExportor(ExtractFileExt(AFileName));
  658. ExportToSheet(FOExport.AddWorkSheet);
  659. FOExport.SaveToFile(FTempFile, vExportor);
  660. if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
  661. CopyFile(PChar(FTempFile), PChar(AFileName), False);
  662. finally
  663. vExportor.Free;
  664. AfterExport;
  665. end;
  666. end;
  667. procedure TMasterExcelExportor.ExportToSheet(ASheet: TExportWorkSheet);
  668. begin
  669. if not Assigned(FMasterDataSet) then Exit;
  670. DefineHeader(ASheet);
  671. ExportData(ASheet);
  672. end;
  673. function TMasterExcelExportor.GetCellValue(ARec: TsdDataRecord;
  674. ColInfo: TColInfo): Variant;
  675. var
  676. Value: TsdValue;
  677. begin
  678. Result := '';
  679. if Assigned(ARec) then
  680. begin
  681. Value := ARec.ValueByName(ColInfo.FieldName);
  682. if Assigned(Value) then
  683. Result := Value.AsVariant;
  684. end;
  685. end;
  686. end.