Measure/SubTenderGatherGcl/stgGclSubGatherFile.pas

unit stgGclSubGatherFile;
// 导入导出汇总结果

interface

uses
  stgGclSubGatherFileDm, ADODB, sdDB, stgGclGatherDm, SysUtils, ProjectData,
  StageDm, mDataRecord, BillsTree, DetailExcelImport, OExport, stgGclImportHint;

type
  TstgGclSubGatherFileHelper = class
  private
    FTempFile: string;
    FConnection: TADOConnection;
    FGatherData: TstgGclSubGatherData;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Open(const AFileName: string);
    procedure Close;
    procedure SaveTo(const AFileName: string);

    property Connection: TADOConnection read FConnection;
    property GatherData: TstgGclSubGatherData read FGatherData;
  end;

  TstgGclSubGatherFileExportor = class(TstgGclSubGatherFileHelper)
  private
    procedure LoadMemoryRecord(ARec: TsdDataRecord);
    procedure LoadMemoryGatherData(AGatherData: TstgGclGatherData);
  public
    procedure ExportGatherDataTo(AGatherData: TstgGclGatherData; const AFileName: string);
  end;

  TstgGclSubGatherFileImportor = class(TstgGclSubGatherFileHelper)
  private
    FFails: TstgGclFailList;

    procedure ClearOldData(AStageData: TStageData);
    procedure ImportGatherData(AProjectData: TProjectData);
  public
    constructor Create;
    destructor Destroy; override;

    procedure ImportGatherDataTo(AProjectData: TProjectData; const AFileName: string);
  end;

  TstgGclSubGatherFileExcelImportor = class(TDetailExcelImport)
  private
    FCurRow: Integer;

    FB_CodeCol: Integer;
    FNameCol: Integer;
    FUnitsCol: Integer;
    FPriceCol: Integer;
    FDealQuantityCol: Integer;

    FFails: TstgGclFailList;

    procedure ClearOldData(AStageData: TStageData);

    function LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
    procedure LoadGatherData(ASheet: TExportWorkSheet);
  protected
    procedure BeginImport; override;
    procedure EndImport; override;

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

implementation


uses
  UtilMethods, ZhAPI, Connections, stgGclTables, ScAutoUpdateUnit, Math,
  BillsMeasureDm, stgGclImportHintFrm;

{ TstgGclSubGatherFileExportor }

procedure TstgGclSubGatherFileExportor.ExportGatherDataTo(
  AGatherData: TstgGclGatherData; const AFileName: string);
begin
  Open(GetEmptyDataBaseFileName);
  try
    LoadMemoryGatherData(AGatherData);
  finally                             
    SaveTo(AFileName);
  end;
end;

procedure TstgGclSubGatherFileExportor.LoadMemoryRecord(ARec: TsdDataRecord);
var
  vRec: TsdDataRecord;
begin
  vRec := GatherData.sddBills.Add;
  vRec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
  vRec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
  vRec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
  vRec.ValueByName('Price').AsFloat := ARec.ValueByName('Price').AsFloat;
  vRec.ValueByName('DealQuantity').AsFloat := ARec.ValueByName('DealQuantity').AsFloat;
  vRec.ValueByName('DealTotalPrice').AsFloat := ARec.ValueByName('DealTotalPrice').AsFloat;
  vRec.ValueByName('QcQuantity').AsFloat := ARec.ValueByName('QcQuantity').AsFloat;
  vRec.ValueByName('QcTotalPrice').AsFloat := ARec.ValueByName('QcTotalPrice').AsFloat;
  vRec.ValueByName('QcBGLCode').AsString := ARec.ValueByName('QcBGLCode').AsString;
  vRec.ValueByName('QcBGLNum').AsString := ARec.ValueByName('QcBGLNum').AsString;
end;

procedure TstgGclSubGatherFileExportor.LoadMemoryGatherData(
  AGatherData: TstgGclGatherData);
var
  i: Integer;
  vRec: TsdDataRecord;
begin
  GatherData.sddBills.BeginUpdate;
  try
    for i := 0 to AGatherData.sddGatherGcl.RecordCount - 1 do
    begin
      vRec := AGatherData.sddGatherGcl.Records[i];
      LoadMemoryRecord(vRec);
    end;
  finally
    GatherData.sddBills.EndUpdate;
  end;
end;

{ TstgGclSubGatherFileHelper }

procedure TstgGclSubGatherFileHelper.Close;
begin
  FConnection.Close;
  if FileExists(FTempFile) then
    DeleteFile(FTempFile);
end;

constructor TstgGclSubGatherFileHelper.Create;
begin
  FConnection := TADOConnection.Create(nil);
  FConnection.LoginPrompt := False;
  FGatherData := TstgGclSubGatherData.Create(nil);
end;

destructor TstgGclSubGatherFileHelper.Destroy;
begin
  Close;
  FGatherData.Free;
  FConnection.Free;
  inherited;
end;

