BillsEditor/CU/ExportDecorateUnit.pas

{
  ***************************************

  Note: Add the Third Part Bills when Export .smb File

  **************************************
}

unit ExportDecorateUnit;

interface

uses
  Classes,
  ADODB,
  DataBase,
  ConstTypeUnit,
  Provider,
  ConstMethodUnit,
  DBClient,
  DB,
  ConstVarUnit,
  ScFileArchiver;

type
  TBillsConfig = class
  private
    FBillsStrings: TStrings;
    FRecordList: TList;
  public
    constructor Create(const aFileName: string);
    destructor Destroy; override;

    procedure ResolveStrings;

  end;

  TDecorator = class
  private
    FBillsConfig: TBillsConfig;
  public
    constructor Create(const aCfgFileName: string);
    destructor Destroy; override;

    procedure Decorate; virtual; abstract;
  end;

  TCreateDecorator = class(TDecorator)
  private
    FBillsData: TDMDataBase;
    procedure ClearExprs;
    procedure Save;
    procedure WriteBillsAndExprs;
  public
    constructor Create(aBillsData: TDMDataBase; const aCfgFileName: string);

    procedure Decorate; override;
  end;

  TBillsDecorator = class(TDecorator)
  private
    FArchiver        : TScProjectFileArchiver;
    FBillsTable      : TADOTable;
    FBillsDsp        : TDataSetProvider;
    FBillsCds        : TClientDataSet;
    FDrawQtyTable    : TADOTable;
    FDrawQtyDsp      : TDataSetProvider;
    FDrawQtyCds      : TClientDataSet;
    FProjProperty    : TADOTable;
    FProjPropertyDsp : TDataSetProvider;
    FProjPropertyCds : TClientDataSet;

    function CanDecorate: Boolean;
    function MaxBillsID: Integer;
    function GetMaxProjPropertyID: Integer;
    procedure ModifyNextID;
    procedure ModifyItemIDs;
    procedure AppendBills;
    procedure ModifyExprs;
    procedure ModifyProjProperty;
    procedure ModifyIsCreatePriceAnalysis;
  public
    constructor Create(const aArFileName, aCfgFileName: string); overload;
    destructor Destroy; override;

    procedure Decorate; override;
  end;

implementation

uses SysUtils, ScExprsDM;

{ TBillsConfig }

constructor TBillsConfig.Create(const aFileName: string);
begin
  FBillsStrings := TStringList.Create;
  FRecordList := TList.Create;

  FBillsStrings.LoadFromFile(aFileName);
end;

destructor TBillsConfig.Destroy;
begin
  FBillsStrings.Free;
  ClearPointerList(FRecordList);
  FRecordList.Free;
  inherited;
end;

procedure TBillsConfig.ResolveStrings;
var
  iLoop   : Integer;

  iID     : Integer;
  iErrCode: Integer;

  sBills: string;
  sChain: string;
  rdBillsConfig: PBillsConfigRecord;
begin
  for iLoop := 0 to FBillsStrings.Count - 1 do
  begin
    sBills := FBillsStrings[iLoop];
    if sBills = '' then Continue;
    
    New(rdBillsConfig);

    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));

    Val(sChain, iID, iErrCode);
    rdBillsConfig.ID := iID;

    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));

    Val(sChain, iID, iErrCode);
    rdBillsConfig.ParentID := iID;

    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));

    Val(sChain, iID, iErrCode);
    rdBillsConfig.NextID := iID;    

    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));

    rdBillsConfig.Code := Trim(sChain);

    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));

    rdBillsConfig.BCode := sChain;    

    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));

    rdBillsConfig.Name := sChain;

    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));

    rdBillsConfig.Units := sChain;

    sChain := Copy(sBills, 1, Pos(',', sBills) - 1);
    sBills := Copy(sBills, Pos(',', sBills) + 1, Length(sBills));

    rdBillsConfig.IsPreDefine := UpperCase(sChain) = 'TRUE';

    rdBillsConfig.Exprs := Trim(sBills);

    rdBillsConfig.ParentModified := False;
    rdBillsConfig.NextModified := False;

    FRecordList.Add(rdBillsConfig);
  end;
