ExcelImport.pas 25 KB

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