stgGclSubGatherFile.pas 11 KB

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