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.