end;

{ TBillsDecorator }

procedure TBillsDecorator.AppendBills;
var
  I: Integer;
  rdBillsConfig: PBillsConfigRecord;
begin
  for I := 0 to FBillsConfig.FRecordList.Count - 1 do
  begin
    rdBillsConfig := FBillsConfig.FRecordList.List^[I];

    if rdBillsConfig.ID = 0 then Continue;

    FBillsCds.Append;
    FBillsCds.FieldByName(SID).AsInteger            := rdBillsConfig.ID;
    FBillsCds.FieldByName(sParentID).AsInteger      := rdBillsConfig.ParentID;
    FBillsCds.FieldByName(sNextSiblingID).AsInteger := rdBillsConfig.NextID;
    FBillsCds.FieldByName(sCode).AsString           := rdBillsConfig.Code;
    FBillsCds.FieldByName(sB_Code).AsString         := rdBillsConfig.BCode;
    FBillsCds.FieldByName(sName).AsString           := rdBillsConfig.Name;
    FBillsCds.FieldByName(sUnits).AsString          := rdBillsConfig.Units;
    FBillsCds.FieldByName(sIsPreDefine).AsBoolean   := rdBillsConfig.IsPreDefine;
    FBillsCds.FieldByName('IsCreatePriceAnalysis').AsBoolean := True;
    FBillsCds.Post;
  end;
end;

function TBillsDecorator.CanDecorate: Boolean;
begin
  FBillsCds.EditKey;
  FBillsCds.FieldByName(SID).AsInteger := 3;
  Result := not FBillsCds.GotoKey;
end;

constructor TBillsDecorator.Create(const aArFileName, aCfgFileName: string);
begin
  FArchiver        := TScProjectFileArchiver.Create;
  FBillsTable      := TADOTable.Create(nil);
  FBillsDsp        := TDataSetProvider.Create(nil);
  FBillsCds        := TClientDataSet.Create(nil);
  FDrawQtyTable    := TADOTable.Create(nil);
  FDrawQtyDsp      := TDataSetProvider.Create(nil);
  FDrawQtyCds      := TClientDataSet.Create(nil);
  FProjProperty    := TADOTable.Create(nil);
  FProjPropertyDsp := TDataSetProvider.Create(nil);
  FProjPropertyCds := TClientDataSet.Create(nil);

  FBillsDsp.UpdateMode := upWhereKeyOnly;
  FDrawQtyDsp.UpdateMode := upWhereKeyOnly;
  FProjPropertyDsp.UpdateMode := upWhereKeyOnly;

  FArchiver.FileName := aArFileName;
  if FArchiver.OpenFile then
  begin
    FBillsTable.Connection := FArchiver.Connection;
    FBillsTable.TableName := 'Bills';
    FBillsDsp.DataSet := FBillsTable;
    FBillsCds.SetProvider(FBillsDsp);
    FBillsCds.Active := True;
    FBillsCds.IndexFieldNames := SID;

    FDrawQtyTable.Connection := FArchiver.Connection;
    FDrawQtyTable.TableName := 'Exprs';
    FDrawQtyDsp.DataSet := FDrawQtyTable;
    FDrawQtyCds.SetProvider(FDrawQtyDsp);
    FDrawQtyCds.IndexFieldNames := 'RecdID';
    FDrawQtyCds.Active := True;

    FProjProperty.Connection := FArchiver.Connection;
    FProjProperty.TableName := 'ProjProperty';
    FProjPropertyDsp.DataSet := FProjProperty;
    FProjPropertyCds.SetProvider(FProjPropertyDsp);
    FProjPropertyCds.Open;
    FProjPropertyCds.IndexFieldNames := 'ID';
  end;

  inherited Create(aCfgFileName);