procedure TstgGclSubGatherFileHelper.Open(const AFileName: string);

  procedure UpdateDataTables;
  var
    Updater: TScUpdater;
  begin
    Updater := TScUpdater.Create;
    try
      Updater.ForceUpdate := True;
      Updater.Open('', FConnection, '', '');
      Updater.AddTableDef(sStgGclBills, @tdStgGclBills, Length(tdStgGclBills), False, False);
      Updater.ExcuteUpdate;
    finally
      Updater.Free;
    end;
  end;

begin
  FTempFile := GetTempFileName;
  CopyFileOrFolder(AFileName, FTempFile);
  FConnection.ConnectionString := Format(SAdoConnectStr, [FTempFile]);
  FConnection.Open;
  UpdateDataTables;
  GatherData.Open(FConnection);
end;

procedure TstgGclSubGatherFileHelper.SaveTo(const AFileName: string);
begin
  FGatherData.Save;
  CopyFileOrFolder(FTempFile, AFileName);
end;

{ TstgGclSubGatherFileImportor }

procedure TstgGclSubGatherFileImportor.ClearOldData(AStageData: TStageData);
var
  i: Integer;
  vRec: TStageRecord;
begin
  for i := 0 to AStageData.sddStage.RecordCount - 1 do
  begin
    vRec := TStageRecord(AStageData.sddStage.Records[i]);
    vRec.DealQuantity.AsFloat := 0;
    vRec.DealTotalPrice.AsFloat := 0;
    vRec.DealFlag.AsInteger := 0;
    vRec.DealFormula.AsString := '';
    vRec.EndDealQuantity.AsFloat := vRec.PreDealQuantity.AsFloat;
    vRec.EndDealTotalPrice.AsFloat := vRec.PreDealTotalPrice.AsFloat;
  end;
end;

constructor TstgGclSubGatherFileImportor.Create;
begin
  FFails := TstgGclFailList.Create;
end;

destructor TstgGclSubGatherFileImportor.Destroy;
begin
  FFails.Free;
  inherited;
end;

