DetailExcelImport.pas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771
  1. unit DetailExcelImport;
  2. interface
  3. uses
  4. Classes, ProjectData, ScXlsOutput, MCacheTree, XLSAdapter, sdDB,
  5. Variants, Forms, Controls;
  6. type
  7. TDetailExcelImport = class
  8. private
  9. FProjectData: TProjectData;
  10. FTempFile: string;
  11. FExcel: TXlsOutPut;
  12. protected
  13. function GetCellValue(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
  14. function GetCellValueFormat(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
  15. function GetCellTrimStr(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
  16. function GetCellFloat(AXlsFile: TXLSFile; ARow, ACol: Integer): Double;
  17. procedure BeginImport; virtual; abstract;
  18. procedure EndImport; virtual; abstract;
  19. procedure Import; virtual; abstract;
  20. public
  21. constructor Create(AProjectData: TProjectData); virtual;
  22. destructor Destroy; override;
  23. procedure ImportFile(const AFileName: string);
  24. property ProjectData: TProjectData read FProjectData;
  25. property Excel: TXlsOutPut read FExcel;
  26. end;
  27. // 平面分项清单格式导入,导入至某项目节节点之下
  28. TPlaneFxBillsExcelImport = class(TDetailExcelImport)
  29. private
  30. FParentID: Integer;
  31. FCacheTree: TBillsCacheTree;
  32. FCurRow: Integer;
  33. FXmjLevel1Col: Integer;
  34. FXmjLevel2Col: Integer;
  35. FXmjLevel3Col: Integer;
  36. FXmjLevel4Col: Integer;
  37. FXmjLevel5Col: Integer;
  38. FXmjLevel6Col: Integer;
  39. FXmjLevel7Col: Integer;
  40. FB_CodeCol: Integer;
  41. FNameCol: Integer;
  42. FUnitCol: Integer;
  43. FQuantityCol: Integer;
  44. FPriceCol: Integer;
  45. FDrawingCol: Integer;
  46. FMemoCol: Integer;
  47. procedure LoadXmjLevel1(AXlsFile: TXLSFile);
  48. procedure LoadXmjLevel2(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
  49. procedure LoadXmjLevel3(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
  50. procedure LoadXmjLevel4(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
  51. procedure LoadXmjLevel5(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
  52. procedure LoadXmjLevel6(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
  53. procedure LoadXmjLevel7(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
  54. procedure LoadBillsNode(AXlsFile: TXLSFile; AXmj: TBillsCacheNode);
  55. function LoadColumnsFromHead(AXlsFile: TXlsFile): Boolean;
  56. procedure LoadFxBills(AXlsFile: TXLSFile);
  57. procedure WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode);
  58. procedure WriteNodes(ADataSet: TsdDataSet);
  59. protected
  60. procedure BeginImport; override;
  61. procedure EndImport; override;
  62. procedure Import; override;
  63. public
  64. property ParentID: Integer read FParentID write FParentID;
  65. end;
  66. // 清单单价
  67. TBillsPriceExcelImport = class(TDetailExcelImport)
  68. private
  69. FCurRow: Integer;
  70. FB_CodeCol: Integer;
  71. FNameCol: Integer;
  72. FPriceCol: Integer;
  73. procedure BeginImport; override;
  74. procedure EndImport; override;
  75. procedure LoadColumnsFromHead;
  76. procedure UpdateBillsPrice(const AB_Code: string; APrice: Double);
  77. procedure ImportBillsPriceData;
  78. procedure Import; override;
  79. end;
  80. implementation
  81. uses
  82. UtilMethods, SysUtils, ZhAPI, SheetSelectFrm, UExcelAdapter, UFlxMessages,
  83. UFlxFormats, ProgressHintFrm, mDataRecord;
  84. { TDetailExcelImport }
  85. constructor TDetailExcelImport.Create(AProjectData: TProjectData);
  86. begin
  87. FProjectData := AProjectData;
  88. FTempFile := GetTempFileName;
  89. end;
  90. destructor TDetailExcelImport.Destroy;
  91. begin
  92. if FileExists(FTempFile) then
  93. DeleteFile(FTempFile);
  94. inherited;
  95. end;
  96. function TDetailExcelImport.GetCellFloat(AXlsFile: TXLSFile; ARow,
  97. ACol: Integer): Double;
  98. begin
  99. Result := StrToFloatDef(GetCellTrimStr(AXlsFile, ARow, ACol), 0);
  100. end;
  101. function TDetailExcelImport.GetCellTrimStr(AXlsFile: TXLSFile; ARow,
  102. ACol: Integer): string;
  103. begin
  104. Result := Trim(GetCellValue(AXlsFile, ARow, ACol));
  105. end;
  106. function TDetailExcelImport.GetCellValue(AXlsFile: TXLSFile; ARow,
  107. ACol: Integer): string;
  108. var
  109. xlsCell: TXlsCellValue;
  110. begin
  111. Result := '';
  112. if not Assigned(AXlsFile) or (ARow = -1) or (ACol = -1) then Exit;
  113. xlsCell := AXlsFile.CellValueX[ARow, ACol];
  114. Result := VarToStrDef(xlsCell.Value, '');
  115. end;
  116. function TDetailExcelImport.GetCellValueFormat(AXlsFile: TXLSFile; ARow,
  117. ACol: Integer): string;
  118. function GetDigit(AFormat: WideString): Integer;
  119. var
  120. I: Integer;
  121. bDigit: Boolean;
  122. begin
  123. Result := 0;
  124. bDigit := False;
  125. for I := 1 to Length(AFormat) do
  126. begin
  127. if AFormat[I] = '.' then
  128. begin
  129. if bDigit then Break
  130. else bDigit := True;
  131. end
  132. else if AFormat[I] = ';' then Break
  133. else if bDigit and (AFormat[I] = '0') then
  134. Dec(Result);
  135. end;
  136. end;
  137. function FormatNum(AValue: Variant; AFormat: WideString): string;
  138. begin
  139. Result := AValue;
  140. if not VarIsNull(AValue) then
  141. begin
  142. if CheckNumeric(Result) then
  143. begin
  144. if Pos('%', AFormat) <> 0 then AValue := AValue * 100;
  145. if AFormat <> '' then
  146. Result := FloatToStr(AdvRoundTo(AValue, GetDigit(AFormat)))
  147. else
  148. Result := FloatToStr(AdvRoundTo(AValue, -2));
  149. if Pos('%', AFormat) <> 0 then Result := Result + '%';
  150. if AValue = '0' then Result := '';
  151. end;
  152. end;
  153. end;
  154. var
  155. xlsCell: TXlsCellValue;
  156. FlxFormat: TFlxFormat;
  157. begin
  158. Result := '';
  159. if not Assigned(AXlsFile) or (ARow = -1) or (ACol = -1) then Exit;
  160. xlsCell := AXlsFile.GetCellDataX(ARow, ACol);
  161. Result := xlsCell.Value;
  162. if xlsCell.XF <> -1 then
  163. begin
  164. FlxFormat := AXlsFile.FormatList[xlsCell.XF];
  165. Result := FormatNum(xlsCell.Value, FlxFormat.Format);
  166. end;
  167. end;
  168. procedure TDetailExcelImport.ImportFile(const AFileName: string);
  169. begin
  170. CopyFileOrFolder(AFileName, FTempFile);
  171. FExcel := TXlsOutPut.Create(FTempFile);
  172. BeginImport;
  173. try
  174. Import;
  175. finally
  176. EndImport;
  177. FExcel.Free;
  178. end;
  179. end;
  180. { TPlaneFxBillsExcelImport }
  181. procedure TPlaneFxBillsExcelImport.Import;
  182. begin
  183. FCurRow := 1;
  184. if LoadColumnsFromHead(FExcel.XlsFile) then
  185. begin
  186. LoadFxBills(FExcel.XlsFile);
  187. WriteNodes(FProjectData.BillsData.sddBills);
  188. end
  189. else
  190. ErrorMessage('导入的Excel格式有误!');
  191. end;
  192. procedure TPlaneFxBillsExcelImport.LoadBillsNode(AXlsFile: TXLSFile;
  193. AXmj: TBillsCacheNode);
  194. var
  195. sB_Code, sName, sUnits: string;
  196. vGclNode: TBillsCacheNode;
  197. fPrice: Double;
  198. begin
  199. sB_Code := Trim(GetCellValue(AXlsFile, FCurRow, FB_CodeCol));
  200. sName := Trim(GetCellValue(AXlsFile, FCurRow, FNameCol));
  201. sUnits := Trim(GetCellValue(AXlsFile, FCurRow, FUnitCol));
  202. fPrice := StrToFloatDef(GetCellValue(AXlsFile, FCurRow, FPriceCol), 0);
  203. if sB_Code <> '' then
  204. begin
  205. vGclNode := FCacheTree.FindGclChild(AXmj, sB_Code, sName, sUnits, fPrice);
  206. if not Assigned(vGclNode) then
  207. begin
  208. vGclNode := FCacheTree.AddNode(AXmj, nil);
  209. vGclNode.B_Code := sB_Code;
  210. vGclNode.Name := sName;
  211. vGclNode.Units := sUnits;
  212. vGclNode.Quantity := StrToFloatDef(GetCellValue(AXlsFile, FCurRow, FQuantityCol), 0);
  213. vGclNode.Price := fPrice;
  214. vGclNode.DrawingCode := Trim(GetCellValue(AXlsFile, FCurRow, FDrawingCol));
  215. vGclNode.MemoStr := Trim(GetCellValue(AXlsFile, FCurRow, FMemoCol));
  216. end
  217. else
  218. vGclNode.Quantity := vGclNode.Quantity + StrToFloatDef(GetCellValue(AXlsFile, FCurRow, FQuantityCol), 0);
  219. end;
  220. Inc(FCurRow);
  221. end;
  222. function TPlaneFxBillsExcelImport.LoadColumnsFromHead(AXlsFile: TXlsFile): Boolean;
  223. var
  224. iCol: Integer;
  225. sColName: string;
  226. begin
  227. Result := False;
  228. FXmjLevel1Col := -1;
  229. FXmjLevel2Col := -1;
  230. FXmjLevel3Col := -1;
  231. FXmjLevel4Col := -1;
  232. FXmjLevel5Col := -1;
  233. FXmjLevel6Col := -1;
  234. FXmjLevel7Col := -1;
  235. FB_CodeCol := -1;
  236. FNameCol := -1;
  237. FUnitCol := -1;
  238. FQuantityCol := -1;
  239. FPriceCol := -1;
  240. FDrawingCol := -1;
  241. FMemoCol := -1;
  242. UpdateProgressHint('正在识别Excel数据格式');
  243. UpdateProgressPosition(0);
  244. while not Result and (FCurRow <= AXlsFile.MaxRow) do
  245. begin
  246. for iCol := 1 to AXlsFile.MaxCol do
  247. begin
  248. sColName := Trim(GetCellValue(AXlsFile, FCurRow, iCol));
  249. if sColName = '第1层' then
  250. FXmjLevel1Col := iCol
  251. else if sColName = '第2层' then
  252. FXmjLevel2Col := iCol
  253. else if sColName = '第3层' then
  254. FXmjLevel3Col := iCol
  255. else if sColName = '第4层' then
  256. FXmjLevel4Col := iCol
  257. else if sColName = '第5层' then
  258. FXmjLevel5Col := iCol
  259. else if sColName = '第6层' then
  260. FXmjLevel6Col := iCol
  261. else if sColName = '第7层' then
  262. FXmjLevel7Col := iCol
  263. else if sColName = '清单号' then
  264. FB_CodeCol := iCol
  265. else if sColName = '清单名称' then
  266. FNameCol := iCol
  267. else if sColName = '单位' then
  268. FUnitCol := iCol
  269. else if sColName = '数量' then
  270. FQuantityCol := iCol
  271. else if sColName = '单价' then
  272. FPriceCol := iCol
  273. else if sColName = '图号' then
  274. FDrawingCol := iCol
  275. else if sColName = '备注' then
  276. FMemoCol := iCol
  277. end;
  278. Result := FXmjLevel1Col <> -1;
  279. Inc(FCurRow);
  280. end;
  281. end;
  282. procedure TPlaneFxBillsExcelImport.LoadFxBills(AXlsFile: TXLSFile);
  283. var
  284. iPos: Integer;
  285. begin
  286. UpdateProgressHint('正在解析平面台账数据');
  287. while FCurRow <= AXlsFile.MaxRow do
  288. begin
  289. iPos := FCurRow*100 div AXlsFile.MaxRow;
  290. UpdateProgressPosition(iPos);
  291. LoadXmjLevel1(AXlsFile);
  292. end;
  293. end;
  294. procedure TPlaneFxBillsExcelImport.LoadXmjLevel1(AXlsFile: TXLSFile);
  295. var
  296. sName: string;
  297. vXmj: TBillsCacheNode;
  298. iEndRow: Integer;
  299. begin
  300. sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel1Col));
  301. with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel1Col] do
  302. iEndRow := FCurRow + Bottom - Top;
  303. if sName <> '' then
  304. begin
  305. vXmj := FCacheTree.FindXmjChild(nil, '', sName);
  306. if not Assigned(vXmj) then
  307. begin
  308. vXmj := FCacheTree.AddNode(nil);
  309. vXmj.Name := sName;
  310. end;
  311. if FXmjLevel2Col <> -1 then
  312. begin
  313. while FCurRow <= iEndRow do
  314. LoadXmjLevel2(AXlsFile, vXmj);
  315. end
  316. else
  317. begin
  318. while FCurRow <= iEndRow do
  319. LoadBillsNode(AXlsFile, vXmj);
  320. end;
  321. end
  322. else
  323. Inc(FCurRow);
  324. end;
  325. procedure TPlaneFxBillsExcelImport.LoadXmjLevel2(AXlsFile: TXLSFile;
  326. AParent: TBillsCacheNode);
  327. var
  328. sName: string;
  329. vXmj: TBillsCacheNode;
  330. iEndRow: Integer;
  331. begin
  332. sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel2Col));
  333. with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel2Col] do
  334. iEndRow := FCurRow + Bottom - Top;
  335. if sName <> '' then
  336. begin
  337. vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  338. if not Assigned(vXmj) then
  339. begin
  340. vXmj := FCacheTree.AddNode(AParent);
  341. vXmj.Name := sName;
  342. end;
  343. if FXmjLevel3Col <> -1 then
  344. begin
  345. while FCurRow <= iEndRow do
  346. LoadXmjLevel3(AXlsFile, vXmj);
  347. end
  348. else
  349. begin
  350. while FCurRow <= iEndRow do
  351. LoadBillsNode(AXlsFile, vXmj);
  352. end;
  353. end
  354. else
  355. begin
  356. while FCurRow <= iEndRow do
  357. LoadBillsNode(AXlsFile, AParent);
  358. end;
  359. end;
  360. procedure TPlaneFxBillsExcelImport.LoadXmjLevel3(AXlsFile: TXLSFile;
  361. AParent: TBillsCacheNode);
  362. var
  363. sName: string;
  364. vXmj: TBillsCacheNode;
  365. iEndRow: Integer;
  366. begin
  367. sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel3Col));
  368. with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel3Col] do
  369. iEndRow := FCurRow + Bottom - Top;
  370. if sName <> '' then
  371. begin
  372. vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  373. if not Assigned(vXmj) then
  374. begin
  375. vXmj := FCacheTree.AddNode(AParent);
  376. vXmj.Name := sName;
  377. end;
  378. if FXmjLevel4Col <> -1 then
  379. begin
  380. while FCurRow <= iEndRow do
  381. LoadXmjLevel4(AXlsFile, vXmj);
  382. end
  383. else
  384. begin
  385. while FCurRow <= iEndRow do
  386. LoadBillsNode(AXlsFile, vXmj);
  387. end;
  388. end
  389. else
  390. begin
  391. while FCurRow <= iEndRow do
  392. LoadBillsNode(AXlsFile, AParent);
  393. end;
  394. end;
  395. procedure TPlaneFxBillsExcelImport.LoadXmjLevel4(AXlsFile: TXLSFile;
  396. AParent: TBillsCacheNode);
  397. var
  398. sName: string;
  399. vXmj: TBillsCacheNode;
  400. iEndRow: Integer;
  401. begin
  402. sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel4Col));
  403. with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel4Col] do
  404. iEndRow := FCurRow + Bottom - Top;
  405. if sName <> '' then
  406. begin
  407. vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  408. if not Assigned(vXmj) then
  409. begin
  410. vXmj := FCacheTree.AddNode(AParent);
  411. vXmj.Name := sName;
  412. end;
  413. if FXmjLevel5Col <> -1 then
  414. begin
  415. while FCurRow <= iEndRow do
  416. LoadXmjLevel5(AXlsFile, vXmj);
  417. end
  418. else
  419. begin
  420. while FCurRow <= iEndRow do
  421. LoadBillsNode(AXlsFile, vXmj);
  422. end;
  423. end
  424. else
  425. begin
  426. while FCurRow <= iEndRow do
  427. LoadBillsNode(AXlsFile, AParent);
  428. end;
  429. end;
  430. procedure TPlaneFxBillsExcelImport.LoadXmjLevel5(AXlsFile: TXLSFile;
  431. AParent: TBillsCacheNode);
  432. var
  433. sName: string;
  434. vXmj: TBillsCacheNode;
  435. iEndRow: Integer;
  436. begin
  437. sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel5Col));
  438. with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel5Col] do
  439. iEndRow := FCurRow + Bottom - Top;
  440. if sName <> '' then
  441. begin
  442. vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  443. if not Assigned(vXmj) then
  444. begin
  445. vXmj := FCacheTree.AddNode(AParent);
  446. vXmj.Name := sName;
  447. end;
  448. if FXmjLevel6Col <> -1 then
  449. begin
  450. while FCurRow <= iEndRow do
  451. LoadXmjLevel6(AXlsFile, vXmj);
  452. end
  453. else
  454. begin
  455. while FCurRow <= iEndRow do
  456. LoadBillsNode(AXlsFile, vXmj);
  457. end;
  458. end
  459. else
  460. begin
  461. while FCurRow <= iEndRow do
  462. LoadBillsNode(AXlsFile, AParent);
  463. end;
  464. end;
  465. procedure TPlaneFxBillsExcelImport.LoadXmjLevel6(AXlsFile: TXLSFile;
  466. AParent: TBillsCacheNode);
  467. var
  468. sName: string;
  469. vXmj: TBillsCacheNode;
  470. iEndRow: Integer;
  471. begin
  472. sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel6Col));
  473. with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel6Col] do
  474. iEndRow := FCurRow + Bottom - Top;
  475. if sName <> '' then
  476. begin
  477. vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  478. if not Assigned(vXmj) then
  479. begin
  480. vXmj := FCacheTree.AddNode(AParent);
  481. vXmj.Name := sName;
  482. end;
  483. if FXmjLevel7Col <> -1 then
  484. begin
  485. while FCurRow <= iEndRow do
  486. LoadXmjLevel7(AXlsFile, vXmj);
  487. end
  488. else
  489. begin
  490. while FCurRow <= iEndRow do
  491. LoadBillsNode(AXlsFile, vXmj);
  492. end;
  493. end
  494. else
  495. begin
  496. while FCurRow <= iEndRow do
  497. LoadBillsNode(AXlsFile, AParent);
  498. end;
  499. end;
  500. procedure TPlaneFxBillsExcelImport.LoadXmjLevel7(AXlsFile: TXLSFile;
  501. AParent: TBillsCacheNode);
  502. var
  503. sName: string;
  504. vXmj: TBillsCacheNode;
  505. iEndRow: Integer;
  506. begin
  507. sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel7Col));
  508. if sName <> '' then
  509. begin
  510. vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  511. if not Assigned(vXmj) then
  512. begin
  513. vXmj := FCacheTree.AddNode(AParent);
  514. vXmj.Name := sName;
  515. end;
  516. with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel7Col] do
  517. iEndRow := FCurRow + Bottom - Top;
  518. while FCurRow <= iEndRow do
  519. LoadBillsNode(AXlsFile, vXmj);
  520. end
  521. else
  522. begin
  523. while FCurRow <= iEndRow do
  524. LoadBillsNode(AXlsFile, AParent);
  525. end;
  526. end;
  527. procedure TPlaneFxBillsExcelImport.WriteNodes(ADataSet: TsdDataSet);
  528. var
  529. i, iPos: Integer;
  530. begin
  531. UpdateProgressHint('写入读取的Excel数据');
  532. UpdateProgressPosition(0);
  533. for i := 0 to FCacheTree.CacheNodes.Count - 1 do
  534. begin
  535. WriteNode(ADataSet, TBillsCacheNode(FCacheTree.CacheNodes[i]));
  536. iPos := i*100 div FCacheTree.CacheNodes.Count;
  537. UpdateProgressPosition(iPos);
  538. end;
  539. UpdateProgressPosition(100);
  540. end;
  541. procedure TPlaneFxBillsExcelImport.WriteNode(ADataSet: TsdDataSet;
  542. ANode: TBillsCacheNode);
  543. var
  544. Rec: TsdDataRecord;
  545. begin
  546. if ANode.B_Code <> '' then
  547. UpdateProgressHint('写入读取的Excel数据 ' + ANode.B_Code)
  548. else
  549. UpdateProgressHint('写入读取的Excel数据 ' + ANode.Name);
  550. Rec := ADataSet.Add;
  551. Rec.ValueByName('ID').AsInteger := ANode.ID;
  552. if ANode.ParentID = -1 then
  553. Rec.ValueByName('ParentID').AsInteger := ParentID
  554. else
  555. Rec.ValueByName('ParentID').AsInteger := ANode.ParentID;
  556. Rec.ValueByName('NextSiblingID').AsInteger := ANode.NextSiblingID;
  557. Rec.ValueByName('B_Code').AsString := ANode.B_Code;
  558. Rec.ValueByName('Name').AsString := ANode.Name;
  559. Rec.ValueByName('Units').AsString := ANode.Units;
  560. Rec.ValueByName('Price').AsFloat := PriceRoundTo(ANode.Price);
  561. Rec.ValueByName('OrgQuantity').AsFloat := QuantityRoundTo(ANode.Quantity);
  562. Rec.ValueByName('DrawingCode').AsString := ANode.DrawingCode;
  563. Rec.ValueByName('MemoStr').AsString := ANode.MemoStr;
  564. // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单
  565. if FProjectData.ProjProperties.PhaseCount > 0 then
  566. Rec.ValueByName('IsMeasureAdd').AsBoolean := not FProjectData.CanUnlockInfo;
  567. end;
  568. procedure TPlaneFxBillsExcelImport.BeginImport;
  569. begin
  570. Screen.Cursor := crHourGlass;
  571. ShowProgressHint('导入Excel数据', 100);
  572. FCacheTree := TBillsCacheTree.Create;
  573. FCacheTree.NewNodeID := FProjectData.BillsData.GetMaxBillsID + 1;
  574. FProjectData.DisConnectTree;
  575. FProjectData.BillsData.DisableEvents;
  576. end;
  577. procedure TPlaneFxBillsExcelImport.EndImport;
  578. var
  579. ParentRec: TsdDataRecord;
  580. begin
  581. FCacheTree.Free;
  582. FProjectData.BillsData.EnableEvents;
  583. FProjectData.ReConnectTree;
  584. ParentRec := FProjectData.BillsData.sddBills.FindKey('idxID', ParentID);
  585. FProjectData.BillsCompileData.sdvBillsCompile.LocateInControl(ParentRec);
  586. FProjectData.BillsCompileData.CalculateAll;
  587. CloseProgressHint;
  588. Screen.Cursor := crDefault;
  589. end;
  590. { TBillsPriceExcelImport }
  591. procedure TBillsPriceExcelImport.BeginImport;
  592. begin
  593. ShowProgressHint('导入Excel清单单价', 100);
  594. FProjectData.BillsData.sddBills.BeginUpdate;
  595. FCurRow := 1;
  596. end;
  597. procedure TBillsPriceExcelImport.EndImport;
  598. begin
  599. FProjectData.BillsData.sddBills.EndUpdate;
  600. UpdateProgressHint('正在计算导入后的数据');
  601. FProjectData.BillsCompileData.CalculateAll;
  602. CloseProgressHint;
  603. end;
  604. procedure TBillsPriceExcelImport.Import;
  605. begin
  606. LoadColumnsFromHead;
  607. ImportBillsPriceData;
  608. end;
  609. procedure TBillsPriceExcelImport.ImportBillsPriceData;
  610. function CheckIsBillsCode(ACode: string): Boolean;
  611. const
  612. FBillsCodeSet: set of char = ['0'..'9', '-', 'a'..'z', 'A'..'Z'];
  613. var
  614. I: Integer;
  615. begin
  616. Result := True;
  617. I := 1;
  618. while I < Length(ACode) do
  619. if ACode[I] in FBillsCodeSet then
  620. Inc(I)
  621. else
  622. begin
  623. Result := False;
  624. Break;
  625. end;
  626. end;
  627. var
  628. iPos: Integer;
  629. sB_Code: string;
  630. fPrice: Double;
  631. begin
  632. UpdateProgressHint('写入读取的Excel数据');
  633. UpdateProgressPosition(0);
  634. while (FCurRow <= Excel.XlsFile.MaxRow) do
  635. begin
  636. sB_Code := GetCellTrimStr(Excel.XlsFile, FCurRow, FB_CodeCol);
  637. if (sB_Code <> '') and CheckIsBillsCode(sB_Code) then
  638. begin
  639. fPrice := GetCellFloat(Excel.XlsFile, FCurRow, FPriceCol);
  640. UpdateBillsPrice(sB_Code, fPrice);
  641. end;
  642. Inc(FCurRow);
  643. iPos := FCurRow * 100 div Excel.XlsFile.MaxRow;
  644. UpdateProgressPosition(iPos);
  645. end;
  646. UpdateProgressPosition(100);
  647. end;
  648. procedure TBillsPriceExcelImport.LoadColumnsFromHead;
  649. var
  650. iCol: Integer;
  651. sColName: string;
  652. begin
  653. FB_CodeCol := -1;
  654. FNameCol := -1;
  655. FPriceCol := -1;
  656. while ((FB_CodeCol = -1) or (FPriceCol = -1)) and (FCurRow <= Excel.XlsFile.MaxRow) do
  657. begin
  658. for iCol := 1 to Excel.XlsFile.MaxCol do
  659. begin
  660. sColName := GetCellTrimStr(Excel.XlsFile, FCurRow, iCol);
  661. if SameText(sColName, '清单编号') or SameText(sColName, '子目号') then
  662. FB_CodeCol := iCol
  663. else if SameText(sColName, '名称') then
  664. FNameCol := iCol
  665. else if Pos('单价', sColName) = 1 then
  666. FPriceCol := iCol;
  667. end;
  668. Inc(FCurRow);
  669. end;
  670. end;
  671. procedure TBillsPriceExcelImport.UpdateBillsPrice(const AB_Code: string;
  672. APrice: Double);
  673. var
  674. iIndex: Integer;
  675. Rec: TBillsRecord;
  676. begin
  677. with FProjectData.BillsData do
  678. begin
  679. for iIndex := 0 to sddBills.RecordCount - 1 do
  680. begin
  681. Rec := TBillsRecord(sddBills.Records[iIndex]);
  682. if SameText(AB_Code, Rec.B_Code.AsString) then
  683. Rec.Price.AsFloat := PriceRoundTo(APrice);
  684. end;
  685. end;
  686. end;
  687. end.