ExcelImport.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940
  1. unit ExcelImport;
  2. interface
  3. uses
  4. Classes, SMXLS, SMCells, ProjectData, MCacheTree, ZhAPI, sdDB,
  5. Forms, Controls, ProgressHintFrm, mDataRecord;
  6. type
  7. TExcelImport = class
  8. private
  9. FMSExcel: TMSExcel;
  10. FProjectData: TProjectData;
  11. FProgresssHintFrom: TProgressHintForm;
  12. procedure BeginImport; virtual; abstract;
  13. procedure EndImport; virtual; abstract;
  14. procedure Import; virtual; abstract;
  15. function GetCellValue(ASheet: TSpreadSheet; ACol, ARow: Integer): Variant;
  16. function GetCellTrimText(ASheet: TSpreadSheet; ACol, ARow: Integer): string;
  17. public
  18. constructor Create(AProjectData: TProjectData);
  19. destructor Destroy; override;
  20. procedure ImportFile(const AExcelFile: string);
  21. property MSExcel: TMSExcel read FMSExcel;
  22. end;
  23. TBillsExcelImport = class(TExcelImport)
  24. private
  25. FCacheTree: TBillsCacheTree;
  26. FCurRow: Integer;
  27. FLevelCol: Integer;
  28. FCodeCol: Integer;
  29. FB_CodeCol: Integer;
  30. FNameCol: Integer;
  31. FUnitsCol: Integer;
  32. FFixedIDCol: Integer;
  33. FCanDeleteCol: Integer;
  34. procedure BeginImport; override;
  35. procedure EndImport; override;
  36. procedure LoadColumnsFromHead(ASheet: TSpreadSheet);
  37. procedure LoadNodes(ASheet: TSpreadSheet);
  38. procedure LoadNode(ASheet: TSpreadSheet);
  39. procedure WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode);
  40. procedure WriteNodes(ADataSet: TsdDataSet);
  41. procedure Import; override;
  42. public
  43. procedure ImportToTree(ACacheTree: TBillsCacheTree; const sFileName: string);
  44. end;
  45. // 代码中注释部分为导入[无层次编号]的0号台账Excel
  46. TBillsEdtExcelImport = class(TExcelImport)
  47. private
  48. FCacheTree: TBillsCacheTree;
  49. FCurRow: Integer;
  50. FIsFirstPart: Boolean;
  51. FWithLevelCode: Boolean;
  52. FWithoutGclBills: Boolean;
  53. FBaseTree: TBillsCacheTree;
  54. FFixedIDNodes: TList;
  55. FCodeCol: Integer;
  56. FB_CodeCol: Integer;
  57. FNameCol: Integer;
  58. FUnitsCol: Integer;
  59. FPriceCol: Integer;
  60. FQuantityCol: Integer;
  61. FDgnQuantity1Col: Integer;
  62. FDgnQuantity2Col: Integer;
  63. FDrawingCol: Integer;
  64. FMemoCol: Integer;
  65. FLevelCol: Integer;
  66. procedure BeginImport; override;
  67. procedure EndImport; override;
  68. function GetFixedIDNode(AID: Integer): TBillsCacheNode;
  69. function GetFixedID(ACode, AName: string): Integer;
  70. procedure LoadBaseTree(ATree: TBillsCacheTree);
  71. procedure LoadColumnsFromHead(ASheet: TSpreadSheet);
  72. procedure LoadNodes(ASheet: TSpreadSheet);
  73. procedure LoadNode(ASheet: TSpreadSheet);
  74. procedure WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode);
  75. procedure WriteNodes(ADataSet: TsdDataSet);
  76. procedure Import; override;
  77. public
  78. property WithLevelCode: Boolean read FWithLevelCode write FWithLevelCode;
  79. property WithoutGclBills: Boolean read FWithoutGclBills write FWithoutGclBills;
  80. end;
  81. TGclBillsExcelImport = class(TExcelImport)
  82. private
  83. FParentID: Integer;
  84. FSelectSheets: TList;
  85. FCacheTree: TGclCacheTree;
  86. FCurRow: Integer;
  87. FB_CodeCol: Integer;
  88. FNameCol: Integer;
  89. FUnitsCol: Integer;
  90. FPriceCol: Integer;
  91. FQuantityCol: Integer;
  92. procedure BeginImport; override;
  93. procedure EndImport; override;
  94. procedure LoadNode(ASheet: TSpreadSheet);
  95. procedure ImportSheet(ASheet: TSpreadSheet);
  96. procedure WriteNode(ADataSet: TsdDataSet; ANode: TGclCacheNode);
  97. procedure WriteNodes(ADataSet: TsdDataSet);
  98. procedure Import; override;
  99. public
  100. property ParentID: Integer read FParentID write FParentID;
  101. end;
  102. // 清单单价
  103. TBillsPriceExcelImport = class(TExcelImport)
  104. private
  105. FCurRow: Integer;
  106. FB_CodeCol: Integer;
  107. FNameCol: Integer;
  108. FPriceCol: Integer;
  109. procedure BeginImport; override;
  110. procedure EndImport; override;
  111. procedure LoadColumnsFromHead(ASheet: TSpreadSheet);
  112. procedure UpdateBillsPrice(const AB_Code: string; APrice: Double);
  113. procedure ImportBillsPriceData(ASheet: TSpreadSheet);
  114. procedure Import; override;
  115. end;
  116. // 合同清单
  117. TDealBillsExcelImport = class(TExcelImport)
  118. private
  119. FCurRow: Integer;
  120. FBillsID: Integer;
  121. FB_CodeCol: Integer;
  122. FNameCol: Integer;
  123. FUnitsCol: Integer;
  124. FPriceCol: Integer;
  125. FQuantityCol: Integer;
  126. FTotalPriceCol: Integer;
  127. procedure BeginImport; override;
  128. procedure EndImport; override;
  129. procedure LoadColumnsFromHead(ASheet: TSpreadSheet);
  130. procedure LoadDealBillsData(ASheet: TSpreadSheet);
  131. procedure Import; override;
  132. end;
  133. implementation
  134. uses Variants, CacheTree, SysUtils, UtilMethods, sdDataSet, BillsDm,
  135. DealBillsDm, SheetSelectFrm, ADODB, Math;
  136. { TExcelImport }
  137. constructor TExcelImport.Create(AProjectData: TProjectData);
  138. begin
  139. FProjectData := AProjectData;
  140. FMSExcel := TMSExcel.Create(nil);
  141. end;
  142. destructor TExcelImport.Destroy;
  143. begin
  144. FMSExcel.Free;
  145. inherited;
  146. end;
  147. function TExcelImport.GetCellTrimText(ASheet: TSpreadSheet; ACol,
  148. ARow: Integer): string;
  149. begin
  150. Result := Trim(VarToStrDef(GetCellValue(ASheet, ACol, ARow), ''));
  151. end;
  152. function TExcelImport.GetCellValue(ASheet: TSpreadSheet;
  153. ACol, ARow: Integer): Variant;
  154. begin
  155. Result := Null;
  156. if ACol <> -1 then
  157. Result := ASheet.Cells.GetValue(ACol, ARow);
  158. end;
  159. procedure TExcelImport.ImportFile(const AExcelFile: string);
  160. begin
  161. BeginImport;
  162. try
  163. FMSExcel.LoadFromFile(AExcelFile);
  164. Import;
  165. finally
  166. EndImport;
  167. end;
  168. end;
  169. { TBillsExcelImport }
  170. procedure TBillsExcelImport.BeginImport;
  171. begin
  172. FCurRow := 0;
  173. FCacheTree := TBillsCacheTree.Create;
  174. FCacheTree.NewNodeID := 101;
  175. FCacheTree.SeparateChar := '.';
  176. FCacheTree.AutoSort := True;
  177. end;
  178. procedure TBillsExcelImport.EndImport;
  179. begin
  180. FCacheTree.Free;
  181. end;
  182. procedure TBillsExcelImport.Import;
  183. begin
  184. LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0));
  185. LoadNodes(FMSExcel.Sheets.Spreadsheet(0));
  186. WriteNodes(FProjectData.BillsData.sddBills);
  187. end;
  188. procedure TBillsExcelImport.ImportToTree(ACacheTree: TBillsCacheTree;
  189. const sFileName: string);
  190. var
  191. sChar: Char;
  192. begin
  193. FCurRow := 0;
  194. FCacheTree := ACacheTree;
  195. sChar := FCacheTree.SeparateChar;
  196. FCacheTree.SeparateChar := '.';
  197. MSExcel.LoadFromFile(sFileName);
  198. LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0));
  199. LoadNodes(FMSExcel.Sheets.Spreadsheet(0));
  200. FCacheTree.SeparateChar := sChar;
  201. end;
  202. procedure TBillsExcelImport.LoadColumnsFromHead(ASheet: TSpreadSheet);
  203. var
  204. iCol: Integer;
  205. sColName: string;
  206. begin
  207. for iCol := 0 to ASheet.Cells.UsedRowCount do
  208. begin
  209. sColName := VarToStrDef(ASheet.Cells.GetValue(iCol, FCurRow), '');
  210. if sColName = '层次编号' then
  211. FLevelCol := iCol
  212. else if sColName = '项目节编号' then
  213. FCodeCol := iCol
  214. else if sColName = '清单子目号' then
  215. FB_CodeCol := iCol
  216. else if sColName = '名称' then
  217. FNameCol := iCol
  218. else if sColName = '单位' then
  219. begin
  220. FUnitsCol := iCol;
  221. FFixedIDCol := iCol + 1;
  222. FCanDeleteCol := iCol + 2;
  223. end;
  224. end;
  225. Inc(FCurRow);
  226. end;
  227. procedure TBillsExcelImport.LoadNode(ASheet: TSpreadSheet);
  228. var
  229. sLevelCode: string;
  230. iFixedID: Integer;
  231. Node: TBillsCacheNode;
  232. vValue: Variant;
  233. begin
  234. sLevelCode := GetCellTrimText(ASheet, FLevelCol, FCurRow);
  235. if sLevelCode = '' then Exit;
  236. iFixedID := StrToIntDef(GetCellTrimText(ASheet, FFixedIDCol, FCurRow), -1);
  237. Node := FCacheTree.AddNodeByCode(sLevelCode, iFixedID);
  238. Node.Code := GetCellTrimText(ASheet, FCodeCol, FCurRow);
  239. Node.B_Code := GetCellTrimText(ASheet, FB_CodeCol, FCurRow);
  240. Node.Name := GetCellTrimText(ASheet, FNameCol, FCurRow);
  241. Node.Units := GetCellTrimText(ASheet, FUnitsCol, FCurRow);
  242. Node.CanDelete := VarToIntDef(GetCellValue(ASheet, FCanDeleteCol, FCurRow), 0) = 0;
  243. end;
  244. procedure TBillsExcelImport.LoadNodes(ASheet: TSpreadSheet);
  245. begin
  246. while FCurRow < ASheet.Cells.UsedRowCount do
  247. begin
  248. LoadNode(ASheet);
  249. Inc(FCurRow);
  250. end;
  251. end;
  252. procedure TBillsExcelImport.WriteNode(ADataSet: TsdDataSet;
  253. ANode: TBillsCacheNode);
  254. var
  255. Rec: TBillsRecord;
  256. begin
  257. Rec := TBillsRecord(ADataSet.Add);
  258. Rec.ID.AsInteger := ANode.ID;
  259. Rec.ParentID.AsInteger := ANode.ParentID;
  260. Rec.NextSiblingID.AsInteger := ANode.NextSiblingID;
  261. Rec.Code.AsString := ANode.Code;
  262. Rec.B_Code.AsString := ANode.B_Code;
  263. Rec.Name.AsString := ANode.Name;
  264. Rec.Units.AsString := ANode.Units;
  265. //Rec.ValueByName('LockedLevel').AsBoolean := ANode.CanDelete;
  266. end;
  267. procedure TBillsExcelImport.WriteNodes(ADataSet: TsdDataSet);
  268. var
  269. i: Integer;
  270. begin
  271. for i := 0 to FCacheTree.CacheNodes.Count - 1 do
  272. WriteNode(ADataSet, TBillsCacheNode(FCacheTree.CacheNodes[i]));
  273. end;
  274. { TBillsEdtExcelImport }
  275. procedure TBillsEdtExcelImport.BeginImport;
  276. begin
  277. Screen.Cursor := crHourGlass;
  278. ShowProgressHint('导入Excel数据', 100, '读取Excel数据', 100);
  279. FCurRow := 0;
  280. FIsFirstPart := True;
  281. FCacheTree := TBillsCacheTree.Create;
  282. FCacheTree.NewNodeID := 101;
  283. // 以层次编号为依据,分隔用'.',以项目节、清单编号为依据,分隔用'-'
  284. if WithLevelCode then
  285. FCacheTree.SeparateChar := '.'
  286. else
  287. FCacheTree.SeparateChar := '-';
  288. FCacheTree.AutoSort := True;
  289. FProjectData.DisConnectTree;
  290. FProjectData.BillsData.DisableEvents;
  291. FBaseTree := TBillsCacheTree.Create;
  292. FBaseTree.NewNodeID := 101;
  293. FBaseTree.SeparateChar := '.';
  294. FFixedIDNodes := TList.Create;
  295. end;
  296. procedure TBillsEdtExcelImport.EndImport;
  297. begin
  298. // For Test
  299. // FCacheTree.SaveTreeToFile('E:\Tree.txt');
  300. FFixedIDNodes.Free;
  301. FBaseTree.Free;
  302. FProjectData.BillsData.EnableEvents;
  303. FProjectData.ReConnectTree;
  304. FCacheTree.Free;
  305. FProjectData.BillsCompileData.CalculateAll;
  306. CloseProgressHint;
  307. Screen.Cursor := crDefault;
  308. end;
  309. function TBillsEdtExcelImport.GetFixedIDNode(AID: Integer): TBillsCacheNode;
  310. var
  311. i: Integer;
  312. Node: TBillsCacheNode;
  313. begin
  314. Result := nil;
  315. for i := 0 to FFixedIDNodes.Count - 1 do
  316. begin
  317. Node := TBillsCacheNode(FFixedIDNodes.Items[i]);
  318. if (AID = Node.ID) then
  319. begin
  320. Result := Node;
  321. Break;
  322. end;
  323. end;
  324. end;
  325. function TBillsEdtExcelImport.GetFixedID(ACode, AName: string): Integer;
  326. var
  327. i: Integer;
  328. Node: TBillsCacheNode;
  329. begin
  330. Result := -1;
  331. for i := 0 to FBaseTree.CacheNodes.Count - 1 do
  332. begin
  333. Node := TBillsCacheNode(FBaseTree.CacheNodes.Items[i]);
  334. if (Node.Code = ACode) and (Node.Name = AName) then
  335. begin
  336. if Node.ID < 100 then
  337. Result := Node.ID;
  338. Break;
  339. end;
  340. end;
  341. end;
  342. procedure TBillsEdtExcelImport.Import;
  343. begin
  344. if WithLevelCode then
  345. LoadBaseTree(FBaseTree)
  346. else
  347. LoadBaseTree(FCacheTree);
  348. LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0));
  349. LoadNodes(FMSExcel.Sheets.Spreadsheet(0));
  350. WriteNodes(FProjectData.BillsData.sddBills);
  351. end;
  352. procedure TBillsEdtExcelImport.LoadBaseTree(ATree: TBillsCacheTree);
  353. var
  354. BaseImportor: TBillsExcelImport;
  355. begin
  356. BaseImportor := TBillsExcelImport.Create(nil);
  357. try
  358. BaseImportor.ImportToTree(ATree, GetTemplateBillsFileName);
  359. finally
  360. BaseImportor.Free;
  361. end;
  362. end;
  363. procedure TBillsEdtExcelImport.LoadColumnsFromHead(ASheet: TSpreadSheet);
  364. var
  365. iCol: Integer;
  366. sColName: string;
  367. begin
  368. FCodeCol := -1;
  369. FB_CodeCol := -1;
  370. FNameCol := -1;
  371. FUnitsCol := -1;
  372. FPriceCol := -1;
  373. FQuantityCol := -1;
  374. FDgnQuantity1Col := -1;
  375. FDgnQuantity2Col := -1;
  376. FDrawingCol := -1;
  377. FMemoCol := -1;
  378. for iCol := 0 to ASheet.Cells.UsedRowCount do
  379. begin
  380. sColName := VarToStrDef(ASheet.Cells.GetValue(iCol, FCurRow), '');
  381. if (sColName = '预算项目节') or (sColName = '项目节编号') then
  382. FCodeCol := iCol
  383. else if (sColName = '清单子目号') or (sColName = '清单编号') then
  384. FB_CodeCol := iCol
  385. else if sColName = '名称' then
  386. FNameCol := iCol
  387. else if sColName = '单位' then
  388. FUnitsCol := iCol
  389. else if sColName = '单价' then
  390. FPriceCol := iCol
  391. else if (sColName = '清单数量') or (sColName = '工程量') or (sColName = '数量') then
  392. FQuantityCol := iCol
  393. else if (sColName = '设计数量1') or (sColName = '数量1') then
  394. FDgnQuantity1Col := iCol
  395. else if (sColName = '设计数量2') or (sColName = '数量2') then
  396. FDgnQuantity2Col := iCol
  397. else if sColName = '图号' then
  398. FDrawingCol := iCol
  399. else if sColName = '备注' then
  400. FMemoCol := iCol
  401. else if sColName = '层次编号' then
  402. FLevelCol := iCol;
  403. end;
  404. Inc(FCurRow);
  405. end;
  406. procedure TBillsEdtExcelImport.LoadNode(ASheet: TSpreadSheet);
  407. var
  408. sLevelCode, sCode, sB_Code, sName: string;
  409. Node: TBillsCacheNode;
  410. vValue: Variant;
  411. iFixedID: Integer;
  412. begin
  413. sLevelCode := GetCellTrimText(ASheet, FLevelCol, FCurRow);
  414. sCode := GetCellTrimText(ASheet, FCodeCol, FCurRow);
  415. sB_Code := GetCellTrimText(ASheet, FB_CodeCol, FCurRow);
  416. sName := GetCellTrimText(ASheet, FNameCol, FCurRow);
  417. // 含层次编号时,层次编号为空不导入
  418. // 不含层次编号时,仅导入第一部分,且项目节编号、清单编号均未空时不导入
  419. if WithLevelCode then
  420. begin
  421. if sLevelCode = '' then Exit;
  422. end
  423. else
  424. begin
  425. if ((sCode = '') and (sB_Code = '')) or SameText(sCode, '2') or
  426. (Pos('第二部分', sName) > 0) then
  427. begin
  428. FIsFirstPart := False;
  429. Exit;
  430. end;
  431. end;
  432. if (sCode = '') and FWithoutGclBills then Exit;
  433. // 含层次编号时,以层次编号为依据新增节点;反之以项目节编号为依据新增节点
  434. if not WithLevelCode then
  435. begin
  436. if (sCode <> '') then
  437. Node := FCacheTree.AddNodeByCode(sCode, -1)
  438. else
  439. Node := FCacheTree.AddLeafBillsNode(sB_Code);
  440. end
  441. else
  442. begin
  443. // 1. 从模板树中查询当前节点是否为固定ID,否则为-1
  444. iFixedID := GetFixedID(sCode, sName);
  445. // 2. 从导入树中查询是否添加过该固定ID,防止存在两个固定ID节点主键冲突
  446. // 如果已添加过固定ID节点,则其他节点未非固定ID节点
  447. Node := GetFixedIDNode(iFixedID);
  448. if Assigned(Node) then
  449. iFixedID := -1;
  450. // 3. 添加当前节点
  451. Node := FCacheTree.AddNodeByCode(sLevelCode, iFixedID);
  452. // 4. 如果当前添加的节点为固定ID节点,则添加到List中便于2快速查找
  453. if Node.ID < 100 then
  454. FFixedIDNodes.Add(Node);
  455. end;
  456. Node.Code := sCode;
  457. Node.B_Code := sB_Code;
  458. Node.Name := sName;
  459. Node.Units := GetCellTrimText(ASheet, FUnitsCol, FCurRow);
  460. Node.Price := StrToFloatDef(VarToStrDef(GetCellValue(ASheet, FPriceCol, FCurRow), ''), 0);
  461. Node.Quantity := StrToFloatDef(VarToStrDef(GetCellValue(ASheet, FQuantityCol, FCurRow), ''), 0);
  462. Node.DgnQuantity1 := StrToFloatDef(VarToStrDef(GetCellValue(ASheet, FDgnQuantity1Col, FCurRow), ''), 0);
  463. Node.DgnQuantity2 := StrToFloatDef(VarToStrDef(GetCellValue(ASheet, FDgnQuantity2Col, FCurRow), ''), 0);
  464. Node.DrawingCode := GetCellTrimText(ASheet, FDrawingCol, FCurRow);
  465. Node.MemoStr := GetCellTrimText(ASheet, FMemoCol, FCurRow);
  466. end;
  467. procedure TBillsEdtExcelImport.LoadNodes(ASheet: TSpreadSheet);
  468. var
  469. iPos, iSubPos: Integer;
  470. begin
  471. while (FCurRow < ASheet.Cells.UsedRowCount){ and FIsFirstPart }do
  472. begin
  473. LoadNode(ASheet);
  474. Inc(FCurRow);
  475. iSubPos := FCurRow * 100 div ASheet.Cells.UsedRowCount;
  476. iPos := iSubPos div 2;
  477. UpdateProgressPosition(iPos, iSubPos);
  478. end;
  479. end;
  480. procedure TBillsEdtExcelImport.WriteNode(ADataSet: TsdDataSet;
  481. ANode: TBillsCacheNode);
  482. var
  483. Rec: TBillsRecord;
  484. begin
  485. if ANode.Code <> '' then
  486. UpdateProgressHint('写入读取的Excel数据 ' + ANode.Code)
  487. else if ANode.B_Code <> '' then
  488. UpdateProgressHint('写入读取的Excel数据 ' + ANode.B_Code)
  489. else
  490. UpdateProgressHint('写入读取的Excel数据 ' + ANode.Name);
  491. Rec := TBillsRecord(ADataSet.Add);
  492. Rec.ID.AsInteger := ANode.ID;
  493. Rec.ParentID.AsInteger := ANode.ParentID;
  494. Rec.NextSiblingID.AsInteger := ANode.NextSiblingID;
  495. Rec.Code.AsString := ANode.Code;
  496. Rec.B_Code.AsString := ANode.B_Code;
  497. Rec.Name.AsString := ANode.Name;
  498. Rec.Units.AsString := ANode.Units;
  499. Rec.Price.AsFloat := PriceRoundTo(ANode.Price);
  500. Rec.OrgQuantity.AsFloat := QuantityRoundTo(ANode.Quantity);
  501. Rec.DgnQuantity1.AsFloat := QuantityRoundTo(ANode.DgnQuantity1);
  502. Rec.DgnQuantity2.AsFloat := QuantityRoundTo(ANode.DgnQuantity2);
  503. Rec.DrawingCode.AsString := ANode.DrawingCode;
  504. Rec.MemoStr.AsString := ANode.MemoStr;
  505. end;
  506. procedure TBillsEdtExcelImport.WriteNodes(ADataSet: TsdDataSet);
  507. var
  508. i, iPos, iSubPos: Integer;
  509. begin
  510. UpdateProgressHint('写入读取的Excel数据', True);
  511. UpdateProgressPosition(50, 0);
  512. ADataSet.DeleteAll;
  513. for i := 0 to FCacheTree.CacheNodes.Count - 1 do
  514. begin
  515. WriteNode(ADataSet, TBillsCacheNode(FCacheTree.CacheNodes[i]));
  516. iSubPos := i*100 div FCacheTree.CacheNodes.Count;
  517. iPos := 50 + iSubPos div 2;
  518. UpdateProgressPosition(iPos, iSubPos);
  519. end;
  520. UpdateProgressPosition(100, 100);
  521. end;
  522. { TBillsPriceExcelImport }
  523. procedure TBillsPriceExcelImport.BeginImport;
  524. begin
  525. ShowProgressHint('导入Excel清单单价', 100);
  526. FProjectData.BillsData.sddBills.BeginUpdate;
  527. end;
  528. procedure TBillsPriceExcelImport.EndImport;
  529. begin
  530. FProjectData.BillsData.sddBills.EndUpdate;
  531. UpdateProgressHint('正在计算导入后的数据');
  532. FProjectData.BillsCompileData.CalculateAll;
  533. CloseProgressHint;
  534. end;
  535. procedure TBillsPriceExcelImport.Import;
  536. begin
  537. LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0));
  538. ImportBillsPriceData(FMSExcel.Sheets.Spreadsheet(0));
  539. end;
  540. procedure TBillsPriceExcelImport.ImportBillsPriceData(ASheet: TSpreadSheet);
  541. function CheckIsBillsCode(ACode: string): Boolean;
  542. const
  543. FBillsCodeSet: set of char = ['0'..'9', '-', 'a'..'z', 'A'..'Z'];
  544. var
  545. I: Integer;
  546. begin
  547. Result := True;
  548. I := 1;
  549. while I < Length(ACode) do
  550. if ACode[I] in FBillsCodeSet then
  551. Inc(I)
  552. else
  553. begin
  554. Result := False;
  555. Break;
  556. end;
  557. end;
  558. var
  559. iPos: Integer;
  560. sB_Code: string;
  561. fPrice: Double;
  562. begin
  563. UpdateProgressHint('写入读取的Excel数据');
  564. UpdateProgressPosition(0);
  565. while (FCurRow < ASheet.Cells.UsedRowCount) do
  566. begin
  567. sB_Code := GetCellTrimText(ASheet, FB_CodeCol, FCurRow);
  568. if (sB_Code <> '') and CheckIsBillsCode(sB_Code) then
  569. begin
  570. fPrice := StrToFloatDef(VarToStrDef(ASheet.Cells.GetValue(FPriceCol, FCurRow), ''), 0);
  571. UpdateBillsPrice(sB_Code, fPrice);
  572. end;
  573. Inc(FCurRow);
  574. iPos := FCurRow * 100 div ASheet.Cells.UsedRowCount;
  575. UpdateProgressPosition(iPos);
  576. end;
  577. UpdateProgressPosition(100);
  578. end;
  579. procedure TBillsPriceExcelImport.LoadColumnsFromHead(ASheet: TSpreadSheet);
  580. var
  581. iCol: Integer;
  582. sColName: string;
  583. begin
  584. FB_CodeCol := -1;
  585. FNameCol := -1;
  586. FPriceCol := -1;
  587. while ((FB_CodeCol = -1) or (FPriceCol = -1)) and (FCurRow < ASheet.Cells.UsedRowCount) do
  588. begin
  589. for iCol := 0 to ASheet.Cells.UsedColCount do
  590. begin
  591. sColName := GetCellTrimText(ASheet, iCol, FCurRow);
  592. if SameText(sColName, '清单编号') or SameText(sColName, '子目号') then
  593. FB_CodeCol := iCol
  594. else if SameText(sColName, '名称') then
  595. FNameCol := iCol
  596. else if Pos('单价', sColName) = 1 then
  597. FPriceCol := iCol;
  598. end;
  599. Inc(FCurRow);
  600. end;
  601. end;
  602. procedure TBillsPriceExcelImport.UpdateBillsPrice(const AB_Code: string;
  603. APrice: Double);
  604. var
  605. iIndex: Integer;
  606. Rec: TBillsRecord;
  607. begin
  608. with FProjectData.BillsData do
  609. begin
  610. for iIndex := 0 to sddBills.RecordCount - 1 do
  611. begin
  612. Rec := TBillsRecord(sddBills.Records[iIndex]);
  613. if SameText(AB_Code, Rec.B_Code.AsString) then
  614. Rec.Price.AsFloat := PriceRoundTo(APrice);
  615. end;
  616. end;
  617. end;
  618. { TDealBillsExcelImport }
  619. procedure TDealBillsExcelImport.BeginImport;
  620. begin
  621. FProjectData.DealBillsData.sddDealBills.BeginUpdate;
  622. end;
  623. procedure TDealBillsExcelImport.EndImport;
  624. begin
  625. FProjectData.DealBillsData.sddDealBills.EndUpdate;
  626. end;
  627. procedure TDealBillsExcelImport.Import;
  628. begin
  629. LoadColumnsFromHead(FMSExcel.Sheets.Spreadsheet(0));
  630. FBillsID := 1;
  631. FProjectData.DealBillsData.Clear;
  632. FProjectData.DealBillsData.DisableEvent;
  633. LoadDealBillsData(FMSExcel.Sheets.Spreadsheet(0));
  634. FProjectData.DealBillsData.EnableEvent;
  635. end;
  636. procedure TDealBillsExcelImport.LoadColumnsFromHead(ASheet: TSpreadSheet);
  637. var
  638. iCol: Integer;
  639. sColName: string;
  640. begin
  641. FB_CodeCol := -1;
  642. FNameCol := 1;
  643. FUnitsCol := 2;
  644. FPriceCol := 3;
  645. FQuantityCol := 4;
  646. FTotalPriceCol := 5;
  647. while ((FB_CodeCol = -1) or (FPriceCol = -1)) and (FCurRow < ASheet.Cells.UsedRowCount) do
  648. begin
  649. for iCol := 0 to ASheet.Cells.UsedColCount do
  650. begin
  651. sColName := GetCellTrimText(ASheet, iCol, FCurRow);
  652. if SameText(sColName, '清单编号') or SameText(sColName, '子目号') then
  653. FB_CodeCol := iCol
  654. else if SameText(sColName, '名称') then
  655. FNameCol := iCol
  656. else if SameText(sColName, '单位') then
  657. FUnitsCol := iCol
  658. else if Pos('单价', sColName) = 1 then
  659. FPriceCol := iCol
  660. else if SameText(sColName, '数量') then
  661. FQuantityCol := iCol
  662. else if SameText(sColName, '金额') then
  663. FTotalPriceCol := iCol;
  664. end;
  665. Inc(FCurRow);
  666. end;
  667. end;
  668. procedure TDealBillsExcelImport.LoadDealBillsData(ASheet: TSpreadSheet);
  669. function CheckIsBillsCode(ACode: string): Boolean;
  670. const
  671. FBillsCodeSet: set of char = ['0'..'9', '-', 'a'..'z', 'A'..'Z'];
  672. var
  673. I: Integer;
  674. begin
  675. Result := True;
  676. I := 1;
  677. while I < Length(ACode) do
  678. if ACode[I] in FBillsCodeSet then
  679. Inc(I)
  680. else
  681. begin
  682. Result := False;
  683. Break;
  684. end;
  685. end;
  686. var
  687. sB_Code: string;
  688. Rec: TsdDataRecord;
  689. begin
  690. while (FCurRow < ASheet.Cells.UsedRowCount) do
  691. begin
  692. sB_Code := GetCellTrimText(ASheet, FB_CodeCol, FCurRow);
  693. if (sB_Code <> '') and CheckIsBillsCode(sB_Code) then
  694. begin
  695. Rec := FProjectData.DealBillsData.sddDealBills.Add;
  696. Rec.ValueByName('ID').AsInteger := FBillsID;
  697. Rec.ValueByName('B_Code').AsString := sB_Code;
  698. Rec.ValueByName('IndexCode').AsString := B_CodeToIndexCode(sB_Code);
  699. Rec.ValueByName('Name').AsString := GetCellTrimText(ASheet, FNameCol, FCurRow);
  700. Rec.ValueByName('Units').AsString := GetCellTrimText(ASheet, FUnitsCol, FCurRow);
  701. Rec.ValueByName('Price').AsFloat := PriceRoundTo(
  702. StrToFloatDef(GetCellTrimText(ASheet, FPriceCol, FCurRow), 0));
  703. Rec.ValueByName('Quantity').AsFloat := QuantityRoundTo(
  704. StrToFloatDef(GetCellTrimText(ASheet, FQuantityCol, FCurRow), 0));
  705. Rec.ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(
  706. StrToFloatDef(GetCellTrimText(ASheet, FTotalPriceCol, FCurRow), 0));
  707. Inc(FBillsID);
  708. end;
  709. Inc(FCurRow);
  710. end;
  711. end;
  712. { TGclBillsExcelImport }
  713. procedure TGclBillsExcelImport.BeginImport;
  714. begin
  715. Screen.Cursor := crHourGlass;
  716. ShowProgressHint('导入Excel数据', 100);
  717. FCacheTree := TGclCacheTree.Create;
  718. FCacheTree.NewNodeID := FProjectData.BillsData.GetMaxBillsID + 1;
  719. FProjectData.DisConnectTree;
  720. FProjectData.BillsData.DisableEvents;
  721. FSelectSheets := TList.Create;
  722. FB_CodeCol := 0;
  723. FNameCol := 1;
  724. FUnitsCol := 2;
  725. FQuantityCol := 3;
  726. FPriceCol := 4;
  727. end;
  728. procedure TGclBillsExcelImport.EndImport;
  729. var
  730. ParentRec: TsdDataRecord;
  731. begin
  732. FSelectSheets.Free;
  733. FCacheTree.Free;
  734. FProjectData.BillsData.EnableEvents;
  735. FProjectData.ReConnectTree;
  736. ParentRec := FProjectData.BillsData.sddBills.FindKey('idxID', ParentID);
  737. FProjectData.BillsCompileData.sdvBillsCompile.LocateInControl(ParentRec);
  738. FProjectData.BillsCompileData.CalculateAll;
  739. CloseProgressHint;
  740. Screen.Cursor := crDefault;
  741. end;
  742. procedure TGclBillsExcelImport.Import;
  743. var
  744. i: Integer;
  745. begin
  746. {if SelectSheets(FMSExcel, FSelectSheets) then
  747. begin
  748. for i := 0 to FSelectSheets.Count - 1 do
  749. begin
  750. UpdateProgressHint(Format('导入Excel数据--工作表[%s]', [FMSExcel.SheetNames.Strings[i]]));
  751. UpdateProgressPosition(0);
  752. ImportSheet(FSelectSheets.Items[i]);
  753. end;
  754. end;}
  755. ImportSheet(FMSExcel.Sheets.Spreadsheet(0));
  756. WriteNodes(FProjectData.BillsData.sddBills);
  757. end;
  758. procedure TGclBillsExcelImport.ImportSheet(ASheet: TSpreadSheet);
  759. var
  760. iPos: Integer;
  761. begin
  762. FCurRow := 1;
  763. while (FCurRow < ASheet.Cells.UsedRowCount) do
  764. begin
  765. LoadNode(ASheet);
  766. Inc(FCurRow);
  767. iPos := FCurRow * 100 div ASheet.Cells.UsedRowCount;
  768. UpdateProgressPosition(iPos);
  769. end;
  770. end;
  771. procedure TGclBillsExcelImport.LoadNode(ASheet: TSpreadSheet);
  772. var
  773. sB_Code, sName: string;
  774. Node: TGclCacheNode;
  775. begin
  776. with ASheet.Cells do
  777. begin
  778. sB_Code := Trim(VarToStrDef(GetValue(FB_CodeCol, FCurRow), ''));
  779. sName := Trim(VarToStrDef(GetValue(FNameCol, FCurRow), ''));
  780. Node := FCacheTree.AddNodeByData(sB_Code, sName);
  781. Node.B_Code := sB_Code;
  782. Node.Name := sName;
  783. Node.Units := Trim(VarToStrDef(GetValue(FUnitsCol, FCurRow), ''));
  784. Node.Price := StrToFloatDef(VarToStrDef(GetValue(FPriceCol, FCurRow), ''), 0);
  785. Node.Quantity := StrToFloatDef(VarToStrDef(GetValue(FQuantityCol, FCurRow), ''), 0);
  786. end;
  787. end;
  788. procedure TGclBillsExcelImport.WriteNodes(ADataSet: TsdDataSet);
  789. var
  790. i, iPos: Integer;
  791. begin
  792. UpdateProgressHint('写入读取的Excel数据');
  793. UpdateProgressPosition(0);
  794. for i := 0 to FCacheTree.CacheNodes.Count - 1 do
  795. begin
  796. WriteNode(ADataSet, TGclCacheNode(FCacheTree.CacheNodes[i]));
  797. iPos := i*100 div FCacheTree.CacheNodes.Count;
  798. UpdateProgressPosition(iPos);
  799. end;
  800. UpdateProgressPosition(100);
  801. end;
  802. procedure TGclBillsExcelImport.WriteNode(ADataSet: TsdDataSet;
  803. ANode: TGclCacheNode);
  804. var
  805. Rec: TBillsRecord;
  806. begin
  807. if ANode.B_Code <> '' then
  808. UpdateProgressHint('写入读取的Excel数据 ' + ANode.B_Code)
  809. else
  810. UpdateProgressHint('写入读取的Excel数据 ' + ANode.Name);
  811. Rec := TBillsRecord(ADataSet.Add);
  812. Rec.ID.AsInteger := ANode.ID;
  813. if ANode.ParentID = -1 then
  814. Rec.ParentID.AsInteger := ParentID
  815. else
  816. Rec.ParentID.AsInteger := ANode.ParentID;
  817. Rec.NextSiblingID.AsInteger := ANode.NextSiblingID;
  818. Rec.B_Code.AsString := ANode.B_Code;
  819. Rec.Name.AsString := ANode.Name;
  820. Rec.Units.AsString := ANode.Units;
  821. Rec.Price.AsFloat := PriceRoundTo(ANode.Price);
  822. Rec.OrgQuantity.AsFloat := QuantityRoundTo(ANode.Quantity);
  823. end;
  824. end.