unit DetailExcelImport; interface uses Classes, ProjectData, ScXlsOutput, MCacheTree, XLSAdapter, sdDB, Variants, Forms, Controls, OExport, OExport_VclForms; type TDetailExcelImport = class private FProjectData: TProjectData; FOExport: TOExport; protected function GetCellStr(ASheet: TExportWorkSheet; ARow, ACol: Integer): string; overload; function GetCellStr(ARow: TExportRow; ACol: Integer): string; overload; function GetCellTrimStr(ARow: TExportRow; ACol: Integer): string; function GetCellFloat(ARow: TExportRow; 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 OExport: TOExport read FOExport; 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(ASheet: TExportWorkSheet); procedure LoadXmjLevel2(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); procedure LoadXmjLevel3(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); procedure LoadXmjLevel4(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); procedure LoadXmjLevel5(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); procedure LoadXmjLevel6(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); procedure LoadXmjLevel7(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); procedure LoadBillsNode(ASheet: TExportWorkSheet; AXmj: TBillsCacheNode); function LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean; procedure LoadFxBills(ASheet: TExportWorkSheet); 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(ASheet: TExportWorkSheet); procedure UpdateBillsPrice(const AB_Code: string; APrice: Double); procedure ImportBillsPriceData(ASheet: TExportWorkSheet); procedure Import; override; end; implementation uses UtilMethods, SysUtils, ZhAPI, SheetSelectFrm, UExcelAdapter, UFlxMessages, UFlxFormats, ProgressHintFrm, mDataRecord; { TDetailExcelImport } constructor TDetailExcelImport.Create(AProjectData: TProjectData); begin FProjectData := AProjectData; FOExport := TOExport.Create; FOExport.UseProgress := False; end; destructor TDetailExcelImport.Destroy; begin FOExport.Free; inherited; end; function TDetailExcelImport.GetCellFloat(ARow: TExportRow; ACol: Integer): Double; begin Result := StrToFloatDef(GetCellTrimStr(ARow, ACol), 0); end; function TDetailExcelImport.GetCellStr(ARow: TExportRow; ACol: Integer): string; begin if (ACol < ARow.Cells.Count) and (ACol >= 0) then Result := ARow.Cells[ACol].SqlText else Result := ''; end; function TDetailExcelImport.GetCellStr(ASheet: TExportWorkSheet; ARow, ACol: Integer): string; begin if ARow < ASheet.Rows.Count then Result := GetCellStr(ASheet.Rows[ARow], ACol) else Result := ''; end; function TDetailExcelImport.GetCellTrimStr(ARow: TExportRow; ACol: Integer): string; begin Result := Trim(GetCellStr(ARow, ACol)); end; procedure TDetailExcelImport.ImportFile(const AFileName: string); begin BeginImport; try FOExport.LoadFromFile(AFileName); Import; finally EndImport; end; end; { TPlaneFxBillsExcelImport } procedure TPlaneFxBillsExcelImport.Import; begin FCurRow := 0; if LoadColumnsFromHead(FOExport.OpenWorkSheet) then begin LoadFxBills(FOExport.OpenWorkSheet); WriteNodes(FProjectData.BillsData.sddBills); end else ErrorMessage('导入的Excel格式有误!'); end; procedure TPlaneFxBillsExcelImport.LoadBillsNode(ASheet: TExportWorkSheet; AXmj: TBillsCacheNode); var vRow: TExportRow; sB_Code, sName, sUnits: string; vGclNode: TBillsCacheNode; fPrice: Double; begin vRow := ASheet.Rows[FCurRow]; sB_Code := Trim(GetCellStr(vRow, FB_CodeCol)); sName := Trim(GetCellStr(vRow, FNameCol)); sUnits := Trim(GetCellStr(vRow, FUnitCol)); fPrice := StrToFloatDef(GetCellStr(vRow, 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.OrgQuantity := StrToFloatDef(GetCellStr(vRow, FQuantityCol), 0); vGclNode.Price := fPrice; vGclNode.DrawingCode := Trim(GetCellStr(vRow, FDrawingCol)); vGclNode.MemoStr := Trim(GetCellStr(vRow, FMemoCol)); end else vGclNode.OrgQuantity := vGclNode.OrgQuantity + StrToFloatDef(GetCellStr(vRow, FQuantityCol), 0); end; Inc(FCurRow); end; function TPlaneFxBillsExcelImport.LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean; var iCol: Integer; vRow: TExportRow; 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 <= ASheet.Rows.Count - 1) do begin vRow := ASheet.Rows[FCurRow]; for iCol := 0 to vRow.Cells.Count - 1 do begin sColName := vRow.Cells[iCol].SqlText; 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(ASheet: TExportWorkSheet); var iPos: Integer; begin UpdateProgressHint('正在解析平面台账数据'); while FCurRow < ASheet.Rows.Count do begin iPos := FCurRow * 100 div ASheet.Rows.Count; UpdateProgressPosition(iPos); LoadXmjLevel1(ASheet); end; end; procedure TPlaneFxBillsExcelImport.LoadXmjLevel1(ASheet: TExportWorkSheet); var vRow: TExportRow; vCell: TExportCell; sName: string; vXmj: TBillsCacheNode; iEndRow: Integer; begin vRow := ASheet.Rows[FCurRow]; if FXmjLevel1Col < vRow.Cells.Count then begin vCell := vRow.Cells[FXmjLevel1Col]; sName := Trim(vCell.SqlText); iEndRow := FCurRow + vCell.RowSpan; 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(ASheet, vXmj); end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, vXmj); end; end else Inc(FCurRow); end else Inc(FCurRow); end; procedure TPlaneFxBillsExcelImport.LoadXmjLevel2(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); var vRow: TExportRow; vCell: TExportCell; sName: string; vXmj: TBillsCacheNode; iEndRow: Integer; begin vRow := ASheet.Rows[FCurRow]; if FXmjLevel2Col < vRow.Cells.Count then begin vCell := vRow.Cells[FXmjLevel2Col]; sName := Trim(vCell.SqlText); iEndRow := FCurRow + vCell.RowSpan; 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(ASheet, vXmj); end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, vXmj); end; end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, AParent); end; end else Inc(FCurRow); end; procedure TPlaneFxBillsExcelImport.LoadXmjLevel3(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); var vRow: TExportRow; vCell: TExportCell; sName: string; vXmj: TBillsCacheNode; iEndRow: Integer; begin vRow := ASheet.Rows[FCurRow]; if FXmjLevel3Col < vRow.Cells.Count then begin vCell := vRow.Cells[FXmjLevel3Col]; sName := Trim(vCell.SqlText); iEndRow := FCurRow + vCell.RowSpan; 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(ASheet, vXmj); end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, vXmj); end; end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, AParent); end; end else Inc(FCurRow); end; procedure TPlaneFxBillsExcelImport.LoadXmjLevel4(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); var vRow: TExportRow; vCell: TExportCell; sName: string; vXmj: TBillsCacheNode; iEndRow: Integer; begin vRow := ASheet.Rows[FCurRow]; if FXmjLevel4Col < vRow.Cells.Count then begin vCell := vRow.Cells[FXmjLevel4Col]; sName := Trim(vCell.SqlText); iEndRow := FCurRow + vCell.RowSpan; 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(ASheet, vXmj); end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, vXmj); end; end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, AParent); end; end else Inc(FCurRow); end; procedure TPlaneFxBillsExcelImport.LoadXmjLevel5(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); var vRow: TExportRow; vCell: TExportCell; sName: string; vXmj: TBillsCacheNode; iEndRow: Integer; begin vRow := ASheet.Rows[FCurRow]; if FXmjLevel5Col < vRow.Cells.Count then begin vCell := vRow.Cells[FXmjLevel5Col]; sName := Trim(vCell.SqlText); iEndRow := FCurRow + vCell.RowSpan; 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(ASheet, vXmj); end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, vXmj); end; end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, AParent); end; end else Inc(FCurRow); end; procedure TPlaneFxBillsExcelImport.LoadXmjLevel6(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); var vRow: TExportRow; vCell: TExportCell; sName: string; vXmj: TBillsCacheNode; iEndRow: Integer; begin vRow := ASheet.Rows[FCurRow]; if FXmjLevel6Col < vRow.Cells.Count then begin vCell := vRow.Cells[FXmjLevel6Col]; sName := Trim(vCell.SqlText); iEndRow := FCurRow + vCell.RowSpan; 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(ASheet, vXmj); end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, vXmj); end; end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, AParent); end; end else Inc(FCurRow); end; procedure TPlaneFxBillsExcelImport.LoadXmjLevel7(ASheet: TExportWorkSheet; AParent: TBillsCacheNode); var vRow: TExportRow; vCell: TExportCell; sName: string; vXmj: TBillsCacheNode; iEndRow: Integer; begin vRow := ASheet.Rows[FCurRow]; if FXmjLevel7Col < vRow.Cells.Count then begin vCell := vRow.Cells[FXmjLevel7Col]; sName := Trim(vCell.SqlText); iEndRow := FCurRow + vCell.RowSpan; if (sName <> '') then begin vXmj := FCacheTree.FindXmjChild(AParent, '', sName); if not Assigned(vXmj) then begin vXmj := FCacheTree.AddNode(AParent); vXmj.Name := sName; end; while FCurRow < iEndRow do LoadBillsNode(ASheet, vXmj); end else begin while FCurRow < iEndRow do LoadBillsNode(ASheet, AParent); end; end else Inc(FCurRow); 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.OrgQuantity); 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 := 0; end; procedure TBillsPriceExcelImport.EndImport; begin FProjectData.BillsData.sddBills.EndUpdate; UpdateProgressHint('正在计算导入后的数据'); FProjectData.BillsCompileData.CalculateAll; CloseProgressHint; end; procedure TBillsPriceExcelImport.Import; var vSheet: TExportWorkSheet; begin vSheet := OExport.OpenWorkSheet; LoadColumnsFromHead(vSheet); ImportBillsPriceData(vSheet); end; procedure TBillsPriceExcelImport.ImportBillsPriceData(ASheet: TExportWorkSheet); 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 vRow: TExportRow; iPos: Integer; sB_Code: string; fPrice: Double; begin UpdateProgressHint('写入读取的Excel数据'); UpdateProgressPosition(0); while (FCurRow < ASheet.Rows.Count) do begin vRow := ASheet.Rows[FCurRow]; sB_Code := Trim(GetCellStr(vRow, FB_CodeCol)); if (sB_Code <> '') and CheckIsBillsCode(sB_Code) then begin fPrice := StrToFloatDef(Trim(GetCellStr(vRow, FPriceCol)), 0); UpdateBillsPrice(sB_Code, fPrice); end; Inc(FCurRow); iPos := (FCurRow + 1) * 100 div ASheet.Rows.Count; UpdateProgressPosition(iPos); end; UpdateProgressPosition(100); end; procedure TBillsPriceExcelImport.LoadColumnsFromHead(ASheet: TExportWorkSheet); var vRow: TExportRow; iCol: Integer; sColName: string; begin FB_CodeCol := -1; FNameCol := -1; FPriceCol := -1; while ((FB_CodeCol = -1) or (FPriceCol = -1)) and (FCurRow < ASheet.Rows.Count) do begin vRow := ASheet.Rows[FCurRow]; for iCol := 0 to vRow.Cells.Count - 1 do begin sColName := Trim(GetCellStr(vRow, 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.