DealBillsExcelImport.pas 7.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289
  1. unit DealBillsExcelImport;
  2. // 导入签约清单
  3. interface
  4. uses
  5. DetailExcelImport, ProjectData, Classes, sdDB;
  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: Boolean;
  48. procedure LoadDealBills;
  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 := 1;
  84. if LoadColumnsFromHead then
  85. begin
  86. LoadDealBills;
  87. WriteDealBills;
  88. end
  89. else
  90. ErrorMessage('导入的Excel格式有误!');
  91. end;
  92. function TDealBillsExcelImport.LoadColumnsFromHead: Boolean;
  93. var
  94. iCol: Integer;
  95. sColName: string;
  96. begin
  97. Result := False;
  98. FB_CodeCol := -1;
  99. FNameCol := -1;
  100. FUnitsCol := -1;
  101. FPriceCol := -1;
  102. FQuantityCol := -1;
  103. FTotalPriceCol := -1;
  104. while (not Result) and (FCurRow <= Excel.XlsFile.MaxRow) do
  105. begin
  106. for iCol := 1 to Excel.XlsFile.MaxCol do
  107. begin
  108. sColName := GetCellValue(Excel.XlsFile, FCurRow, iCol);
  109. sColName := StringReplace(sColName, ' ', '', [rfReplaceAll]);
  110. if SameText(sColName, '清单编号') or (Pos('子目号', sColName) > 0) then
  111. FB_CodeCol := iCol
  112. else if Pos('名称', sColName) > 0 then
  113. FNameCol := iCol
  114. else if SameText(sColName, '单位') then
  115. FUnitsCol := iCol
  116. else if Pos('单价', sColName) = 1 then
  117. FPriceCol := iCol
  118. else if Pos('数量', sColName) > 0 then
  119. FQuantityCol := iCol
  120. else if (Pos('金额', sColName) > 0) or (Pos('合价', sColName) > 0) then
  121. FTotalPriceCol := iCol;
  122. end;
  123. Result := (FB_CodeCol <> -1) and (FNameCol <> -1) and (FUnitsCol <> -1)
  124. and (FPriceCol <> -1) and (FQuantityCol <> -1) and (FTotalPriceCol <> -1);
  125. Inc(FCurRow);
  126. end;
  127. end;
  128. procedure TDealBillsExcelImport.LoadDealBills;
  129. function CheckIsBillsCode(ACode: string): Boolean;
  130. const
  131. FBillsCodeSet: set of char = ['0'..'9', '-', 'a'..'z', 'A'..'Z'];
  132. var
  133. I: Integer;
  134. begin
  135. Result := True;
  136. I := 1;
  137. while I < Length(ACode) do
  138. if ACode[I] in FBillsCodeSet then
  139. Inc(I)
  140. else
  141. begin
  142. Result := False;
  143. Break;
  144. end;
  145. end;
  146. function FilterBillsCode(ACode: string): string;
  147. var
  148. I: Integer;
  149. begin
  150. Result := StringReplace(ACode, ' ', '', [rfReplaceAll]);
  151. Result := StringReplace(Result, ' ', '', [rfReplaceAll]);
  152. Result := StringReplace(Result, '补', '', [rfReplaceAll]);
  153. end;
  154. var
  155. sB_Code, sFilterB_Code: string;
  156. vDealBill: TDealBill;
  157. begin
  158. while (FCurRow <= Excel.XlsFile.MaxRow) do
  159. begin
  160. sB_Code := GetCellTrimStr(Excel.XlsFile, FCurRow, FB_CodeCol);
  161. sFilterB_Code := FilterBillsCode(sB_Code);
  162. if (sFilterB_Code <> '')then
  163. begin
  164. if CheckIsBillsCode(sFilterB_Code) then
  165. begin
  166. vDealBill := TDealBill.Create;
  167. vDealBill.B_Code := sB_Code;
  168. vDealBill.Name := GetCellTrimStr(Excel.XlsFile, FCurRow, FNameCol);
  169. vDealBill.Units := GetCellTrimStr(Excel.XlsFile, FCurRow, FUnitsCol);
  170. vDealBill.Price := GetCellFloat(Excel.XlsFile, FCurRow, FPriceCol);
  171. vDealBill.Quantity := GetCellFloat(Excel.XlsFile, FCurRow, FQuantityCol);
  172. vDealBill.TotalPrice := GetCellFloat(Excel.XlsFile, FCurRow, FTotalPriceCol);
  173. FDealBills.AddDealBill(vDealBill);
  174. end;
  175. end;
  176. Inc(FCurRow);
  177. end;
  178. end;
  179. procedure TDealBillsExcelImport.WriteDealBills;
  180. var
  181. i: Integer;
  182. vDealBill: TDealBill;
  183. Rec: TsdDataRecord;
  184. begin
  185. with ProjectData.DealBillsData do
  186. begin
  187. Clear;
  188. for i := 0 to FDealBills.Count - 1 do
  189. begin
  190. vDealBill := FDealBills.DealBills[i];
  191. Rec := sddDealBills.Add;
  192. Rec.ValueByName('ID').AsInteger := i;
  193. Rec.ValueByName('B_Code').AsString := vDealBill.B_Code;
  194. Rec.ValueByName('IndexCode').AsString := B_CodeToIndexCode(vDealBill.B_Code);
  195. Rec.ValueByName('Name').AsString := vDealBill.Name;
  196. Rec.ValueByName('Units').AsString := vDealBill.Units;
  197. Rec.ValueByName('Price').AsFloat := PriceRoundTo(vDealBill.Price);
  198. Rec.ValueByName('Quantity').AsFloat := QuantityRoundTo(vDealBill.Quantity);
  199. Rec.ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(vDealBill.TotalPrice);
  200. end;
  201. end;
  202. end;
  203. { TDealBill }
  204. function TDealBill.IsParent(AChild: TDealBill): Boolean;
  205. begin
  206. Result := Pos(B_Code+'-', AChild.B_Code) = 1;
  207. end;
  208. { TDealBillList }
  209. procedure TDealBillList.AddDealBill(ADealBill: TDealBill);
  210. begin
  211. ClearParent(ADealBill);
  212. FList.Add(ADealBill);
  213. end;
  214. procedure TDealBillList.ClearParent(ADealBill: TDealBill);
  215. var
  216. i: Integer;
  217. vDealBill: TDealBill;
  218. begin
  219. for i := 0 to FList.Count - 1 do
  220. begin
  221. vDealBill := DealBills[i];
  222. if vDealBill.IsParent(ADealBill) then
  223. begin
  224. FList.Delete(i);
  225. vDealBill.Free;
  226. Break;
  227. end;
  228. end;
  229. end;
  230. constructor TDealBillList.Create;
  231. begin
  232. FList := TList.Create;
  233. end;
  234. destructor TDealBillList.Destroy;
  235. begin
  236. FList.Free;
  237. inherited;
  238. end;
  239. function TDealBillList.GetCount: Integer;
  240. begin
  241. Result := FList.Count;
  242. end;
  243. function TDealBillList.GetDealBills(AIndex: Integer): TDealBill;
  244. begin
  245. Result := TDealBill(FList.Items[AIndex]);
  246. end;
  247. end.