ExportExcel.pas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542
  1. unit ExportExcel;
  2. interface
  3. uses
  4. Classes, ZjGrid, ScXlsOutput, ScXlsCustomUD, Windows, StdCtrls,
  5. sdIDTree, sdDB, Graphics, SysUtils, ProgressHintFrm, Forms, Controls;
  6. type
  7. TExcelExportor = class
  8. private
  9. FXlsOutPut: TXlsOutPut;
  10. FGrid: TZJGrid;
  11. FTempFile: string;
  12. FFileName: string;
  13. procedure InitialPage(AGrid: TZJGrid; AXlsPage: TXlsCustomPage);
  14. protected
  15. procedure BeforeExport;
  16. procedure EndExport;
  17. public
  18. constructor Create;
  19. destructor Destroy; override;
  20. procedure ExportToXlsPage(AGrid: TZJGrid; AXlsPage: TXlsCustomPage);
  21. procedure ExportToFile(AGrid: TZJGrid; const AFileName: string);
  22. end;
  23. PColInfo = ^TColInfo;
  24. TColInfo = record
  25. // 字段名
  26. FieldName: string;
  27. // 查询字段名,应用于联合几个数据库的情况,参照dataset的Lookup方式
  28. KeyField: string;
  29. LookupKeyField: string;
  30. // 查询数据库ID
  31. LookupDataSetIndex: Integer;
  32. // 列名
  33. TitleCaption: string;
  34. // 列宽
  35. Width: Integer;
  36. // 对齐方式
  37. HorTextAlign: TUDHTextAlign;
  38. //VerTextAlign: TUDVTextAlign;
  39. end;
  40. PColInfos = ^TColInfos;
  41. TColInfos = array [0..30] of TColInfo;
  42. // 仿照DataSet的Lookup以及数据库的AutoUpdate已达到关于sdIDTree导出数据至Excel的普适性
  43. // 导出前须根据所需列信息,以及查询数据库(列信息须与查询数据库对等,否则将会报错,并不检查列与数据库是否匹配)
  44. TIDTreeExcelExportor = class
  45. private
  46. FXlsOutPut: TXlsOutPut;
  47. FDataSetList: TList;
  48. FColInfos: PColInfos;
  49. FColCount: Integer;
  50. FHasLevelCode: Boolean;
  51. FTree: TsdIDTree;
  52. FTempFile: string;
  53. // 当清单数超过3w3k行时,使用Variant会内存溢出
  54. function GetCellValue(ANode: TsdIDTreeNode; ColInfo: TColInfo): Variant;
  55. // 故换成直接使用String
  56. function GetCellStr(ANode: TsdIDTreeNode; ColInfo: TColInfo): string;
  57. procedure ExportNodeData(ANode: TsdIDTreeNode; AXlsPage: TXlsCustomPage; const ALevelCode: string);
  58. procedure ExportTreeNode(ANode: TsdIDTreeNode; AXlsPage: TXlsCustomPage; const ALevelCode: string);
  59. procedure DefineHeader(AXlsPage: TXlsCustomPage);
  60. protected
  61. procedure BeforeExport;
  62. procedure EndExport;
  63. public
  64. constructor Create;
  65. destructor Destroy; override;
  66. procedure AddLookupDataSet(ADataSet: TsdDataSet);
  67. procedure DefineCol(AColInfos: PColInfos; AColCount: Integer);
  68. procedure ExportToXlsPage(ATree: TsdIDTree; AXlsPage: TXlsCustomPage);
  69. procedure ExportToFile(ATree: TsdIDTree; const AFileName: string);
  70. property HasLevelCode: Boolean read FHasLevelCode write FHasLevelCode;
  71. end;
  72. const
  73. ciLedger: array [0..8] of TColInfo =(
  74. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: htaLeft),
  75. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: htaLeft),
  76. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
  77. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
  78. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
  79. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 80; HorTextAlign: htaRight),
  80. (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: htaRight),
  81. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: htaLeft),
  82. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
  83. );
  84. ciLedgerWithMis: array [0..10] of TColInfo =(
  85. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: htaLeft),
  86. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: htaLeft),
  87. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
  88. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
  89. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
  90. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '施工图数量'; Width: 90; HorTextAlign: htaRight),
  91. (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: htaRight),
  92. (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: htaRight),
  93. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: htaRight),
  94. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: htaLeft),
  95. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
  96. );
  97. ciFxBills: array [0..10] of TColInfo =(
  98. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: htaLeft),
  99. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: htaLeft),
  100. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
  101. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
  102. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 80; HorTextAlign: htaRight),
  103. (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: htaRight),
  104. (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: htaRight),
  105. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
  106. (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: htaRight),
  107. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: htaLeft),
  108. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
  109. );
  110. ciFxBillsWithMis: array [0..12] of TColInfo =(
  111. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: htaLeft),
  112. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: htaLeft),
  113. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
  114. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
  115. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 90; HorTextAlign: htaRight),
  116. (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: htaRight),
  117. (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: htaRight),
  118. (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: htaRight),
  119. (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: htaRight),
  120. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
  121. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: htaRight),
  122. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: htaLeft),
  123. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
  124. );
  125. implementation
  126. uses
  127. ZhAPI, Variants, UtilMethods;
  128. { TExcelExportor }
  129. procedure TExcelExportor.BeforeExport;
  130. begin
  131. Screen.Cursor := crHourGlass;
  132. ShowProgressHint('导出Excel表格数据', FGrid.RowCount);
  133. end;
  134. constructor TExcelExportor.Create;
  135. begin
  136. FXlsOutPut := TXlsOutPut.Create;
  137. FTempFile := GetTempFileName;
  138. end;
  139. destructor TExcelExportor.Destroy;
  140. begin
  141. if FileExists(FTempFile) then
  142. DeleteFileOrFolder(FTempFile);
  143. FXlsOutPut.Free;
  144. inherited;
  145. end;
  146. procedure TExcelExportor.EndExport;
  147. begin
  148. CloseProgressHint;
  149. Screen.Cursor := crDefault;
  150. end;
  151. procedure TExcelExportor.ExportToFile(AGrid: TZJGrid;
  152. const AFileName: string);
  153. begin
  154. FFileName := AFileName;
  155. FGrid := AGrid;
  156. BeforeExport;
  157. try
  158. ExportToXlsPage(AGrid, FXlsOutPut.AddPage);
  159. FXlsOutPut.SaveToFile(FTempFile);
  160. if not FileExists(FFileName) or QuestMessage('存在同名文件,是否替换?') then
  161. CopyFile(PChar(FTempFile), PChar(FFileName), False);
  162. finally
  163. EndExport;
  164. end;
  165. end;
  166. procedure TExcelExportor.ExportToXlsPage(AGrid: TZJGrid;
  167. AXlsPage: TXlsCustomPage);
  168. procedure SetXlsCellTextAlign(AXlsCell: TXlsCustomCell; AGridCell: TzjCell);
  169. begin
  170. case AGridCell.TextAlign of
  171. gaTopLeft:
  172. begin
  173. AXlsCell.VTextAlign := vtaTop;
  174. AXlsCell.HTextAlign := htaLeft;
  175. end;
  176. gaTopCenter:
  177. begin
  178. AXlsCell.VTextAlign := vtaTop;
  179. AXlsCell.HTextAlign := htaCenter;
  180. end;
  181. gaTopRight:
  182. begin
  183. AXlsCell.VTextAlign := vtaTop;
  184. AXlsCell.HTextAlign := htaRight;
  185. end;
  186. gaCenterLeft:
  187. begin
  188. AXlsCell.VTextAlign := vtaCenter;
  189. AXlsCell.HTextAlign := htaLeft;
  190. end;
  191. gaCenterCenter:
  192. begin
  193. AXlsCell.VTextAlign := vtaCenter;
  194. AXlsCell.HTextAlign := htaCenter;
  195. end;
  196. gaCenterRight:
  197. begin
  198. AXlsCell.VTextAlign := vtaCenter;
  199. AXlsCell.HTextAlign := htaRight;
  200. end;
  201. gaBottomLeft:
  202. begin
  203. AXlsCell.VTextAlign := vtaBottom;
  204. AXlsCell.HTextAlign := htaLeft;
  205. end;
  206. gaBottomCenter:
  207. begin
  208. AXlsCell.VTextAlign := vtaBottom;
  209. AXlsCell.HTextAlign := htaCenter;
  210. end;
  211. gaBottomRight:
  212. begin
  213. AXlsCell.VTextAlign := vtaBottom;
  214. AXlsCell.HTextAlign := htaRight;
  215. end;
  216. end;
  217. if goWarpText in AGridCell.Grid.Options then
  218. AXlsCell.WartText := True;
  219. end;
  220. procedure ExportGridCell(AGridCell: TzjCell);
  221. var
  222. XlsCell: TXlsCustomCell;
  223. begin
  224. if AGridCell = nil then Exit;
  225. XlsCell := AXlsPage.AddCell(AGridCell.Col, AGridCell.Row, AGridCell.Text);
  226. SetXlsCellTextAlign(XlsCell, AGridCell);
  227. XlsCell.Font.Name := AGridCell.Font.Name;
  228. XlsCell.Font.Size := AGridCell.Font.Size;
  229. XlsCell.Width := AGridCell.Width;
  230. XlsCell.Height := AGridCell.Height;
  231. end;
  232. var
  233. iColumn, iRow: Integer;
  234. begin
  235. InitialPage(AGrid, AXlsPage);
  236. for iRow := 0 to AGrid.RowCount - 1 do
  237. begin
  238. UpdateProgressHint(Format('导出第%d行数据', [iRow + 1]));
  239. UpdateProgressHint(1);
  240. for iColumn := 0 to AGrid.ColCount - 1 do
  241. ExportGridCell(AGrid.Cells[iColumn, iRow]);
  242. end;
  243. end;
  244. procedure TExcelExportor.InitialPage(AGrid: TZJGrid;
  245. AXlsPage: TXlsCustomPage);
  246. procedure InitialColumnWidth;
  247. var
  248. iColumn: Integer;
  249. begin
  250. for iColumn := 0 to AGrid.ColCount - 1 do
  251. AXlsPage.Widths[iColumn] := AGrid.ColWidths[iColumn];
  252. end;
  253. procedure InitialRowHeight;
  254. var
  255. iRow: Integer;
  256. begin
  257. for iRow := 0 to AGrid.RowCount - 1 do
  258. AXlsPage.Heights.Items[iRow] := AGrid.RowHeights[iRow];
  259. end;
  260. begin
  261. InitialColumnWidth;
  262. InitialRowHeight;
  263. end;
  264. { TIDTreeExcelExportor }
  265. constructor TIDTreeExcelExportor.Create;
  266. begin
  267. FXlsOutPut := TXlsOutPut.Create;
  268. FDataSetList := TList.Create;
  269. FTempFile := GetTempFileName;
  270. end;
  271. destructor TIDTreeExcelExportor.Destroy;
  272. begin
  273. if FileExists(FTempFile) then
  274. DeleteFileOrFolder(FTempFile);
  275. FDataSetList.Free;
  276. FXlsOutPut.Free;
  277. inherited;
  278. end;
  279. procedure TIDTreeExcelExportor.ExportToFile(ATree: TsdIDTree;
  280. const AFileName: string);
  281. begin
  282. FTree := ATree;
  283. BeforeExport;
  284. try
  285. ExportToXlsPage(ATree, FXlsOutPut.AddPage);
  286. UpdateProgressHint('保存0号台账Excel数据');
  287. FXlsOutPut.SaveToFile(FTempFile);
  288. if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
  289. CopyFile(PChar(FTempFile), PChar(AFileName), False);
  290. finally
  291. EndExport;
  292. end;
  293. end;
  294. procedure TIDTreeExcelExportor.ExportTreeNode(ANode: TsdIDTreeNode;
  295. AXlsPage: TXlsCustomPage; const ALevelCode: string);
  296. function GetFirstChildLevelCode(const ACode: string): string;
  297. begin
  298. Result := ACode + '.1';
  299. end;
  300. function GetNextSiblingLevelCode(const ACode: string): string;
  301. var
  302. strPreCode, strLastCode: string;
  303. iNextCode: Integer;
  304. begin
  305. if Pos('.', ACode) = 0 then
  306. Result := IntToStr(StrToIntDef(ACode, 1) + 1)
  307. else
  308. begin
  309. strPreCode := GetPrefixOfCode(ACode, '.');
  310. strLastCode := GetLastSetmentOfCode(ACode, '.');
  311. iNextCode := StrToIntDef(strLastCode, 1) + 1;
  312. Result := strPreCode + '.' + IntToStr(iNextCode);
  313. end;
  314. end;
  315. var
  316. sHint: string;
  317. begin
  318. if not Assigned(ANode) then Exit;
  319. if ANode.Rec.ValueByName('Code').AsString <> '' then
  320. sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Code').AsString
  321. else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
  322. sHint := '正在导出清单 ' + ANode.Rec.ValueByName('B_Code').AsString
  323. else
  324. sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Name').AsString;
  325. UpdateProgressHint(sHint);
  326. UpdateProgressHint(1);
  327. ExportNodeData(ANode, AXlsPage, ALevelCode);
  328. ExportTreeNode(ANode.FirstChild, AXlsPage, GetFirstChildLevelCode(ALevelCode));
  329. ExportTreeNode(ANode.NextSibling, AXlsPage, GetNextSiblingLevelCode(ALevelCode));
  330. end;
  331. procedure TIDTreeExcelExportor.ExportNodeData(ANode: TsdIDTreeNode;
  332. AXlsPage: TXlsCustomPage; const ALevelCode: string);
  333. function ExportCell(ACol, ARow: Integer; AValue: Variant): TXlsCustomCell;
  334. begin
  335. Result := nil;
  336. // -----------
  337. if VarIsNull(AValue) then Exit;
  338. // -----------
  339. // 当数据超过3w3k行时,运行至某行时,AddCell会内存溢出
  340. // 可能是Cell的数目超过某个限度时,报错
  341. // 如果AValue为Null时不AddCell,则3w3k行可以安全度过
  342. case VarType(AValue) of
  343. varSmallInt, varInteger, varSingle, varDouble,
  344. varCurrency, varShortInt, varByte, varWord,
  345. varLongWord, varInt64:
  346. begin
  347. if AValue <> 0 then
  348. Result := AXlsPage.AddCell(ACol, ARow, AValue);
  349. end
  350. else Result := AXlsPage.AddCell(ACol, ARow, AValue);
  351. end;
  352. end;
  353. var
  354. iCol: Integer;
  355. ColInfo: TColInfo;
  356. XlsCell: TXlsCustomCell;
  357. sStr: string;
  358. begin
  359. if not Assigned(ANode) then Exit;
  360. for iCol := 0 to FColCount - 1 do
  361. begin
  362. ColInfo := FColInfos[iCol];
  363. XlsCell := ExportCell(iCol, ANode.MajorIndex + 1, GetCellValue(ANode, ColInfo));
  364. {sStr := GetCellStr(ANode, ColInfo);
  365. if sStr = '' then Continue;
  366. XlsCell := AXlsPage.AddCell(iCol, ANode.MajorIndex + 1, sStr);}
  367. if Assigned(XlsCell) then
  368. begin
  369. XlsCell.HTextAlign := ColInfo.HorTextAlign;
  370. //XlsCell.VTextAlign := ColInfo.VerTextAlign;
  371. XlsCell.Font.Name := 'SmartSimSun';
  372. XlsCell.Font.Size := 9;
  373. end;
  374. end;
  375. if HasLevelCode then
  376. begin
  377. XlsCell := ExportCell(FColCount, ANode.MajorIndex + 1, ALevelCode);
  378. XlsCell.Font.Name := 'SmartSimSun';
  379. XlsCell.Font.Size := 9;
  380. end;
  381. end;
  382. procedure TIDTreeExcelExportor.ExportToXlsPage(ATree: TsdIDTree;
  383. AXlsPage: TXlsCustomPage);
  384. begin
  385. DefineHeader(AXlsPage);
  386. ExportTreeNode(ATree.FirstNode, AXlsPage, '1');
  387. end;
  388. function TIDTreeExcelExportor.GetCellValue(ANode: TsdIDTreeNode;
  389. ColInfo: TColInfo): Variant;
  390. function GetRec: TsdDataRecord;
  391. var
  392. DataSet: TsdDataSet;
  393. begin
  394. Result := nil;
  395. DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
  396. if not Assigned(DataSet) then Exit;
  397. Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
  398. end;
  399. var
  400. ARec: TsdDataRecord;
  401. begin
  402. Result := '';
  403. if not Assigned(ANode) then Exit;
  404. if ColInfo.LookupDataSetIndex = -1 then
  405. ARec := ANode.Rec
  406. else
  407. ARec := GetRec;
  408. if Assigned(ARec) then
  409. Result := ARec.ValueByName(ColInfo.FieldName).Value;
  410. end;
  411. procedure TIDTreeExcelExportor.DefineHeader(AXlsPage: TXlsCustomPage);
  412. var
  413. iCol: Integer;
  414. ColInfo: TColInfo;
  415. XlsCell: TXlsCustomCell;
  416. begin
  417. for iCol := 0 to FColCount - 1 do
  418. begin
  419. ColInfo := FColInfos[iCol];
  420. XlsCell := AXlsPage.AddCell(iCol, 0, ColInfo.TitleCaption);
  421. XlsCell.HTextAlign := htaCenter;
  422. XlsCell.Font.Name := '黑体';
  423. XlsCell.Font.Size := 10;
  424. XlsCell.Font.Style := [fsBold];
  425. AXlsPage.Widths[iCol] := ColInfo.Width;
  426. end;
  427. if HasLevelCode then
  428. begin
  429. XlsCell := AXlsPage.AddCell(iCol, 0, '层次编号');
  430. XlsCell.HTextAlign := htaCenter;
  431. XlsCell.Font.Name := '黑体';
  432. XlsCell.Font.Size := 10;
  433. XlsCell.Font.Style := [fsBold];
  434. end;
  435. end;
  436. procedure TIDTreeExcelExportor.AddLookupDataSet(ADataSet: TsdDataSet);
  437. begin
  438. FDataSetList.Add(ADataSet);
  439. end;
  440. procedure TIDTreeExcelExportor.DefineCol(AColInfos: PColInfos;
  441. AColCount: Integer);
  442. begin
  443. FColInfos := AColInfos;
  444. FColCount := AColCount;
  445. end;
  446. procedure TIDTreeExcelExportor.BeforeExport;
  447. begin
  448. Screen.Cursor := crHourGlass;
  449. ShowProgressHint('导出0号台账Excel数据', FTree.Count);
  450. end;
  451. procedure TIDTreeExcelExportor.EndExport;
  452. begin
  453. CloseProgressHint;
  454. Screen.Cursor := crDefault;
  455. end;
  456. function TIDTreeExcelExportor.GetCellStr(ANode: TsdIDTreeNode;
  457. ColInfo: TColInfo): string;
  458. function GetRec: TsdDataRecord;
  459. var
  460. DataSet: TsdDataSet;
  461. begin
  462. Result := nil;
  463. DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
  464. if not Assigned(DataSet) then Exit;
  465. Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
  466. end;
  467. var
  468. ARec: TsdDataRecord;
  469. begin
  470. Result := '';
  471. if not Assigned(ANode) then Exit;
  472. if ColInfo.LookupDataSetIndex = -1 then
  473. ARec := ANode.Rec
  474. else
  475. ARec := GetRec;
  476. if Assigned(ARec) then
  477. Result := ARec.ValueByName(ColInfo.FieldName).AsString;
  478. if SameText(Result, '0') then
  479. Result := '';
  480. end;
  481. end.