end;

procedure TBillsDecorator.Decorate;

begin
  if FDrawQtyCds.Active then
    { TODO : Ð޸Ĺ«Ê½ }
    ModifyExprs;

  // Ð޸ļÆËãģʽ
  if FProjPropertyCds.Active then
    ModifyProjProperty;

  if FBillsCds.Active then
  begin
    ModifyIsCreatePriceAnalysis;
    FBillsCds.ApplyUpdates(0);
  end;

  if FBillsCds.Active and CanDecorate then
  begin
    { TODO : Read txt }
    FBillsConfig.ResolveStrings;
    { TODO : Modify NextID }
    ModifyNextID;
    ModifyItemIDs;
    { TODO : Append Bills }
    AppendBills;
    { TODO : Save }
    FBillsCds.ApplyUpdates(0);
  end;
  FArchiver.Save;
end;

destructor TBillsDecorator.Destroy;
begin
  FArchiver.Free;
  FBillsTable.Free;
  FBillsDsp.Free;
  FBillsCds.Free;

  FDrawQtyTable.Free;
  FDrawQtyDsp.Free;
  FDrawQtyCds.Free;
  FProjProperty.Free;
  FProjPropertyDsp.Free;
  FProjPropertyCds.Free;
  
  inherited;
end;

function TBillsDecorator.MaxBillsID: Integer;
begin
  FBillsCds.Last;
  Result := FBillsCds.FieldByName(SID).AsInteger;
end;

function TBillsDecorator.GetMaxProjPropertyID: Integer;
begin
  FProjPropertyCds.Last;
  Result := FProjPropertyCds.FieldByName('ID').AsInteger + 1;
end;

procedure TBillsDecorator.ModifyExprs;
begin
  FDrawQtyCds.First;
  while not FDrawQtyCds.Eof do
  begin
    if FDrawQtyCds.FieldByName('MajorID').AsInteger = 2 then
    begin
      FDrawQtyCds.Edit;
      FDrawQtyCds.FieldByName('MajorID').AsInteger := 4;
      FDrawQtyCds.FieldByName('MinorID').AsInteger := 1;
      FDrawQtyCds.Post;
    end;
    FDrawQtyCds.Next;
  end;
  FDrawQtyCds.ApplyUpdates(0);
end;

procedure TBillsDecorator.ModifyItemIDs;
var
  I: Integer;
  J: Integer;
  iMaxID: Integer;
  rdBillsConfig: PBillsConfigRecord;
  rdTemConfig: PBillsConfigRecord;
begin
  iMaxID := MaxBillsID + 1;
  for I := 0 to FBillsConfig.FRecordList.Count - 1 do
  begin
    rdBillsConfig := FBillsConfig.FRecordList.List^[I];

    if rdBillsConfig.ID >= 100 then
    begin
      for J := 0 to FBillsConfig.FRecordList.Count - 1 do
      begin
        rdTemConfig := FBillsConfig.FRecordList.List^[J];
        if rdTemConfig <> rdBillsConfig then
        begin
          if (not rdTemConfig.ParentModified) and (rdTemConfig.ParentID = rdBillsConfig.ID) then
          begin
            rdTemConfig.ParentID := iMaxID;
            rdTemConfig.ParentModified := True;
          end
          else if (not rdTemConfig.NextModified) and (rdTemConfig.NextID = rdBillsConfig.ID) then
          begin
            rdTemConfig.NextID := iMaxID;
            rdTemConfig.NextModified := True;
          end;
        end;
      end;

      rdBillsConfig.ID := iMaxID;
      Inc(iMaxID);
    end;
  end;
end;

procedure TBillsDecorator.ModifyNextID;
begin
  FBillsCds.EditKey;
  FBillsCds.FieldByName(SID).AsInteger := 2;
  if FBillsCds.GotoKey then
  begin
    FBillsCds.Edit;
    FBillsCds.FieldByName(sNextSiblingID).AsInteger := 3;
    FBillsCds.Post;
  end;
