ExportExcel.pas 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287
  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, BillsPosTree, BillsTree;
  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. TBillsPosExcelExportor = class
  101. private
  102. FOExport: TOExport;
  103. FTempFile: string;
  104. FTree: TBillsPosTree;
  105. FCodeCol: Integer;
  106. FB_CodeCol: Integer;
  107. FP_CodeCol: Integer;
  108. FNameCol: Integer;
  109. FUnitsCol: Integer;
  110. FQuantityCol: Integer;
  111. FDgnQty1: Integer;
  112. FDgnQty2: Integer;
  113. FPriceCol: Integer;
  114. FTotalPriceCol: Integer;
  115. FDrawingCodeCol: Integer;
  116. FMemoStrCol: Integer;
  117. procedure DefineHeader(ASheet: TExportWorkSheet);
  118. function HasGclChild(ANode: TBillsIDTreeNode): Boolean;
  119. function FindNode(AParent: TBillsPosTreeNode; AMatch: TBillsIDTreeNode): TBillsPosTreeNode;
  120. procedure ConversePosNode(ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode = nil);
  121. function ConverseNodeData(ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode = nil): TBillsPosTreeNode;
  122. procedure ConverseTreeNode(ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode = nil);
  123. procedure ExportPos(ASheet: TExportWorkSheet; ANode: TBillsPosTreeNode);
  124. procedure ExportNode(ASheet: TExportWorkSheet; ANode: TBillsPosTreeNode);
  125. procedure ExportData(ASheet: TExportWorkSheet);
  126. protected
  127. procedure BeforeExport;
  128. procedure AfterExport;
  129. public
  130. constructor Create;
  131. destructor Destroy; override;
  132. procedure ExportToSheet(ABillsIDTree: TBillsIDTree; ASheet: TExportWorkSheet);
  133. procedure ExportToFile(ABillsIDTree: TBillsIDTree; const AFileName: string);
  134. end;
  135. TPosBillsExcelExportor = class
  136. private
  137. FOExport: TOExport;
  138. FTempFile: string;
  139. FCodeCol: Integer;
  140. FB_CodeCol: Integer;
  141. FP_CodeCol: Integer;
  142. FNameCol: Integer;
  143. FUnitsCol: Integer;
  144. FQuantityCol: Integer;
  145. FDgnQty1: Integer;
  146. FDgnQty2: Integer;
  147. FPriceCol: Integer;
  148. FTotalPriceCol: Integer;
  149. FDrawingCodeCol: Integer;
  150. FMemoStrCol: Integer;
  151. procedure DefineHeader(ASheet: TExportWorkSheet);
  152. function HasGclChild(ANode: TBillsIDTreeNode): Boolean;
  153. procedure ExportNode(ASheet: TExportWorkSheet; ANode: TBillsIDTreeNode);
  154. protected
  155. procedure BeforeExport;
  156. procedure AfterExport;
  157. public
  158. constructor Create;
  159. destructor Destroy; override;
  160. procedure ExportToSheet(ABillsIDTree: TBillsIDTree; ASheet: TExportWorkSheet);
  161. procedure ExportToFile(ABillsIDTree: TBillsIDTree; const AFileName: string);
  162. end;
  163. const
  164. ciLedger: array [0..8] of TColInfo =(
  165. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  166. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  167. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  168. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  169. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  170. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 80; HorTextAlign: cahRight),
  171. (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  172. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
  173. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  174. );
  175. ciLedgerWithMis: array [0..10] of TColInfo =(
  176. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  177. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  178. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  179. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  180. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  181. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '施工图数量'; Width: 90; HorTextAlign: cahRight),
  182. (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
  183. (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
  184. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  185. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
  186. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  187. );
  188. ciFxBills: array [0..10] of TColInfo =(
  189. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
  190. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
  191. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  192. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  193. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 80; HorTextAlign: cahRight),
  194. (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
  195. (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
  196. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  197. (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
  198. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
  199. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  200. );
  201. ciFxBillsWithMis: array [0..12] of TColInfo =(
  202. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
  203. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
  204. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  205. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  206. (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 90; HorTextAlign: cahRight),
  207. (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
  208. (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
  209. (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
  210. (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
  211. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  212. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
  213. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
  214. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  215. );
  216. ciTpPegGcl: array [0..9] of TColInfo =(
  217. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  218. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  219. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  220. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  221. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  222. (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
  223. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  224. (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
  225. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
  226. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  227. );
  228. ciTpGclPeg_Gcl: array [0..9] of TColInfo =(
  229. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  230. (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  231. (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  232. (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  233. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  234. (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
  235. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  236. (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
  237. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
  238. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  239. );
  240. ciTpGclPeg_Peg: array [0..9] of TColInfo =(
  241. (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
  242. (FieldName: 'PegXmjCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
  243. (FieldName: 'PegXmjName'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
  244. (FieldName: 'PegXmjUnits'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
  245. (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
  246. (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
  247. (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
  248. (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
  249. (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
  250. (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
  251. );
  252. implementation
  253. uses
  254. ZhAPI, Variants, UtilMethods, Math, CacheTree, mDataRecord;
  255. function GetExportor(const AFileType: string): TOCustomExporter;
  256. begin
  257. if SameText(AFileType, '.xls') then
  258. Result := TOCustomExporterXLS.Create
  259. else if SameText(AFileType, '.xlsx') then
  260. Result := TOCustomExporterXLSX.Create;
  261. end;
  262. { TExcelExportor }
  263. procedure TExcelExportor.BeforeExport;
  264. begin
  265. Screen.Cursor := crHourGlass;
  266. ShowProgressHint('导出Excel表格数据', FGrid.RowCount);
  267. end;
  268. constructor TExcelExportor.Create;
  269. begin
  270. FOExport := TOExport.Create;
  271. FOExport.UseProgress := False;
  272. FTempFile := GetTempFileName;
  273. end;
  274. destructor TExcelExportor.Destroy;
  275. begin
  276. if FileExists(FTempFile) then
  277. DeleteFileOrFolder(FTempFile);
  278. FOExport.Free;
  279. inherited;
  280. end;
  281. procedure TExcelExportor.EndExport;
  282. begin
  283. CloseProgressHint;
  284. Screen.Cursor := crDefault;
  285. end;
  286. procedure TExcelExportor.ExportToFile(AGrid: TZJGrid;
  287. const AFileName: string);
  288. var
  289. vExportor: TOCustomExporter;
  290. begin
  291. FFileName := AFileName;
  292. FGrid := AGrid;
  293. BeforeExport;
  294. try
  295. vExportor := GetExportor(ExtractFileExt(AFileName));
  296. ExportToSheet(AGrid, FOExport.AddWorkSheet);
  297. FOExport.SaveToFile(FTempFile, vExportor);
  298. if not FileExists(FFileName) or QuestMessage('存在同名文件,是否替换?') then
  299. CopyFileOrFolder(FTempFile, FFileName);
  300. finally
  301. vExportor.Free;
  302. EndExport;
  303. end;
  304. end;
  305. procedure TExcelExportor.ExportToSheet(AGrid: TZJGrid;
  306. ASheet: TExportWorkSheet);
  307. procedure SetXlsCellTextAlign(ACell: TExportCell; AGridCell: TzjCell);
  308. begin
  309. case AGridCell.TextAlign of
  310. gaTopLeft:
  311. begin
  312. ACell.SetVAlignment(cavTop);
  313. ACell.SetAlignment(cahLeft);
  314. end;
  315. gaTopCenter:
  316. begin
  317. ACell.SetVAlignment(cavTop);
  318. ACell.SetAlignment(cahCenter);
  319. end;
  320. gaTopRight:
  321. begin
  322. ACell.SetVAlignment(cavTop);
  323. ACell.SetAlignment(cahRight);
  324. end;
  325. gaCenterLeft:
  326. begin
  327. ACell.SetVAlignment(cavCenter);
  328. ACell.SetAlignment(cahLeft);
  329. end;
  330. gaCenterCenter:
  331. begin
  332. ACell.SetVAlignment(cavCenter);
  333. ACell.SetAlignment(cahCenter);
  334. end;
  335. gaCenterRight:
  336. begin
  337. ACell.SetVAlignment(cavCenter);
  338. ACell.SetAlignment(cahRight);
  339. end;
  340. gaBottomLeft:
  341. begin
  342. ACell.SetVAlignment(cavBottom);
  343. ACell.SetAlignment(cahLeft);
  344. end;
  345. gaBottomCenter:
  346. begin
  347. ACell.SetVAlignment(cavBottom);
  348. ACell.SetAlignment(cahCenter);
  349. end;
  350. gaBottomRight:
  351. begin
  352. ACell.SetVAlignment(cavBottom);
  353. ACell.SetAlignment(cahRight);
  354. end;
  355. end;
  356. if goWarpText in AGridCell.Grid.Options then
  357. ACell.WrapText := True;
  358. end;
  359. procedure ExportGridCell(AGridCell: TzjCell; ARow: TExportRow);
  360. var
  361. vCell: TExportCell;
  362. XlsCell: TXlsCustomCell;
  363. begin
  364. if (AGridCell = nil) then Exit;
  365. if ARow.Cells.Count >= AGridCell.Col + 1 then
  366. vCell := ARow.Cells[AGridCell.Col]
  367. else
  368. vCell := ARow.AddCellString(AGridCell.Text);
  369. SetXlsCellTextAlign(vCell, AGridCell);
  370. vCell.Font.Name := AGridCell.Font.Name;
  371. vCell.Font.Size := AGridCell.Font.Size;
  372. vCell.RowSpan := AGridCell.Height;
  373. vCell.ColSpan := AGridCell.Width;
  374. vCell.Width := FGrid.ColWidths[AGridCell.Col];
  375. vCell.Height := FGrid.RowHeights[AGridCell.Row];
  376. end;
  377. var
  378. iColumn, iRow: Integer;
  379. vRow: TExportRow;
  380. begin
  381. for iRow := 0 to AGrid.RowCount - 1 do
  382. begin
  383. UpdateProgressHint(Format('导出第%d行数据', [iRow + 1]));
  384. UpdateProgressHint(1);
  385. vRow := ASheet.AddRow;
  386. for iColumn := 0 to AGrid.ColCount - 1 do
  387. ExportGridCell(AGrid.Cells[iColumn, iRow], vRow);
  388. end;
  389. end;
  390. procedure TExcelExportor.InitialPage(AGrid: TZJGrid;
  391. ASheet: TExportWorkSheet);
  392. procedure InitialColumnWidth;
  393. var
  394. iColumn: Integer;
  395. begin
  396. for iColumn := 0 to AGrid.ColCount - 1 do
  397. ASheet.Cols[iColumn].SetWidth(AGrid.ColWidths[iColumn]);
  398. end;
  399. procedure InitialRowHeight;
  400. var
  401. iRow: Integer;
  402. begin
  403. for iRow := 0 to AGrid.RowCount - 1 do
  404. ASheet.Rows[iRow].SetHeight(AGrid.RowHeights[iRow]);
  405. end;
  406. begin
  407. InitialColumnWidth;
  408. InitialRowHeight;
  409. end;
  410. { TIDTreeExcelExportor }
  411. constructor TIDTreeExcelExportor.Create;
  412. begin
  413. FOExport := TOExport.Create;
  414. FDataSetList := TList.Create;
  415. FTempFile := GetTempFileName;
  416. end;
  417. destructor TIDTreeExcelExportor.Destroy;
  418. begin
  419. if FileExists(FTempFile) then
  420. DeleteFileOrFolder(FTempFile);
  421. FDataSetList.Free;
  422. FOExport.Free;
  423. inherited;
  424. end;
  425. procedure TIDTreeExcelExportor.ExportToFile(ATree: TsdIDTree;
  426. const AFileName: string);
  427. var
  428. vExportor: TOCustomExporter;
  429. begin
  430. FTree := ATree;
  431. BeforeExport;
  432. try
  433. vExportor := GetExportor(ExtractFileExt(AFileName));
  434. ExportToSheet(ATree, FOExport.AddWorkSheet);
  435. UpdateProgressHint('保存0号台账Excel数据');
  436. FOExport.SaveToFile(FTempFile, vExportor);
  437. if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
  438. CopyFileOrFolder(FTempFile, AFileName);
  439. finally
  440. vExportor.Free;
  441. AfterExport;
  442. end;
  443. end;
  444. procedure TIDTreeExcelExportor.ExportTreeNode(ANode: TsdIDTreeNode;
  445. ASheet: TExportWorkSheet; const ALevelCode: string);
  446. function GetFirstChildLevelCode(const ACode: string): string;
  447. begin
  448. Result := ACode + '.1';
  449. end;
  450. function GetNextSiblingLevelCode(const ACode: string): string;
  451. var
  452. strPreCode, strLastCode: string;
  453. iNextCode: Integer;
  454. begin
  455. if Pos('.', ACode) = 0 then
  456. Result := IntToStr(StrToIntDef(ACode, 1) + 1)
  457. else
  458. begin
  459. strPreCode := GetPrefixOfCode(ACode, '.');
  460. strLastCode := GetLastSetmentOfCode(ACode, '.');
  461. iNextCode := StrToIntDef(strLastCode, 1) + 1;
  462. Result := strPreCode + '.' + IntToStr(iNextCode);
  463. end;
  464. end;
  465. var
  466. sHint: string;
  467. begin
  468. if not Assigned(ANode) then Exit;
  469. if ANode.Rec.ValueByName('Code').AsString <> '' then
  470. sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Code').AsString
  471. else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
  472. sHint := '正在导出清单 ' + ANode.Rec.ValueByName('B_Code').AsString
  473. else
  474. sHint := '正在导出清单 ' + ANode.Rec.ValueByName('Name').AsString;
  475. UpdateProgressHint(sHint);
  476. UpdateProgressHint(1);
  477. ExportNodeData(ANode, ASheet, ALevelCode);
  478. ExportTreeNode(ANode.FirstChild, ASheet, GetFirstChildLevelCode(ALevelCode));
  479. ExportTreeNode(ANode.NextSibling, ASheet, GetNextSiblingLevelCode(ALevelCode));
  480. end;
  481. procedure TIDTreeExcelExportor.ExportNodeData(ANode: TsdIDTreeNode;
  482. ASheet: TExportWorkSheet; const ALevelCode: string);
  483. var
  484. iCol: Integer;
  485. ColInfo: TColInfo;
  486. vRow: TExportRow;
  487. vCell: TExportCell;
  488. XlsCell: TXlsCustomCell;
  489. sStr: string;
  490. begin
  491. if not Assigned(ANode) then Exit;
  492. vRow := ASheet.AddRow;
  493. vRow.Height := 20;
  494. for iCol := 0 to FColCount - 1 do
  495. begin
  496. ColInfo := FColInfos[iCol];
  497. vCell := vRow.AddCellString(GetCellStr(ANode, ColInfo));
  498. vCell.Alignment := ColInfo.HorTextAlign;
  499. vCell.Font.Name := 'SmartSimSun';
  500. vCell.Font.Size := 9;
  501. end;
  502. if HasLevelCode then
  503. begin
  504. vCell := vRow.AddCellString(ALevelCode);
  505. vCell.Font.Name := 'SmartSimSun';
  506. vCell.Font.Size := 9;
  507. end;
  508. end;
  509. procedure TIDTreeExcelExportor.ExportToSheet(ATree: TsdIDTree;
  510. ASheet: TExportWorkSheet);
  511. begin
  512. DefineHeader(ASheet);
  513. ExportTreeNode(ATree.FirstNode, ASheet, '1');
  514. end;
  515. function TIDTreeExcelExportor.GetCellValue(ANode: TsdIDTreeNode;
  516. ColInfo: TColInfo): Variant;
  517. function GetRec: TsdDataRecord;
  518. var
  519. DataSet: TsdDataSet;
  520. begin
  521. Result := nil;
  522. DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
  523. if not Assigned(DataSet) then Exit;
  524. Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
  525. end;
  526. var
  527. ARec: TsdDataRecord;
  528. begin
  529. Result := '';
  530. if not Assigned(ANode) then Exit;
  531. if ColInfo.LookupDataSetIndex = -1 then
  532. ARec := ANode.Rec
  533. else
  534. ARec := GetRec;
  535. if Assigned(ARec) then
  536. Result := ARec.ValueByName(ColInfo.FieldName).Value;
  537. end;
  538. procedure TIDTreeExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
  539. var
  540. iCol: Integer;
  541. ColInfo: TColInfo;
  542. vRow: TExportRow;
  543. vCell: TExportCell;
  544. XlsCell: TXlsCustomCell;
  545. begin
  546. vRow := ASheet.AddRow;
  547. vRow.Height := 20;
  548. for iCol := 0 to FColCount - 1 do
  549. begin
  550. ColInfo := FColInfos[iCol];
  551. vCell := vRow.AddCellString(ColInfo.TitleCaption);
  552. vCell.SetAlignment(cahCenter);
  553. vCell.SetVAlignment(cavCenter);
  554. vCell.Font.Name := '黑体';
  555. vCell.Font.Size := 10;
  556. vCell.Width := ColInfo.Width;
  557. end;
  558. if HasLevelCode then
  559. begin
  560. vCell := vRow.AddCellString('层次编号');
  561. vCell.SetAlignment(cahCenter);
  562. vCell.SetVAlignment(cavCenter);
  563. vCell.Font.Name := '黑体';
  564. vCell.Font.Size := 10;
  565. end;
  566. end;
  567. procedure TIDTreeExcelExportor.AddLookupDataSet(ADataSet: TsdDataSet);
  568. begin
  569. FDataSetList.Add(ADataSet);
  570. end;
  571. procedure TIDTreeExcelExportor.DefineCol(AColInfos: PColInfos;
  572. AColCount: Integer);
  573. begin
  574. FColInfos := AColInfos;
  575. FColCount := AColCount;
  576. end;
  577. procedure TIDTreeExcelExportor.BeforeExport;
  578. begin
  579. Screen.Cursor := crHourGlass;
  580. ShowProgressHint('导出0号台账Excel数据', FTree.Count);
  581. end;
  582. procedure TIDTreeExcelExportor.AfterExport;
  583. begin
  584. CloseProgressHint;
  585. Screen.Cursor := crDefault;
  586. end;
  587. function TIDTreeExcelExportor.GetCellStr(ANode: TsdIDTreeNode;
  588. ColInfo: TColInfo): string;
  589. function GetRec: TsdDataRecord;
  590. var
  591. DataSet: TsdDataSet;
  592. begin
  593. Result := nil;
  594. DataSet := TsdDataSet(FDataSetList.Items[ColInfo.LookupDataSetIndex]);
  595. if not Assigned(DataSet) then Exit;
  596. Result := DataSet.Locate(ColInfo.LookupKeyField, ANode.Rec.ValueByName(ColInfo.KeyField).Value);
  597. end;
  598. var
  599. ARec: TsdDataRecord;
  600. begin
  601. Result := '';
  602. if not Assigned(ANode) then Exit;
  603. if ColInfo.LookupDataSetIndex = -1 then
  604. ARec := ANode.Rec
  605. else
  606. ARec := GetRec;
  607. if Assigned(ARec) then
  608. Result := ARec.ValueByName(ColInfo.FieldName).AsString;
  609. if SameText(Result, '0') then
  610. Result := '';
  611. end;
  612. { TMasterExcelExportor }
  613. procedure TMasterExcelExportor.BeforeExport;
  614. begin
  615. Screen.Cursor := crHourGlass;
  616. end;
  617. constructor TMasterExcelExportor.Create;
  618. begin
  619. FOExport := TOExport.Create;
  620. FTempFile := GetTempFileName;
  621. end;
  622. procedure TMasterExcelExportor.DefineCol(AColInfos: PColInfos;
  623. AColCount: Integer; ARelaColInfo: PColInfos);
  624. begin
  625. FColInfos := AColInfos;
  626. FColCount := AColCount;
  627. FRelaColInfos := ARelaColInfo;
  628. end;
  629. procedure TMasterExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
  630. var
  631. iCol: Integer;
  632. ColInfo: TColInfo;
  633. vRow: TExportRow;
  634. vCell: TExportCell;
  635. begin
  636. vRow := ASheet.AddRow;
  637. vRow.Height := 20;
  638. for iCol := 0 to FColCount - 1 do
  639. begin
  640. ColInfo := FColInfos[iCol];
  641. vCell := vRow.AddCellString(ColInfo.TitleCaption);
  642. vCell.SetAlignment(cahCenter);
  643. vCell.SetVAlignment(cavCenter);
  644. vCell.Font.Name := '黑体';
  645. vCell.Font.Size := 10;
  646. vCell.Width := ColInfo.Width;
  647. end;
  648. end;
  649. procedure TMasterExcelExportor.DefineMasterDataSet(ADataSet: TsdDataSet;
  650. const AKeyFieldName: string);
  651. begin
  652. FMasterDataSet := ADataSet;
  653. FKeyFieldName := AKeyFieldName;
  654. end;
  655. procedure TMasterExcelExportor.DefineRelaDataSet(ADataSet: TsdDataSet;
  656. const AMasterFieldName: string);
  657. begin
  658. FRelaDataSet := ADataSet;
  659. FMasterFieldName := AMasterFieldName;
  660. end;
  661. destructor TMasterExcelExportor.Destroy;
  662. begin
  663. if FileExists(FTempFile) then
  664. DeleteFileOrFolder(FTempFile);
  665. FOExport.Free;
  666. inherited;
  667. end;
  668. procedure TMasterExcelExportor.AfterExport;
  669. begin
  670. Screen.Cursor := crDefault;
  671. end;
  672. procedure TMasterExcelExportor.ExportData(ASheet: TExportWorkSheet);
  673. var
  674. i, j: Integer;
  675. Rec, RelaRec: TsdDataRecord;
  676. begin
  677. for i := 0 to FMasterDataSet.RecordCount - 1 do
  678. begin
  679. Rec := FMasterDataSet.Records[i];
  680. ExportRecord(Rec, ASheet, FColInfos);
  681. for j := 0 to FRelaDataSet.RecordCount - 1 do
  682. begin
  683. RelaRec := FRelaDataSet.Records[j];
  684. if (RelaRec.ValueByName(FMasterFieldName).Value = Rec.ValueByName(FKeyFieldName).Value) then
  685. begin
  686. if Assigned(FRelaColInfos) then
  687. ExportRecord(RelaRec, ASheet, FRelaColInfos)
  688. else
  689. ExportRecord(RelaRec, ASheet, FColInfos);
  690. end;
  691. end;
  692. end;
  693. end;
  694. procedure TMasterExcelExportor.ExportRecord(ARec: TsdDataRecord;
  695. ASheet: TExportWorkSheet; AColInfos: PColInfos);
  696. var
  697. iCol: Integer;
  698. ColInfo: TColInfo;
  699. vRow: TExportRow;
  700. vCell: TExportCell;
  701. sStr: string;
  702. begin
  703. if not Assigned(ARec) then Exit;
  704. vRow := ASheet.AddRow;
  705. for iCol := 0 to FColCount - 1 do
  706. begin
  707. ColInfo := AColInfos[iCol];
  708. vCell := vRow.AddCellVariant(GetCellValue(ARec, ColInfo));
  709. vCell.Font.Name := 'SmartSimSun';
  710. vCell.Font.Size := 9;
  711. end;
  712. end;
  713. procedure TMasterExcelExportor.ExportToFile(const AFileName: string);
  714. var
  715. vExportor: TOCustomExporter;
  716. begin
  717. if not Assigned(FMasterDataSet) then Exit;
  718. BeforeExport;
  719. try
  720. vExportor := GetExportor(ExtractFileExt(AFileName));
  721. ExportToSheet(FOExport.AddWorkSheet);
  722. FOExport.SaveToFile(FTempFile, vExportor);
  723. if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
  724. CopyFile(PChar(FTempFile), PChar(AFileName), False);
  725. finally
  726. vExportor.Free;
  727. AfterExport;
  728. end;
  729. end;
  730. procedure TMasterExcelExportor.ExportToSheet(ASheet: TExportWorkSheet);
  731. begin
  732. if not Assigned(FMasterDataSet) then Exit;
  733. DefineHeader(ASheet);
  734. ExportData(ASheet);
  735. end;
  736. function TMasterExcelExportor.GetCellValue(ARec: TsdDataRecord;
  737. ColInfo: TColInfo): Variant;
  738. var
  739. Value: TsdValue;
  740. begin
  741. Result := '';
  742. if Assigned(ARec) then
  743. begin
  744. Value := ARec.ValueByName(ColInfo.FieldName);
  745. if Assigned(Value) then
  746. Result := Value.AsVariant;
  747. end;
  748. end;
  749. { TBillsPosExcelExportor }
  750. procedure TBillsPosExcelExportor.AfterExport;
  751. begin
  752. Screen.Cursor := crDefault;
  753. end;
  754. procedure TBillsPosExcelExportor.BeforeExport;
  755. begin
  756. Screen.Cursor := crHourGlass;
  757. end;
  758. procedure TBillsPosExcelExportor.ConversePosNode(ANode: TBillsIDTreeNode;
  759. AParent: TBillsPosTreeNode);
  760. var
  761. i: Integer;
  762. vChild: TBillsIDTreeNode;
  763. vCur: TBillsPosTreeNode;
  764. vPos: TPosNode;
  765. begin
  766. if ANode.ChildCount = 0 then Exit;
  767. for i := 0 to ANode.ChildCount - 1 do
  768. begin
  769. vChild := TBillsIDTreeNode(ANode.ChildNodes[i]);
  770. if (vChild.Rec.B_Code.AsString <> '') then
  771. begin
  772. vCur := FindNode(AParent, vChild);
  773. if not Assigned(vCur) then
  774. vCur := ConverseNodeData(vChild, AParent);
  775. vPos := vCur.AddPos;
  776. vPos.Name := ANode.Rec.Name.AsString;
  777. vPos.Quantity := vChild.Rec.Quantity.AsFloat;
  778. vPos.MemoStr := ANode.Rec.MemoStr.AsString;
  779. vPos.DrawingCode := ANode.Rec.DrawingCode.AsString;
  780. end;
  781. end;
  782. end;
  783. procedure TBillsPosExcelExportor.ConverseTreeNode(
  784. ANode: TBillsIDTreeNode; AParent: TBillsPosTreeNode);
  785. var
  786. vCur: TBillsPosTreeNode;
  787. begin
  788. if not Assigned(ANode) then Exit;
  789. if (ANode.Rec.B_Code.AsString = '') then
  790. begin
  791. if (Pos('1-1-', ANode.Rec.Code.AsString) = 1) or (not HasGclChild(ANode)) then
  792. begin
  793. vCur := ConverseNodeData(ANode, AParent);
  794. ConverseTreeNode(TBillsIDTreeNode(ANode.FirstChild), vCur);
  795. end
  796. else
  797. ConversePosNode(ANode, AParent);
  798. end
  799. else if (Assigned(ANode.Parent) And (Pos('1-1-', TBillsIDTreeNode(ANode.Parent).Rec.Code.AsString) = 1)) then
  800. begin
  801. vCur := ConverseNodeData(ANode, AParent);
  802. vCur.Quantity := ANode.Rec.Quantity.AsFloat;
  803. ConverseTreeNode(TBillsIDTreeNode(ANode.FirstChild), vCur);
  804. end;
  805. ConverseTreeNode(TBillsIDTreeNode(ANode.NextSibling), AParent);
  806. end;
  807. function TBillsPosExcelExportor.ConverseNodeData(ANode: TBillsIDTreeNode;
  808. AParent: TBillsPosTreeNode): TBillsPosTreeNode;
  809. begin
  810. Result := TBillsPosTreeNode(FTree.AddNode(AParent));
  811. Result.Code := ANode.Rec.Code.AsString;
  812. Result.B_Code := ANode.Rec.B_Code.AsString;
  813. Result.Name := ANode.Rec.Name.AsString;
  814. Result.Units := ANode.Rec.Units.AsString;
  815. Result.DrawingCode := ANode.Rec.DrawingCode.AsString;
  816. Result.MemoStr := ANode.Rec.MemoStr.AsString;
  817. Result.DgnQty1 := ANode.Rec.DgnQuantity1.AsFloat;
  818. Result.DgnQty2 := ANode.Rec.DgnQuantity2.AsFloat;
  819. Result.Price := ANode.Rec.Price.AsFloat;
  820. Result.TotalPrice := ANode.Rec.TotalPrice.AsFloat;
  821. end;
  822. constructor TBillsPosExcelExportor.Create;
  823. begin
  824. FOExport := TOExport.Create;
  825. FTempFile := GetTempFileName;
  826. FCodeCol := 0;
  827. FB_CodeCol := 1;
  828. FP_COdeCol := 2;
  829. FNameCol := 3;
  830. FUnitsCol := 4;
  831. FQuantityCol := 5;
  832. FDgnQty1 := 6;
  833. FDgnQty2 := 7;
  834. FPriceCol := 8;
  835. FTotalPriceCol := 9;
  836. FDrawingCodeCol := 10;
  837. FMemoStrCol := 11;
  838. end;
  839. procedure TBillsPosExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
  840. procedure AddHeaderCell(ARow: TExportRow; iCol: Integer; const AText: String; AWidth: Integer);
  841. var
  842. vCell: TExportCell;
  843. begin
  844. vCell := ARow.AddCellString(AText);
  845. vCell.SetAlignment(cahCenter);
  846. vCell.SetVAlignment(cavCenter);
  847. vCell.Font.Name := '黑体';
  848. vCell.Font.Size := 10;
  849. vCell.Width := AWidth;
  850. end;
  851. var
  852. iCol: Integer;
  853. ColInfo: TColInfo;
  854. vRow: TExportRow;
  855. vCell: TExportCell;
  856. begin
  857. vRow := ASheet.AddRow;
  858. vRow.Height := 20;
  859. AddHeaderCell(vRow, FCodeCol, '项目节编号', 100);
  860. AddHeaderCell(vRow, FB_CodeCol, '清单编号', 80);
  861. AddHeaderCell(vRow, FP_CodeCol, '计量单元', 80);
  862. AddHeaderCell(vRow, FNameCol, '名称', 300);
  863. AddHeaderCell(vRow, FUnitsCol, '单位', 60);
  864. AddHeaderCell(vRow, FQuantityCol, '清单数量', 70);
  865. AddHeaderCell(vRow, FDgnQty1, '设计数量1', 70);
  866. AddHeaderCell(vRow, FDgnQty2, '设计数量2', 70);
  867. AddHeaderCell(vRow, FPriceCol, '单价', 70);
  868. AddHeaderCell(vRow, FTotalPriceCol, '合价', 70);
  869. AddHeaderCell(vRow, FDrawingCodeCol, '图号', 85);
  870. AddHeaderCell(vRow, FMemoStrCol, '备注', 100);
  871. end;
  872. destructor TBillsPosExcelExportor.Destroy;
  873. begin
  874. if FileExists(FTempFile) then
  875. DeleteFileOrFolder(FTempFile);
  876. FOExport.Free;
  877. inherited;
  878. end;
  879. procedure TBillsPosExcelExportor.ExportData(ASheet: TExportWorkSheet);
  880. begin
  881. ExportNode(ASheet, TBillsPosTreeNode(FTree.FirstNode));
  882. end;
  883. procedure TBillsPosExcelExportor.ExportNode(ASheet: TExportWorkSheet;
  884. ANode: TBillsPosTreeNode);
  885. var
  886. vRow: TExportRow;
  887. vCell: TExportCellNumber;
  888. begin
  889. if not Assigned(ANode) then Exit;
  890. vRow := ASheet.AddRow;
  891. vRow.AddCellString(ANode.Code);
  892. vRow.AddCellString(ANode.B_Code);
  893. vRow.AddCellString('');
  894. vRow.AddCellString(ANode.Name);
  895. vRow.AddCellString(ANode.Units);
  896. vCell := vRow.AddCellNumber(ANode.Quantity);
  897. vCell.EmptyIfZero := True;
  898. vCell := vRow.AddCellNumber(ANode.DgnQty1);
  899. vCell.EmptyIfZero := True;
  900. vCell := vRow.AddCellNumber(ANode.DgnQty2);
  901. vCell.EmptyIfZero := True;
  902. vCell := vRow.AddCellNumber(ANode.Price);
  903. vCell.EmptyIfZero := True;
  904. vCell := vRow.AddCellNumber(ANode.TotalPrice);
  905. vCell.EmptyIfZero := True;
  906. vRow.AddCellString(ANode.DrawingCode);
  907. vRow.AddCellString(ANode.MemoStr);
  908. ExportPos(ASheet, ANode);
  909. ExportNode(ASheet, TBillsPosTreeNode(ANode.FirstChild));
  910. ExportNode(ASheet, TBillsPosTreeNode(ANode.NextSibling));
  911. end;
  912. procedure TBillsPosExcelExportor.ExportPos(ASheet: TExportWorkSheet;
  913. ANode: TBillsPosTreeNode);
  914. var
  915. i: Integer;
  916. vPos: TPosNode;
  917. vRow: TExportRow;
  918. vCell: TExportCellNumber;
  919. begin
  920. if not Assigned(ANode) then Exit;
  921. for i := 0 to ANode.PosCount - 1 do
  922. begin
  923. vPos := ANode.Pos[i];
  924. vRow := ASheet.AddRow;
  925. vRow.AddCellString();
  926. vRow.AddCellString();
  927. vRow.AddCellString(IntToStr(i+1));
  928. vRow.AddCellString(vPos.Name);
  929. vRow.AddCellString();
  930. vCell := vRow.AddCellNumber(vPos.Quantity);
  931. vCell.EmptyIfZero := True;
  932. vCell := vRow.AddCellNumber();
  933. vCell.EmptyIfZero := True;
  934. vCell := vRow.AddCellNumber();
  935. vCell.EmptyIfZero := True;
  936. vCell := vRow.AddCellNumber();
  937. vCell.EmptyIfZero := True;
  938. vCell := vRow.AddCellNumber();
  939. vCell.EmptyIfZero := True;
  940. vRow.AddCellString(vPos.DrawingCode);
  941. vRow.AddCellString(vPos.MemoStr);
  942. end;
  943. end;
  944. procedure TBillsPosExcelExportor.ExportToFile(ABillsIDTree: TBillsIDTree; const AFileName: string);
  945. var
  946. vExportor: TOCustomExporter;
  947. begin
  948. BeforeExport;
  949. try
  950. vExportor := GetExportor(ExtractFileExt(AFileName));
  951. ExportToSheet(ABillsIDTree, FOExport.AddWorkSheet);
  952. FOExport.SaveToFile(FTempFile, vExportor);
  953. if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
  954. CopyFile(PChar(FTempFile), PChar(AFileName), False);
  955. finally
  956. vExportor.Free;
  957. AfterExport;
  958. end;
  959. end;
  960. procedure TBillsPosExcelExportor.ExportToSheet(ABillsIDTree: TBillsIDTree; ASheet: TExportWorkSheet);
  961. begin
  962. DefineHeader(ASheet);
  963. FTree := TBillsPosTree.Create;
  964. try
  965. ConverseTreeNode(TBillsIDTreeNode(ABillsIDTree.FirstNode));
  966. FTree.CalculateAll;
  967. ExportData(ASheet);
  968. finally
  969. FTree.Free;
  970. end;
  971. end;
  972. function TBillsPosExcelExportor.HasGclChild(
  973. ANode: TBillsIDTreeNode): Boolean;
  974. var
  975. i: Integer;
  976. vChild: TBillsIDTreeNode;
  977. begin
  978. Result := False;
  979. for i := 0 to ANode.ChildCount - 1 do
  980. begin
  981. vChild := TBillsIDTreeNode(ANode.ChildNodes[i]);
  982. if (vChild.Rec.B_Code.AsString <> '') then
  983. begin
  984. Result := True;
  985. Exit;
  986. end;
  987. end;
  988. end;
  989. function TBillsPosExcelExportor.FindNode(AParent: TBillsPosTreeNode;
  990. AMatch: TBillsIDTreeNode): TBillsPosTreeNode;
  991. var
  992. i: Integer;
  993. vChild: TBillsPosTreeNode;
  994. begin
  995. Result := nil;
  996. if not Assigned(AParent) then Exit;
  997. for i := 0 to AParent.Children.Count - 1 do
  998. begin
  999. vChild := TBillsPosTreeNode(AParent.Children.Items[i]);
  1000. if ((vChild.B_Code = AMatch.Rec.B_Code.AsString) And
  1001. (vChild.Name = AMatch.Rec.Name.AsString) And
  1002. (vChild.Units = AMatch.Rec.Units.AsString) And
  1003. (PriceRoundTo(vChild.Price - AMatch.Rec.Price.AsFloat) = 0)) then
  1004. begin
  1005. Result := vChild;
  1006. Break;
  1007. end;
  1008. end;
  1009. end;
  1010. { TPosBillsExcelExportor }
  1011. procedure TPosBillsExcelExportor.AfterExport;
  1012. begin
  1013. Screen.Cursor := crDefault;
  1014. end;
  1015. procedure TPosBillsExcelExportor.BeforeExport;
  1016. begin
  1017. Screen.Cursor := crHourGlass;
  1018. end;
  1019. constructor TPosBillsExcelExportor.Create;
  1020. begin
  1021. FOExport := TOExport.Create;
  1022. FTempFile := GetTempFileName;
  1023. FCodeCol := 0;
  1024. FP_COdeCol := 1;
  1025. FB_CodeCol := 2;
  1026. FNameCol := 3;
  1027. FUnitsCol := 4;
  1028. FQuantityCol := 5;
  1029. FDgnQty1 := 6;
  1030. FDgnQty2 := 7;
  1031. FPriceCol := 8;
  1032. FTotalPriceCol := 9;
  1033. FDrawingCodeCol := 10;
  1034. FMemoStrCol := 11;
  1035. end;
  1036. procedure TPosBillsExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
  1037. procedure AddHeaderCell(ARow: TExportRow; iCol: Integer; const AText: String; AWidth: Integer);
  1038. var
  1039. vCell: TExportCell;
  1040. begin
  1041. vCell := ARow.AddCellString(AText);
  1042. vCell.SetAlignment(cahCenter);
  1043. vCell.SetVAlignment(cavCenter);
  1044. vCell.Font.Name := '黑体';
  1045. vCell.Font.Size := 10;
  1046. vCell.Width := AWidth;
  1047. end;
  1048. var
  1049. iCol: Integer;
  1050. ColInfo: TColInfo;
  1051. vRow: TExportRow;
  1052. vCell: TExportCell;
  1053. begin
  1054. vRow := ASheet.AddRow;
  1055. vRow.Height := 20;
  1056. AddHeaderCell(vRow, FCodeCol, '项目节编号', 100);
  1057. AddHeaderCell(vRow, FP_CodeCol, '计量单元', 80);
  1058. AddHeaderCell(vRow, FB_CodeCol, '清单编号', 80);
  1059. AddHeaderCell(vRow, FNameCol, '名称', 300);
  1060. AddHeaderCell(vRow, FUnitsCol, '单位', 60);
  1061. AddHeaderCell(vRow, FQuantityCol, '清单数量', 70);
  1062. AddHeaderCell(vRow, FDgnQty1, '设计数量1', 70);
  1063. AddHeaderCell(vRow, FDgnQty2, '设计数量2', 70);
  1064. AddHeaderCell(vRow, FPriceCol, '单价', 70);
  1065. AddHeaderCell(vRow, FTotalPriceCol, '合价', 70);
  1066. AddHeaderCell(vRow, FDrawingCodeCol, '图号', 85);
  1067. AddHeaderCell(vRow, FMemoStrCol, '备注', 100);
  1068. end;
  1069. destructor TPosBillsExcelExportor.Destroy;
  1070. begin
  1071. if FileExists(FTempFile) then
  1072. DeleteFileOrFolder(FTempFile);
  1073. FOExport.Free;
  1074. inherited;
  1075. end;
  1076. procedure TPosBillsExcelExportor.ExportNode(ASheet: TExportWorkSheet;
  1077. ANode: TBillsIDTreeNode);
  1078. var
  1079. vRow: TExportRow;
  1080. vCell: TExportCellNumber;
  1081. begin
  1082. if not Assigned(ANode) then Exit;
  1083. vRow := ASheet.AddRow;
  1084. if (Pos('1-1-', ANode.Rec.Code.AsString) = 1) or (not HasGclChild(ANode)) then
  1085. begin
  1086. vRow.AddCellString(ANode.Rec.Code.AsString);
  1087. vRow.AddCellString('');
  1088. end
  1089. else
  1090. begin
  1091. vRow.AddCellString('');
  1092. vRow.AddCellString(ANode.Rec.Code.AsString);
  1093. end;
  1094. vRow.AddCellString(ANode.Rec.B_Code.AsString);
  1095. vRow.AddCellString(ANode.Rec.Name.AsString);
  1096. vRow.AddCellString(ANode.Rec.Units.AsString);
  1097. vCell := vRow.AddCellNumber(ANode.Rec.Quantity.AsFloat);
  1098. vCell.EmptyIfZero := True;
  1099. vCell := vRow.AddCellNumber(ANode.Rec.DgnQuantity1.AsFloat);
  1100. vCell.EmptyIfZero := True;
  1101. vCell := vRow.AddCellNumber(ANode.Rec.DgnQuantity2.AsFloat);
  1102. vCell.EmptyIfZero := True;
  1103. vCell := vRow.AddCellNumber(ANode.Rec.Price.AsFloat);
  1104. vCell.EmptyIfZero := True;
  1105. vCell := vRow.AddCellNumber(ANode.Rec.TotalPrice.AsFloat);
  1106. vCell.EmptyIfZero := True;
  1107. vRow.AddCellString(ANode.Rec.DrawingCode.AsString);
  1108. vRow.AddCellString(ANode.Rec.MemoStr.AsString);
  1109. ExportNode(ASheet, TBillsIDTreeNode(ANode.FirstChild));
  1110. ExportNode(ASheet, TBillsIDTreeNode(ANode.NextSibling));
  1111. end;
  1112. procedure TPosBillsExcelExportor.ExportToFile(ABillsIDTree: TBillsIDTree;
  1113. const AFileName: string);
  1114. var
  1115. vExportor: TOCustomExporter;
  1116. begin
  1117. BeforeExport;
  1118. try
  1119. vExportor := GetExportor(ExtractFileExt(AFileName));
  1120. ExportToSheet(ABillsIDTree, FOExport.AddWorkSheet);
  1121. FOExport.SaveToFile(FTempFile, vExportor);
  1122. if not FileExists(AFileName) or QuestMessage('存在同名文件,是否替换?') then
  1123. CopyFile(PChar(FTempFile), PChar(AFileName), False);
  1124. finally
  1125. vExportor.Free;
  1126. AfterExport;
  1127. end;
  1128. end;
  1129. procedure TPosBillsExcelExportor.ExportToSheet(ABillsIDTree: TBillsIDTree;
  1130. ASheet: TExportWorkSheet);
  1131. begin
  1132. DefineHeader(ASheet);
  1133. ExportNode(ASheet, TBillsIDTreeNode(ABillsIDTree.FirstNode));
  1134. end;
  1135. function TPosBillsExcelExportor.HasGclChild(
  1136. ANode: TBillsIDTreeNode): Boolean;
  1137. var
  1138. i: Integer;
  1139. vChild: TBillsIDTreeNode;
  1140. begin
  1141. Result := False;
  1142. for i := 0 to ANode.ChildCount - 1 do
  1143. begin
  1144. vChild := TBillsIDTreeNode(ANode.ChildNodes[i]);
  1145. if (vChild.Rec.B_Code.AsString <> '') then
  1146. begin
  1147. Result := True;
  1148. Exit;
  1149. end;
  1150. end;
  1151. end;
  1152. end.