stgGclSubGatherFile.pas 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430
  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. end;
  176. destructor TstgGclSubGatherFileImportor.Destroy;
  177. begin
  178. FFails.Free;
  179. inherited;
  180. end;
  181. procedure TstgGclSubGatherFileImportor.ImportGatherData(
  182. AProjectData: TProjectData);
  183. function FindBillsNode(ARec: TsdDataRecord): TBillsIDTreeNode;
  184. var
  185. i: Integer;
  186. vNode: TBillsIDTreeNode;
  187. begin
  188. Result := nil;
  189. for i := 0 to AProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
  190. begin
  191. vNode := TBillsIDTreeNode(AProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
  192. if (vNode.HasChildren) then Continue;
  193. if (vNode.Rec.B_Code.AsString = ARec.ValueByName('B_Code').AsString) and
  194. (vNode.Rec.Name.AsString = ARec.ValueByName('Name').AsString) and
  195. (vNode.Rec.Units.AsString = ARec.ValueByName('Units').AsString) then
  196. //(vNode.Rec.Units.AsString = ARec.ValueByName('Units').AsString) and
  197. //(CommonRoundTo(vNode.Rec.Price.AsFloat - ARec.ValueByName('Price').AsFloat, -6) = 0) then
  198. begin
  199. Result := vNode;
  200. Break;
  201. end;
  202. end;
  203. end;
  204. var
  205. i: Integer;
  206. vNode: TBillsIDTreeNode;
  207. vOrgRec: TsdDataRecord;
  208. vStageRec: TStageRecord;
  209. begin
  210. for i := 0 to GatherData.sddBills.RecordCount - 1 do
  211. begin
  212. vOrgRec := GatherData.sddBills.Records[i];
  213. vNode := FindBillsNode(vOrgRec);
  214. if Assigned(vNode) then
  215. begin
  216. vStageRec := AProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
  217. vStageRec.DealQuantity.AsFloat := vOrgRec.ValueByName('DealQuantity').AsFloat;
  218. end
  219. else
  220. FFails.AddFailGcl(vOrgRec.ValueByName('B_Code').AsString,
  221. vOrgRec.ValueByName('Name').AsString, vOrgRec.ValueByName('Units').AsString,
  222. vOrgRec.ValueByName('Price').AsFloat, vOrgRec.ValueByName('DealQuantity').AsFloat);
  223. end;
  224. end;
  225. procedure TstgGclSubGatherFileImportor.ImportGatherDataTo(
  226. AProjectData: TProjectData; const AFileName: string);
  227. begin
  228. Open(AFileName);
  229. AProjectData.PhaseData.StageData.sddStage.BeginUpdate;
  230. AProjectData.PhaseData.StageData.BeforeBatchOperation;
  231. try
  232. ClearOldData(AProjectData.PhaseData.StageData);
  233. ImportGatherData(AProjectData);
  234. finally
  235. AProjectData.PhaseData.StageData.AfterBatchOperation;
  236. AProjectData.PhaseData.StageData.sddStage.EndUpdate;
  237. end;
  238. if FFails.Count > 0 then
  239. ShowGclImportForm(FFails);
  240. end;
  241. { TstgGclSubGatherFileExcelImportor }
  242. procedure TstgGclSubGatherFileExcelImportor.BeginImport;
  243. begin
  244. inherited;
  245. ProjectData.PhaseData.StageData.sddStage.BeginUpdate;
  246. ProjectData.PhaseData.StageData.BeforeBatchOperation;
  247. end;
  248. procedure TstgGclSubGatherFileExcelImportor.ClearOldData(
  249. AStageData: TStageData);
  250. var
  251. i: Integer;
  252. vRec: TStageRecord;
  253. begin
  254. for i := 0 to AStageData.sddStage.RecordCount - 1 do
  255. begin
  256. vRec := TStageRecord(AStageData.sddStage.Records[i]);
  257. vRec.DealQuantity.AsFloat := 0;
  258. vRec.DealTotalPrice.AsFloat := 0;
  259. vRec.DealFlag.AsInteger := 0;
  260. vRec.DealFormula.AsString := '';
  261. vRec.EndDealQuantity.AsFloat := vRec.PreDealQuantity.AsFloat;
  262. vRec.EndDealTotalPrice.AsFloat := vRec.PreDealTotalPrice.AsFloat;
  263. end;
  264. end;
  265. constructor TstgGclSubGatherFileExcelImportor.Create(
  266. AProjectData: TProjectData);
  267. begin
  268. inherited Create(AProjectData);
  269. FFails := TstgGclFailList.Create;
  270. end;
  271. destructor TstgGclSubGatherFileExcelImportor.Destroy;
  272. begin
  273. FFails.Free;
  274. inherited;
  275. end;
  276. procedure TstgGclSubGatherFileExcelImportor.EndImport;
  277. begin
  278. ProjectData.PhaseData.StageData.AfterBatchOperation;
  279. ProjectData.PhaseData.StageData.sddStage.EndUpdate;
  280. if FFails.Count > 0 then
  281. ShowGclImportForm(FFails);
  282. inherited;
  283. end;
  284. procedure TstgGclSubGatherFileExcelImportor.Import;
  285. begin
  286. ClearOldData(ProjectData.PhaseData.StageData);
  287. FCurRow := 0;
  288. if LoadColumnsFromHead(OExport.OpenWorkSheet) then
  289. LoadGatherData(OExport.OpenWorkSheet)
  290. else
  291. ErrorMessage('导入的Excel格式有误!');
  292. inherited;
  293. end;
  294. function TstgGclSubGatherFileExcelImportor.LoadColumnsFromHead(
  295. ASheet: TExportWorkSheet): Boolean;
  296. var
  297. vRow: TExportRow;
  298. iCol: Integer;
  299. sColName: String;
  300. begin
  301. FB_CodeCol := -1;
  302. FNameCol := -1;
  303. FUnitsCol := -1;
  304. FPriceCol := -1;
  305. FDealQuantityCol := -1;
  306. vRow := ASheet.Rows[FCurRow];
  307. for iCol := 0 to vRow.Cells.Count - 1 do
  308. begin
  309. sColName := GetCellTrimStr(vRow, iCol);
  310. if (sColName = '清单编号') then
  311. FB_CodeCol := iCol
  312. else if sColName = '名称' then
  313. FNameCol := iCol
  314. else if sColName = '单位' then
  315. FUnitsCol := iCol
  316. else if sColName = '单价' then
  317. FPriceCol := iCol
  318. else if (sColName = '合同计量') then
  319. FDealQuantityCol := iCol;
  320. end;
  321. Result := (FB_CodeCol <> -1) and (FNameCol <> -1) and (FUnitsCol <> -1) and
  322. (FPriceCol <> -1) and (FDealQuantityCol <> -1);
  323. Inc(FCurRow);
  324. end;
  325. procedure TstgGclSubGatherFileExcelImportor.LoadGatherData(
  326. ASheet: TExportWorkSheet);
  327. function FindBillsNode(const AB_Code, AName, AUnits: string; APrice: Double): TBillsIDTreeNode;
  328. var
  329. i: Integer;
  330. vNode: TBillsIDTreeNode;
  331. begin
  332. Result := nil;
  333. for i := 0 to ProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
  334. begin
  335. vNode := TBillsIDTreeNode(ProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
  336. if (vNode.HasChildren) then Continue;
  337. if (vNode.Rec.B_Code.AsString = AB_Code) and
  338. (vNode.Rec.Name.AsString = AName) and
  339. (vNode.Rec.Units.AsString = AUnits) then
  340. //(vNode.Rec.Units.AsString = AUnits) and
  341. //(CommonRoundTo(vNode.Rec.Price.AsFloat - APrice, -6) = 0) then
  342. begin
  343. Result := vNode;
  344. Break;
  345. end;
  346. end;
  347. end;
  348. var
  349. vRow: TExportRow;
  350. sB_Code, sName, sUnits: string;
  351. fPrice: Double;
  352. vNode: TBillsIDTreeNode;
  353. vStageRec: TStageRecord;
  354. begin
  355. while FCurRow < ASheet.Rows.Count do
  356. begin
  357. vRow := ASheet.Rows[FCurRow];
  358. Inc(FCurRow);
  359. sB_Code := Trim(GetCellStr(vRow, FB_CodeCol));
  360. sName := Trim(GetCellStr(vRow, FNameCol));
  361. sUnits := Trim(GetCellStr(vRow, FUnitsCol));
  362. fPrice := StrToFloatDef(GetCellStr(vRow, FPriceCol), 0);
  363. if (sB_Code = '') then Continue;
  364. vNode := FindBillsNode(sB_Code, sName, sUnits, fPrice);
  365. if Assigned(vNode) then
  366. begin
  367. vStageRec := ProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
  368. vStageRec.DealQuantity.AsFloat := StrToFloatDef(GetCellStr(vRow, FDealQuantityCol), 0);
  369. end
  370. else
  371. FFails.AddFailGcl(sB_Code, sName, sUnits, fPrice, StrToFloatDef(GetCellStr(vRow, FDealQuantityCol), 0));
  372. end;
  373. end;
  374. end.