DetailExcelImport.pas 20 KB

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