Measure/Units/DetailExcelImport.pas

unit DetailExcelImport;

interface

uses
  Classes, ProjectData, ScXlsOutput, MCacheTree, XLSAdapter, sdDB,
  Variants, Forms, Controls;

type
  TDetailExcelImport = class
  private
    FProjectData: TProjectData;
    FTempFile: string;
    FExcel: TXlsOutPut;

    function GetCellValue(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
    function GetCellValueFormat(AXlsFile: TXLSFile; ARow, ACol: Integer): string;

    procedure BeginImport; virtual; abstract;
    procedure EndImport; virtual; abstract;

    procedure Import; virtual; abstract;
  public
    constructor Create(AProjectData: TProjectData);
    destructor Destroy; override;

    procedure ImportFile(const AFileName: string);
  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);

    procedure BeginImport; override;
    procedure EndImport; override;

    procedure Import; override;
  public
    property ParentID: Integer read FParentID write FParentID;
  end;

implementation

uses
  UtilMethods, SysUtils, ZhAPI, SheetSelectFrm, UExcelAdapter, UFlxMessages,
  UFlxFormats, ProgressHintFrm;

{ 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.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 := 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 := GetCellValue(AXlsFile, FCurRow, FDrawingCol);
      vGclNode.MemoStr := 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 := 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));
  if sName = '' then Exit;

  vXmj := FCacheTree.FindXmjChild(nil, '', sName);
  if not Assigned(vXmj) then
  begin
    vXmj := FCacheTree.AddNode(nil);
    vXmj.Name := sName;
  end;

  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel1Col] do
    iEndRow := FCurRow + Bottom - Top;

  if FXmjLevel2Col <> -1 then
  begin
    while FCurRow <= iEndRow do
      LoadXmjLevel2(AXlsFile, vXmj);
  end
  else
  begin
    while FCurRow <= iEndRow do
      LoadBillsNode(AXlsFile, vXmj);
  end;
end;

procedure TPlaneFxBillsExcelImport.LoadXmjLevel2(AXlsFile: TXLSFile;
  AParent: TBillsCacheNode);
var
  sName: string;
  vXmj: TBillsCacheNode;
  iEndRow: Integer;
begin
  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel2Col));
  if sName = '' then Exit;

  vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  if not Assigned(vXmj) then
  begin
    vXmj := FCacheTree.AddNode(AParent);
    vXmj.Name := sName;
  end;

  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel2Col] do
    iEndRow := FCurRow + Bottom - Top;

  if FXmjLevel3Col <> -1 then
  begin
    while FCurRow <= iEndRow do
      LoadXmjLevel3(AXlsFile, vXmj);
  end
  else
  begin
    while FCurRow <= iEndRow do
      LoadBillsNode(AXlsFile, vXmj);
  end;
end;

procedure TPlaneFxBillsExcelImport.LoadXmjLevel3(AXlsFile: TXLSFile;
  AParent: TBillsCacheNode);
var
  sName: string;
  vXmj: TBillsCacheNode;
  iEndRow: Integer;
begin
  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel3Col));
  if sName = '' then Exit;

  vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  if not Assigned(vXmj) then
  begin
    vXmj := FCacheTree.AddNode(AParent);
    vXmj.Name := sName;
  end;

  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel3Col] do
    iEndRow := FCurRow + Bottom - Top;

  if FXmjLevel4Col <> -1 then
  begin
    while FCurRow <= iEndRow do
      LoadXmjLevel4(AXlsFile, vXmj);
  end
  else
  begin
    while FCurRow <= iEndRow do
      LoadBillsNode(AXlsFile, vXmj);
  end;
end;

procedure TPlaneFxBillsExcelImport.LoadXmjLevel4(AXlsFile: TXLSFile;
  AParent: TBillsCacheNode);
var
  sName: string;
  vXmj: TBillsCacheNode;
  iEndRow: Integer;
begin
  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel4Col));
  if sName = '' then Exit;

  vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  if not Assigned(vXmj) then
  begin
    vXmj := FCacheTree.AddNode(AParent);
    vXmj.Name := sName;
  end;

  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel4Col] do
    iEndRow := FCurRow + Bottom - Top;

  if FXmjLevel5Col <> -1 then
  begin
    while FCurRow <= iEndRow do
      LoadXmjLevel5(AXlsFile, vXmj);
  end
  else
  begin
    while FCurRow <= iEndRow do
      LoadBillsNode(AXlsFile, vXmj);
  end;
end;

procedure TPlaneFxBillsExcelImport.LoadXmjLevel5(AXlsFile: TXLSFile;
  AParent: TBillsCacheNode);
var
  sName: string;
  vXmj: TBillsCacheNode;
  iEndRow: Integer;
begin
  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel5Col));
  if sName = '' then Exit;

  vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  if not Assigned(vXmj) then
  begin
    vXmj := FCacheTree.AddNode(AParent);
    vXmj.Name := sName;
  end;

  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel5Col] do
    iEndRow := FCurRow + Bottom - Top;

  if FXmjLevel6Col <> -1 then
  begin
    while FCurRow <= iEndRow do
      LoadXmjLevel6(AXlsFile, vXmj);
  end
  else
  begin
    while FCurRow <= iEndRow do
      LoadBillsNode(AXlsFile, vXmj);
  end;
end;

procedure TPlaneFxBillsExcelImport.LoadXmjLevel6(AXlsFile: TXLSFile;
  AParent: TBillsCacheNode);
var
  sName: string;
  vXmj: TBillsCacheNode;
  iEndRow: Integer;
begin
  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel6Col));
  if sName = '' then Exit;

  vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
  if not Assigned(vXmj) then
  begin
    vXmj := FCacheTree.AddNode(AParent);
    vXmj.Name := sName;
  end;

  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel6Col] do
    iEndRow := FCurRow + Bottom - Top;

  if FXmjLevel7Col <> -1 then
  begin
    while FCurRow <= iEndRow do
      LoadXmjLevel7(AXlsFile, vXmj);
  end
  else
  begin
    while FCurRow <= iEndRow do
      LoadBillsNode(AXlsFile, vXmj);
  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 Exit;

  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;

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;
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;
begin
  FCacheTree.Free;

  FProjectData.BillsData.EnableEvents;
  FProjectData.ReConnectTree;

  FProjectData.BillsCompileData.CalculateAll;

  CloseProgressHint;
  Screen.Cursor := crDefault;
end;

end.