DealBillsExcelImport.pas 7.0 KB

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