123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289 |
- unit DealBillsExcelImport;
- // 导入签约清单
- interface
- uses
- DetailExcelImport, ProjectData, Classes, sdDB;
- type
- TDealBill = class
- private
- FB_Code: string;
- FName: string;
- FUnits: string;
- FPrice: Double;
- FQuantity: Double;
- FTotalPrice: Double;
- public
- property B_Code: string read FB_Code write FB_Code;
- property Name: string read FName write FName;
- property Units: string read FUnits write FUnits;
- property Price: Double read FPrice write FPrice;
- property Quantity: Double read FQuantity write FQuantity;
- property TotalPrice: Double read FTotalPrice write FTotalPrice;
- function IsParent(AChild: TDealBill): Boolean;
- end;
- TDealBillList = class
- private
- FList: TList;
- procedure ClearParent(ADealBill: TDealBill);
- function GetCount: Integer;
- function GetDealBills(AIndex: Integer): TDealBill;
- public
- constructor Create;
- destructor Destroy; override;
- procedure AddDealBill(ADealBill: TDealBill);
- property Count: Integer read GetCount;
- property DealBills[AIndex: Integer]: TDealBill read GetDealBills;
- end;
- TDealBillsExcelImport = class(TDetailExcelImport)
- private
- FDealBills: TDealBillList;
- FB_CodeCol: Integer;
- FNameCol: Integer;
- FUnitsCol: Integer;
- FPriceCol: Integer;
- FQuantityCol: Integer;
- FTotalPriceCol: Integer;
- FCurRow: Integer;
- function LoadColumnsFromHead: Boolean;
- procedure LoadDealBills;
- procedure WriteDealBills;
- protected
- procedure BeginImport; override;
- procedure EndImport; override;
- procedure Import; override;
- public
- constructor Create(AProjectData: TProjectData); override;
- destructor Destroy; override;
- end;
- implementation
- uses DateUtils, DealBillsDm, UtilMethods, SysUtils;
- { TDealBillsExcelImport }
- procedure TDealBillsExcelImport.BeginImport;
- begin
- ProjectData.DealBillsData.DisableEvent;
- ProjectData.DealBillsData.sddDealBills.BeginUpdate;
- end;
- constructor TDealBillsExcelImport.Create(AProjectData: TProjectData);
- begin
- inherited;
- FDealBills := TDealBillList.Create;
- end;
- destructor TDealBillsExcelImport.Destroy;
- begin
- FDealBills.Free;
- inherited;
- end;
- procedure TDealBillsExcelImport.EndImport;
- begin
- ProjectData.DealBillsData.sddDealBills.EndUpdate;
- ProjectData.DealBillsData.EnableEvent;
- end;
- procedure TDealBillsExcelImport.Import;
- begin
- FCurRow := 1;
- if LoadColumnsFromHead then
- begin
- LoadDealBills;
- WriteDealBills;
- end
- else
- ErrorMessage('导入的Excel格式有误!');
- end;
- function TDealBillsExcelImport.LoadColumnsFromHead: Boolean;
- var
- iCol: Integer;
- sColName: string;
- begin
- Result := False;
- FB_CodeCol := -1;
- FNameCol := -1;
- FUnitsCol := -1;
- FPriceCol := -1;
- FQuantityCol := -1;
- FTotalPriceCol := -1;
- while (not Result) and (FCurRow <= Excel.XlsFile.MaxRow) do
- begin
- for iCol := 1 to Excel.XlsFile.MaxCol do
- begin
- sColName := GetCellValue(Excel.XlsFile, FCurRow, iCol);
- sColName := StringReplace(sColName, ' ', '', [rfReplaceAll]);
- if SameText(sColName, '清单编号') or (Pos('子目号', sColName) > 0) then
- FB_CodeCol := iCol
- else if Pos('名称', sColName) > 0 then
- FNameCol := iCol
- else if SameText(sColName, '单位') then
- FUnitsCol := iCol
- else if Pos('单价', sColName) = 1 then
- FPriceCol := iCol
- else if Pos('数量', sColName) > 0 then
- FQuantityCol := iCol
- else if (Pos('金额', sColName) > 0) or (Pos('合价', sColName) > 0) then
- FTotalPriceCol := iCol;
- end;
- Result := (FB_CodeCol <> -1) and (FNameCol <> -1) and (FUnitsCol <> -1)
- and (FPriceCol <> -1) and (FQuantityCol <> -1) and (FTotalPriceCol <> -1);
- Inc(FCurRow);
- end;
- end;
- procedure TDealBillsExcelImport.LoadDealBills;
- function CheckIsBillsCode(ACode: string): Boolean;
- const
- FBillsCodeSet: set of char = ['0'..'9', '-', 'a'..'z', 'A'..'Z'];
- var
- I: Integer;
- begin
- Result := True;
- I := 1;
- while I < Length(ACode) do
- if ACode[I] in FBillsCodeSet then
- Inc(I)
- else
- begin
- Result := False;
- Break;
- end;
- end;
- function FilterBillsCode(ACode: string): string;
- var
- I: Integer;
- begin
- Result := StringReplace(ACode, ' ', '', [rfReplaceAll]);
- Result := StringReplace(Result, ' ', '', [rfReplaceAll]);
- Result := StringReplace(Result, '补', '', [rfReplaceAll]);
- end;
- var
- sB_Code, sFilterB_Code: string;
- vDealBill: TDealBill;
- begin
- while (FCurRow <= Excel.XlsFile.MaxRow) do
- begin
- sB_Code := GetCellTrimStr(Excel.XlsFile, FCurRow, FB_CodeCol);
- sFilterB_Code := FilterBillsCode(sB_Code);
- if (sFilterB_Code <> '')then
- begin
- if CheckIsBillsCode(sFilterB_Code) then
- begin
- vDealBill := TDealBill.Create;
- vDealBill.B_Code := sB_Code;
- vDealBill.Name := GetCellTrimStr(Excel.XlsFile, FCurRow, FNameCol);
- vDealBill.Units := GetCellTrimStr(Excel.XlsFile, FCurRow, FUnitsCol);
- vDealBill.Price := GetCellFloat(Excel.XlsFile, FCurRow, FPriceCol);
- vDealBill.Quantity := GetCellFloat(Excel.XlsFile, FCurRow, FQuantityCol);
- vDealBill.TotalPrice := GetCellFloat(Excel.XlsFile, FCurRow, FTotalPriceCol);
- FDealBills.AddDealBill(vDealBill);
- end;
- end;
- Inc(FCurRow);
- end;
- end;
- procedure TDealBillsExcelImport.WriteDealBills;
- var
- i: Integer;
- vDealBill: TDealBill;
- Rec: TsdDataRecord;
- begin
- with ProjectData.DealBillsData do
- begin
- Clear;
- for i := 0 to FDealBills.Count - 1 do
- begin
- vDealBill := FDealBills.DealBills[i];
- Rec := sddDealBills.Add;
- Rec.ValueByName('ID').AsInteger := i;
- Rec.ValueByName('B_Code').AsString := vDealBill.B_Code;
- Rec.ValueByName('IndexCode').AsString := B_CodeToIndexCode(vDealBill.B_Code);
- Rec.ValueByName('Name').AsString := vDealBill.Name;
- Rec.ValueByName('Units').AsString := vDealBill.Units;
- Rec.ValueByName('Price').AsFloat := PriceRoundTo(vDealBill.Price);
- Rec.ValueByName('Quantity').AsFloat := QuantityRoundTo(vDealBill.Quantity);
- Rec.ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(vDealBill.TotalPrice);
- end;
- end;
- end;
- { TDealBill }
- function TDealBill.IsParent(AChild: TDealBill): Boolean;
- begin
- Result := Pos(B_Code+'-', AChild.B_Code) = 1;
- end;
- { TDealBillList }
- procedure TDealBillList.AddDealBill(ADealBill: TDealBill);
- begin
- ClearParent(ADealBill);
- FList.Add(ADealBill);
- end;
- procedure TDealBillList.ClearParent(ADealBill: TDealBill);
- var
- i: Integer;
- vDealBill: TDealBill;
- begin
- for i := 0 to FList.Count - 1 do
- begin
- vDealBill := DealBills[i];
- if vDealBill.IsParent(ADealBill) then
- begin
- FList.Delete(i);
- vDealBill.Free;
- Break;
- end;
- end;
- end;
- constructor TDealBillList.Create;
- begin
- FList := TList.Create;
- end;
- destructor TDealBillList.Destroy;
- begin
- FList.Free;
- inherited;
- end;
- function TDealBillList.GetCount: Integer;
- begin
- Result := FList.Count;
- end;
- function TDealBillList.GetDealBills(AIndex: Integer): TDealBill;
- begin
- Result := TDealBill(FList.Items[AIndex]);
- end;
- end.
|