stgGclSubGatherFile.pas 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431
  1. unit stgGclSubGatherFile;
  2. // 导入导出汇总结果
  3. interface
  4. uses
  5. stgGclSubGatherFileDm, ADODB, sdDB, stgGclGatherDm, SysUtils, ProjectData,
  6. StageDm, mDataRecord, BillsTree, DetailExcelImport, OExport, stgGclImportHint;
  7. type
  8. TstgGclSubGatherFileHelper = class
  9. private
  10. FTempFile: string;
  11. FConnection: TADOConnection;
  12. FGatherData: TstgGclSubGatherData;
  13. public
  14. constructor Create;
  15. destructor Destroy; override;
  16. procedure Open(const AFileName: string);
  17. procedure Close;
  18. procedure SaveTo(const AFileName: string);
  19. property Connection: TADOConnection read FConnection;
  20. property GatherData: TstgGclSubGatherData read FGatherData;
  21. end;
  22. TstgGclSubGatherFileExportor = class(TstgGclSubGatherFileHelper)
  23. private
  24. procedure LoadMemoryRecord(ARec: TsdDataRecord);
  25. procedure LoadMemoryGatherData(AGatherData: TstgGclGatherData);
  26. public
  27. procedure ExportGatherDataTo(AGatherData: TstgGclGatherData; const AFileName: string);
  28. end;
  29. TstgGclSubGatherFileImportor = class(TstgGclSubGatherFileHelper)
  30. private
  31. FFails: TstgGclFailList;
  32. procedure ClearOldData(AStageData: TStageData);
  33. procedure ImportGatherData(AProjectData: TProjectData);
  34. public
  35. constructor Create;
  36. destructor Destroy; override;
  37. procedure ImportGatherDataTo(AProjectData: TProjectData; const AFileName: string);
  38. end;
  39. TstgGclSubGatherFileExcelImportor = class(TDetailExcelImport)
  40. private
  41. FCurRow: Integer;
  42. FB_CodeCol: Integer;
  43. FNameCol: Integer;
  44. FUnitsCol: Integer;
  45. FPriceCol: Integer;
  46. FDealQuantityCol: Integer;
  47. FFails: TstgGclFailList;
  48. procedure ClearOldData(AStageData: TStageData);
  49. function LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
  50. procedure LoadGatherData(ASheet: TExportWorkSheet);
  51. protected
  52. procedure BeginImport; override;
  53. procedure EndImport; override;
  54. procedure Import; override;
  55. public
  56. constructor Create(AProjectData: TProjectData); override;
  57. destructor Destroy; override;
  58. end;
  59. implementation
  60. uses
  61. UtilMethods, ZhAPI, Connections, stgGclTables, ScAutoUpdateUnit, Math,
  62. BillsMeasureDm, stgGclImportHintFrm;
  63. { TstgGclSubGatherFileExportor }
  64. procedure TstgGclSubGatherFileExportor.ExportGatherDataTo(
  65. AGatherData: TstgGclGatherData; const AFileName: string);
  66. begin
  67. Open(GetEmptyDataBaseFileName);
  68. try
  69. LoadMemoryGatherData(AGatherData);
  70. finally
  71. SaveTo(AFileName);
  72. end;
  73. end;
  74. procedure TstgGclSubGatherFileExportor.LoadMemoryRecord(ARec: TsdDataRecord);
  75. var
  76. vRec: TsdDataRecord;
  77. begin
  78. vRec := GatherData.sddBills.Add;
  79. vRec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
  80. vRec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
  81. vRec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
  82. vRec.ValueByName('Price').AsFloat := ARec.ValueByName('Price').AsFloat;
  83. vRec.ValueByName('DealQuantity').AsFloat := ARec.ValueByName('DealQuantity').AsFloat;
  84. vRec.ValueByName('DealTotalPrice').AsFloat := ARec.ValueByName('DealTotalPrice').AsFloat;
  85. vRec.ValueByName('QcQuantity').AsFloat := ARec.ValueByName('QcQuantity').AsFloat;
  86. vRec.ValueByName('QcTotalPrice').AsFloat := ARec.ValueByName('QcTotalPrice').AsFloat;
  87. vRec.ValueByName('QcBGLCode').AsString := ARec.ValueByName('QcBGLCode').AsString;
  88. vRec.ValueByName('QcBGLNum').AsString := ARec.ValueByName('QcBGLNum').AsString;
  89. end;
  90. procedure TstgGclSubGatherFileExportor.LoadMemoryGatherData(
  91. AGatherData: TstgGclGatherData);
  92. var
  93. i: Integer;
  94. vRec: TsdDataRecord;
  95. begin
  96. GatherData.sddBills.BeginUpdate;
  97. try
  98. for i := 0 to AGatherData.sddGatherGcl.RecordCount - 1 do
  99. begin
  100. vRec := AGatherData.sddGatherGcl.Records[i];
  101. LoadMemoryRecord(vRec);
  102. end;
  103. finally
  104. GatherData.sddBills.EndUpdate;
  105. end;
  106. end;
  107. { TstgGclSubGatherFileHelper }
  108. procedure TstgGclSubGatherFileHelper.Close;
  109. begin
  110. FConnection.Close;
  111. if FileExists(FTempFile) then
  112. DeleteFile(FTempFile);
  113. end;
  114. constructor TstgGclSubGatherFileHelper.Create;
  115. begin
  116. FConnection := TADOConnection.Create(nil);
  117. FConnection.LoginPrompt := False;
  118. FGatherData := TstgGclSubGatherData.Create(nil);
  119. end;
  120. destructor TstgGclSubGatherFileHelper.Destroy;
  121. begin
  122. Close;
  123. FGatherData.Free;
  124. FConnection.Free;
  125. inherited;
  126. end;
  127. procedure TstgGclSubGatherFileHelper.Open(const AFileName: string);
  128. procedure UpdateDataTables;
  129. var
  130. Updater: TScUpdater;
  131. begin
  132. Updater := TScUpdater.Create;
  133. try
  134. Updater.ForceUpdate := True;
  135. Updater.Open('', FConnection, '', '');
  136. Updater.AddTableDef(sStgGclBills, @tdStgGclBills, Length(tdStgGclBills), False, False);
  137. Updater.ExcuteUpdate;
  138. finally
  139. Updater.Free;
  140. end;
  141. end;
  142. begin
  143. FTempFile := GetTempFileName;
  144. CopyFileOrFolder(AFileName, FTempFile);
  145. FConnection.ConnectionString := Format(SAdoConnectStr, [FTempFile]);
  146. FConnection.Open;
  147. UpdateDataTables;
  148. GatherData.Open(FConnection);
  149. end;
  150. procedure TstgGclSubGatherFileHelper.SaveTo(const AFileName: string);
  151. begin
  152. FGatherData.Save;
  153. CopyFileOrFolder(FTempFile, AFileName);
  154. end;
  155. { TstgGclSubGatherFileImportor }
  156. procedure TstgGclSubGatherFileImportor.ClearOldData(AStageData: TStageData);
  157. var
  158. i: Integer;
  159. vRec: TStageRecord;
  160. begin
  161. for i := 0 to AStageData.sddStage.RecordCount - 1 do
  162. begin
  163. vRec := TStageRecord(AStageData.sddStage.Records[i]);
  164. vRec.DealQuantity.AsFloat := 0;
  165. vRec.DealTotalPrice.AsFloat := 0;
  166. vRec.DealFlag.AsInteger := 0;
  167. vRec.DealFormula.AsString := '';
  168. vRec.EndDealQuantity.AsFloat := vRec.PreDealQuantity.AsFloat;
  169. vRec.EndDealTotalPrice.AsFloat := vRec.PreDealTotalPrice.AsFloat;
  170. end;
  171. end;
  172. constructor TstgGclSubGatherFileImportor.Create;
  173. begin
  174. FFails := TstgGclFailList.Create;
  175. inherited Create;
  176. end;
  177. destructor TstgGclSubGatherFileImportor.Destroy;
  178. begin
  179. FFails.Free;
  180. inherited;
  181. end;
  182. procedure TstgGclSubGatherFileImportor.ImportGatherData(
  183. AProjectData: TProjectData);
  184. function FindBillsNode(ARec: TsdDataRecord): TBillsIDTreeNode;
  185. var
  186. i: Integer;
  187. vNode: TBillsIDTreeNode;
  188. begin
  189. Result := nil;
  190. for i := 0 to AProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
  191. begin
  192. vNode := TBillsIDTreeNode(AProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
  193. if (vNode.HasChildren) then Continue;
  194. if (vNode.Rec.B_Code.AsString = ARec.ValueByName('B_Code').AsString) and
  195. (vNode.Rec.Name.AsString = ARec.ValueByName('Name').AsString) and
  196. (vNode.Rec.Units.AsString = ARec.ValueByName('Units').AsString) then
  197. //(vNode.Rec.Units.AsString = ARec.ValueByName('Units').AsString) and
  198. //(CommonRoundTo(vNode.Rec.Price.AsFloat - ARec.ValueByName('Price').AsFloat, -6) = 0) then
  199. begin
  200. Result := vNode;
  201. Break;
  202. end;
  203. end;
  204. end;
  205. var
  206. i: Integer;
  207. vNode: TBillsIDTreeNode;
  208. vOrgRec: TsdDataRecord;
  209. vStageRec: TStageRecord;
  210. begin
  211. for i := 0 to GatherData.sddBills.RecordCount - 1 do
  212. begin
  213. vOrgRec := GatherData.sddBills.Records[i];
  214. vNode := FindBillsNode(vOrgRec);
  215. if Assigned(vNode) then
  216. begin
  217. vStageRec := AProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
  218. vStageRec.DealQuantity.AsFloat := vOrgRec.ValueByName('DealQuantity').AsFloat;
  219. end
  220. else
  221. FFails.AddFailGcl(vOrgRec.ValueByName('B_Code').AsString,
  222. vOrgRec.ValueByName('Name').AsString, vOrgRec.ValueByName('Units').AsString,
  223. vOrgRec.ValueByName('Price').AsFloat, vOrgRec.ValueByName('DealQuantity').AsFloat);
  224. end;
  225. end;
  226. procedure TstgGclSubGatherFileImportor.ImportGatherDataTo(
  227. AProjectData: TProjectData; const AFileName: string);
  228. begin
  229. Open(AFileName);
  230. AProjectData.PhaseData.StageData.sddStage.BeginUpdate;
  231. AProjectData.PhaseData.StageData.BeforeBatchOperation;
  232. try
  233. ClearOldData(AProjectData.PhaseData.StageData);
  234. ImportGatherData(AProjectData);
  235. finally
  236. AProjectData.PhaseData.StageData.AfterBatchOperation;
  237. AProjectData.PhaseData.StageData.sddStage.EndUpdate;
  238. end;
  239. if FFails.Count > 0 then
  240. ShowGclImportForm(FFails);
  241. end;
  242. { TstgGclSubGatherFileExcelImportor }
  243. procedure TstgGclSubGatherFileExcelImportor.BeginImport;
  244. begin
  245. inherited;
  246. ProjectData.PhaseData.StageData.sddStage.BeginUpdate;
  247. ProjectData.PhaseData.StageData.BeforeBatchOperation;
  248. end;
  249. procedure TstgGclSubGatherFileExcelImportor.ClearOldData(
  250. AStageData: TStageData);
  251. var
  252. i: Integer;
  253. vRec: TStageRecord;
  254. begin
  255. for i := 0 to AStageData.sddStage.RecordCount - 1 do
  256. begin
  257. vRec := TStageRecord(AStageData.sddStage.Records[i]);
  258. vRec.DealQuantity.AsFloat := 0;
  259. vRec.DealTotalPrice.AsFloat := 0;
  260. vRec.DealFlag.AsInteger := 0;
  261. vRec.DealFormula.AsString := '';
  262. vRec.EndDealQuantity.AsFloat := vRec.PreDealQuantity.AsFloat;
  263. vRec.EndDealTotalPrice.AsFloat := vRec.PreDealTotalPrice.AsFloat;
  264. end;
  265. end;
  266. constructor TstgGclSubGatherFileExcelImportor.Create(
  267. AProjectData: TProjectData);
  268. begin
  269. inherited Create(AProjectData);
  270. FFails := TstgGclFailList.Create;
  271. end;
  272. destructor TstgGclSubGatherFileExcelImportor.Destroy;
  273. begin
  274. FFails.Free;
  275. inherited;
  276. end;
  277. procedure TstgGclSubGatherFileExcelImportor.EndImport;
  278. begin
  279. ProjectData.PhaseData.StageData.AfterBatchOperation;
  280. ProjectData.PhaseData.StageData.sddStage.EndUpdate;
  281. if FFails.Count > 0 then
  282. ShowGclImportForm(FFails);
  283. inherited;
  284. end;
  285. procedure TstgGclSubGatherFileExcelImportor.Import;
  286. begin
  287. ClearOldData(ProjectData.PhaseData.StageData);
  288. FCurRow := 0;
  289. if LoadColumnsFromHead(OExport.OpenWorkSheet) then
  290. LoadGatherData(OExport.OpenWorkSheet)
  291. else
  292. ErrorMessage('导入的Excel格式有误!');
  293. inherited;
  294. end;
  295. function TstgGclSubGatherFileExcelImportor.LoadColumnsFromHead(
  296. ASheet: TExportWorkSheet): Boolean;
  297. var
  298. vRow: TExportRow;
  299. iCol: Integer;
  300. sColName: String;
  301. begin
  302. FB_CodeCol := -1;
  303. FNameCol := -1;
  304. FUnitsCol := -1;
  305. FPriceCol := -1;
  306. FDealQuantityCol := -1;
  307. vRow := ASheet.Rows[FCurRow];
  308. for iCol := 0 to vRow.Cells.Count - 1 do
  309. begin
  310. sColName := GetCellTrimStr(vRow, iCol);
  311. if (sColName = '清单编号') then
  312. FB_CodeCol := iCol
  313. else if sColName = '名称' then
  314. FNameCol := iCol
  315. else if sColName = '单位' then
  316. FUnitsCol := iCol
  317. else if sColName = '单价' then
  318. FPriceCol := iCol
  319. else if (sColName = '合同计量') then
  320. FDealQuantityCol := iCol;
  321. end;
  322. Result := (FB_CodeCol <> -1) and (FNameCol <> -1) and (FUnitsCol <> -1) and
  323. (FPriceCol <> -1) and (FDealQuantityCol <> -1);
  324. Inc(FCurRow);
  325. end;
  326. procedure TstgGclSubGatherFileExcelImportor.LoadGatherData(
  327. ASheet: TExportWorkSheet);
  328. function FindBillsNode(const AB_Code, AName, AUnits: string; APrice: Double): TBillsIDTreeNode;
  329. var
  330. i: Integer;
  331. vNode: TBillsIDTreeNode;
  332. begin
  333. Result := nil;
  334. for i := 0 to ProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
  335. begin
  336. vNode := TBillsIDTreeNode(ProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
  337. if (vNode.HasChildren) then Continue;
  338. if (vNode.Rec.B_Code.AsString = AB_Code) and
  339. (vNode.Rec.Name.AsString = AName) and
  340. (vNode.Rec.Units.AsString = AUnits) then
  341. //(vNode.Rec.Units.AsString = AUnits) and
  342. //(CommonRoundTo(vNode.Rec.Price.AsFloat - APrice, -6) = 0) then
  343. begin
  344. Result := vNode;
  345. Break;
  346. end;
  347. end;
  348. end;
  349. var
  350. vRow: TExportRow;
  351. sB_Code, sName, sUnits: string;
  352. fPrice: Double;
  353. vNode: TBillsIDTreeNode;
  354. vStageRec: TStageRecord;
  355. begin
  356. while FCurRow < ASheet.Rows.Count do
  357. begin
  358. vRow := ASheet.Rows[FCurRow];
  359. Inc(FCurRow);
  360. sB_Code := Trim(GetCellStr(vRow, FB_CodeCol));
  361. sName := Trim(GetCellStr(vRow, FNameCol));
  362. sUnits := Trim(GetCellStr(vRow, FUnitsCol));
  363. fPrice := StrToFloatDef(GetCellStr(vRow, FPriceCol), 0);
  364. if (sB_Code = '') then Continue;
  365. vNode := FindBillsNode(sB_Code, sName, sUnits, fPrice);
  366. if Assigned(vNode) then
  367. begin
  368. vStageRec := ProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
  369. vStageRec.DealQuantity.AsFloat := StrToFloatDef(GetCellStr(vRow, FDealQuantityCol), 0);
  370. end
  371. else
  372. FFails.AddFailGcl(sB_Code, sName, sUnits, fPrice, StrToFloatDef(GetCellStr(vRow, FDealQuantityCol), 0));
  373. end;
  374. end;
  375. end.