DealBillsExcelImport.pas 7.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293
  1. unit DealBillsExcelImport;
  2. // 导入签约清单
  3. interface
  4. uses
  5. DetailExcelImport, ProjectData, Classes, sdDB, OExport;
  6. type
  7. TDealBill = class
  8. private
  9. FB_Code: string;
  10. FName: string;
  11. FUnits: string;
  12. FPrice: Double;
  13. FQuantity: Double;
  14. FTotalPrice: Double;
  15. public
  16. property B_Code: string read FB_Code write FB_Code;
  17. property Name: string read FName write FName;
  18. property Units: string read FUnits write FUnits;
  19. property Price: Double read FPrice write FPrice;
  20. property Quantity: Double read FQuantity write FQuantity;
  21. property TotalPrice: Double read FTotalPrice write FTotalPrice;
  22. function IsParent(AChild: TDealBill): Boolean;
  23. end;
  24. TDealBillList = class
  25. private
  26. FList: TList;
  27. procedure ClearParent(ADealBill: TDealBill);
  28. function GetCount: Integer;
  29. function GetDealBills(AIndex: Integer): TDealBill;
  30. public
  31. constructor Create;
  32. destructor Destroy; override;
  33. procedure AddDealBill(ADealBill: TDealBill);
  34. property Count: Integer read GetCount;
  35. property DealBills[AIndex: Integer]: TDealBill read GetDealBills;
  36. end;
  37. TDealBillsExcelImport = class(TDetailExcelImport)
  38. private
  39. FDealBills: TDealBillList;
  40. FB_CodeCol: Integer;
  41. FNameCol: Integer;
  42. FUnitsCol: Integer;
  43. FPriceCol: Integer;
  44. FQuantityCol: Integer;
  45. FTotalPriceCol: Integer;
  46. FCurRow: Integer;
  47. function LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
  48. procedure LoadDealBills(ASheet: TExportWorkSheet);
  49. procedure WriteDealBills;
  50. protected
  51. procedure BeginImport; override;
  52. procedure EndImport; override;
  53. procedure Import; override;
  54. public
  55. constructor Create(AProjectData: TProjectData); override;
  56. destructor Destroy; override;
  57. end;
  58. implementation
  59. uses DateUtils, DealBillsDm, UtilMethods, SysUtils;
  60. { TDealBillsExcelImport }
  61. procedure TDealBillsExcelImport.BeginImport;
  62. begin
  63. ProjectData.DealBillsData.DisableEvent;
  64. ProjectData.DealBillsData.sddDealBills.BeginUpdate;
  65. end;
  66. constructor TDealBillsExcelImport.Create(AProjectData: TProjectData);
  67. begin
  68. inherited;
  69. FDealBills := TDealBillList.Create;
  70. end;
  71. destructor TDealBillsExcelImport.Destroy;
  72. begin
  73. FDealBills.Free;
  74. inherited;
  75. end;
  76. procedure TDealBillsExcelImport.EndImport;
  77. begin
  78. ProjectData.DealBillsData.sddDealBills.EndUpdate;
  79. ProjectData.DealBillsData.EnableEvent;
  80. end;
  81. procedure TDealBillsExcelImport.Import;
  82. begin
  83. FCurRow := 0;
  84. if LoadColumnsFromHead(OExport.OpenWorkSheet) then
  85. begin
  86. LoadDealBills(OExport.OpenWorkSheet);
  87. WriteDealBills;
  88. end
  89. else
  90. ErrorMessage('导入的Excel格式有误!');
  91. end;
  92. function TDealBillsExcelImport.LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
  93. var
  94. vRow: TExportRow;
  95. iCol: Integer;
  96. sColName: string;
  97. begin
  98. Result := False;
  99. FB_CodeCol := -1;
  100. FNameCol := -1;
  101. FUnitsCol := -1;
  102. FPriceCol := -1;
  103. FQuantityCol := -1;
  104. FTotalPriceCol := -1;
  105. while (not Result) and (FCurRow < ASheet.Rows.Count) do
  106. begin
  107. vRow := ASheet.Rows[FCurRow];
  108. for iCol := 0 to vRow.Cells.Count - 1 do
  109. begin
  110. sColName := GetCellTrimStr(vRow, iCol);
  111. sColName := StringReplace(sColName, ' ', '', [rfReplaceAll]);
  112. if SameText(sColName, '清单编号') or (Pos('子目号', sColName) > 0) then
  113. FB_CodeCol := iCol
  114. else if Pos('名称', sColName) > 0 then
  115. FNameCol := iCol
  116. else if SameText(sColName, '单位') then
  117. FUnitsCol := iCol
  118. else if Pos('单价', sColName) = 1 then
  119. FPriceCol := iCol
  120. else if Pos('数量', sColName) > 0 then
  121. FQuantityCol := iCol
  122. else if (Pos('金额', sColName) > 0) or (Pos('合价', sColName) > 0) then
  123. FTotalPriceCol := iCol;
  124. end;
  125. Result := (FB_CodeCol <> -1) and (FNameCol <> -1) and (FUnitsCol <> -1)
  126. and (FPriceCol <> -1) and (FQuantityCol <> -1) and (FTotalPriceCol <> -1);
  127. Inc(FCurRow);
  128. end;
  129. end;
  130. procedure TDealBillsExcelImport.LoadDealBills(ASheet: TExportWorkSheet);
  131. function CheckIsBillsCode(ACode: string): Boolean;
  132. const
  133. FBillsCodeSet: set of char = ['0'..'9', '-', 'a'..'z', 'A'..'Z'];
  134. var
  135. I: Integer;
  136. begin
  137. Result := True;
  138. I := 1;
  139. while I < Length(ACode) do
  140. if ACode[I] in FBillsCodeSet then
  141. Inc(I)
  142. else
  143. begin
  144. Result := False;
  145. Break;
  146. end;
  147. end;
  148. function FilterBillsCode(ACode: string): string;
  149. var
  150. I: Integer;
  151. begin
  152. Result := StringReplace(ACode, ' ', '', [rfReplaceAll]);
  153. Result := StringReplace(Result, ' ', '', [rfReplaceAll]);
  154. Result := StringReplace(Result, '补', '', [rfReplaceAll]);
  155. end;
  156. var
  157. vRow: TExportRow;
  158. sB_Code, sFilterB_Code: string;
  159. vDealBill: TDealBill;
  160. begin
  161. while (FCurRow < ASheet.Rows.Count) do
  162. begin
  163. vRow := ASheet.Rows[FCurRow];
  164. sB_Code := GetCellTrimStr(vRow, FB_CodeCol);
  165. sFilterB_Code := FilterBillsCode(sB_Code);
  166. if (sFilterB_Code <> '')then
  167. begin
  168. if CheckIsBillsCode(sFilterB_Code) then
  169. begin
  170. vDealBill := TDealBill.Create;
  171. vDealBill.B_Code := sB_Code;
  172. vDealBill.Name := GetCellTrimStr(vRow, FNameCol);
  173. vDealBill.Units := GetCellTrimStr(vRow, FUnitsCol);
  174. vDealBill.Price := GetCellFloat(vRow, FPriceCol);
  175. vDealBill.Quantity := GetCellFloat(vRow, FQuantityCol);
  176. vDealBill.TotalPrice := GetCellFloat(vRow, FTotalPriceCol);
  177. FDealBills.AddDealBill(vDealBill);
  178. end;
  179. end;
  180. Inc(FCurRow);
  181. end;
  182. end;
  183. procedure TDealBillsExcelImport.WriteDealBills;
  184. var
  185. i: Integer;
  186. vDealBill: TDealBill;
  187. Rec: TsdDataRecord;
  188. begin
  189. with ProjectData.DealBillsData do
  190. begin
  191. Clear;
  192. for i := 0 to FDealBills.Count - 1 do
  193. begin
  194. vDealBill := FDealBills.DealBills[i];
  195. Rec := sddDealBills.Add;
  196. Rec.ValueByName('ID').AsInteger := i;
  197. Rec.ValueByName('B_Code').AsString := vDealBill.B_Code;
  198. Rec.ValueByName('IndexCode').AsString := B_CodeToIndexCode(vDealBill.B_Code);
  199. Rec.ValueByName('Name').AsString := vDealBill.Name;
  200. Rec.ValueByName('Units').AsString := vDealBill.Units;
  201. Rec.ValueByName('Price').AsFloat := PriceRoundTo(vDealBill.Price);
  202. Rec.ValueByName('Quantity').AsFloat := QuantityRoundTo(vDealBill.Quantity);
  203. Rec.ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(vDealBill.TotalPrice);
  204. end;
  205. end;
  206. end;
  207. { TDealBill }
  208. function TDealBill.IsParent(AChild: TDealBill): Boolean;
  209. begin
  210. Result := Pos(B_Code+'-', AChild.B_Code) = 1;
  211. end;
  212. { TDealBillList }
  213. procedure TDealBillList.AddDealBill(ADealBill: TDealBill);
  214. begin
  215. ClearParent(ADealBill);
  216. FList.Add(ADealBill);
  217. end;
  218. procedure TDealBillList.ClearParent(ADealBill: TDealBill);
  219. var
  220. i: Integer;
  221. vDealBill: TDealBill;
  222. begin
  223. for i := 0 to FList.Count - 1 do
  224. begin
  225. vDealBill := DealBills[i];
  226. if vDealBill.IsParent(ADealBill) then
  227. begin
  228. FList.Delete(i);
  229. vDealBill.Free;
  230. Break;
  231. end;
  232. end;
  233. end;
  234. constructor TDealBillList.Create;
  235. begin
  236. FList := TList.Create;
  237. end;
  238. destructor TDealBillList.Destroy;
  239. begin
  240. FList.Free;
  241. inherited;
  242. end;
  243. function TDealBillList.GetCount: Integer;
  244. begin
  245. Result := FList.Count;
  246. end;
  247. function TDealBillList.GetDealBills(AIndex: Integer): TDealBill;
  248. begin
  249. Result := TDealBill(FList.Items[AIndex]);
  250. end;
  251. end.