procedure TstgGclSubGatherFileImportor.ImportGatherData(
  AProjectData: TProjectData);

  function FindBillsNode(ARec: TsdDataRecord): TBillsIDTreeNode;
  var
    i: Integer;
    vNode: TBillsIDTreeNode;
  begin
    Result := nil;
    for i := 0 to AProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
    begin
      vNode := TBillsIDTreeNode(AProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
      if (vNode.HasChildren) then Continue;
      if (vNode.Rec.B_Code.AsString = ARec.ValueByName('B_Code').AsString) and
         (vNode.Rec.Name.AsString = ARec.ValueByName('Name').AsString) and
         (vNode.Rec.Units.AsString = ARec.ValueByName('Units').AsString) and
         (CommonRoundTo(vNode.Rec.Price.AsFloat - ARec.ValueByName('Price').AsFloat, -6) = 0) then
      begin
        Result := vNode;
        Break;
      end;
    end;
  end;

var
  i: Integer;
  vNode: TBillsIDTreeNode;
  vOrgRec: TsdDataRecord;
  vStageRec: TStageRecord;
begin
  for i := 0 to GatherData.sddBills.RecordCount - 1 do
  begin
    vOrgRec := GatherData.sddBills.Records[i];
    vNode := FindBillsNode(vOrgRec);
    if Assigned(vNode) then
    begin
      vStageRec := AProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
      vStageRec.DealQuantity.AsFloat := vOrgRec.ValueByName('DealQuantity').AsFloat;
    end
    else
      FFails.AddFailGcl(vOrgRec.ValueByName('B_Code').AsString,
        vOrgRec.ValueByName('Name').AsString, vOrgRec.ValueByName('Units').AsString,
        vOrgRec.ValueByName('Price').AsFloat, vOrgRec.ValueByName('DealQuantity').AsFloat);
  end;
end;

procedure TstgGclSubGatherFileImportor.ImportGatherDataTo(
  AProjectData: TProjectData; const AFileName: string);
begin
  Open(AFileName);
  AProjectData.PhaseData.StageData.sddStage.BeginUpdate;
  AProjectData.PhaseData.StageData.BeforeBatchOperation;
  try
    ClearOldData(AProjectData.PhaseData.StageData);
    ImportGatherData(AProjectData);
  finally
    AProjectData.PhaseData.StageData.AfterBatchOperation;
    AProjectData.PhaseData.StageData.sddStage.EndUpdate;
  end;   
  if FFails.Count > 0 then
    ShowGclImportForm(FFails);
end;

{ TstgGclSubGatherFileExcelImportor }

procedure TstgGclSubGatherFileExcelImportor.BeginImport;
begin
  inherited;
  ProjectData.PhaseData.StageData.sddStage.BeginUpdate;
  ProjectData.PhaseData.StageData.BeforeBatchOperation;
end;

procedure TstgGclSubGatherFileExcelImportor.ClearOldData(
  AStageData: TStageData);
var
  i: Integer;
  vRec: TStageRecord;
begin
  for i := 0 to AStageData.sddStage.RecordCount - 1 do
  begin
    vRec := TStageRecord(AStageData.sddStage.Records[i]);
    vRec.DealQuantity.AsFloat := 0;
    vRec.DealTotalPrice.AsFloat := 0;
    vRec.DealFlag.AsInteger := 0;
    vRec.DealFormula.AsString := '';
    vRec.EndDealQuantity.AsFloat := vRec.PreDealQuantity.AsFloat;
    vRec.EndDealTotalPrice.AsFloat := vRec.PreDealTotalPrice.AsFloat;
  end;
end;

constructor TstgGclSubGatherFileExcelImportor.Create(
  AProjectData: TProjectData);
begin
  inherited Create(AProjectData);
  FFails := TstgGclFailList.Create;
end;

destructor TstgGclSubGatherFileExcelImportor.Destroy;
begin
  FFails.Free;
  inherited;
end;

procedure TstgGclSubGatherFileExcelImportor.EndImport;
begin
  ProjectData.PhaseData.StageData.AfterBatchOperation;
  ProjectData.PhaseData.StageData.sddStage.EndUpdate;  
  if FFails.Count > 0 then
    ShowGclImportForm(FFails);
  inherited;
end;

procedure TstgGclSubGatherFileExcelImportor.Import;
begin
  ClearOldData(ProjectData.PhaseData.StageData);

  FCurRow := 0;
  if LoadColumnsFromHead(OExport.OpenWorkSheet) then
    LoadGatherData(OExport.OpenWorkSheet)
  else
    ErrorMessage('导入的Excel格式有误！');
  inherited;
end;

function TstgGclSubGatherFileExcelImportor.LoadColumnsFromHead(
  ASheet: TExportWorkSheet): Boolean;
var        
  vRow: TExportRow;
  iCol: Integer;
  sColName: String;
begin
  FB_CodeCol := -1;
  FNameCol := -1;
  FUnitsCol := -1;
  FPriceCol := -1;
  FDealQuantityCol := -1;

  vRow := ASheet.Rows[FCurRow];
  for iCol := 0 to vRow.Cells.Count - 1 do
  begin
    sColName := GetCellTrimStr(vRow, iCol);

   if (sColName = '清单编号') then
      FB_CodeCol := iCol
    else if sColName = '名称' then
      FNameCol := iCol
    else if sColName = '单位' then
      FUnitsCol := iCol
    else if sColName = '单价' then
      FPriceCol := iCol
    else if (sColName = '合同计量') then
      FDealQuantityCol := iCol;
  end;
  Result := (FB_CodeCol <> -1) and (FNameCol <> -1) and (FUnitsCol <> -1) and
    (FPriceCol <> -1) and (FDealQuantityCol <> -1);
  Inc(FCurRow);
end;

procedure TstgGclSubGatherFileExcelImportor.LoadGatherData(
  ASheet: TExportWorkSheet);

  function FindBillsNode(const AB_Code, AName, AUnits: string; APrice: Double): TBillsIDTreeNode;
  var
    i: Integer;
    vNode: TBillsIDTreeNode;
  begin
    Result := nil;
    for i := 0 to ProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
    begin
      vNode := TBillsIDTreeNode(ProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
      if (vNode.HasChildren) then Continue;
      if (vNode.Rec.B_Code.AsString = AB_Code) and
         (vNode.Rec.Name.AsString = AName) and
         (vNode.Rec.Units.AsString = AUnits) and
         (CommonRoundTo(vNode.Rec.Price.AsFloat - APrice, -6) = 0) then
      begin
        Result := vNode;
        Break;
      end;
    end;
  end;

var
  vRow: TExportRow;
  sB_Code, sName, sUnits: string;
  fPrice: Double;  
  vNode: TBillsIDTreeNode;
  vStageRec: TStageRecord;
begin
  while FCurRow < ASheet.Rows.Count do
  begin
    vRow := ASheet.Rows[FCurRow];
    Inc(FCurRow);

    sB_Code := Trim(GetCellStr(vRow, FB_CodeCol));
    sName := Trim(GetCellStr(vRow, FNameCol));
    sUnits := Trim(GetCellStr(vRow, FUnitsCol));
    fPrice := StrToFloatDef(GetCellStr(vRow, FPriceCol), 0);

    if (sB_Code = '') then Continue;

    vNode := FindBillsNode(sB_Code, sName, sUnits, fPrice);
    if Assigned(vNode) then
    begin
      vStageRec := ProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
      vStageRec.DealQuantity.AsFloat := StrToFloatDef(GetCellStr(vRow, FDealQuantityCol), 0);
    end
    else
      FFails.AddFailGcl(sB_Code, sName, sUnits, fPrice, StrToFloatDef(GetCellStr(vRow, FDealQuantityCol), 0));
  end;
end;

end.