{ *************************************** 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.