end;

procedure TBillsDecorator.ModifyProjProperty;
var
  iMaxID: Integer;
begin
  if FProjPropertyCds.Locate('Name', 'ExpressMode', []) then
  begin
    FProjPropertyCds.Edit;
    FProjPropertyCds.FieldByName('ItemValue').Value := '1';
    FProjPropertyCds.Post;
  end
  else
  begin
    iMaxID := GetMaxProjPropertyID; 
    FProjPropertyCds.Append;
    FProjPropertyCds.FieldByName('ID').Value := iMaxID;
    FProjPropertyCds.FieldByName('Name').Value := 'ExpressMode';
    FProjPropertyCds.FieldByName('ItemValue').Value := '1';
    FProjPropertyCds.Post;
  end;
  FProjPropertyCds.ApplyUpdates(0);
end;

procedure TBillsDecorator.ModifyIsCreatePriceAnalysis;
begin
  FBillsCds.First;
  while not FBillsCds.Eof do
  begin
    if not FBillsCds.FieldByName('IsCreatePriceAnalysis').AsBoolean then
    begin
      FBillsCds.Edit;
      FBillsCds.FieldByName('IsCreatePriceAnalysis').AsBoolean := True;
      FBillsCds.Post;
    end;
    FBillsCds.Next;
  end;
end;

{ TDecorator }

constructor TDecorator.Create(const aCfgFileName: string);
begin
  FBillsConfig := TBillsConfig.Create(aCfgFileName);
end;

destructor TDecorator.Destroy;
begin
  FBillsConfig.Free;
  inherited;
end;

{ TCreateDecorator }

procedure TCreateDecorator.ClearExprs;
begin
  with FBillsData.DMExprs do
  begin
    cdsOrgExprs.First;
    while not cdsOrgExprs.Eof do
      cdsOrgExprs.Delete;
  end;
end;

constructor TCreateDecorator.Create(aBillsData: TDMDataBase;
  const aCfgFileName: string);
begin
  FBillsData := aBillsData;
  inherited Create(aCfgFileName);
end;

procedure TCreateDecorator.Decorate;

begin
  { Read Txt }
  FBillsConfig.ResolveStrings;
  ClearExprs;
  { write Bills }
  WriteBillsAndExprs;
  Save;
end;

procedure TCreateDecorator.Save;
begin
  FBillsData.cdsBills.ApplyUpdates(0);
  FBillsData.DMExprs.Save;
end;

procedure TCreateDecorator.WriteBillsAndExprs;

  procedure WriteBills(ABills: PBillsConfigRecord);
  begin
    with FBillsData do
    begin
      cdsBills.Append;
      cdsBillsID.Value := ABills.ID;
      cdsBillsParentID.Value := ABills.ParentID;
      cdsBillsNextSiblingID.Value := ABills.NextID;
      cdsBillsCode.Value := ABills.Code;
      cdsBillsB_Code.Value := ABills.BCode;
      cdsBillsName.Value := ABills.Name;
      cdsBillsUnits.Value := ABills.Units;
      cdsBillsIsPreDefine.Value := ABills.IsPreDefine;
      cdsBills.Post;
    end;
  end;

  procedure WriteExprs(ABills: PBillsConfigRecord);
  begin
    if ABills.Exprs <> '' then
      FBillsData.DMExprs.AddExprs(1, 3, ABills.ID, ABills.Exprs, 0, 0);
  end;

var
  I: Integer;
  rdBillsConfig: PBillsConfigRecord;
begin
  for I := 0 to FBillsConfig.FRecordList.Count - 1 do
  begin
    rdBillsConfig := FBillsConfig.FRecordList.List^[I];
    if rdBillsConfig.ID > 0 then
    begin
      WriteBills(rdBillsConfig);
      WriteExprs(rdBillsConfig);
    end;
  end;
end;

end.