123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771 |
- unit DetailExcelImport;
- interface
- uses
- Classes, ProjectData, ScXlsOutput, MCacheTree, XLSAdapter, sdDB,
- Variants, Forms, Controls;
- type
- TDetailExcelImport = class
- private
- FProjectData: TProjectData;
- FTempFile: string;
- FExcel: TXlsOutPut;
- protected
- function GetCellValue(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
- function GetCellValueFormat(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
- function GetCellTrimStr(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
- function GetCellFloat(AXlsFile: TXLSFile; ARow, ACol: Integer): Double;
- procedure BeginImport; virtual; abstract;
- procedure EndImport; virtual; abstract;
- procedure Import; virtual; abstract;
- public
- constructor Create(AProjectData: TProjectData); virtual;
- destructor Destroy; override;
- procedure ImportFile(const AFileName: string);
- property ProjectData: TProjectData read FProjectData;
- property Excel: TXlsOutPut read FExcel;
- end;
- // 平面分项清单格式导入,导入至某项目节节点之下
- TPlaneFxBillsExcelImport = class(TDetailExcelImport)
- private
- FParentID: Integer;
- FCacheTree: TBillsCacheTree;
- FCurRow: Integer;
- FXmjLevel1Col: Integer;
- FXmjLevel2Col: Integer;
- FXmjLevel3Col: Integer;
- FXmjLevel4Col: Integer;
- FXmjLevel5Col: Integer;
- FXmjLevel6Col: Integer;
- FXmjLevel7Col: Integer;
- FB_CodeCol: Integer;
- FNameCol: Integer;
- FUnitCol: Integer;
- FQuantityCol: Integer;
- FPriceCol: Integer;
- FDrawingCol: Integer;
- FMemoCol: Integer;
- procedure LoadXmjLevel1(AXlsFile: TXLSFile);
- procedure LoadXmjLevel2(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
- procedure LoadXmjLevel3(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
- procedure LoadXmjLevel4(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
- procedure LoadXmjLevel5(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
- procedure LoadXmjLevel6(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
- procedure LoadXmjLevel7(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
- procedure LoadBillsNode(AXlsFile: TXLSFile; AXmj: TBillsCacheNode);
- function LoadColumnsFromHead(AXlsFile: TXlsFile): Boolean;
- procedure LoadFxBills(AXlsFile: TXLSFile);
- procedure WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode);
- procedure WriteNodes(ADataSet: TsdDataSet);
- protected
- procedure BeginImport; override;
- procedure EndImport; override;
- procedure Import; override;
- public
- property ParentID: Integer read FParentID write FParentID;
- end;
- // 清单单价
- TBillsPriceExcelImport = class(TDetailExcelImport)
- private
- FCurRow: Integer;
- FB_CodeCol: Integer;
- FNameCol: Integer;
- FPriceCol: Integer;
- procedure BeginImport; override;
- procedure EndImport; override;
- procedure LoadColumnsFromHead;
- procedure UpdateBillsPrice(const AB_Code: string; APrice: Double);
- procedure ImportBillsPriceData;
- procedure Import; override;
- end;
- implementation
- uses
- UtilMethods, SysUtils, ZhAPI, SheetSelectFrm, UExcelAdapter, UFlxMessages,
- UFlxFormats, ProgressHintFrm, mDataRecord;
- { TDetailExcelImport }
- constructor TDetailExcelImport.Create(AProjectData: TProjectData);
- begin
- FProjectData := AProjectData;
- FTempFile := GetTempFileName;
- end;
- destructor TDetailExcelImport.Destroy;
- begin
- if FileExists(FTempFile) then
- DeleteFile(FTempFile);
- inherited;
- end;
- function TDetailExcelImport.GetCellFloat(AXlsFile: TXLSFile; ARow,
- ACol: Integer): Double;
- begin
- Result := StrToFloatDef(GetCellTrimStr(AXlsFile, ARow, ACol), 0);
- end;
- function TDetailExcelImport.GetCellTrimStr(AXlsFile: TXLSFile; ARow,
- ACol: Integer): string;
- begin
- Result := Trim(GetCellValue(AXlsFile, ARow, ACol));
- end;
- function TDetailExcelImport.GetCellValue(AXlsFile: TXLSFile; ARow,
- ACol: Integer): string;
- var
- xlsCell: TXlsCellValue;
- begin
- Result := '';
- if not Assigned(AXlsFile) or (ARow = -1) or (ACol = -1) then Exit;
- xlsCell := AXlsFile.CellValueX[ARow, ACol];
- Result := VarToStrDef(xlsCell.Value, '');
- end;
- function TDetailExcelImport.GetCellValueFormat(AXlsFile: TXLSFile; ARow,
- ACol: Integer): string;
- function GetDigit(AFormat: WideString): Integer;
- var
- I: Integer;
- bDigit: Boolean;
- begin
- Result := 0;
- bDigit := False;
- for I := 1 to Length(AFormat) do
- begin
- if AFormat[I] = '.' then
- begin
- if bDigit then Break
- else bDigit := True;
- end
- else if AFormat[I] = ';' then Break
- else if bDigit and (AFormat[I] = '0') then
- Dec(Result);
- end;
- end;
- function FormatNum(AValue: Variant; AFormat: WideString): string;
- begin
- Result := AValue;
- if not VarIsNull(AValue) then
- begin
- if CheckNumeric(Result) then
- begin
- if Pos('%', AFormat) <> 0 then AValue := AValue * 100;
- if AFormat <> '' then
- Result := FloatToStr(AdvRoundTo(AValue, GetDigit(AFormat)))
- else
- Result := FloatToStr(AdvRoundTo(AValue, -2));
- if Pos('%', AFormat) <> 0 then Result := Result + '%';
- if AValue = '0' then Result := '';
- end;
- end;
- end;
- var
- xlsCell: TXlsCellValue;
- FlxFormat: TFlxFormat;
- begin
- Result := '';
- if not Assigned(AXlsFile) or (ARow = -1) or (ACol = -1) then Exit;
- xlsCell := AXlsFile.GetCellDataX(ARow, ACol);
- Result := xlsCell.Value;
- if xlsCell.XF <> -1 then
- begin
- FlxFormat := AXlsFile.FormatList[xlsCell.XF];
- Result := FormatNum(xlsCell.Value, FlxFormat.Format);
- end;
- end;
- procedure TDetailExcelImport.ImportFile(const AFileName: string);
- begin
- CopyFileOrFolder(AFileName, FTempFile);
- FExcel := TXlsOutPut.Create(FTempFile);
- BeginImport;
- try
- Import;
- finally
- EndImport;
- FExcel.Free;
- end;
- end;
- { TPlaneFxBillsExcelImport }
- procedure TPlaneFxBillsExcelImport.Import;
- begin
- FCurRow := 1;
- if LoadColumnsFromHead(FExcel.XlsFile) then
- begin
- LoadFxBills(FExcel.XlsFile);
- WriteNodes(FProjectData.BillsData.sddBills);
- end
- else
- ErrorMessage('导入的Excel格式有误!');
- end;
- procedure TPlaneFxBillsExcelImport.LoadBillsNode(AXlsFile: TXLSFile;
- AXmj: TBillsCacheNode);
- var
- sB_Code, sName, sUnits: string;
- vGclNode: TBillsCacheNode;
- fPrice: Double;
- begin
- sB_Code := Trim(GetCellValue(AXlsFile, FCurRow, FB_CodeCol));
- sName := Trim(GetCellValue(AXlsFile, FCurRow, FNameCol));
- sUnits := Trim(GetCellValue(AXlsFile, FCurRow, FUnitCol));
- fPrice := StrToFloatDef(GetCellValue(AXlsFile, FCurRow, FPriceCol), 0);
- if sB_Code <> '' then
- begin
- vGclNode := FCacheTree.FindGclChild(AXmj, sB_Code, sName, sUnits, fPrice);
- if not Assigned(vGclNode) then
- begin
- vGclNode := FCacheTree.AddNode(AXmj, nil);
- vGclNode.B_Code := sB_Code;
- vGclNode.Name := sName;
- vGclNode.Units := sUnits;
- vGclNode.Quantity := StrToFloatDef(GetCellValue(AXlsFile, FCurRow, FQuantityCol), 0);
- vGclNode.Price := fPrice;
- vGclNode.DrawingCode := Trim(GetCellValue(AXlsFile, FCurRow, FDrawingCol));
- vGclNode.MemoStr := Trim(GetCellValue(AXlsFile, FCurRow, FMemoCol));
- end
- else
- vGclNode.Quantity := vGclNode.Quantity + StrToFloatDef(GetCellValue(AXlsFile, FCurRow, FQuantityCol), 0);
- end;
- Inc(FCurRow);
- end;
- function TPlaneFxBillsExcelImport.LoadColumnsFromHead(AXlsFile: TXlsFile): Boolean;
- var
- iCol: Integer;
- sColName: string;
- begin
- Result := False;
- FXmjLevel1Col := -1;
- FXmjLevel2Col := -1;
- FXmjLevel3Col := -1;
- FXmjLevel4Col := -1;
- FXmjLevel5Col := -1;
- FXmjLevel6Col := -1;
- FXmjLevel7Col := -1;
- FB_CodeCol := -1;
- FNameCol := -1;
- FUnitCol := -1;
- FQuantityCol := -1;
- FPriceCol := -1;
- FDrawingCol := -1;
- FMemoCol := -1;
- UpdateProgressHint('正在识别Excel数据格式');
- UpdateProgressPosition(0);
- while not Result and (FCurRow <= AXlsFile.MaxRow) do
- begin
- for iCol := 1 to AXlsFile.MaxCol do
- begin
- sColName := Trim(GetCellValue(AXlsFile, FCurRow, iCol));
- if sColName = '第1层' then
- FXmjLevel1Col := iCol
- else if sColName = '第2层' then
- FXmjLevel2Col := iCol
- else if sColName = '第3层' then
- FXmjLevel3Col := iCol
- else if sColName = '第4层' then
- FXmjLevel4Col := iCol
- else if sColName = '第5层' then
- FXmjLevel5Col := iCol
- else if sColName = '第6层' then
- FXmjLevel6Col := iCol
- else if sColName = '第7层' then
- FXmjLevel7Col := iCol
- else if sColName = '清单号' then
- FB_CodeCol := iCol
- else if sColName = '清单名称' then
- FNameCol := iCol
- else if sColName = '单位' then
- FUnitCol := iCol
- else if sColName = '数量' then
- FQuantityCol := iCol
- else if sColName = '单价' then
- FPriceCol := iCol
- else if sColName = '图号' then
- FDrawingCol := iCol
- else if sColName = '备注' then
- FMemoCol := iCol
- end;
- Result := FXmjLevel1Col <> -1;
- Inc(FCurRow);
- end;
- end;
- procedure TPlaneFxBillsExcelImport.LoadFxBills(AXlsFile: TXLSFile);
- var
- iPos: Integer;
- begin
- UpdateProgressHint('正在解析平面台账数据');
- while FCurRow <= AXlsFile.MaxRow do
- begin
- iPos := FCurRow*100 div AXlsFile.MaxRow;
- UpdateProgressPosition(iPos);
- LoadXmjLevel1(AXlsFile);
- end;
- end;
- procedure TPlaneFxBillsExcelImport.LoadXmjLevel1(AXlsFile: TXLSFile);
- var
- sName: string;
- vXmj: TBillsCacheNode;
- iEndRow: Integer;
- begin
- sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel1Col));
- with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel1Col] do
- iEndRow := FCurRow + Bottom - Top;
- if sName <> '' then
- begin
- vXmj := FCacheTree.FindXmjChild(nil, '', sName);
- if not Assigned(vXmj) then
- begin
- vXmj := FCacheTree.AddNode(nil);
- vXmj.Name := sName;
- end;
- if FXmjLevel2Col <> -1 then
- begin
- while FCurRow <= iEndRow do
- LoadXmjLevel2(AXlsFile, vXmj);
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, vXmj);
- end;
- end
- else
- Inc(FCurRow);
- end;
- procedure TPlaneFxBillsExcelImport.LoadXmjLevel2(AXlsFile: TXLSFile;
- AParent: TBillsCacheNode);
- var
- sName: string;
- vXmj: TBillsCacheNode;
- iEndRow: Integer;
- begin
- sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel2Col));
- with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel2Col] do
- iEndRow := FCurRow + Bottom - Top;
- if sName <> '' then
- begin
- vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
- if not Assigned(vXmj) then
- begin
- vXmj := FCacheTree.AddNode(AParent);
- vXmj.Name := sName;
- end;
- if FXmjLevel3Col <> -1 then
- begin
- while FCurRow <= iEndRow do
- LoadXmjLevel3(AXlsFile, vXmj);
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, vXmj);
- end;
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, AParent);
- end;
- end;
- procedure TPlaneFxBillsExcelImport.LoadXmjLevel3(AXlsFile: TXLSFile;
- AParent: TBillsCacheNode);
- var
- sName: string;
- vXmj: TBillsCacheNode;
- iEndRow: Integer;
- begin
- sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel3Col));
- with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel3Col] do
- iEndRow := FCurRow + Bottom - Top;
- if sName <> '' then
- begin
- vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
- if not Assigned(vXmj) then
- begin
- vXmj := FCacheTree.AddNode(AParent);
- vXmj.Name := sName;
- end;
- if FXmjLevel4Col <> -1 then
- begin
- while FCurRow <= iEndRow do
- LoadXmjLevel4(AXlsFile, vXmj);
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, vXmj);
- end;
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, AParent);
- end;
- end;
- procedure TPlaneFxBillsExcelImport.LoadXmjLevel4(AXlsFile: TXLSFile;
- AParent: TBillsCacheNode);
- var
- sName: string;
- vXmj: TBillsCacheNode;
- iEndRow: Integer;
- begin
- sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel4Col));
- with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel4Col] do
- iEndRow := FCurRow + Bottom - Top;
- if sName <> '' then
- begin
- vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
- if not Assigned(vXmj) then
- begin
- vXmj := FCacheTree.AddNode(AParent);
- vXmj.Name := sName;
- end;
- if FXmjLevel5Col <> -1 then
- begin
- while FCurRow <= iEndRow do
- LoadXmjLevel5(AXlsFile, vXmj);
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, vXmj);
- end;
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, AParent);
- end;
- end;
- procedure TPlaneFxBillsExcelImport.LoadXmjLevel5(AXlsFile: TXLSFile;
- AParent: TBillsCacheNode);
- var
- sName: string;
- vXmj: TBillsCacheNode;
- iEndRow: Integer;
- begin
- sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel5Col));
- with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel5Col] do
- iEndRow := FCurRow + Bottom - Top;
- if sName <> '' then
- begin
- vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
- if not Assigned(vXmj) then
- begin
- vXmj := FCacheTree.AddNode(AParent);
- vXmj.Name := sName;
- end;
- if FXmjLevel6Col <> -1 then
- begin
- while FCurRow <= iEndRow do
- LoadXmjLevel6(AXlsFile, vXmj);
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, vXmj);
- end;
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, AParent);
- end;
- end;
- procedure TPlaneFxBillsExcelImport.LoadXmjLevel6(AXlsFile: TXLSFile;
- AParent: TBillsCacheNode);
- var
- sName: string;
- vXmj: TBillsCacheNode;
- iEndRow: Integer;
- begin
- sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel6Col));
- with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel6Col] do
- iEndRow := FCurRow + Bottom - Top;
- if sName <> '' then
- begin
- vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
- if not Assigned(vXmj) then
- begin
- vXmj := FCacheTree.AddNode(AParent);
- vXmj.Name := sName;
- end;
- if FXmjLevel7Col <> -1 then
- begin
- while FCurRow <= iEndRow do
- LoadXmjLevel7(AXlsFile, vXmj);
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, vXmj);
- end;
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, AParent);
- end;
- end;
- procedure TPlaneFxBillsExcelImport.LoadXmjLevel7(AXlsFile: TXLSFile;
- AParent: TBillsCacheNode);
- var
- sName: string;
- vXmj: TBillsCacheNode;
- iEndRow: Integer;
- begin
- sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel7Col));
- if sName <> '' then
- begin
- vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
- if not Assigned(vXmj) then
- begin
- vXmj := FCacheTree.AddNode(AParent);
- vXmj.Name := sName;
- end;
- with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel7Col] do
- iEndRow := FCurRow + Bottom - Top;
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, vXmj);
- end
- else
- begin
- while FCurRow <= iEndRow do
- LoadBillsNode(AXlsFile, AParent);
- end;
- end;
- procedure TPlaneFxBillsExcelImport.WriteNodes(ADataSet: TsdDataSet);
- var
- i, iPos: Integer;
- begin
- UpdateProgressHint('写入读取的Excel数据');
- UpdateProgressPosition(0);
- for i := 0 to FCacheTree.CacheNodes.Count - 1 do
- begin
- WriteNode(ADataSet, TBillsCacheNode(FCacheTree.CacheNodes[i]));
- iPos := i*100 div FCacheTree.CacheNodes.Count;
- UpdateProgressPosition(iPos);
- end;
- UpdateProgressPosition(100);
- end;
- procedure TPlaneFxBillsExcelImport.WriteNode(ADataSet: TsdDataSet;
- ANode: TBillsCacheNode);
- var
- Rec: TsdDataRecord;
- begin
- if ANode.B_Code <> '' then
- UpdateProgressHint('写入读取的Excel数据 ' + ANode.B_Code)
- else
- UpdateProgressHint('写入读取的Excel数据 ' + ANode.Name);
- Rec := ADataSet.Add;
- Rec.ValueByName('ID').AsInteger := ANode.ID;
- if ANode.ParentID = -1 then
- Rec.ValueByName('ParentID').AsInteger := ParentID
- else
- Rec.ValueByName('ParentID').AsInteger := ANode.ParentID;
- Rec.ValueByName('NextSiblingID').AsInteger := ANode.NextSiblingID;
- Rec.ValueByName('B_Code').AsString := ANode.B_Code;
- Rec.ValueByName('Name').AsString := ANode.Name;
- Rec.ValueByName('Units').AsString := ANode.Units;
- Rec.ValueByName('Price').AsFloat := PriceRoundTo(ANode.Price);
- Rec.ValueByName('OrgQuantity').AsFloat := QuantityRoundTo(ANode.Quantity);
- Rec.ValueByName('DrawingCode').AsString := ANode.DrawingCode;
- Rec.ValueByName('MemoStr').AsString := ANode.MemoStr;
- // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单
- if FProjectData.ProjProperties.PhaseCount > 0 then
- Rec.ValueByName('IsMeasureAdd').AsBoolean := not FProjectData.CanUnlockInfo;
- end;
- procedure TPlaneFxBillsExcelImport.BeginImport;
- begin
- Screen.Cursor := crHourGlass;
- ShowProgressHint('导入Excel数据', 100);
- FCacheTree := TBillsCacheTree.Create;
- FCacheTree.NewNodeID := FProjectData.BillsData.GetMaxBillsID + 1;
- FProjectData.DisConnectTree;
- FProjectData.BillsData.DisableEvents;
- end;
- procedure TPlaneFxBillsExcelImport.EndImport;
- var
- ParentRec: TsdDataRecord;
- begin
- FCacheTree.Free;
- FProjectData.BillsData.EnableEvents;
- FProjectData.ReConnectTree;
- ParentRec := FProjectData.BillsData.sddBills.FindKey('idxID', ParentID);
- FProjectData.BillsCompileData.sdvBillsCompile.LocateInControl(ParentRec);
- FProjectData.BillsCompileData.CalculateAll;
- CloseProgressHint;
- Screen.Cursor := crDefault;
- end;
- { TBillsPriceExcelImport }
- procedure TBillsPriceExcelImport.BeginImport;
- begin
- ShowProgressHint('导入Excel清单单价', 100);
- FProjectData.BillsData.sddBills.BeginUpdate;
- FCurRow := 1;
- end;
- procedure TBillsPriceExcelImport.EndImport;
- begin
- FProjectData.BillsData.sddBills.EndUpdate;
- UpdateProgressHint('正在计算导入后的数据');
- FProjectData.BillsCompileData.CalculateAll;
- CloseProgressHint;
- end;
- procedure TBillsPriceExcelImport.Import;
- begin
- LoadColumnsFromHead;
- ImportBillsPriceData;
- end;
- procedure TBillsPriceExcelImport.ImportBillsPriceData;
- 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;
- var
- iPos: Integer;
- sB_Code: string;
- fPrice: Double;
- begin
- UpdateProgressHint('写入读取的Excel数据');
- UpdateProgressPosition(0);
- while (FCurRow <= Excel.XlsFile.MaxRow) do
- begin
- sB_Code := GetCellTrimStr(Excel.XlsFile, FCurRow, FB_CodeCol);
- if (sB_Code <> '') and CheckIsBillsCode(sB_Code) then
- begin
- fPrice := GetCellFloat(Excel.XlsFile, FCurRow, FPriceCol);
- UpdateBillsPrice(sB_Code, fPrice);
- end;
- Inc(FCurRow);
- iPos := FCurRow * 100 div Excel.XlsFile.MaxRow;
- UpdateProgressPosition(iPos);
- end;
- UpdateProgressPosition(100);
- end;
- procedure TBillsPriceExcelImport.LoadColumnsFromHead;
- var
- iCol: Integer;
- sColName: string;
- begin
- FB_CodeCol := -1;
- FNameCol := -1;
- FPriceCol := -1;
- while ((FB_CodeCol = -1) or (FPriceCol = -1)) and (FCurRow <= Excel.XlsFile.MaxRow) do
- begin
- for iCol := 1 to Excel.XlsFile.MaxCol do
- begin
- sColName := GetCellTrimStr(Excel.XlsFile, FCurRow, iCol);
- if SameText(sColName, '清单编号') or SameText(sColName, '子目号') then
- FB_CodeCol := iCol
- else if SameText(sColName, '名称') then
- FNameCol := iCol
- else if Pos('单价', sColName) = 1 then
- FPriceCol := iCol;
- end;
- Inc(FCurRow);
- end;
- end;
- procedure TBillsPriceExcelImport.UpdateBillsPrice(const AB_Code: string;
- APrice: Double);
- var
- iIndex: Integer;
- Rec: TBillsRecord;
- begin
- with FProjectData.BillsData do
- begin
- for iIndex := 0 to sddBills.RecordCount - 1 do
- begin
- Rec := TBillsRecord(sddBills.Records[iIndex]);
- if SameText(AB_Code, Rec.B_Code.AsString) then
- Rec.Price.AsFloat := PriceRoundTo(APrice);
- end;
- end;
- end;
- end.
|