unit DataBase; interface uses SysUtils, Classes, DBClient, Provider, DB, ADODB, ScBillsTree, ConstVarUnit, ConstMethodUnit, ScKindsOfTrees, ConstTypeUnit, ZjIDTree, ScExprsDM, ZJLists; type // 评分统计，参数：附加费 TStatEvent = procedure (AFJF: Currency; AYsCount, AQdCount: Integer) of object; // 评分部分用到，为了和SmartCost定义保持一致，方便代码Copy. chenshilong, 2011-07-20 TStdItem = TStdBillNode; TStdTree = TStdBillsTree; TDMDataBase = class(TDataModule) atBills: TADOTable; atDrawingQuantity: TADOTable; dspBills: TDataSetProvider; dspDrawingQuantity: TDataSetProvider; cdsBills: TClientDataSet; cdsDrawingQuantity: TClientDataSet; dsBillsDrawing: TDataSource; cdsOrgBills: TClientDataSet; cdsOrgDrawingQuantity: TClientDataSet; cdsDrawingQuantityID: TIntegerField; cdsDrawingQuantityName: TWideStringField; cdsDrawingQuantityUnits: TWideStringField; cdsDrawingQuantityBillsID: TIntegerField; cdsDrawingQuantityDQuantity1: TFloatField; cdsDrawingQuantityDQuantity2: TFloatField; cdsBillsID: TIntegerField; cdsBillsParentID: TIntegerField; cdsBillsNextSiblingID: TIntegerField; cdsBillsCode: TWideStringField; cdsBillsName: TWideStringField; cdsBillsUnits: TWideStringField; cdsBillsQuantity: TFloatField; cdsBillsUnitPrice: TBCDField; cdsBillsTotalPrice: TBCDField; cdsBillsB_Code: TWideStringField; cdsBillsDesignQuantity: TFloatField; cdsBillsDesignQuantity2: TFloatField; cdsBillsDesignPrice: TFloatField; cdsBillsMemoStr: TMemoField; cdsOrgBillsID: TIntegerField; cdsOrgBillsParentID: TIntegerField; cdsOrgBillsNextSiblingID: TIntegerField; cdsOrgBillsCode: TWideStringField; cdsOrgBillsName: TWideStringField; cdsOrgBillsUnits: TWideStringField; cdsOrgBillsQuantity: TFloatField; cdsOrgBillsUnitPrice: TBCDField; cdsOrgBillsTotalPrice: TBCDField; cdsOrgBillsB_Code: TWideStringField; cdsOrgBillsDesignQuantity: TFloatField; cdsOrgBillsDesignQuantity2: TFloatField; cdsOrgBillsDesignPrice: TFloatField; cdsOrgBillsMemoStr: TMemoField; cdsOrgDrawingQuantityID: TIntegerField; cdsOrgDrawingQuantityName: TWideStringField; cdsOrgDrawingQuantityUnits: TWideStringField; cdsOrgDrawingQuantityBillsID: TIntegerField; cdsOrgDrawingQuantityDQuantity1: TFloatField; cdsBillsIsPreDefine: TBooleanField; cdsOrgBillsIsPreDefine: TBooleanField; cdsDrawingQuantityMemoContext: TWideStringField; cdsOrgDrawingQuantityMemoContext: TWideStringField; cdsDQForLocate: TClientDataSet; cdsDQForLocateID: TIntegerField; cdsDQForLocateBillsID: TIntegerField; cdsDQForLocateName: TWideStringField; cdsDQForLocateUnits: TWideStringField; cdsDQForLocateMemoContext: TWideStringField; cdsDQForLocateDQuantity1: TFloatField; cdsDQForLocateDQuantity2: TFloatField; cdsDrawingQuantitySerinalNo: TIntegerField; cdsOrgDrawingQuantitySerinalNo: TIntegerField; cdsDQForLocateSerinalNo: TIntegerField; cdsOrgBillsSelected: TBooleanField; cdsXMJBills: TClientDataSet; cdsOrgBillsOwnerName: TWideStringField; cdsXMJBillsQuantity: TFloatField; cdsXMJBillsUnitPrice: TBCDField; cdsXMJBillsTotalPrice: TBCDField; cdsXMJBillsDesignQuantity: TFloatField; cdsXMJBillsDesignQuantity2: TFloatField; cdsXMJBillsDesignPrice: TFloatField; cdsXMJBillsID: TIntegerField; cdsXMJBillsParentID: TIntegerField; cdsXMJBillsNextSiblingID: TIntegerField; cdsXMJBillsCode: TWideStringField; cdsXMJBillsName: TWideStringField; cdsXMJBillsUnits: TWideStringField; cdsXMJBillsB_Code: TWideStringField; cdsXMJBillsMemoStr: TMemoField; cdsXMJBillsSelected: TBooleanField; cdsXMJBillsIsPreDefine: TBooleanField; cdsBillsSelected: TBooleanField; cdsDQForLocateIsGatherQ: TBooleanField; cdsOrgDrawingQuantityIsGatherQ: TBooleanField; cdsDrawingQuantityIsGatherQ: TBooleanField; cdsOrgBillsCustomValue: TFloatField; cdsBillsCustomValue: TFloatField; cdsBillsSerialNo: TIntegerField; cdsOrgBillsSerialNo: TIntegerField; cdsBillsLookup: TClientDataSet; cdsBillsLookupID: TIntegerField; cdsBillsLookupParentID: TIntegerField; cdsBillsLookupNextSiblingID: TIntegerField; cdsBillsLookupCode: TWideStringField; cdsBillsLookupName: TWideStringField; cdsBillsLookupUnits: TWideStringField; cdsBillsLookupQuantity: TFloatField; cdsBillsLookupUnitPrice: TBCDField; cdsBillsLookupTotalPrice: TBCDField; cdsBillsLookupB_Code: TWideStringField; cdsBillsLookupDesignQuantity: TFloatField; cdsBillsLookupDesignQuantity2: TFloatField; cdsBillsLookupDesignPrice: TFloatField; cdsBillsLookupMemoStr: TMemoField; cdsBillsLookupIsPreDefine: TBooleanField; cdsBillsLookupSelected: TBooleanField; cdsBillsLookupCustomValue: TFloatField; cdsBillsLookupSerialNo: TIntegerField; cdsBillsErrorHint: TWideStringField; cdsBillsIsSuperscale: TBooleanField; cdsBillsStandardGrade: TFloatField; cdsBillsDeductGrade: TFloatField; cdsBillsIsIgNore: TBooleanField; cdsBillsUserModified: TBooleanField; cdsBillsLostPreSiblingCount: TIntegerField; cdsBillsLostChildrenCount: TIntegerField; cdsBillsLostNextSiblingCount: TIntegerField; cdsBillsNameErrorFlag: TIntegerField; cdsBillsUnitsErrorFlag: TIntegerField; cdsBillsLookupLostNextSiblingCount: TIntegerField; cdsBillsLookupLostChildrenCount: TIntegerField; cdsBillsLookupLostPreSiblingCount: TIntegerField; cdsBillsLookupUserModified: TBooleanField; cdsBillsLookupIsIgNore: TBooleanField; cdsBillsLookupDeductGrade: TFloatField; cdsBillsLookupStandardGrade: TFloatField; cdsBillsLookupIsSuperscale: TBooleanField; cdsBillsLookupErrorHint: TWideStringField; cdsBillsLookupNameErrorFlag: TIntegerField; cdsBillsLookupUnitsErrorFlag: TIntegerField; cdsOrgBillsLostNextSiblingCount: TIntegerField; cdsOrgBillsLostChildrenCount: TIntegerField; cdsOrgBillsLostPreSiblingCount: TIntegerField; cdsOrgBillsUserModified: TBooleanField; cdsOrgBillsIsIgNore: TBooleanField; cdsOrgBillsDeductGrade: TFloatField; cdsOrgBillsStandardGrade: TFloatField; cdsOrgBillsIsSuperscale: TBooleanField; cdsOrgBillsErrorHint: TWideStringField; cdsOrgBillsNameErrorFlag: TIntegerField; cdsOrgBillsUnitsErrorFlag: TIntegerField; aqStat: TADOQuery; aqStatChapterID: TIntegerField; aqStatCode: TWideStringField; aqStatName: TWideStringField; aqStatStandardGrade: TFloatField; aqStatDeductGrade: TFloatField; aqStatActureMark: TCurrencyField; aqStatTotalMark: TCurrencyField; aqStatResultMark: TCurrencyField; aqStatStdMarkPercent: TBCDField; aqStatYsCount: TIntegerField; aqStatQdCount: TIntegerField; cdsStat: TClientDataSet; cdsStatChapterID: TIntegerField; cdsStatCode: TWideStringField; cdsStatName: TWideStringField; cdsStatStandardGrade: TBCDField; cdsStatDeductGrade: TBCDField; cdsStatActureMark: TBCDField; cdsStatTotalMark: TBCDField; cdsStatResultMark: TBCDField; cdsStatStdMarkPercent: TBCDField; cdsStatYsCount: TIntegerField; cdsStatQdCount: TIntegerField; dsStat: TDataSource; atStat: TADOTable; dspStat: TDataSetProvider; cdsBillsChapterID: TIntegerField; cdsOrgBillsChapterID: TIntegerField; cdsXMJBillsLostNextSiblingCount: TIntegerField; cdsXMJBillsLostChildrenCount: TIntegerField; cdsXMJBillsLostPreSiblingCount: TIntegerField; cdsXMJBillsUserModified: TBooleanField; cdsXMJBillsIsIgNore: TBooleanField; cdsXMJBillsDeductGrade: TFloatField; cdsXMJBillsStandardGrade: TFloatField; cdsXMJBillsIsSuperscale: TBooleanField; cdsXMJBillsErrorHint: TWideStringField; cdsXMJBillsNameErrorFlag: TIntegerField; cdsXMJBillsUnitsErrorFlag: TIntegerField; cdsXMJBillsChapterID: TIntegerField; acProject: TADOConnection; cdsBillsFullCode: TWideStringField; cdsStatTotal: TClientDataSet; atStatTotal: TADOTable; dspStatTotal: TDataSetProvider; cdsStatTotalID: TIntegerField; cdsStatTotalStandardGradeTotal: TBCDField; cdsStatTotalDeductGradeTotal: TBCDField; cdsStatTotalResultMarkTotal: TBCDField; cdsStatTotalAdditionalMark: TBCDField; cdsStatTotalQualityMark: TBCDField; cdsStatTotalYsCountTotal: TIntegerField; cdsStatTotalQdCountTotal: TIntegerField; aqStatTotal: TADOQuery; aqStatTotalID: TIntegerField; aqStatTotalStandardGradeTotal: TBCDField; aqStatTotalDeductGradeTotal: TBCDField; aqStatTotalResultMarkTotal: TBCDField; aqStatTotalAdditionalMark: TBCDField; aqStatTotalQualityMark: TBCDField; aqStatTotalYsCountTotal: TIntegerField; aqStatTotalQdCountTotal: TIntegerField; cdsBillsRightName: TWideStringField; cdsBillsRightUnits: TWideStringField; cdsOrgBillsRightName: TWideStringField; cdsOrgBillsRightUnits: TWideStringField; cdsBillsIsLeaf: TBooleanField; cdsOrgBillsIsLeaf: TBooleanField; cdsXMJBillsRightName: TWideStringField; cdsXMJBillsRightUnits: TWideStringField; cdsBillsIsCreatePriceAnalysis: TBooleanField; cdsOrgBillsIsCreatePriceAnalysis: TBooleanField; cdsBillsB_CodeAlpha: TWideStringField; cdsBillsIsAccQuantity: TBooleanField; cdsBillsLookupIsAccQuantity: TBooleanField; cdsOrgBillsIsAccQuantity: TBooleanField; blnfldXMJBillsIsAccQuantity: TBooleanField; cdsBillsDrawingCode: TWideStringField; cdsBillsLookupDrawingCode: TWideStringField; cdsOrgBillsDrawingCode: TWideStringField; procedure DataModuleCreate(Sender: TObject); procedure DataModuleDestroy(Sender: TObject); procedure cdsBillsAfterOpen(DataSet: TDataSet); procedure cdsDrawingQuantityAfterOpen(DataSet: TDataSet); procedure cdsOrgBillsAfterInsert(DataSet: TDataSet); procedure cdsOrgDrawingQuantityAfterInsert(DataSet: TDataSet); procedure cdsOrgBillsBeforePost(DataSet: TDataSet); procedure cdsOrgBillsCodeChange(Sender: TField); procedure cdsOrgBillsBeforeEdit(DataSet: TDataSet); procedure cdsOrgBillsAfterPost(DataSet: TDataSet); procedure cdsOrgBillsAfterScroll(DataSet: TDataSet); procedure cdsOrgDrawingQuantityAfterPost(DataSet: TDataSet); procedure cdsOrgDrawingQuantityBeforePost(DataSet: TDataSet); procedure cdsOrgBillsQuantityGetText(Sender: TField; var Text: String; DisplayText: Boolean); procedure cdsOrgBillsQuantitySetText(Sender: TField; const Text: String); procedure cdsOrgDrawingQuantityDQuantity1GetText(Sender: TField; var Text: String; DisplayText: Boolean); procedure cdsOrgDrawingQuantityDQuantity1SetText(Sender: TField; const Text: String); procedure cdsOrgDrawingQuantityBeforeDelete(DataSet: TDataSet); procedure cdsBillsAfterPost(DataSet: TDataSet); procedure cdsXMJBillsAfterScroll(DataSet: TDataSet); procedure cdsOrgBillsUnitPriceGetText(Sender: TField; var Text: String; DisplayText: Boolean); procedure cdsXMJBillsQuantityGetText(Sender: TField; var Text: String; DisplayText: Boolean); procedure cdsOrgDrawingQuantityBeforeEdit(DataSet: TDataSet); procedure cdsBillsAfterInsert(DataSet: TDataSet); procedure cdsDrawingQuantityAfterInsert(DataSet: TDataSet); procedure cdsOrgBillsDeductGradeGetText(Sender: TField; var Text: String; DisplayText: Boolean); procedure cdsBillsLostNextSiblingCountChange(Sender: TField); procedure cdsOrgBillsLostNextSiblingCountChange(Sender: TField); procedure aqStatCalcFields(DataSet: TDataSet); procedure aqStatTotalCalcFields(DataSet: TDataSet); procedure cdsOrgDrawingQuantityAfterDelete(DataSet: TDataSet); procedure cdsOrgBillsIsAccQuantityChange(Sender: TField); private // 当前是否填工程量 FCurIsGatherQ: Boolean; FDMExprs: TDMExprs; FProject: TObject; // FTriggerEvents: Boolean; FBillsTree: TScBillsTree; FXMJBillsTree: TXMJBillsTree; {std bills lib ctrl} FStdBillsCtrl: TObject; FStdLib: TObject; FStdTree: TStdBillsTree; FStdBQTree: TStdBillsTree; {code and b_code} FOldCode: string; FOldB_Code: string; { detail Items } FIsProjectBills: Boolean; FDetailItemsDM: TObject; FOldTotalPrice: Double; FBillsUndoRef: Integer; FDrawQtyUndoRef: Integer; FSavePoint: Integer; FSelList: TIntegerSList; FConnection: TADOConnection; {Event-Fields} FBillsAfterInsertEvt: TDataSetNotifyEvent; FBillsBeforePostEvt: TDataSetNotifyEvent; FBillsBeforeEditEvt: TDataSetNotifyEvent; FBillsAfterPostEvt: TDataSetNotifyEvent; FBillsAfterScrollEvt: TDataSetNotifyEvent; {UI} FEnabledUITreeEvt: TControlUIEvent; FEnabledUIDrawQtyEvt: TControlUIEvent; FDesignCodeEvt: TControlUIEvent; // 是否需要同步树：用于清单评分部分 FNeedSyncTree: Boolean; FOnStat: TStatEvent; // 名称含“××”的清单项的父清单的Code FXXParentCodeSL: TStringList; FPBStdTreeFile: string; FBQStdTreeFile: string; FGatherXXItems: TStrings; // 判断是否在执行CancelChildItemIsAQ方法 FOnCancelIsAQ: Boolean; function GetActive: Boolean; procedure SetActive(const Value: Boolean); procedure SetConnection(ACon: TADOConnection); function getConnection: TADOConnection; procedure SetStdBillsCtrl(Value: TObject); procedure SetIsProjectBills(const Value: Boolean); function GetBillsFullCode(AID: Integer): string; procedure InternalSave; procedure DeleteDQ(const ABillsID: Integer); procedure ClearBlankGatherXXItems; {gather DQquantity to Bills} procedure GatherDQQty(ABillsID: Integer; AGQ: Boolean); {auto match code form std lib, only used in beforepost} function IsGatherNode: Boolean; overload; function IsGatherNode(const aID: Integer): Boolean; overload; procedure SetDecimalDigit; procedure MatchCodeFromStdLib; overload; procedure MatchCodeFromStdLib(const AName, AUnits: string); overload; procedure CalculateParentQuantity; procedure AccQuantityToParentItem(AParentID: Integer; AQuantity1, AQuantity2: Double); function HasCalcPQChildItem(ABillsID: Integer): Boolean; procedure CancelChildItemIsAQ(ABillsID: Integer); procedure GatherChildDQuantity(ABillsID: Integer); {change children's code by parent} procedure ModifyCode(ANode: TZjIDTreeNode; const APreCode, AOldCode: string; AIsCode: Boolean); procedure ChildCodeModifyByParent(ANode: TZjIDTreeNode; const APreCode, AOldCode: string; AIsCode: Boolean); procedure ModifyCodeIncludeChildren(ANode: TZjIDTreeNode; const APreCode, AOldCode: string; AIsCode: Boolean); {sync billsitem code or b_code} procedure SyncBillsItemCode(const aID: Integer; const aCode, aB_Code, aName: string); {Events Handler} procedure BeginEvents(aExceptInsert: Boolean = False); procedure EndEvents; procedure ClearBillsFieldsTagAfterHandle; {Before Delete and After Delete} procedure BeforeDelete(aID: Integer; var aMajorIdx: Integer); procedure AfterDelete(aMajorIdx, aCount, aParentID, aPreID, aLastID: Integer); {clear quantity include children's} procedure ClearAllQuantity(ANode: TZjIDTreeNode); procedure ClearBillsQuantity(const ABillsID: Integer); procedure ClearDQQuantity(const ABillsID: Integer); {Filter xiang mu jie} function HasXMJ(aNode: TZjIDTreeNode): Boolean; procedure FilterXMJ(aNode: TZjIDTreeNode); { TODO -o-Litao : cancel cds operation } function GetSavePoint: Integer; procedure SetSavePoint(aSavePoint: Integer); {Remove zero Qty Bills} procedure ClearList(aList: TList); procedure FilterZeroQtyBills(aItems, aIDs: TList; aNode: TZjIDTreeNode); function FindIDRecord(AItems: TList; AID: Integer): PIDRecord; procedure UpdateRecords(aList: TList); procedure RemoveRecords(aIDs: TList); overload; procedure RemoveRecords(aIDs: string); overload; procedure UpdateRecord(aPreID, aNextID: Integer); function CanRemove(aNode: TZjIDTreeNode): Boolean; function IsQuantityZero(aID: Integer): Boolean; procedure FilterRemoveIDs(aNode: TZjIDTreeNode; aIDs: TList); function GetHasGatherQ: Boolean; function GetBQStdTreeFile: string; function GetPBStdTreeFile: string; procedure ReadBillGradeStdFile; public constructor Create(aProject: TObject); procedure Save; procedure SaveSerialNo; { Undo } procedure UnDoBillsText; procedure UnDoDrawQtyText; function CanUnDoBillsText: Boolean; function CanUnDoDrawQtyText: Boolean; function ShouldSave: Boolean; function HasDrawingQuantity(const AID: Integer): Boolean; {max IDs} function GetMaxBillsID: Integer; function GetMaxDrawingQuangtiyID: Integer; { TODO : Paste } function InsertItem(aNode: TZjIDTreeNode; const aCode, aName: string; aIsCode: Boolean): TZjIDTreeNode; { input excel } procedure AddBillsItem(ExlItem: TScExcelItem); overload; procedure AddBillsItem(GatherNode: TCacheGatherNode); overload; procedure AddDrawQItem(DQItem: TDrawingQuantityItem; SerinalNo: Integer = -1); procedure DeletePartSubItem(strList: TStringList); procedure ModifyNextSiblingID(const AID, ANextSiblingID: Integer); overload; function ModifyNextSiblingID(aID, aNewNextID: Integer; var aParentID, aNextID: Integer): Boolean; overload; procedure GetDQListByBillsID(ABillsID: Integer; GNode: TCacheGatherNode; var DQID: Integer); {gather} procedure ExtractBillsRecord(const AID: Integer; GatherNode: TCacheGatherNode); procedure ExtractBillsCode(const ID: Integer; var Code, BCode, Name: string); procedure PlusDesignQuantitys(const ID: Integer; GNode: TCacheGatherNode); procedure PlusBillsQuantity(const ID: Integer; GNode: TCacheGatherNode); procedure PlusDQDesignQuantitys(AID: Integer; GNode: TCacheGatherNode; var DQID: Integer); procedure DeleteAllBills(aDeleteDetail: Boolean = True); {PasteBills} procedure WriteRecIntoDB(aList: TList); { 删除工程量=0的清单 } procedure RemoveZeroQtyBills; { TODO : 导入工程量清单的单价 } procedure BeginImport; procedure EndImport; procedure AssignQtyItemUnitPrice(const aCode: string; aUnitPrice: Double); {节点收缩状态存取 } procedure SaveStatus; procedure ReadStatus(AID, ALength: Integer); {Delete Bills} procedure DeleteBills(aID: Integer); overload; procedure DeleteBills(aIDList: TStringList; aPreID, aLastID, aParentID: Integer); overload; function PreBlackFontItemID(ACurID: Integer): Integer; {control events} procedure BeginHandler(aExceptInsert: Boolean = False); procedure EndHandler; {BillsTree} procedure DisconnectBillsTree; procedure ConnectionBillsTree; { XMJBillsTree } procedure EnterXMJBills; procedure LeaveXMJBills; procedure LocateProjectBills; procedure SelectGatherNode(aNode: TZjIDTreeNode; aSelected: Boolean); function IsContainXXItem(ACode: string): Boolean; function HasSelected: Boolean; {clear cur node's Quantity} procedure ClearCurNodeQty; {show Levels} procedure ShowLevel(aLevelID: Integer); procedure OnlyShowXMJ; { Note: test tree is right } procedure CheckTree(aNode: TZjIDTreeNode); {Locate Bills} procedure GetChapterNames(ANames: TStrings); procedure LocateBills(aBillsID: Integer); overload; procedure LocateBills(const aCode: string); overload; {Selected} procedure ModifySelected(aID: Integer; aValue: Boolean); { Find Bills } function FindBills(aCdsDataset: TClientDataSet; aID: Integer): Boolean; { Calculate All Bills } function CalculateNode(aNode: TZjIDTreeNode): Double; overload; function CalculateSingle(aNode: TZjIDTreeNode): Double; procedure CalculateNode(aNode: TZjIDTreeNode; aTotalPrice: Double); overload; function CalculateOther(aFirstSum, aSecondSum: Double): Double; function CalculateAll: Double; procedure AscendSumToParent(aParent: TZjIDTreeNode; aOldSum, aNewSum: Double); procedure GatherBillsQuantity; // chenshilong, 2011-01-26 11:56:18 以下这部分清单评分 procedure Grade(AllScope: Boolean = True); // 扣分规则。注意不是标准分，扣分不一定会将标准分扣完 function StdDeductMark(ABillCategory: TBillCategory; AErrorCategory: TErrorCategory; ACount: Integer): Currency; function StdMark(AItem: TScBillsItem): Currency; overload; function StdMark(ACode, AB_Code: string): Currency; overload; function Stat: Currency; procedure ClearUserFlags; procedure CancelError(AEC: TErrorCategory); procedure AddError(AEC: TErrorCategory; ACount: Integer); // 递归删除最后节点的父节点的单位 procedure DeleteLastParentUnit(AID: Integer); // 根据树节点数据刷新cdsOrgBills procedure RefreshByItem(AItem: TScBillsItem); procedure SyncGradeFromTreeNodeToDataSet(AItem: TScBillsItem); procedure SyncGradeFromDataSetToTreeNode(ACDS: TClientDataSet); // 用户手工修改了清单评分数据 procedure SetUserModifiedGrade; // 宽松对比，AStr1和AStr2是否相同，如忽略括号全半角等。 function LooseCompareIsSame(AStr1, AStr2: string): Boolean; procedure Save_SerialNo_ChapterID_FullCode; // 清空所有清单单价 chenshilong, 2011-07-26 procedure ClearAllUnitPrices; property Active: Boolean read GetActive write SetActive; property Connection: TADOConnection read getConnection write SetConnection; property BillsTree: TScBillsTree read FBillsTree; property XMJBillsTree: TXMJBillsTree read FXMJBillsTree; property DMExprs: TDMExprs read FDMExprs write FDMExprs; property DetailItemsDM: TObject read FDetailItemsDM; property IsProjectBills: Boolean read FIsProjectBills write SetIsProjectBills; {std bills lib} property StdBillsCtrl: TObject read FStdBillsCtrl write SetStdBillsCtrl; {Events} property EnabledUITreeEvt: TControlUIEvent read FEnabledUITreeEvt write FEnabledUITreeEvt; property EnabledUIDrawQtyEvt: TControlUIEvent read FEnabledUIDrawQtyEvt write FEnabledUIDrawQtyEvt; property DesignCodeEvt: TControlUIEvent read FDesignCodeEvt write FDesignCodeEvt; property OnStat: TStatEvent read FOnStat write FOnStat; property HasGatherQ: Boolean read GetHasGatherQ; property Project: TObject read FProject write FProject; property PBStdTreeFile: string read GetPBStdTreeFile write FPBStdTreeFile; property BQStdTreeFile: string read GetBQStdTreeFile write FBQStdTreeFile; procedure CloneActive(IsActive: Boolean); end; var DMDataBase: TDMDataBase; // 获取所有子结点个数（包含子子结点，但不包括自身） function GetAllChildrenCount(ANode: TZjIDTreeNode): Integer; implementation uses Graphics, ScStdBillsCtrl, Math, ScEvaluate, Windows, Forms, Controls, ScConfig, StrUtils, ScProjectManager, DetailItemsDM, ScProgressFrm, StdBillsLibDM, IniFiles, {CslTimeDebug,} MainForm; {$R *.dfm} { TDMDataBase } function TDMDataBase.HasDrawingQuantity(const AID: Integer): Boolean; begin Result := cdsDQForLocate.FindKey([AID]); end; procedure TDMDataBase.DataModuleCreate(Sender: TObject); var sXXFile: string; begin FXXParentCodeSL := TStringList.Create; FGatherXXItems := TStringList.Create; sXXFile := ExtractFilePath(Application.ExeName) + 'Data\XXItem.dll'; if FileExists(sXXFile) then FXXParentCodeSL.LoadFromFile(sXXFile); sXXFile := ExtractFilePath(Application.ExeName) + 'Data\GatherXXItem.ini'; if FileExists(sXXFile) then FGatherXXItems.LoadFromFile(sXXFile); ClearBlankGatherXXItems; FBillsTree := TScBillsTree.Create; FBillsTree.Bills := Self; FBillsTree.AutoExpand := True; FBillsTree.KeyFieldName := SID; FBillsTree.ParentFieldName := sParentID; FBillsTree.NextSiblingFieldName := sNextSiblingID; cdsBills.IndexDefs.Clear; cdsBills.IndexDefs.Add('BillsIDidx', SID, [ixPrimary, ixUnique]); cdsBills.IndexDefs.Add('idxB_Code', 'B_Code', []); cdsBills.IndexName := 'BillsIDidx'; cdsDrawingQuantity.IndexDefs.Add('IDidx', SID, [ixPrimary, ixUnique]); cdsDrawingQuantity.IndexName := 'IDidx'; FSelList := TIntegerSList.Create; { XmjBillsTree } FXMJBillsTree := TXMJBillsTree.Create; FXMJBillsTree.Bills := Self; FXMJBillsTree.AutoExpand := True; FXMJBillsTree.KeyFieldName := SID; FXMJBillsTree.ParentFieldName := sParentID; FXMJBillsTree.NextSiblingFieldName := sNextSiblingID; {add vaildchars for exprs calc} cdsOrgBillsQuantity.ValidChars := cdsOrgBillsQuantity.ValidChars + ExprsCharSet; cdsOrgBillsDesignQuantity.ValidChars := cdsOrgBillsDesignQuantity.ValidChars + ExprsCharSet; cdsOrgBillsDesignQuantity2.ValidChars := cdsOrgBillsDesignQuantity2.ValidChars + ExprsCharSet; cdsOrgDrawingQuantityDQuantity1.ValidChars := cdsOrgDrawingQuantityDQuantity1.ValidChars + ExprsCharSet; FNeedSyncTree := True; ReadBillGradeStdFile; end; procedure TDMDataBase.DataModuleDestroy(Sender: TObject); begin FXXParentCodeSL.Free; FGatherXXItems.Free; FBillsTree.Free; FXMJBillsTree.Free; FSelList.Free; end; function TDMDataBase.GetActive: Boolean; begin Result := cdsBills.Active and cdsDrawingQuantity.Active; end; procedure TDMDataBase.SetActive(const Value: Boolean); begin cdsBills.Active := Value; cdsDrawingQuantity.Active := Value; cdsStat.Active := Value; cdsStatTotal.Active := Value; if Value then cdsStat.IndexFieldNames := 'ChapterID'; end; procedure TDMDataBase.cdsBillsAfterOpen(DataSet: TDataSet); begin if cdsBills.Active then begin cdsOrgBills.CloneCursor(cdsBills, True); cdsBillsLookup.CloneCursor(cdsBills, True); // ConnectionBillsTree; end; end; procedure TDMDataBase.cdsDrawingQuantityAfterOpen(DataSet: TDataSet); begin cdsDQForLocate.CloneCursor(cdsDrawingQuantity, True); cdsDQForLocate.IndexFieldNames := Format('%s;%s', [sBillsID, sSerinalNO]); cdsOrgDrawingQuantity.CloneCursor(cdsDrawingQuantity, True); cdsOrgDrawingQuantity.MasterSource := dsBillsDrawing; {主表字段} cdsOrgDrawingQuantity.MasterFields := SID; {从表字段, 通过索引字段来设} cdsOrgDrawingQuantity.IndexFieldNames := Format('%s;%s', [sBillsID, sSerinalNO]); end; function TDMDataBase.getConnection: TADOConnection; begin Result := FConnection; end; procedure TDMDataBase.SetConnection(ACon: TADOConnection); begin FConnection := ACon; atBills.Connection := FConnection; atDrawingQuantity.Connection := FConnection; atStat.Connection := FConnection; aqStat.Connection := FConnection; atStatTotal.Connection := FConnection; aqStatTotal.Connection := FConnection; end; function TDMDataBase.GetMaxBillsID: Integer; begin cdsBills.Last; Result := cdsBillsID.Value + 1; if Result < 300 then Result := 300; end; procedure TDMDataBase.cdsOrgBillsAfterInsert(DataSet: TDataSet); var iMaxBillsID: Integer; begin iMaxBillsID := GetMaxBillsID; cdsOrgBillsID.Value := iMaxBillsID; FBillsUndoRef := 0; cdsOrgBillsIsCreatePriceAnalysis.Value := True; if Assigned(FStdBillsCtrl) then TStdBillsCtrl(FStdBillsCtrl).DMStdBillsLib.AutoIncreaseBillsCode; end; function TDMDataBase.GetMaxDrawingQuangtiyID: Integer; begin cdsDrawingQuantity.Last; Result := cdsDrawingQuantityID.Value + 1; end; procedure TDMDataBase.cdsOrgDrawingQuantityAfterInsert(DataSet: TDataSet); begin // if FTriggerEvents then Exit; FDrawQtyUndoRef := 0; cdsOrgDrawingQuantityID.Value := GetMaxDrawingQuangtiyID; cdsOrgDrawingQuantitySerinalNo.Value := cdsOrgDrawingQuantity.RecordCount + 1; end; procedure TDMDataBase.Save; begin CreateProgressForm(100, '正在保存数据，请稍候>>>'); AddProgressForm(10, '正在保存流水号和章节号...'); FBillsUndoRef := 0; FDrawQtyUndoRef := 0; {InternalSave; } Save_SerialNo_ChapterID_FullCode; AddProgressForm(20, '正在保存清单，根据项目的大小，可能需要较长时间...'); cdsBills.ApplyUpdates(0); AddProgressForm(20, '正在保存图纸工程量...'); cdsDrawingQuantity.ApplyUpdates(0); AddProgressForm(10, '正在保存计算公式...'); AddProgressForm(10, '正在保存评分统计...'); cdsStat.ApplyUpdates(0); cdsStatTotal.ApplyUpdates(0); CloseProgressForm; end; function TDMDataBase.ShouldSave: Boolean; begin Result := (cdsBills.ChangeCount > 0) or (cdsDrawingQuantity.ChangeCount > 0) or (cdsStat.ChangeCount > 0); end; procedure TDMDataBase.AddBillsItem(ExlItem: TScExcelItem); begin cdsBills.Insert; cdsBillsID.Value := ExlItem.ID; cdsBillsParentID.Value := ExlItem.ParentID; cdsBillsNextSiblingID.Value := ExlItem.NextSiblingID; cdsBillsCode.Value := ExlItem.Code; cdsBillsUnitPrice.Value := ScRoundTo(ExlItem.Price, -2); cdsBillsTotalPrice.Value := ScRoundTo(ExlItem.TotalPrice, 0); if SameText(ExlItem.Code, '') then begin cdsBillsQuantity.Value := ScRoundTo(ExlItem.Quantity, -3); {if cdsBillsQuantity.AsFloat <> 0 then begin cdsBillsUnitPrice.Value := ScRoundTo(ExlItem.TotalPrice/cdsBillsQuantity.AsFloat, -2); cdsBillsTotalPrice.Value := ScRoundTo(cdsBillsQuantity.AsFloat*cdsBillsUnitPrice.AsFloat, 0); end; } end else begin cdsBillsDesignQuantity.Value := ScRoundTo(ExlItem.Quantity1, -3); cdsBillsDesignQuantity2.Value := ScRoundTo(ExlItem.Quantity2, -3); {if cdsBillsDesignQuantity.AsFloat <> 0 then begin cdsBillsTotalPrice.Value := ScRoundTo(ExlItem.TotalPrice, 0); cdsBillsDesignPrice.AsFloat := ScRoundTo(cdsBillsTotalPrice.AsFloat/cdsBillsDesignQuantity.AsFloat, -2); end; } end; cdsBillsB_Code.Value := ExlItem.BCode; cdsBillsName.Value := ExlItem.Name; cdsBillsUnits.Value := ExlItem.Units; cdsBillsMemoStr.Value := ExlItem.MemoString; cdsBillsIsPreDefine.Value := ExlItem.ParentID = -1; cdsBills.Post; end; procedure TDMDataBase.AddDrawQItem(DQItem: TDrawingQuantityItem; SerinalNo: Integer); begin cdsDrawingQuantity.Insert; cdsDrawingQuantityID.Value := DQItem.ID; if SerinalNo = -1 then cdsDrawingQuantitySerinalNo.Value := DQItem.SerinalNo else cdsDrawingQuantitySerinalNo.Value := SerinalNo; cdsDrawingQuantityBillsID.Value := DQItem.BillsID; cdsDrawingQuantityName.Value := DQItem.Name; cdsDrawingQuantityUnits.Value := DQItem.Units; if DQItem.DesignQuantity1 <> 0 then cdsDrawingQuantityDQuantity1.Value := ScRoundTo(DQItem.DesignQuantity1, -3); if DQItem.DesignQuantity2 <> 0 then cdsDrawingQuantityDQuantity2.Value := ScRoundTo(DQItem.DesignQuantity2, -3); cdsDrawingQuantityMemoContext.Value := DQItem.MemoContext; cdsDrawingQuantity.Post; end; function ComPareItemsID(Obj1, Obj2: Pointer): Integer; begin if TBillsOrderItem(Obj1).ID < TBillsOrderItem(Obj2).ID then Result := -1 else if TBillsOrderItem(Obj1).ID > TBillsOrderItem(Obj2).ID then Result := 1 else Result := 0; end; procedure TDMDataBase.InternalSave; { procedure ClearObjects(ObjList: TList); var I: Integer; ObjItem: TBillsOrderItem; begin for I := ObjList.Count - 1 downto 0 do begin ObjItem := TBillsOrderItem(ObjList[I]); ObjItem.Free; end; end; procedure ExtractBillsPropertities(ObjList: TList); var I: Integer; ObjBills: TBillsOrderItem; billsItem: TScBillsItem; begin for I := 0 to BillsTree.Count - 1 do begin billsItem := BillsTree.Items[I]; ObjBills := TBillsOrderItem.Create; ObjBills.ID := billsItem.ID; ObjBills.MajorIndex := billsItem.MajorIndex; ObjBills.CharpterID := billsItem.ChapterID; ObjBills.HasChildren := billsItem.HasChildren; ObjList.Add(ObjBills); end; ObjList.Sort(ComPareItemsID); end; var I, CurID: Integer; ObjectsList: TList; DataSet: TDataSet; Item: TScBillsItem; ObjBills: TBillsOrderItem; } begin { ObjectsList := TList.Create; try DataSet := nil; CurID := BillsTree.SelectedIndex; ExtractBillsPropertities(ObjectsList); if Assigned(BillsTree.DataSet) then begin DataSet := BillsTree.DataSet; BillsTree.DataSet := nil; end; try I := 0; cdsBills.First; while not cdsBills.Eof do begin ObjBills := TBillsOrderItem(ObjectsList[I]); cdsBills.Edit; cdsBillsSerialNo.Value := ObjBills.MajorIndex; cdsBillsChapterID.Value := ObjBills.CharpterID; cdsBillsIsLeaf.Value := not ObjBills.HasChildren; // cdsBillsFullCode.Value := GetBillsFullCode(cdsBillsID.Value); cdsBills.Post; cdsBills.Next; Inc(I); end; finally if Assigned(DataSet) then BillsTree.DataSet := DataSet; Item := TScBillsItem(BillsTree.Items[curID]); Item.LocateDBRecord; end; finally ClearObjects(ObjectsList); ObjectsList.Free; end; } end; procedure TDMDataBase.DeletePartSubItem(strList: TStringList); var I: Integer; IDLstString: string; cdsDataSet: TClientDataSet; begin for I := 0 to strList.Count - 1 do begin IDLstString := strList.Strings[I]; cdsDataSet := TClientDataSet.Create(nil); cdsDataSet.CloneCursor(cdsBills, True); try cdsDataSet.Filter := IDLstString; cdsDataSet.Filtered := True; cdsDataSet.First; while not cdsDataSet.Eof do begin DeleteDQ(cdsDataSet.FieldByName(SID).AsInteger); cdsDataSet.Delete; end; finally cdsDataSet.Free; end; end; end; procedure TDMDataBase.ModifyNextSiblingID(const AID, ANextSiblingID: Integer); begin if AID = -1 then Exit; if cdsBills.FindKey([AID]) then begin cdsBills.Edit; cdsBillsNextSiblingID.Value := ANextSiblingID; cdsBills.Post; end; end; procedure TDMDataBase.DeleteDQ(const ABillsID: Integer); var cdsDelete: TClientDataSet; begin cdsDelete := TClientDataSet.Create(nil); try cdsDelete.CloneCursor(cdsDrawingQuantity, True); cdsDelete.IndexFieldNames := sBillsID; cdsDelete.SetRange([ABillsID], [ABillsID]); cdsDelete.First; while not cdsDelete.Eof do begin FDMExprs.Delete(Exprs_DrawQty_ID, cdsDelete.FieldByName(SID).AsInteger); cdsDelete.Delete; end; finally cdsDelete.Free; end; end; procedure TDMDataBase.AddBillsItem(GatherNode: TCacheGatherNode); begin cdsBills.Insert; cdsBillsID.Value := GatherNode.ID; cdsBillsParentID.Value := GatherNode.ParentID; cdsBillsNextSiblingID.Value := GatherNode.NextSiblingID; cdsBillsCode.Value := GatherNode.Code; //cdsBillsTotalPrice.Value := ScRoundTo(GatherNode.TotalPrice, 0); if SameText(GatherNode.Code, '') then begin cdsBillsQuantity.Value := ScRoundTo(GatherNode.Quantity, -3); if cdsBillsQuantity.AsFloat <> 0 then begin cdsBillsUnitPrice.Value := ScRoundTo(GatherNode.TotalPrice/cdsBillsQuantity.AsFloat, -2); cdsBillsTotalPrice.Value := ScRoundTo(cdsBillsQuantity.AsFloat*cdsBillsUnitPrice.AsFloat, 0); end; end else begin cdsBillsDesignQuantity.Value := ScRoundTo(GatherNode.DesignQuantity1, -3); cdsBillsDesignQuantity2.Value := ScRoundTo(GatherNode.DesignQuantity2, -3); if cdsBillsDesignQuantity.AsFloat <> 0 then begin cdsBillsTotalPrice.Value := ScRoundTo(GatherNode.TotalPrice, 0); cdsBillsDesignPrice.AsFloat := ScRoundTo(cdsBillsTotalPrice.AsFloat/cdsBillsDesignQuantity.AsFloat, -2); end; end; cdsBillsB_Code.Value := GatherNode.BCode; cdsBillsName.Value := GatherNode.Name; cdsBillsUnits.Value := GatherNode.Units; cdsBillsMemoStr.Value := GatherNode.MemoString; cdsBillsIsPreDefine.Value := GatherNode.IsPreDefined; cdsBills.Post; end; procedure TDMDataBase.GetDQListByBillsID(ABillsID: Integer; GNode: TCacheGatherNode; var DQID: Integer); var DQItem: TDrawingQuantityItem; cdsDQList: TClientDataSet; begin cdsDQList := TClientDataSet.Create(nil); cdsDQList.CloneCursor(cdsDrawingQuantity, True); cdsDQList.IndexFieldNames := sBillsID; cdsDQList.SetRange([ABillsID], [ABillsID]); cdsDQList.First; while not cdsDQList.Eof do begin DQItem := TDrawingQuantityItem.Create; DQItem.ID := DQID; DQItem.BillsID := GNode.ID; DQItem.Name := cdsDQList.FieldByName(sName).AsString; DQItem.Units := cdsDQList.FieldByName(sUnits).AsString; DQItem.DesignQuantity1 := cdsDQList.FieldByName(sDQuantity1).AsFloat; DQItem.DesignQuantity2 := cdsDQList.FieldByName(sDQuantity2).AsFloat; DQItem.MemoContext := cdsDQList.FieldByName(sMemoContext).AsString; GNode.DQList.Add(DQItem); Inc(DQID); cdsDQList.Next; end; cdsDQList.Free; end; procedure TDMDataBase.ExtractBillsRecord(const AID: Integer; GatherNode: TCacheGatherNode); begin if cdsBills.FindKey([AID]) then begin GatherNode.Code := cdsBillsCode.AsString; GatherNode.Quantity := cdsBillsQuantity.Value; GatherNode.BCode := cdsBillsB_Code.AsString; GatherNode.OldBCode := GatherNode.BCode; GatherNode.DesignQuantity1 := cdsBillsDesignQuantity.Value; GatherNode.DesignQuantity2 := cdsBillsDesignQuantity2.Value; GatherNode.Name := cdsBillsName.AsString; GatherNode.Units := cdsBillsUnits.AsString; GatherNode.UnitPrice := cdsBillsUnitPrice.Value; if cdsBillsB_Code.AsString <> '' then GatherNode.TotalPrice := cdsBillsQuantity.AsFloat*cdsBillsUnitPrice.AsFloat else GatherNode.TotalPrice := cdsBillsTotalPrice.AsFloat; GatherNode.MemoString := cdsBillsMemoStr.AsString; GatherNode.IsPreDefined := cdsBillsIsPreDefine.AsBoolean; end; end; procedure TDMDataBase.ExtractBillsCode(const ID: Integer; var Code, BCode, Name: string); begin if cdsBills.FindKey([ID]) then begin Code := cdsBillsCode.Value; BCode := cdsBillsB_Code.Value; Name := cdsBillsName.Value; end; end; procedure TDMDataBase.PlusBillsQuantity(const ID: Integer; GNode: TCacheGatherNode); begin if cdsBills.FindKey([ID]) then begin GNode.Quantity := GNode.Quantity + cdsBillsQuantity.AsFloat; GNode.TotalPrice := GNode.TotalPrice + cdsBillsQuantity.AsFloat*cdsBillsUnitPrice.AsFloat; end; end; procedure TDMDataBase.PlusDesignQuantitys(const ID: Integer; GNode: TCacheGatherNode); begin if cdsBills.FindKey([ID]) then begin GNode.DesignQuantity1 := GNode.DesignQuantity1 + cdsBillsDesignQuantity.Value; GNode.DesignQuantity2 := GNode.DesignQuantity2 + cdsBillsDesignQuantity2.Value; GNode.TotalPrice := GNode.TotalPrice + cdsBillsTotalPrice.Value; end; end; procedure TDMDataBase.PlusDQDesignQuantitys(AID: Integer; GNode: TCacheGatherNode; var DQID: Integer); var I: Integer; blFounded: Boolean; DQItem: TDrawingQuantityItem; CDS1: TClientDataSet; begin CDS1 := TClientDataSet.Create(nil); CDS1.CloneCursor(cdsDrawingQuantity, True); CDS1.IndexFieldNames := sBillsID; CDS1.SetRange([AID], [AID]); CDS1.First; while not CDS1.Eof do begin blFounded := False; for I := 0 to GNode.DQList.Count - 1 do begin DQItem := TDrawingQuantityItem(GNode.DQList[I]); if SameText(DQItem.Name, CDS1.FieldByName(sName).AsString) and SameText(DQItem.Units, CDS1.FieldByName(sUnits).AsString) then begin DQItem.DesignQuantity1 := DQItem.DesignQuantity1 + CDS1.FieldByName(sDQuantity1).AsFloat; DQItem.DesignQuantity2 := DQItem.DesignQuantity2 + CDS1.FieldByName(sDQuantity2).AsFloat; blFounded := True; Break; end; end; if not blFounded then begin DQItem := TDrawingQuantityItem.Create; DQItem.ID := DQID; DQItem.BillsID := GNode.ID; DQItem.Name := CDS1.FieldByName(sName).AsString; DQItem.Units := CDS1.FieldByName(sUnits).AsString; DQItem.DesignQuantity1 := CDS1.FieldByName(sDQuantity1).AsFloat; DQItem.DesignQuantity2 := CDS1.FieldByName(sDQuantity2).AsFloat; DQItem.MemoContext := CDS1.FieldByName(sMemoContext).AsString; GNode.DQList.Add(DQItem); Inc(DQID); end; CDS1.Next; end; CDS1.Free; end; procedure TDMDataBase.DeleteAllBills(aDeleteDetail: Boolean); begin cdsBills.First; while not cdsBills.Eof do begin if aDeleteDetail then begin DeleteDQ(cdsBillsID.AsInteger); FDMExprs.Delete(Exprs_Bills_ID, cdsBillsID.AsInteger); end; cdsBills.Delete; end; end; procedure TDMDataBase.cdsOrgBillsBeforePost(DataSet: TDataSet); var bCanMatch: Boolean; begin bCanMatch := (cdsOrgBillsCode.Tag = 1) or (cdsOrgBillsB_Code.Tag = 1); if bCanMatch then begin if (cdsOrgBillsCode.AsString <> '') and (cdsOrgBillsB_Code.AsString <> '') then begin DataSet.Cancel; raise Exception.Create('项目编号和清单编号不能同时存在！'); end; end; // Modified By MaiXinRong 2012-03-21 {Is Accept Quantity Input} if (cdsOrgBillsDesignQuantity.Tag = 1) or (cdsOrgBillsDesignQuantity2.Tag = 1) then begin if HasCalcPQChildItem(cdsOrgBillsID.AsInteger) then begin if MessageQuest('该清单下有子清单勾选填父项量，是否修改并取消子清单的填父项量勾选？','询问') then CancelChildItemIsAQ(cdsBillsID.AsInteger) else // 将DataSet.Cancel注释掉,因为在这里直接Cancel后会报错，所以这里不做修改，直接去保持原有的状态 // 在后面的AfterPost中去保持原来的方式计算一遍，这也相当于不做修改 // 2012.5.8HXY // DataSet.Cancel; end; //CalculateParentQuantity; //cdsOrgBillsDesignQuantity.Tag := 0; //cdsOrgBillsDesignQuantity2.Tag := 0; end; if cdsOrgBillsIsAccQuantity.Tag = 1 then begin if cdsOrgBillsB_Code.AsString <> '' then begin cdsOrgBillsIsAccQuantity.Clear; cdsOrgBillsIsAccQuantity.Tag := 1; end; end; { Moved to AfterPost, As Used Gather Replace Addition and subtraction} { if cdsOrgBillsIsAccQuantity.Tag = 1 then begin CalculateParentQuantity; cdsOrgBillsIsAccQuantity.Tag := 0; end; } {set float number decimal digit} SetDecimalDigit; {match info from std lib} if Assigned(FStdBillsCtrl) and bCanMatch and (cdsOrgBillsName.AsString = '') then MatchCodeFromStdLib; {refresh custom step record when bills node uplevel or downlevel } if (DataSet.State = dsEdit) and ((cdsOrgBillsParentID.Tag = 1) or (cdsOrgBillsNextSiblingID.Tag = 1)) then begin FBillsUndoRef := 0; cdsOrgBills.AfterScroll(nil); cdsOrgBillsParentID.Tag := 0; cdsOrgBillsNextSiblingID.Tag := 0; end; end; // chenshilong, 2011-07-13 function TDMDataBase.GetBillsFullCode(AID: Integer): string; var vItem: TScBillsItem; sCode, sBCode: string; begin Result := ''; vItem := BillsTree.BillsItem[AID]; if vItem = nil then Exit; sCode := Trim(vItem.Code); sBCode := Trim(vItem.B_Code); // 预算项目节，FullCode直接等于自身的Code if (sCode <> '') then Result := sCode else // 清单子目号，FullCode等于最底层预算项目节Code begin while Assigned(vItem) and (Trim(vItem.Code) = '') do begin vItem := TScBillsItem(vItem.Parent); end; if Assigned(vItem) then Result := Trim(vItem.Code); end; end; procedure TDMDataBase.BeginHandler(aExceptInsert: Boolean); begin BeginEvents(aExceptInsert); end; procedure TDMDataBase.EndHandler; begin EndEvents; ClearBillsFieldsTagAfterHandle; {this code is used for showing custom step} FBillsAfterScrollEvt(nil); end; function TDMDataBase.PreBlackFontItemID(ACurID: Integer): Integer; const arrayID: array [0..5] of Integer = (1, 2, 3, 4, 8, 9); var i, iPos: Integer; begin Result := 1; iPos := 0; for i :=Low(arrayID) to High(arrayID) do begin if arrayID[i] = ACurID then begin iPos := i; Break; end; end; for i := iPos - 1 downto Low(arrayID) do begin if cdsBills.FindKey([arrayID[i]]) then begin Result := arrayID[i]; Break; end; end; end; procedure TDMDataBase.ChildCodeModifyByParent(ANode: TZjIDTreeNode; const APreCode, AOldCode: string; AIsCode: Boolean); var I: Integer; vNode: TZjIDTreeNode; begin for I := 0 to ANode.ChildCount - 1 do begin vNode := ANode.ChildNodes[I]; ModifyCode(vNode, APreCode, AOldCode, AIsCode); end; end; {function GetNewCode(const AOldCode, AOldParentCode, APreCode: string): string; begin Result := AOldCode; if Result = '' then Exit; if AOldParentCode = '' then begin if APreCode <> '' then Result := format('%s-%s', [APreCode, Result]); end else begin if APreCode = '' then begin Delete(Result, 1, Length(AOldParentCode) + 1); end else begin Delete(Result, 1, Length(AOldParentCode)); Result := APreCode + Result; end; end; end; } function ReplaceCodePreFix(const APreFixCode, AFullCode: string): string; function GetLastcode(const ACode: string): string; var I: Integer; begin Result := ''; for I := Length(ACode) downto 1 do begin if ACode[I] <> '-' then Result := ACode[I] + Result else Break; end; if Result = '' then Result := '1'; end; begin if APreFixCode <> '' then Result := APreFixCode + '-' + GetLastCode(AFullCode) else Result := GetLastcode(AFullCode); end; procedure TDMDataBase.ModifyCode(ANode: TZjIDTreeNode; const APreCode, AOldCode: string; AIsCode: Boolean); var strPreCode, strOldCode: string; begin if cdsBills.FindKey([ANode.ID]) then begin if AIsCode and (cdsBillsB_Code.Value <> '') then Exit; cdsBills.Edit; if AIsCode then begin strOldCode := cdsBillsCode.AsString; strPreCode := ReplaceCodePreFix(APreCode, strOldCode); //GetNewCode(strOldCode, AOldCode, APreCode); cdsBillsCode.Value := strPreCode; end else begin strOldCode := cdsBillsB_Code.AsString; strPreCode := ReplaceCodePreFix(APreCode, strOldCode); //GetNewCode(strOldCode, AOldCode, APreCode); cdsBillsB_Code.Value := strPreCode; end; cdsBills.Post; ChildCodeModifyByParent(ANode, strPreCode, strOldCode, AIsCode); end; end; procedure TDMDataBase.cdsOrgBillsCodeChange(Sender: TField); begin Sender.Tag := 1; end; procedure TDMDataBase.cdsOrgBillsBeforeEdit(DataSet: TDataSet); begin FOldCode := cdsOrgBillsCode.Value; FOldB_Code := cdsOrgBillsB_Code.Value; Inc(FBillsUndoRef); end; procedure TDMDataBase.cdsOrgBillsAfterPost(DataSet: TDataSet); var ztnNode: TZjIDTreeNode; begin if cdsOrgBillsCode.Tag = 1 then ModifyCodeIncludeChildren(FBillsTree.Selected, cdsOrgBillsCode.AsString, FOldCode, True); if cdsOrgBillsB_Code.Tag = 1 then ModifyCodeIncludeChildren(FBillsTree.Selected, cdsOrgBillsB_Code.AsString, FOldB_Code, False); if cdsOrgBillsTotalPrice.Tag = 1 then begin ztnNode := FBillsTree.Selected; if ztnNode <> nil then begin FEnabledUITreeEvt(False); AscendSumToParent(ztnNode.Parent, FOldTotalPrice, cdsOrgBillsTotalPrice.AsFloat); FEnabledUITreeEvt(True); end; cdsOrgBillsTotalPrice.Tag := 0; end; if cdsOrgBillsIsSuperscale.Tag = 1 then begin if cdsOrgBillsIsSuperscale.AsBoolean then AddError(ecSuperscale, 1) else CancelError(ecSuperscale); end; if (cdsOrgBillsCode.Tag = 1) or (cdsOrgBillsB_Code.Tag = 1) or (cdsOrgBillsName.Tag = 1) or (cdsOrgBillsUnits.Tag = 1) or (cdsOrgBillsQuantity.Tag = 1) or (cdsOrgBillsDesignQuantity.Tag = 1) or (cdsOrgBillsDesignQuantity2.Tag = 1) or (cdsOrgBillsErrorHint.Tag = 1) or (cdsOrgBillsIsSuperscale.Tag = 1) or (cdsOrgBillsStandardGrade.Tag = 1) or (cdsOrgBillsDeductGrade.Tag = 1) or (cdsOrgBillsIsIgNore.Tag = 1) or (cdsOrgBillsUserModified.Tag = 1) or (cdsOrgBillsLostPreSiblingCount.Tag = 1) or (cdsOrgBillsLostChildrenCount.Tag = 1) or (cdsOrgBillsLostNextSiblingCount.Tag = 1) or (cdsOrgBillsNameErrorFlag.Tag = 1) or (cdsOrgBillsUnitsErrorFlag.Tag = 1) or (cdsOrgBillsIsAccQuantity.Tag = 1) then begin if FNeedSyncTree then SyncGradeFromDataSetToTreeNode(cdsOrgBills); {ReGather Parent's DesignQuantity and DesignQuantity2} if (cdsOrgBillsIsAccQuantity.Tag = 1) or (cdsOrgBillsDesignQuantity.Tag = 1) or (cdsOrgBillsDesignQuantity2.Tag = 1) then // 这个方法改为对父节点统计子节点的同时，其本身也统计自己的子节点数量 CalculateParentQuantity; cdsOrgBillsCode.Tag := 0; cdsOrgBillsB_Code.Tag := 0; cdsOrgBillsName.Tag := 0; cdsOrgBillsUnits.Tag := 0; cdsOrgBillsQuantity.Tag := 0; cdsOrgBillsDesignQuantity.Tag := 0; cdsOrgBillsDesignQuantity2.Tag := 0; cdsOrgBillsErrorHint.Tag := 0; cdsOrgBillsIsSuperscale.Tag := 0; cdsOrgBillsStandardGrade.Tag := 0; cdsOrgBillsDeductGrade.Tag := 0; cdsOrgBillsIsIgNore.Tag := 0; cdsOrgBillsUserModified.Tag := 0; cdsOrgBillsLostPreSiblingCount.Tag := 0; cdsOrgBillsLostChildrenCount.Tag := 0; cdsOrgBillsLostNextSiblingCount.Tag := 0; cdsOrgBillsNameErrorFlag.Tag := 0; cdsOrgBillsUnitsErrorFlag.Tag := 0; cdsOrgBillsIsAccQuantity.Tag := 0; end; end; procedure TDMDataBase.cdsOrgBillsAfterScroll(DataSet: TDataSet); begin if Assigned(FStdBillsCtrl) then TStdBillsCtrl(FStdBillsCtrl).DMStdBillsLib.RefreshCustomStep; if Assigned(FBillsTree.Selected) and Assigned(FDesignCodeEvt) then begin if FBillsTree.Selected.HasChildren then FDesignCodeEvt(False) else FDesignCodeEvt(True); end; { if FIsProjectBills then begin Screen.Cursor := crHourGlass; try TDMDetailItems(FDetailItemsDM).RefreshPPItems; finally Screen.Cursor := crDefault; end; end; } end; {Note: this method only be used in before post} procedure TDMDataBase.MatchCodeFromStdLib(const AName, AUnits: string); begin cdsOrgBillsName.Value := AName; cdsOrgBillsUnits.Value := AUnits; end; procedure TDMDataBase.cdsOrgDrawingQuantityAfterPost(DataSet: TDataSet); begin // if FTriggerEvents then Exit; if (cdsOrgDrawingQuantityIsGatherQ.Tag = 1) or (cdsOrgDrawingQuantityDQuantity1.Tag = 1) then begin GatherDQQty(cdsOrgBillsID.AsInteger, cdsOrgDrawingQuantityIsGatherQ.Tag = 1); cdsOrgDrawingQuantityIsGatherQ.Tag := 0; cdsOrgDrawingQuantityDQuantity1.Tag := 0; end; end; procedure TDMDataBase.GatherDQQty(ABillsID: Integer; AGQ: Boolean); var sBillsUnit: string; sDQUnit: string; bChecked: Boolean; function CalculateBillsQuantityFromDrawingItems: Double; begin Result := 0; sBillsUnit := cdsBillsUnits.AsString; bChecked := False; cdsDQForLocate.SetRange([ABillsID], [ABillsID]); try while not cdsDQForLocate.Eof do begin if cdsDQForLocateIsGatherQ.Value then begin bChecked := True; sDQUnit := cdsDQForLocateUnits.AsString; if (UpperCase(sBillsUnit) = 'KG') and (UpperCase(sDQUnit) = 'T') then Result := Result + 1000 * cdsDQForLocateDQuantity1.AsFloat else if (UpperCase(sBillsUnit) = 'T') and (UpperCase(sDQUnit) = 'KG') then Result := Result + cdsDQForLocateDQuantity1.AsFloat / 1000 else Result := Result + cdsDQForLocateDQuantity1.AsFloat; end; cdsDQForLocate.Next; end; finally cdsDQForLocate.CancelRange; end; end; procedure UpdateBillsQuantity(AQuantity: Double); begin cdsBills.Edit; cdsBillsQuantity.Value := AQuantity; cdsBills.Post; end; function CanUpdateBillsQuantity: Boolean; begin Result := bChecked or AGQ; end; var dTotalQty: Double; begin if not cdsBills.FindKey([ABillsID]) then Exit; dTotalQty := CalculateBillsQuantityFromDrawingItems; if CanUpdateBillsQuantity then begin UpdateBillsQuantity(dTotalQty); FDMExprs.Delete(Exprs_Bills_ID, Exprs_Qty_ID, ABillsID); end; end; procedure TDMDataBase.MatchCodeFromStdLib; var bIsCode: Boolean; strCode, strName, strUnits: string; begin if cdsOrgBillsCode.Tag = 1 then begin strCode := cdsOrgBillsCode.Value; bIsCode := True; end else if cdsOrgBillsB_Code.Tag = 1 then begin strCode := cdsOrgBillsB_Code.Value; bIsCode := False; end; if TStdBillsCtrl(FStdBillsCtrl).DMStdBillsLib.FindLibCode(strCode, strName, strUnits, bIsCode) then MatchCodeFromStdLib(strName, strUnits); {refresh custom step when modify codes} cdsOrgBills.AfterScroll(nil); end; procedure TDMDataBase.cdsOrgDrawingQuantityBeforePost(DataSet: TDataSet); begin if cdsOrgDrawingQuantityDQuantity1.Tag = 1 then cdsOrgDrawingQuantityDQuantity1.Value := RoundTo(cdsOrgDrawingQuantityDQuantity1.Value, -3); end; procedure TDMDataBase.SetDecimalDigit; begin if cdsOrgBillsCode.AsString = '' then begin cdsOrgBillsDesignQuantity.Clear; cdsOrgBillsDesignQuantity2.Clear; cdsOrgBillsDesignPrice.Clear; {if is gather node, then can not input value} if IsGatherNode then begin cdsOrgBillsQuantity.Clear; cdsOrgBillsUnitPrice.Clear; end else begin if cdsOrgBillsQuantity.Tag = 1 then cdsOrgBillsQuantity.Value := ScRoundTo(cdsOrgBillsQuantity.Value, -3); if cdsOrgBillsUnitPrice.Tag = 1 then cdsOrgBillsUnitPrice.Value := ScRoundTo(cdsOrgBillsUnitPrice.Value, -3); if (cdsOrgBillsQuantity.Tag = 1) or (cdsOrgBillsUnitPrice.Tag = 1) then begin if ScConfigInfo.RealTimeCalc then begin FOldTotalPrice := cdsOrgBillsTotalPrice.AsFloat; cdsOrgBillsTotalPrice.Value := ScRoundTo(cdsOrgBillsQuantity.AsFloat * cdsOrgBillsUnitPrice.AsFloat, 0); end; end; end; end else begin cdsOrgBillsQuantity.Clear; cdsOrgBillsUnitPrice.Clear; if cdsOrgBillsDesignQuantity.Tag = 1 then cdsOrgBillsDesignQuantity.Value := ScRoundTo(cdsOrgBillsDesignQuantity.Value, -3); if cdsOrgBillsDesignQuantity2.Tag = 1 then cdsOrgBillsDesignQuantity2.Value := ScRoundTo(cdsOrgBillsDesignQuantity2.Value, -3); if cdsOrgBillsDesignPrice.Tag = 1 then cdsOrgBillsDesignPrice.Value := ScRoundTo(cdsOrgBillsDesignPrice.Value, -3); if (cdsOrgBillsDesignQuantity.Tag = 1) then begin if ScConfigInfo.RealTimeCalc then begin if cdsOrgBillsDesignQuantity.AsFloat <> 0 then cdsOrgBillsDesignPrice.Value := ScRoundTo(cdsOrgBillsTotalPrice.AsFloat/cdsOrgBillsDesignQuantity.AsFloat, -2) else cdsOrgBillsDesignPrice.Value := 0; //FOldTotalPrice := cdsOrgBillsTotalPrice.AsFloat; //cdsOrgBillsTotalPrice.Value := ScRoundTo(cdsOrgBillsDesignQuantity.AsFloat * cdsOrgBillsDesignPrice.AsFloat, 0); end; end; end; // Litao 2011.4.22 // cdsOrgBillsDesignQuantity.Tag := 0; // cdsOrgBillsDesignQuantity2.Tag := 0; // cdsOrgBillsDesignPrice.Tag := 0; // cdsOrgBillsQuantity.Tag := 0; // cdsOrgBillsUnitPrice.Tag := 0; // chenshilong, 2011-06-17 18:20:22 // 以上这些被注释。AfterPost事件需要用这些标记来同步清单评分树。 end; procedure TDMDataBase.ClearAllQuantity(ANode: TZjIDTreeNode); var I: Integer; vNode: TZjIDTreeNode; begin ClearBillsQuantity(ANode.ID); for I := 0 to ANode.ChildCount - 1 do begin vNode := ANode.ChildNodes[I]; ClearAllQuantity(vNode); end; end; procedure TDMDataBase.ClearDQQuantity(const ABillsID: Integer); begin cdsDQForLocate.SetRange([ABillsID], [ABillsID]); while not cdsDQForLocate.Eof do begin cdsDQForLocate.Edit; cdsDQForLocateDQuantity1.Value := 0; cdsDQForLocate.Post; cdsDQForLocate.Next; end; cdsDQForLocate.CancelRange; end; procedure TDMDataBase.ClearBillsQuantity(const ABillsID: Integer); begin if cdsBills.FindKey([ABillsID]) then begin cdsBills.Edit; if cdsBillsCode.Value = '' then begin if IsGatherNode(ABillsID) then cdsBillsQuantity.Clear else cdsBillsQuantity.Value := 0; // cdsBillsUnitPrice.Value := 0; end else begin cdsBillsDesignQuantity.Value := 0; cdsBillsDesignQuantity2.Value := 0; // cdsBillsDesignPrice.Value := 0; end; cdsBills.Post; ClearDQQuantity(ABillsID); end; end; procedure TDMDataBase.ClearCurNodeQty; begin if Boolean(FBillsTree.Selected) then begin FEnabledUITreeEvt(False); ClearAllQuantity(FBillsTree.Selected); FEnabledUITreeEvt(True); end; end; function TDMDataBase.IsGatherNode: Boolean; begin Result := Assigned(FBillsTree.Selected) and FBillsTree.Selected.HasChildren and (FBillsTree.Selected.ID = cdsOrgBillsID.Value) and (cdsOrgBillsCode.Value = ''); end; procedure TDMDataBase.ShowLevel(aLevelID: Integer); begin FBillsTree.ExpandLevel := aLevelID; end; procedure TDMDataBase.GetChapterNames(ANames: TStrings); var I, iID: Integer; strName: string; begin if not Assigned(ANames) then Exit; ANames.Clear; with FBillsTree.FirstNode do begin for I := 0 to ChildCount - 1 do begin iID := ChildNodes[I].ID; if cdsBills.FindKey([iID]) then begin strName := Format('%s %s', [cdsBillsCode.Value, cdsBillsName.Value]); ANames.AddObject(strName, TObject(Pointer(iID))); end; end; end; end; procedure TDMDataBase.LocateBills(aBillsID: Integer); begin FEnabledUITreeEvt(False); try cdsOrgBills.FindKey([aBillsID]); finally FEnabledUITreeEvt(True); end; end; type TFieldAccess = class(TField); // 功能： 当参数DisplayText=True 时返回字段的文本串 // 当参数DisplayText=False 时返回字段的对应的公式，如果没有公式则返回文本值 // 说明: // 当界面通过Field的DisplayText和Text属性访问字段的内容时会触发该事件。 // 1. 当要显示编辑状态的文本时Field.Text被调用，此时参数DisplayText=False // 2. 当要显示非编辑状态的文本时Field.DisplayText被调用, 此时参数DisplayText=True; procedure TDMDataBase.cdsOrgBillsQuantityGetText(Sender: TField; var Text: String; DisplayText: Boolean); var iFieldID: Integer; begin if DisplayText then begin TFieldAccess(Sender).GetText(Text, DisplayText); if Text = '0' then Text := ''; { if BillsTree[cdsBillsID.Value].HasChildren and (Sender <> cdsBillsTotalPrice) and (Sender <> cdsBillsQuantity) then begin Text := ''; end;} end else begin // 查找公式，公式字符串保存在表cdsExprs中，根据三个字段唯一标示一个公式， // 这三个字段是：拥有该公式的 表的ID、字段ID、记录ID； iFieldID := 0; if Sender = cdsOrgBillsQuantity then iFieldID := 1 else if Sender = cdsOrgBillsDesignQuantity then iFieldID := 2 else if Sender = cdsOrgBillsDesignQuantity2 then iFieldID := 3; Text := FDMExprs.GetExprs(Exprs_Bills_ID, iFieldID, cdsOrgBillsID.Value); if Text = '' then TFieldAccess(Sender).GetText(Text, DisplayText); end; end; procedure TDMDataBase.cdsOrgBillsQuantitySetText(Sender: TField; const Text: String); var fValue: Double; iCode, iLocation, iFieldID: Integer; begin iFieldID := 0; if Sender = cdsOrgBillsQuantity then iFieldID := Exprs_Qty_ID else if Sender = cdsOrgBillsDesignQuantity then iFieldID := Exprs_DQty_ID else if Sender = cdsOrgBillsDesignQuantity2 then iFieldID := Exprs_DQty2_ID; if Trim(Text) = '' then begin Sender.AsString := Text; FDMExprs.Delete(Exprs_Bills_ID, iFieldID, cdsOrgBillsID.Value); end else begin Val(Text, fValue, iCode); if iCode <> 0 then begin fValue := Evaluate(Text, iCode, iLocation); FDMExprs.AddExprs(Exprs_Bills_ID, iFieldID, cdsOrgBillsID.Value, Text, fValue, iCode); end else FDMExprs.Delete(Exprs_Bills_ID, iFieldID, cdsOrgBillsID.Value); if iCode <> 0 then raise EBitsError.Create('输入的计算式不正确！'); Sender.AsFloat := fValue; end; end; procedure TDMDataBase.cdsOrgDrawingQuantityDQuantity1GetText( Sender: TField; var Text: String; DisplayText: Boolean); var iFieldID: Integer; begin if DisplayText then begin TFieldAccess(Sender).GetText(Text, DisplayText); end else begin // 查找公式，公式字符串保存在表cdsExprs中，根据三个字段唯一标示一个公式， // 这三个字段是：拥有该公式的 表的ID、字段ID、记录ID； iFieldID := 0; if (Sender = cdsOrgDrawingQuantityDQuantity1) then iFieldID := Exprs_DQty_ID; if Sender = cdsOrgDrawingQuantityDQuantity1 then Text := FDMExprs.GetExprs(Exprs_DrawQty_ID, iFieldID, cdsOrgDrawingQuantityID.Value); if Text = '' then TFieldAccess(Sender).GetText(Text, DisplayText); end; end; procedure TDMDataBase.cdsOrgDrawingQuantityDQuantity1SetText( Sender: TField; const Text: String); var fValue: Double; iCode, iLocation, iFieldID: Integer; begin iFieldID := 0; if (Sender = cdsOrgDrawingQuantityDQuantity1) then iFieldID := Exprs_DQty_ID; if Trim(Text) = '' then begin Sender.AsString := Text; if Sender = cdsOrgDrawingQuantityDQuantity1 then FDMExprs.Delete(Exprs_DrawQty_ID, iFieldID, cdsOrgDrawingQuantityID.Value); end else begin Val(Text, fValue, iCode); if iCode <> 0 then begin fValue := Evaluate(Text, iCode, iLocation); if Sender = cdsOrgDrawingQuantityDQuantity1 then FDMExprs.AddExprs(Exprs_DrawQty_ID, iFieldID, cdsOrgDrawingQuantityID.Value, Text, fValue, iCode); end else begin if Sender = cdsOrgDrawingQuantityDQuantity1 then FDMExprs.Delete(Exprs_DrawQty_ID, iFieldID, cdsOrgDrawingQuantityID.Value); end; if iCode <> 0 then raise EBitsError.Create('输入的计算式不正确！' + #13#10); Sender.AsFloat := fValue; end; end; procedure TDMDataBase.cdsOrgDrawingQuantityBeforeDelete(DataSet: TDataSet); begin // Added by GiLi 2012-3-19 11:13:43 // 记录当前删除项是否填工程量 FCurIsGatherQ := cdsOrgDrawingQuantityIsGatherQ.AsBoolean; FBillsUndoRef := 0; FDMExprs.Delete(Exprs_DrawQty_ID, cdsOrgDrawingQuantityID.AsInteger); end; procedure TDMDataBase.SyncBillsItemCode(const aID: Integer; const aCode, aB_Code, aName: string); var vItem: TScBillsItem; begin vItem := FBillsTree[aID]; if Assigned(vItem) then begin vItem.SBillCode := aCode; vItem.SBillBCode := aB_Code; vItem.SBillName := aName; end; end; procedure TDMDataBase.cdsBillsAfterPost(DataSet: TDataSet); begin if (cdsBillsCode.Tag = 1) or (cdsBillsB_Code.Tag = 1) or (cdsBillsName.Tag = 1) then begin SyncBillsItemCode(cdsBillsID.Value, cdsBillsCode.Value, cdsBillsB_Code.Value, cdsBillsName.Value); cdsBillsCode.Tag := 0; cdsBillsB_Code.Tag := 0; cdsBillsName.Tag := 0; end; if (cdsBillsErrorHint.Tag = 1) or (cdsBillsIsSuperscale.Tag = 1) or (cdsBillsStandardGrade.Tag = 1) or (cdsBillsDeductGrade.Tag = 1) or (cdsBillsIsIgNore.Tag = 1) or (cdsBillsUserModified.Tag = 1) or (cdsBillsLostPreSiblingCount.Tag = 1) or (cdsBillsLostChildrenCount.Tag = 1) or (cdsBillsLostNextSiblingCount.Tag = 1) or (cdsBillsNameErrorFlag.Tag = 1) or (cdsBillsUnitsErrorFlag.Tag = 1) then begin if FNeedSyncTree then SyncGradeFromDataSetToTreeNode(cdsBills); cdsBillsErrorHint.Tag := 0; cdsBillsIsSuperscale.Tag := 0; cdsBillsStandardGrade.Tag := 0; cdsBillsDeductGrade.Tag := 0; cdsBillsIsIgNore.Tag := 0; cdsBillsUserModified.Tag := 0; cdsBillsLostPreSiblingCount.Tag := 0; cdsBillsLostChildrenCount.Tag := 0; cdsBillsLostNextSiblingCount.Tag := 0; cdsBillsNameErrorFlag.Tag := 0; cdsBillsUnitsErrorFlag.Tag := 0; end; end; function TDMDataBase.IsGatherNode(const aID: Integer): Boolean; var vItem: TScBillsItem; begin Result := False; vItem := FBillsTree[aID]; if Assigned(vItem) and vItem.HasChildren then Result := True; end; procedure TDMDataBase.OnlyShowXMJ; var ztnFirstNode: TZjIDTreeNode; begin ztnFirstNode := FBillsTree.FirstNode; if Assigned(ztnFirstNode) then FilterXMJ(ztnFirstNode); end; procedure TDMDataBase.FilterXMJ(aNode: TZjIDTreeNode); var I: Integer; begin if not aNode.HasChildren then Exit; if HasXMJ(aNode) then begin if not aNode.Expanded then aNode.Expand; for I := 0 to aNode.ChildCount - 1 do FilterXMJ(aNode.ChildNodes[I]); end else if aNode.Expanded then aNode.Collapse; end; procedure TDMDataBase.DeleteBills(aIDList: TStringList; aPreID, aLastID, aParentID: Integer); var I, iID: Integer; iMajorIdx, iCount: Integer; IDLstString: string; cdsDataSet: TClientDataSet; begin iID := StrToInt(aIDList.Strings[0]); BeforeDelete(iID, iMajorIdx); try iCount := 0; for I := 1 to aIDList.Count - 1 do begin IDLstString := aIDList.Strings[I]; cdsDataSet := TClientDataSet.Create(nil); cdsDataSet.CloneCursor(cdsBills, True); try cdsDataSet.Filter := IDLstString; cdsDataSet.Filtered := True; cdsDataSet.First; while not cdsDataSet.Eof do begin DeleteDQ(cdsDataSet.FieldByName(SID).AsInteger); FDMExprs.Delete(Exprs_Bills_ID, cdsDataSet.FieldByName(SID).AsInteger); Inc(iCount); cdsDataSet.Delete; end; finally cdsDataSet.Free; end; end; finally AfterDelete(iMajorIdx, iCount, aParentID, aPreID, aLastID); FBillsUndoRef := 0; FDrawQtyUndoRef := 0; end; end; procedure TDMDataBase.ReadStatus(AID, ALength: Integer); procedure InnerRead(ANode: TZjIDTreeNode); var ID: Integer; begin ID := FSelList[ANode.MajorIndex]; if ID = 0 then begin ANode.Expand; if ANode.HasChildren then InnerRead(ANode.FirstChild); if Assigned(ANode.NextSibling) then InnerRead(ANode.NextSibling); end else if ID = -1 then begin if Assigned(ANode.NextSibling) then InnerRead(ANode.NextSibling); Exit; end else begin ANode.Collapse; ANode := ANode.NextSibling; if Assigned(ANode) then InnerRead(ANode); end; end; begin if AID > -1 then begin if ALength > 0 then // 增加 while ALength > 0 do begin FSelList.Insert(AID + 1, Pointer(-1)); Dec(ALength); end else // 删除 while ALength < 0 do begin FSelList.Delete(AID + 1); Inc(ALength); end; end; if FBillsTree.FirstNode <> nil then InnerRead(FBillsTree.FirstNode); end; procedure TDMDataBase.SaveStatus; {展开为0, 收缩为1} procedure InnerSave(ANode: TZjIDTreeNode); begin if ANode.Expanded then FSelList[ANode.MajorIndex] := 0 else FSelList[ANode.MajorIndex] := 1; if ANode.HasChildren then InnerSave(ANode.FirstChild); if Assigned(ANode.NextSibling) then InnerSave(ANode.NextSibling); end; begin FSelList.Clear; InnerSave(FBillsTree.FirstNode); end; function TDMDataBase.HasXMJ(aNode: TZjIDTreeNode): Boolean; begin Result := False; if (TScBillsItem(aNode.FirstChild).SBillCode <> '') then Result := True; end; procedure TDMDataBase.DeleteBills(aID: Integer); begin if cdsBills.FindKey([aID]) then cdsBills.Delete; end; procedure TDMDataBase.ConnectionBillsTree; begin try FBillsTree.DataSet := cdsOrgBills; BeginEvents; try FBillsTree.Active := True; finally EndEvents; end; except SetSavePoint(FSavePoint); ConnectionBillsTree; end; end; procedure TDMDataBase.DisconnectBillsTree; begin FSavePoint := GetSavePoint; FBillsTree.DataSet := nil; FBillsTree.Active := False; end; procedure TDMDataBase.ModifyCodeIncludeChildren(ANode: TZjIDTreeNode; const APreCode, AOldCode: string; AIsCode: Boolean); {var iCurID: Integer;} begin // iCurID := ANode.ID; FEnabledUITreeEvt(False); { *************************************************** Method2: Note: this way can not refresh the billstree's structure, so it can not be used in copybills method *****************************************************} // cdsOrgBills.Active := False; ChildCodeModifyByParent(ANode, APreCode, AOldCode, AIsCode); // cdsOrgBills.CloneCursor(cdsBills, True); // FBillsTree[iCurID].LocateDBRecord; FEnabledUITreeEvt(True); end; procedure TDMDataBase.WriteRecIntoDB(aList: TList); var I: Integer; billRec: TBillIDRecord; begin for I := 0 to aList.Count - 1 do begin billRec := TBillIDRecord(aList[I]); cdsBills.Insert; cdsBillsID.Value := billRec.NewID; cdsBillsParentID.Value := billRec.ParentID; cdsBillsNextSiblingID.Value := billRec.NextSiblingID; cdsBillsCode.Value := billRec.Code; cdsBillsName.Value := billRec.Name; cdsBillsUnits.Value := billRec.Units; if SameText(billRec.Code, '') then begin cdsBillsQuantity.Value := billRec.Quantity; cdsBillsUnitPrice.Value := billRec.UnitPrice; end else begin cdsBillsDesignQuantity.Value := billRec.DesignQuantity; cdsBillsDesignQuantity2.Value := billRec.DesignQuantity2; cdsBillsDesignPrice.Value := billRec.DesignPrice; end; cdsBillsB_Code.Value := billRec.B_Code; cdsBillsTotalPrice.Value := billRec.TotalPrice; cdsBillsMemoStr.Value := billRec.MemoStr; cdsBills.Post; end; end; procedure TDMDataBase.BeginEvents(aExceptInsert: Boolean); begin FBillsAfterInsertEvt := cdsOrgBills.AfterInsert; FBillsBeforePostEvt := cdsOrgBills.BeforePost; FBillsBeforeEditEvt := cdsOrgBills.BeforeEdit; FBillsAfterPostEvt := cdsOrgBills.AfterPost; FBillsAfterScrollEvt := cdsOrgBills.AfterScroll; if not aExceptInsert then cdsOrgBills.AfterInsert := nil; cdsOrgBills.BeforePost := nil; cdsOrgBills.BeforeEdit := nil; cdsOrgBills.AfterPost := nil; cdsOrgBills.AfterScroll := nil; end; procedure TDMDataBase.EndEvents; begin cdsOrgBills.AfterInsert := FBillsAfterInsertEvt; cdsOrgBills.BeforePost := FBillsBeforePostEvt; cdsOrgBills.BeforeEdit := FBillsBeforeEditEvt; cdsOrgBills.AfterPost := FBillsAfterPostEvt; cdsOrgBills.AfterScroll := FBillsAfterScrollEvt; end; function TDMDataBase.ModifyNextSiblingID(aID, aNewNextID: Integer; var aParentID, aNextID: Integer): Boolean; begin Result := True; if cdsBills.FindKey([aID]) then begin aParentID := cdsBillsParentID.Value; aNextID := cdsBillsNextSiblingID.Value; cdsBills.Edit; cdsBillsNextSiblingID.Value := aNewNextID; cdsBills.Post; end else Result := False; end; function TDMDataBase.GetSavePoint: Integer; begin Result := cdsBills.SavePoint; end; procedure TDMDataBase.SetSavePoint(aSavePoint: Integer); begin cdsBills.SavePoint := aSavePoint; end; procedure TDMDataBase.ModifySelected(aID: Integer; aValue: Boolean); begin if cdsBills.FindKey([aID]) then begin cdsBills.Edit; cdsBillsSelected.Value := aValue; cdsBills.Post; end; end; // 删除第一部分与第二部分的清单为数量单价为0项 procedure TDMDataBase.RemoveZeroQtyBills; var lstItems, lstIDs: TList; begin lstItems := TList.Create; lstIDs := TList.Create; try // 删除第一部分的清单为数量单价为0项 FilterZeroQtyBills(lstItems, lstIDs, FBillsTree.FirstNode); // 删除第二部分的清单为数量单价为0项 FilterZeroQtyBills(lstItems, lstIDs, FBillsTree.FirstNode.NextSibling); FEnabledUITreeEvt(False); DisconnectBillsTree; try UpdateRecords(lstItems); RemoveRecords(lstIDs); finally ConnectionBillsTree; FEnabledUITreeEvt(True); end; finally ClearList(lstItems); lstItems.Free; lstIDs.Free; end; end; procedure TDMDataBase.FilterZeroQtyBills(aItems, aIDs: TList; aNode: TZjIDTreeNode); var I: Integer; rIDRecord: PIDRecord; childNode: TZjIDTreeNode; begin for I := 0 to aNode.ChildCount - 1 do begin childNode := aNode.ChildNodes[I]; if CanRemove(childNode) then begin if Assigned(childNode.PrevSibling) then begin rIDRecord := FindIDRecord(aItems, childNode.ID); if rIDRecord = nil then begin New(rIDRecord); rIDRecord.PreID := childNode.PrevSiblingID; rIDRecord.NextID := childNode.NextSiblingID; aItems.Add(rIDRecord); end else rIDRecord.NextID := childNode.NextSiblingID; end; FilterRemoveIDs(childNode, aIDs); end else FilterZeroQtyBills(aItems, aIDs, childNode); end; end; procedure TDMDataBase.RemoveRecords(aIDs: TList); var I, iCount: Integer; strIDs: string; begin iCount := 0; for I := 0 to aIDs.Count - 1 do begin if strIDs = '' then strIDs := 'ID=' + IntToStr(Integer(aIDs.List^[I])) else strIDs := strIDs + ' or ID=' + IntToStr(Integer(aIDs.List^[I])); Inc(iCount); if I < aIDs.Count - 1 then begin if iCount > 500 then begin RemoveRecords(strIDs); strIDs := ''; iCount := 0; end; Continue; end; RemoveRecords(strIDs); end; end; procedure TDMDataBase.UpdateRecords(aList: TList); var I: Integer; rIDRecord: PIDRecord; begin for I := 0 to aList.Count - 1 do begin rIDRecord := aList.List^[I]; UpdateRecord(rIDRecord.PreID, rIDRecord.NextID); end; end; procedure TDMDataBase.UpdateRecord(aPreID, aNextID: Integer); begin if cdsBills.FindKey([aPreID]) then begin cdsBills.Edit; cdsBillsNextSiblingID.Value := aNextID; cdsBills.Post; end; end; function TDMDataBase.CanRemove(aNode: TZjIDTreeNode): Boolean; var I: Integer; chdNode: TZjIDTreeNode; begin if IsQuantityZero(aNode.ID) then Result := True else begin Result := False; Exit; end; for I := 0 to aNode.ChildCount - 1 do begin chdNode := aNode.ChildNodes[I]; if not CanRemove(chdNode) then begin Result := False; Break; end; end; end; function TDMDataBase.IsQuantityZero(aID: Integer): Boolean; begin Result := True; if cdsBills.FindKey([aID]) then begin Result := (cdsBillsQuantity.Value = 0) and (cdsBillsDesignQuantity.Value = 0) and (cdsBillsDesignQuantity2.Value = 0) and (cdsBillsUnitPrice.Value = 0); end; end; procedure TDMDataBase.FilterRemoveIDs(aNode: TZjIDTreeNode; aIDs: TList); var I: Integer; chdNode: TZjIDTreeNode; begin aIDs.Add(Pointer(aNode.ID)); for I := 0 to aNode.ChildCount - 1 do begin chdNode := aNode.ChildNodes[I]; FilterRemoveIDs(chdNode, aIDs); end; end; procedure TDMDataBase.ClearList(aList: TList); var I: Integer; begin for I := 0 to aList.Count - 1 do Dispose(aList.List^[I]); aList.Clear; end; procedure TDMDataBase.RemoveRecords(aIDs: string); var cdsTempData: TClientDataSet; begin cdsTempData := TClientDataSet.Create(nil); try cdsTempData.CloneCursor(cdsBills, True); cdsTempData.Filter := aIDs; cdsTempData.Filtered := True; {set filtered will set cursor to the first record} while not cdsTempData.Eof do begin DeleteDQ(cdsTempData.FieldByName(SID).AsInteger); FDMExprs.Delete(Exprs_Bills_ID, cdsTempData.FieldByName(SID).AsInteger); cdsTempData.Delete; end; finally cdsTempData.Free; end; end; procedure TDMDataBase.AfterDelete(aMajorIdx, aCount, aParentID, aPreID, aLastID: Integer); var curNode: TScIDTreeNode; begin ModifyNextSiblingID(aPreID, aLastID); ConnectionBillsTree; ReadStatus(aMajorIdx, -aCount); FEnabledUITreeEvt(True); cdsOrgDrawingQuantity.EnableControls; if aLastID <> -1 then begin curNode := FBillsTree.FindNode(ALastID); if Assigned(curNode) then curNode.LocateDBRecord; end else if aPreID <> -1 then begin curNode := FBillsTree.FindNode(APreID); if Assigned(curNode) then curNode.LocateDBRecord; end else if aParentID <> -1 then begin curNode := FBillsTree.FindNode(aParentID); if Assigned(curNode) then curNode.LocateDBRecord; end; end; procedure TDMDataBase.BeforeDelete(aID: Integer; var aMajorIdx: Integer); var curNode: TZjIDTreeNode; begin cdsOrgDrawingQuantity.DisableControls; FEnabledUITreeEvt(False); SaveStatus; curNode := FBillsTree.BillsItem[aID]; aMajorIdx := curNode.PrevNode.MajorIndex; DisconnectBillsTree; end; procedure TDMDataBase.AssignQtyItemUnitPrice(const aCode: string; aUnitPrice: Double); var cdsFilter: TClientDataSet; begin cdsFilter := TClientDataSet.Create(nil); with cdsFilter do begin { keep filter when clonecursor } CloneCursor(cdsBills, False, True); Filter := Format('B_Code=''%s''', [aCode]); Filtered := True; while not Eof do begin Edit; FieldByName('UnitPrice').AsFloat := aUnitPrice; Post; Next; end; Free; end; end; procedure TDMDataBase.BeginImport; begin FEnabledUITreeEvt(False); cdsBills.Filter := 'B_Code<>'''''; cdsBills.Filtered := True; end; procedure TDMDataBase.EndImport; begin cdsBills.Filtered := False; FEnabledUITreeEvt(True); end; procedure TDMDataBase.SetIsProjectBills(const Value: Boolean); begin FIsProjectBills := Value; if FIsProjectBills then TDMDetailItems(FDetailItemsDM).RefreshPPItems else TDMDetailItems(FDetailItemsDM).PPEmptyDetail; end; procedure TDMDataBase.SetStdBillsCtrl(Value: TObject); begin FStdBillsCtrl := Value; if Assigned(FStdBillsCtrl) then begin FDetailItemsDM := TProject(FProject).DetailItemsDM; FStdLib := TStdBillsCtrl(FStdBillsCtrl).DMStdBillsLib; FStdTree := TDMStdBillsLib(FStdLib).StdBillsTree; FStdBQTree := TDMStdBillsLib(FStdLib).BillsQtyTree; end else begin FDetailItemsDM := nil; FStdLib := nil; FStdTree := nil; FStdBQTree := nil; end; end; procedure TDMDataBase.CheckTree(aNode: TZjIDTreeNode); var ztnParentNode: TZjIDTreeNode; ztnNextNode: TZjIDTreeNode; begin if aNode = nil then Exit; ztnParentNode := aNode.Parent; ztnNextNode := aNode.NextSibling; if ztnParentNode = nil then begin if aNode.ParentID <> -1 then raise Exception.Create(Format('%d %d %d', [aNode.ID, aNode.ParentID, aNode.NextSiblingID])); end else begin if aNode.ParentID <> ztnParentNode.ID then raise Exception.Create(Format('%d %d %d', [aNode.ID, aNode.ParentID, aNode.NextSiblingID])); end; if ztnNextNode = nil then begin if aNode.NextSiblingID <> -1 then raise Exception.Create(Format('%d %d %d', [aNode.ID, aNode.ParentID, aNode.NextSiblingID])); end else begin if aNode.NextSiblingID <> ztnNextNode.ID then raise Exception.Create(Format('%d %d %d', [aNode.ID, aNode.ParentID, aNode.NextSiblingID])); end; CheckTree(aNode.FirstChild); CheckTree(aNode.NextSibling); end; procedure TDMDataBase.EnterXMJBills; begin cdsXMJBills.CloneCursor(cdsBills, True); cdsXMJBills.IndexFieldNames := SID; cdsXMJBills.Filter := '(Code<>'''') or (ID<100)'; cdsXMJBills.Filtered := True; FXMJBillsTree.DataSet := cdsXMJBills; FXMJBillsTree.Active := True; end; procedure TDMDataBase.LeaveXMJBills; begin cdsXMJBills.Active := False; FXMJBillsTree.DataSet := nil; FXMJBillsTree.Active := False; end; procedure TDMDataBase.cdsXMJBillsAfterScroll(DataSet: TDataSet); begin if FIsProjectBills then begin Screen.Cursor := crHourGlass; try TDMDetailItems(FDetailItemsDM).RefreshPPItems; finally Screen.Cursor := crDefault; end; end; end; procedure TDMDataBase.cdsOrgBillsUnitPriceGetText(Sender: TField; var Text: String; DisplayText: Boolean); begin // Modified by GiLi 2012-3-19 18:48:19 // 双击编辑Cell的时候，DisplayText=False，所以值为0了 //if DisplayText then begin TFieldAccess(Sender).GetText(Text, DisplayText); if Text = '0' then Text := ''; end; end; constructor TDMDataBase.Create(aProject: TObject); begin inherited Create(nil); FCurIsGatherQ := False; FProject := aProject; end; procedure TDMDataBase.SelectGatherNode(aNode: TZjIDTreeNode; aSelected: Boolean); var ztnNode: TZjIDTreeNode; begin if aNode = nil then Exit; if aSelected then // Select begin if ((Pos('K', TScBillsItem(aNode).SBillName) <> 0) and (Pos('+', TScBillsItem(aNode).SBillName) <> 0) or (Pos('第', TScBillsItem(aNode).SBillName) <> 0) and (Pos('级', TScBillsItem(aNode).SBillName) <> 0) or (Pos('k', TScBillsItem(aNode).SBillName) <> 0) and (Pos('+', TScBillsItem(aNode).SBillName) <> 0) or (Pos('K', TScBillsItem(aNode).SBillName) <> 0) and (Pos('＋', TScBillsItem(aNode).SBillName) <> 0) or (Pos('k', TScBillsItem(aNode).SBillName) <> 0) and (Pos('＋', TScBillsItem(aNode).SBillName) <> 0)) and (not IsContainXXItem(TScBillsItem(aNode).SBillCode)) then begin if not TScBillsItem(aNode).Selected then begin TScBillsItem(aNode).Selected := True; ztnNode := FBillsTree.FindNode(aNode.ID); if Assigned(ztnNode) then TScBillsItem(ztnNode).SyncSelected(True); end; end else begin {if TScBillsItem(aNode).Selected then begin TScBillsItem(aNode).Selected := False; ztnNode := FBillsTree.FindNode(aNode.ID); if Assigned(ztnNode) then TScBillsItem(ztnNode).SyncSelected(False); end; } end; end else // abolish begin if TScBillsItem(aNode).Selected then begin TScBillsItem(aNode).Selected := False; ztnNode := FBillsTree.FindNode(aNode.ID); if Assigned(ztnNode) then TScBillsItem(ztnNode).SyncSelected(False); end; end; SelectGatherNode(aNode.FirstChild, aSelected); SelectGatherNode(aNode.NextSibling, aSelected); end; function TDMDataBase.CalculateAll: Double; var dFirstSum: Double; dSecondSum: Double; begin { 第一部分 } dFirstSum := CalculateNode(FBillsTree.FirstNode); { 第二部分 } dSecondSum := CalculateNode(FBillsTree.FirstNode.NextSibling); { 总额 } // Result := CalculateOther(dFirstSum, dSecondSum); end; function TDMDataBase.CalculateNode(aNode: TZjIDTreeNode): Double; var I: Integer; ztnChild: TZjIDTreeNode; begin Result := 0; if aNode = nil then Exit; if not aNode.HasChildren then begin Result := CalculateSingle(aNode); end else begin for I := 0 to aNode.ChildCount - 1 do begin ztnChild := aNode.ChildNodes[I]; Result := Result + CalculateNode(ztnChild); end; CalculateNode(aNode, Result); end; end; function TDMDataBase.CalculateOther(aFirstSum, aSecondSum: Double): Double; begin { 概预算总金额 } if FindBills(cdsBills, GYTotalPriceID) then begin cdsBills.Edit; cdsBillsTotalPrice.Value := aFirstSum + aSecondSum; cdsBills.Post; end; { 公路基本造价 } if FindBills(cdsBills, GLBaseCost) then begin cdsBills.Edit; cdsBillsTotalPrice.Value := aFirstSum + aSecondSum; cdsBills.Post; end; end; function TDMDataBase.FindBills(aCdsDataset: TClientDataSet; aID: Integer): Boolean; begin aCdsDataset.EditKey; aCdsDataset.FieldByName(SID).AsInteger := aID; Result := aCdsDataset.GotoKey; end; procedure TDMDataBase.CalculateNode(aNode: TZjIDTreeNode; aTotalPrice: Double); begin { 单价2位小数, 数量3位小数 } if FindBills(cdsBills, aNode.ID) then begin cdsBills.Edit; cdsBillsTotalPrice.Value := aTotalPrice; if aNode.HasChildren then begin if TScBillsItem(aNode).SBillCode <> '' then begin if cdsBillsDesignQuantity.AsFloat <> 0 then cdsBillsDesignPrice.Value := ScRoundTo(aTotalPrice/cdsBillsDesignQuantity.Value, -2) else cdsBillsDesignPrice.Value := 0; end else begin if cdsBillsQuantity.AsFloat <> 0 then cdsBillsUnitPrice.Value := ScRoundTo(aTotalPrice/cdsBillsQuantity.Value, -2) else cdsBillsUnitPrice.Value := 0; end; end; cdsBills.Post; end; end; function TDMDataBase.CalculateSingle(aNode: TZjIDTreeNode): Double; begin if FindBills(cdsBills, aNode.ID) then begin if TScBillsItem(aNode).SBillCode <> '' then Result := ScRoundTo(cdsBillsDesignQuantity.Value * cdsBillsDesignPrice.Value, 0) else Result := ScRoundTo(cdsBillsQuantity.Value * cdsBillsUnitPrice.Value, 0); if cdsBillsTotalPrice.Value <> Result then begin cdsBills.Edit; cdsBillsTotalPrice.Value := Result; cdsBills.Post; end; end; end; procedure TDMDataBase.cdsXMJBillsQuantityGetText(Sender: TField; var Text: String; DisplayText: Boolean); begin if DisplayText then begin TFieldAccess(Sender).GetText(Text, DisplayText); if Text = '0' then Text := ''; end end; procedure TDMDataBase.AscendSumToParent(aParent: TZjIDTreeNode; aOldSum, aNewSum: Double); begin if aParent = nil then Exit; if FindBills(cdsBills, aParent.ID) then begin cdsBills.Edit; cdsBillsTotalPrice.Value := cdsBillsTotalPrice.AsFloat + aNewSum - aOldSum; if aParent.HasChildren then begin if cdsBillsCode.AsString <> '' then begin if cdsBillsDesignQuantity.AsFloat <> 0 then cdsBillsDesignPrice.Value := ScRoundTo(cdsBillsTotalPrice.AsFloat/cdsBillsDesignQuantity.AsFloat, -2) else cdsBillsDesignPrice.Value := 0; end else begin if cdsBillsQuantity.AsFloat <> 0 then cdsBillsUnitPrice.Value := ScRoundTo(cdsBillsTotalPrice.AsFloat/cdsBillsQuantity.AsFloat, -2) else cdsBillsUnitPrice.Value := 0; end; end; cdsBills.Post; end; AscendSumToParent(aParent.Parent, aOldSum, aNewSum); end; function TDMDataBase.InsertItem(aNode: TZjIDTreeNode; const aCode, aName: string; aIsCode: Boolean): TZjIDTreeNode; var ztnParent: TZjIDTreeNode; begin Result := nil; if aIsCode then begin if Pos(TScBillsItem(aNode).SBillCode + '-', aCode) = 1 then begin Result := FBillsTree.AddBillsItem(aNode.ID, -1); TScBillsItem(Result).SBillCode := aCode; TScBillsItem(Result).SBillName := aName; end else begin Result := FBillsTree.AddBillsItem(aNode.ParentID, aNode.NextSiblingID); TScBillsItem(Result).SBillCode := aCode; TScBillsItem(Result).SBillName := aName; { ztnParent := aNode.Parent; while Assigned(ztnParent) do begin if Pos(TScBillsItem(ztnParent).SBillCode + '-', aCode) = 1 then begin Result := FBillsTree.AddBillsItem(ztnParent.ID, aNode.NextSiblingID); Break; end; aNode := ztnParent; ztnParent := ztnParent.Parent; end; } end; end else begin if TScBillsItem(aNode).SBillCode <> '' then begin Result := FBillsTree.AddBillsItem(aNode.ID, -1); TScBillsItem(Result).SBillBCode := aCode; TScBillsItem(Result).SBillName := aName; Exit; end; if Pos(TScBillsItem(aNode).SBillBCode + '-', aCode) = 1 then begin Result := FBillsTree.AddBillsItem(aNode.ID, -1); TScBillsItem(Result).SBillBCode := aCode; TScBillsItem(Result).SBillName := aName; end else begin Result := FBillsTree.AddBillsItem(aNode.ParentID, aNode.NextSiblingID); TScBillsItem(Result).SBillBCode := aCode; TScBillsItem(Result).SBillName := aName; { ztnParent := aNode.Parent; while Assigned(ztnParent) do begin if Pos(TScBillsItem(ztnParent).SBillBCode + '-', aCode) = 1 then begin Result := FBillsTree.AddBillsItem(ztnParent.ID, aNode.NextSiblingID); Break; end; if TScBillsItem(ztnParent).SBillCode <> '' then begin Result := FBillsTree.AddBillsItem(ztnParent.ID, aNode.NextSiblingID); Break; end; aNode := ztnParent; ztnParent := ztnParent.Parent; end; } end; end; end; procedure TDMDataBase.SaveSerialNo; var I: Integer; vNode: TZjIDTreeNode; begin // TimeBegin('TDMDataBase.SaveSerialNo'); CloneActive(False); FEnabledUITreeEvt(False); for I := 0 to FBillsTree.Count - 1 do begin vNode := FBillsTree.Items[I]; if cdsBills.FindKey([vNode.ID]) then begin cdsBills.Edit; cdsBillsSerialNo.Value := vNode.MajorIndex; cdsBills.Post; end; end; FEnabledUITreeEvt(True); CloneActive(true); // TimeEnd(); end; function TDMDataBase.CanUnDoBillsText: Boolean; begin Result := FBillsUndoRef > 0; end; function TDMDataBase.CanUnDoDrawQtyText: Boolean; begin Result := FDrawQtyUndoRef > 0; end; procedure TDMDataBase.UnDoBillsText; begin Dec(FBillsUndoRef); if FBillsUndoRef < 0 then FBillsUndoRef := 0; cdsOrgBills.UndoLastChange(True); end; procedure TDMDataBase.UnDoDrawQtyText; begin Dec(FDrawQtyUndoRef); if FDrawQtyUndoRef < 0 then FDrawQtyUndoRef := 0; cdsOrgDrawingQuantity.UndoLastChange(True); end; procedure TDMDataBase.cdsOrgDrawingQuantityBeforeEdit(DataSet: TDataSet); begin Inc(FDrawQtyUndoRef); end; procedure TDMDataBase.cdsBillsAfterInsert(DataSet: TDataSet); begin FBillsUndoRef := 0; cdsBillsIsCreatePriceAnalysis.Value := True; end; procedure TDMDataBase.cdsDrawingQuantityAfterInsert(DataSet: TDataSet); begin FDrawQtyUndoRef := 0; end; procedure TDMDataBase.LocateProjectBills; begin cdsOrgBills.GotoCurrent(cdsXMJBills); end; procedure TDMDataBase.LocateBills(const aCode: string); begin cdsOrgBills.Locate(sCode, aCode, []); end; (* 以下注释需保留 该方法被注释，下面对它进行重写，主要是对速度进行优化。另外该方法中有漏行的自动处理， 下面的方法没有，注意备份。 procedure TDMDataBase.Grade(AllScope: Boolean); var i, iID, iChildCount, iPreCount, iNextCount, idxFirst, idxLast: Integer; vBItem, vLostBItem, vPreBItem, vNextBItem: TScBillsItem; vStdItem, vLostStdPaItem, vPreStdItem, vNextStdItem: TStdBillNode; sHint, sTemplateCode: string; IsLostChildren: Boolean; vBC: TBillCategory; // 扣分及错误信息 procedure MarkAndHint(AItem: TScBillsItem; ABC: TBillCategory; AEC: TErrorCategory; ACount: Integer = 1); var cSDMark, cMark: Currency; sEHint: string; begin cSDMark := StdDeductMark(ABC, AEC, ACount); if cSDMark <> 0 then begin cMark := AItem.DeductGrade; cMark := cMark + cSDMark; if Abs(cMark) > AItem.StandardGrade then cMark := - AItem.StandardGrade; AItem.DeductGrade := cMark; end; case AEC of ecLostChildren, ecLostPreSibling, ecLostNextSibling: begin sEHint := Format(ErrorHintAry[Ord(AEC)], [ACount]); end else sEHint := ErrorHintAry[Ord(AEC)]; end; if AItem.ErrorHint = '' then AItem.ErrorHint := sEHint else AItem.ErrorHint := AItem.ErrorHint + HintSeparator + sEHint; end; {标准项目表清单名称含：①××②…×…③ K字打头：K×和K… 的忽略。这里不判断用户输入的清单名称，只判断标准项目表清单的名称。} function IsSpecialName(AName: string): Boolean; begin if (UpCase(AName[1]) = 'K') or (Pos('××', AName) > 0) or (Pos('…×…', AName) > 0) then Result := True else Result := False; end; {如下情况不属于深度超出：1-4-5-1下有复杂的子项；1-4-5-2下也有，但在标准项目表中 没有罗列出来。当在项目表中出现时不能说它是深度超出。所以：含×××的清单Ax, 第一兄弟A1，父项A,从A继承下来的其它清单，要依据A1检查名称、单位等是否错误。 1-4-5 大桥工程 1-4-5-1 ×××大桥 1-4-5-1-1 1-4-5-1-2 …… …… 1-4-5-2 ×××大桥 1-4-5-n ×××大桥 当能够调用该方法时，已经确定当前项在标准项目表中找不到了。所以它一定不是第一子 结点(为其它兄弟结点提供模板)。ATemplateCode值为模板Code，如：1-4-5-2-1-3的 ATemplateCode值为1-4-5-1-1-3，将父编号后的两个'-'之间的数字替换成1} function IsXXItem(ACode: string; var ATemplateCode: string): Boolean; var i, iPos: Integer; sXXPCode, sTemp, sTail: string; begin Result := False; ATemplateCode := ''; for i := Low(aryXXParentCode) to High(aryXXParentCode) do begin sXXPCode := aryXXParentCode[i]; if Pos(sXXPCode + '-', ACode) = 1 then begin Result := True; sTemp := ACode; Delete(sTemp, 1, Length(sXXPCode) + 1); iPos := Pos('-', sTemp); if iPos > 0 then sTail := Copy(sTemp, iPos, Length(sTemp) - iPos + 1) else sTail := ''; ATemplateCode := sXXPCode + '-1' + sTail; Break; end; end; end; begin if not TScBillsItem(FBillsTree[1]).HasChildren then Exit; with TStdBillsCtrl(TProject(FProject).StdBillsCtrl).DMStdBillsLib do begin if not Assigned(FStdTree.Items[0]) then begin CreateProgressForm(100, '打开标准项目表>>>'); AddProgressForm(25, '正在为第一次使用创建“分项清单”树...'); LoadNewStdLib(ExtractFilePath(Application.ExeName) + 'StdLibs\广东分项清单2010版.dat'); end; if not Assigned(FStdBQTree.Items[0]) then begin AddProgressForm(35, '正在为第一次使用创建“工程量清单”树...'); LoadBillsQtyLib(ExtractFilePath(Application.ExeName) + 'StdLibs\广东工程量清单2010版.dat' ); end; end; // 全部评分 if AllScope then begin idxFirst := FBillsTree[1].MajorIndex + 1; idxLast := FBillsTree[1].LastPosterity.MajorIndex; end else // 只评选中项 begin idxFirst := FBillsTree.Selected.MajorIndex + 1; idxLast := FBillsTree.Selected.LastPosterity.MajorIndex; end; // “10”是为后面的统计Stat预留的进度 CreateProgressForm(idxLast + 10, '正在评分，请稍候>>>'); for i := idxFirst to idxLast do begin vBItem := FBillsTree.Items[i]; AddProgressForm(1, vBItem.Code + vBItem.B_Code + ' ' + vBItem.Name); // 保留用户修改 if vBItem.UserModified = True then Continue // 先清掉原始评分信息 else begin vBItem.ErrorHint := ''; vBItem.DeductGrade := 0; vBItem.IsSuperscale := False; vBItem.LostPreSiblingCount := 0; vBItem.LostChildrenCount := 0; vBItem.LostNextSiblingCount := 0; vBItem.StandardGrade := StdMark(vBItem.Code, vBItem.B_Code); end; // 指定忽略 if vBItem.IsIgNore = True then begin vBItem.UserModified := False; Continue; end; // 重复行 if TScBillsItem(vBItem.Parent).IsRepeat or ( Assigned(vBItem.PrevSibling) and ((TScBillsItem(vBItem.PrevSibling).Code = vBItem.Code) and (TScBillsItem(vBItem.PrevSibling).B_Code = vBItem.B_Code) and (TScBillsItem(vBItem.PrevSibling).Name = vBItem.Name))) then begin vBItem.IsRepeat := True; MarkAndHint(vBItem, bcAll, ecRepeatLine); end else vBItem.IsRepeat := False; // 深度超出 // 情况1：父结点深度超出，子结点跟随深度超出 if TScBillsItem(vBItem.Parent).IsSuperscale then begin vBItem.IsSuperscale := True; MarkAndHint(vBItem, bcAll, ecSuperscale); end else vBItem.IsSuperscale := False; // 标准项目表部分--------------------------------------------------------------- if vBItem.NeedSearchInStdLib then begin vLostBItem := nil; vLostStdPaItem := nil; { 兵分两路：预算项目节直接在分项清单树中查找。清单子目号清单可以任意放位置， 放在另外一个位置不能说它错。所以只能在工程量清单树中遍历。 并检查名称、单位是否正确。如果整个表都查不到证明编号错误。} vBC := BillCategory(vBItem.Code, vBItem.B_Code); case vBC of bcYSXMJ: vStdItem := FStdTree.FindNode(vBItem, vLostBItem, vLostStdPaItem); bcQDZMH: begin vStdItem := FStdBQTree.FindNode(vBItem.Code, vBItem.B_Code); end; end; //---标准项目表找不到----------------------------------------------------- if not Assigned(vStdItem) then begin case vBC of bcYSXMJ: begin // 深度超出情况2：标准项目表已无子结点 if (not vLostStdPaItem.HasChildren) or // 深度超出情况3：标准项目表有子结点，但是是清单级清单，而当前要比较的是预算级清单 ((vBItem.Category = bcYSXMJ) and (not vLostStdPaItem.HasYsxmjChild)) then begin if IsXXItem(vBItem.Code, sTemplateCode) then begin // 根据模板检查名称、单位(这里不用遍历树，使用cdsYSFastSearch，建有索引，优化速度) with TStdBillsCtrl(FStdBillsCtrl).DMStdBillsLib do begin if cdsYSFastSearch.Locate('Code', vBItem.Code, []) then begin // 检查名称 if vBItem.Name <> cdsYSFastSearchName.AsString then begin if (not IsSpecialName(cdsYSFastSearchName.AsString)) and (not LooseCompareIsSame(vBItem.Name, cdsYSFastSearchName.AsString)) then begin MarkAndHint(vBItem, vBC, ecNameError); vBItem.NameErrorFlag := 1; end; end; // 检查单位 if not SameText(ConvertUnitStr(vBItem.Units), ConvertUnitStr(cdsYSFastSearchUnit.AsString)) then begin MarkAndHint(vBItem, vBC, ecUnitError); vBItem.UnitsErrorFlag := 1; end; end; end; end else // 排除了XX项，这时才能认定是真正的深度超出 begin vBItem.IsSuperscale := True; MarkAndHint(vBItem, bcAll, ecSuperscale); vBItem.IsSuperscale := True; end; end // 编号错误 else MarkAndHint(vBItem, bcYSXMJ, ecCodeError); end; bcQDZMH: begin MarkAndHint(vBItem, bcQDZMH, ecB_CodeError); end; end; end // ---标准项目表找到了---------------------------------------------------- else begin // 检查名称 if vBItem.Name <> vStdItem.Name then begin if (not IsSpecialName(vStdItem.Name)) and (not LooseCompareIsSame(vBItem.Name, vStdItem.Name)) then begin MarkAndHint(vBItem, vBItem.Category, ecNameError); vBItem.NameErrorFlag := 1; end; end; // 检查单位 if not SameText(ConvertUnitStr(vBItem.Units), ConvertUnitStr(vStdItem.Units)) then begin MarkAndHint(vBItem, vBItem.Category, ecUnitError); vBItem.UnitsErrorFlag := 1; end; { // 漏行------------------------------------------------------------------- // 情况①：深度不够，即漏孩子 // IsLostChildren := False; if (not vBGNode.HasChildren) and vStdItem.HasChildren then begin // IsLostChildren := True; iChildCount := GetAllChildrenCount(vStdItem); cdsBillsLostChildrenCount.AsInteger := iChildCount; cdsBillsStandardGrade.AsCurrency := cdsBillsStandardGrade.AsCurrency + (-StdDeductMark(bcAll, ecLostChildren, iChildCount)); MarkAndHint(bcAll, ecLostChildren, iChildCount); end; // 情况②：漏前兄弟：二个号一个名称三者完全一致才视为前兄弟存在 vPreBGNode := TBGNode(vBGNode.PrevSibling); vPreStdItem := TStdItem(vStdItem.PrevSibling); if Assigned(vPreBGNode) and Assigned(vPreStdItem) then begin if not ((vPreBGNode.B_Code = vPreStdItem.B_Code) and (vPreBGNode.Code = vPreStdItem.Code) and (vPreBGNode.Name = vPreStdItem.Name)) then begin // 这里要包括前兄弟自身也漏了 iPreCount := GetAllChildrenCount(vPreStdItem) + 1; cdsBillsLostPreSiblingCount.AsInteger := iPreCount; cdsBillsStandardGrade.AsCurrency := cdsBillsStandardGrade.AsCurrency + (-StdDeductMark(bcAll, ecLostPreSibling, iPreCount)); MarkAndHint(bcAll, ecLostPreSibling, iPreCount); end; end; // 情况③：漏后兄弟：二个号一个名称三者完全一致才视为后兄弟存在 // 因为前面已经判断了前兄弟，所以只有最后一个结点需要判断后兄弟 vNextBGNode := TBGNode(vBGNode.NextSibling); if not Assigned(vNextBGNode) then begin vNextStdItem:= TStdItem(vStdItem.NextSibling); if Assigned(vNextStdItem) then begin // 这里要包括后兄弟自身也漏了 iNextCount := GetAllChildrenCount(vNextStdItem) + 1; cdsBillsLostNextSiblingCount.AsInteger := iNextCount; cdsBillsStandardGrade.AsCurrency := cdsBillsStandardGrade.AsCurrency + (-StdDeductMark(bcAll, ecLostNextSibling, iNextCount)); MarkAndHint(bcAll, ecLostNextSibling, iNextCount); end; end; } // 漏行完----------------------------------------------------------------- end; end; // 标准项目表部分结束----------------------------------------------------------- // 最后检查3个数量-------------------------------------------------------------- Case vBC of bcYSXMJ: // 预算项目节清单 begin if vBItem.DesignQuantity = 0 then begin // 缺设计数量1、设计数量2 （两个数量都没填扣2分） if vBItem.DesignQuantity2 = 0 then MarkAndHint(vBItem, bcYSXMJ, ecNoDesignQuantity) // 设计数量2有值 （数量位置错扣0.5分） else MarkAndHint(vBItem, bcYSXMJ, ecDesignQuantityPosError); end; end; bcQDZMH: // 清单子目号清单: 清单数量错误扣1分 begin if not vBItem.HasChildren then if vBItem.Quantity = 0 then MarkAndHint(vBItem, bcQDZMH, ecNoQuantity); end; end; SyncGradeFromTreeNodeToDataSet(vBItem); end; end; *) { 以上注释需保留 } {-------------------------------------------------------------------------------} procedure TDMDataBase.Grade(AllScope: Boolean); var i, iID, idxFirst, idxLast: Integer; vBItem, vLostBItem, vBPaItem: TScBillsItem; vStdItem, vLostStdPaItem, vStdPaItem: TStdBillNode; sHint, sTemplateCode, vUnits: string; IsLostChildren: Boolean; vBC: TBillCategory; sRightUnit: string; // 扣分及错误信息 procedure MarkAndHint(AItem: TScBillsItem; ABC: TBillCategory; AEC: TErrorCategory; ACount: Integer = 1); var cSDMark, cMark: Currency; sEHint: string; begin cSDMark := StdDeductMark(ABC, AEC, ACount); if cSDMark <> 0 then begin cMark := AItem.DeductGrade; cMark := cMark + cSDMark; if Abs(cMark) > AItem.StandardGrade then cMark := - AItem.StandardGrade; AItem.DeductGrade := cMark; end; case AEC of ecLostChildren, ecLostPreSibling, ecLostNextSibling: begin sEHint := Format(ErrorHintAry[Ord(AEC)], [ACount]); end else sEHint := ErrorHintAry[Ord(AEC)]; end; if AItem.ErrorHint = '' then AItem.ErrorHint := sEHint else AItem.ErrorHint := AItem.ErrorHint + HintSeparator + sEHint; end; {标准项目表清单名称含：①××②…×…③ K字打头：K×和K… 的忽略。这里不判断用户输入的清单名称，只判断标准项目表清单的名称。} function IsSpecialName(AName: string): Boolean; begin if (UpCase(AName[1]) = 'K') or (Pos('××', AName) > 0) or (Pos('…×…', AName) > 0) then Result := True else Result := False; end; {如下情况不属于深度超出：1-4-5-1下有复杂的子项；1-4-5-2下也有，但在标准项目表中 没有罗列出来。当在项目表中出现时不能说它是深度超出。所以：含×××的清单Ax, 第一兄弟A1，父项A,从A继承下来的其它清单，要依据A1检查名称、单位等是否错误。 1-4-5 大桥工程 1-4-5-1 ×××大桥 1-4-5-1-1 1-4-5-1-2 …… …… 1-4-5-2 ×××大桥 1-4-5-n ×××大桥 当能够调用该方法时，已经确定当前项在标准项目表中找不到了。所以它一定不是第一子 结点(为其它兄弟结点提供模板)。ATemplateCode值为模板Code，如：1-4-5-2-1-3的 ATemplateCode值为1-4-5-1-1-3，将父编号后的两个'-'之间的数字替换成1} function IsXXItem(ACode: string; var ATemplateCode: string): Boolean; var i, iPos: Integer; sXXPCode, sTemp, sTail: string; begin Result := False; ATemplateCode := ''; for i := 0 to FXXParentCodeSL.Count - 1 do begin sXXPCode := FXXParentCodeSL[i]; if Pos(sXXPCode + '-', ACode) = 1 then begin Result := True; sTemp := ACode; Delete(sTemp, 1, Length(sXXPCode) + 1); iPos := Pos('-', sTemp); if iPos > 0 then sTail := Copy(sTemp, iPos, Length(sTemp) - iPos + 1) else sTail := ''; ATemplateCode := sXXPCode + '-1' + sTail; Break; end; end; end; procedure CheckName(AStdName: string); begin if not SameText(vBItem.Name, AStdName) then begin if (not IsSpecialName(AStdName)) and (not LooseCompareIsSame(vBItem.Name, AStdName)) then begin MarkAndHint(vBItem, vBItem.Category, ecNameError); vBItem.NameErrorFlag := 1; vBItem.RightName := AStdName; end; end; end; procedure CheckUnits(AStdUnits: string); begin sRightUnit := AStdUnits; if not SameText(ConvertUnitStr(vBItem.Units), ConvertUnitStr(AStdUnits)) then begin MarkAndHint(vBItem, vBItem.Category, ecUnitError); vBItem.UnitsErrorFlag := 1; vBItem.RightUnits := AStdUnits; end; end; // 是否有两个单位 function HasTwoUnits(AUnit: string): Boolean; begin Result := False; if Pos('/', AUnit) > 1 then Result := True; end; begin with TStdBillsCtrl(TProject(FProject).StdBillsCtrl).DMStdBillsLib do begin if not Assigned(FStdTree.Items[0]) then begin CreateProgressForm(100, '打开标准项目表>>>'); AddProgressForm(25, '正在为第一次使用创建“分项清单”树...'); LoadNewStdLib(PBStdTreeFile); end; if not Assigned(FStdBQTree.Items[0]) then begin AddProgressForm(35, '正在为第一次使用创建“工程量清单”树...'); LoadBillsQtyLib(BQStdTreeFile); end; end; // 全部评分 if AllScope then begin idxFirst := FBillsTree[1].MajorIndex + 1; idxLast := FBillsTree[1].LastPosterity.MajorIndex; end else // 只评选中项 begin idxFirst := FBillsTree.Selected.MajorIndex; if Assigned(FBillsTree.Selected.LastPosterity) then idxLast := FBillsTree.Selected.LastPosterity.MajorIndex else idxLast := idxFirst; end; // “10”是为后面的统计Stat预留的进度 CreateProgressForm(idxLast + 10, '正在评分，请稍候>>>'); for i := idxFirst to idxLast do begin vBItem := FBillsTree.Items[i]; sRightUnit := vBItem.Units; AddProgressForm(1, vBItem.Code + vBItem.B_Code + ' ' + vBItem.Name); // 保留用户修改 if vBItem.UserModified = True then Continue // 先清掉原始评分信息 else begin vBItem.ErrorHint := ''; vBItem.DeductGrade := 0; vBItem.IsSuperscale := False; vBItem.LostPreSiblingCount := 0; vBItem.LostChildrenCount := 0; vBItem.LostNextSiblingCount := 0; vBItem.StandardGrade := StdMark(vBItem.Code, vBItem.B_Code); end; // 指定忽略 if vBItem.IsIgNore = True then begin vBItem.UserModified := False; Continue; end; vBC := BillCategory(vBItem.Code, vBItem.B_Code); if Assigned(vBItem.Parent) then begin // 重复行 if TScBillsItem(vBItem.Parent).IsRepeat or ( Assigned(vBItem.PrevSibling) and ((TScBillsItem(vBItem.PrevSibling).Code = vBItem.Code) and (TScBillsItem(vBItem.PrevSibling).B_Code = vBItem.B_Code) and (TScBillsItem(vBItem.PrevSibling).Name = vBItem.Name))) then begin vBItem.IsRepeat := True; MarkAndHint(vBItem, bcAll, ecRepeatLine); end else vBItem.IsRepeat := False; // 深度超出 // 情况1：父结点深度超出，子结点跟随深度超出。 if TScBillsItem(vBItem.Parent).IsSuperscale then begin vBItem.IsSuperscale := True; MarkAndHint(vBItem, bcAll, ecSuperscale); end else vBItem.IsSuperscale := False; end else begin vBItem.IsRepeat := False; vBItem.IsSuperscale := False; end; // 标准项目表部分--------------------------------------------------------------- // if vBItem.NeedSearchInStdLib then if not vBItem.IsRepeat then begin vLostBItem := nil; vLostStdPaItem := nil; { 兵分两路：预算项目节直接在分项清单树中查找。清单子目号清单可以任意放位置， 放在另外一个位置不能说它错。所以只能在工程量清单树中遍历。 并检查名称、单位是否正确。如果整个表都查不到证明编号错误。} case vBC of bcYSXMJ: begin vStdItem := FStdTree.FindNode(vBItem, vLostBItem, vLostStdPaItem); //---标准项目表找不到----------------------------------------------------- if not Assigned(vStdItem) then begin // 如果是XX项，则不能算深度超出，也不能算编号错 if IsXXItem(vBItem.Code, sTemplateCode) then begin with TStdBillsCtrl(FStdBillsCtrl).DMStdBillsLib do begin // 根据模板检查名称、单位(这里不用遍历树，使用cdsYSFastSearch，建有索引，优化速度) if cdsFastSearch.Locate('Code', sTemplateCode, []) then begin // 检查名称 CheckName(cdsFastSearchName.AsString); // 检查单位 CheckUnits(cdsFastSearchUnit.AsString); end else // 如果找不到，则属于新增项 begin MarkAndHint(vBItem, bcYSXMJ, ecCodeError); if Trim(vBItem.Units) = '' then MarkAndHint(vBItem, bcYSXMJ, ecNoUnits); end; end; end // 深度超出 else if // 深度超出(情况2：标准项目表已无子结点) (not vLostStdPaItem.HasChildren) or // 深度超出(情况3：标准项目表有子结点，但只是清单子目，而当前要比较的是预算项目节) ((vBItem.Category = bcYSXMJ) and (not vLostStdPaItem.HasYsxmjChild)) then begin // 如果前面已经判断是深度超出这里就不用重复指定深度超出 if not vBItem.IsSuperscale then begin vBItem.IsSuperscale := True; MarkAndHint(vBItem, bcAll, ecSuperscale); end; // 需求1.237 "所有预算项目节行都有单位、设计数量。" if Trim(vBItem.Units) = '' then MarkAndHint(vBItem, bcYSXMJ, ecNoUnits); end // 既不是XX项又不是深度超出，那么就是编号错误/新增预算项目节 else begin MarkAndHint(vBItem, bcYSXMJ, ecCodeError); if Trim(vBItem.Units) = '' then MarkAndHint(vBItem, bcYSXMJ, ecNoUnits); end; end // ---标准项目表找到了---------------------------------------------------- else begin // 检查名称 CheckName(vStdItem.Name); // 检查单位 CheckUnits(vStdItem.Units); end; end; bcQDZMH: begin with TStdBillsCtrl(FStdBillsCtrl).DMStdBillsLib do begin //---标准项目表找不到----------------------------------------------------- if not cdsBQFastSearch.Locate('B_Code', vBItem.B_Code, []) then begin // 编号递延 if IsCodeStepItem(vBItem.B_Code, vUnits) then begin MarkAndHint(vBItem, bcQDZMH, ecCodeStep); // 检查单位 CheckUnits(vUnits); end else // 编号错误或新清单 MarkAndHint(vBItem, bcQDZMH, ecB_CodeError); // 需求1.236 "所有有子项的清单子目，其数量和单位都应为空白， // 所有最底层的清单子目必须有单位和数量。" // 该需求不严谨：202-1、202-1-1 前者无单位，后者有单位，如果在 // 实际项目中只有202-1，则它是最底层清单子目，需求矛盾。所以只 // 能根据标准项目表判断。所以以下判断只适用于新增清单。 if (not vBItem.HasChildren) and (Trim(vBItem.Units) = '') then MarkAndHint(vBItem, bcQDZMH, ecNoUnits); end // ---标准项目表找到了---------------------------------------------------- else begin // 检查名称 CheckName(cdsBQFastSearchName.AsString); // 检查单位 CheckUnits(cdsBQFastSearchUnit.AsString); end; end; end; end; end; // 标准项目表部分结束----------------------------------------------------------- // 最后检查3个数量-------------------------------------------------------------- Case vBC of bcYSXMJ: // 预算项目节清单 begin // 双单位情况下，两个都必须都有数量。 if HasTwoUnits(sRightUnit) then begin if vBItem.DesignQuantity = 0 then MarkAndHint(vBItem, bcYSXMJ, ecNoDesignQuantity); if vBItem.DesignQuantity2 = 0 then MarkAndHint(vBItem, bcYSXMJ, ecNoDesignQuantity2); end else begin // 单单位情况下 // 两个数量都没填扣2分 if (vBItem.DesignQuantity = 0) and (vBItem.DesignQuantity2 = 0) then MarkAndHint(vBItem, bcYSXMJ, ecNoDesignQuantity) // 设计数量2有值 （数量位置错扣0.5分） else if (vBItem.DesignQuantity = 0) and (vBItem.DesignQuantity2 <> 0) then MarkAndHint(vBItem, bcYSXMJ, ecDesignQuantityPosError); end; end; bcQDZMH: // 清单子目号清单: 清单数量错误扣1分 begin if not vBItem.HasChildren then if vBItem.Quantity = 0 then MarkAndHint(vBItem, bcQDZMH, ecNoQuantity); end; end; SyncGradeFromTreeNodeToDataSet(vBItem); end; end; procedure TDMDataBase.AddError(AEC: TErrorCategory; ACount: Integer); var iPos, iValue: Integer; sHint, sError: string; cMark: Currency; vBC: TBillCategory; begin {$IFNDEF _beEncrypt} MessageHint(0, '对不起，此版本不提供评分功能，请购买正式版。'); Exit; {$ENDIF} case AEC of ecLostPreSibling, ecLostChildren, ecLostNextSibling: begin if AEC = ecLostPreSibling then iValue := cdsOrgBillsLostPreSiblingCount.AsInteger else if AEC = ecLostChildren then iValue := cdsOrgBillsLostChildrenCount.AsInteger else if AEC = ecLostNextSibling then iValue := cdsOrgBillsLostNextSiblingCount.AsInteger; if iValue = ACount then Exit; if ACount <= 0 then Exit; // 先处理掉旧的 CancelError(AEC); sError := Format(ErrorHintAry[Ord(AEC)], [ACount]); cMark := StdDeductMark(bcAll, AEC, ACount); end else begin sHint := cdsOrgBillsErrorHint.AsString; sError := ErrorHintAry[Ord(AEC)]; iPos := Pos(sError, sHint); // 错误已存在则不再重复指定 if iPos > 0 then Exit; vBC := BillCategory(cdsOrgBillsCode.AsString, cdsOrgBillsB_Code.AsString); cMark := StdDeductMark(vBC, AEC, 1); end; end; cdsOrgBills.Edit; sHint := cdsOrgBillsErrorHint.AsString; if sHint = '' then sHint := sError else sHint := sHint + HintSeparator + sError; cdsOrgBillsErrorHint.AsString := sHint; if AEC = ecSuperscale then cdsOrgBillsIsSuperscale.AsBoolean := True else if AEC in [ecLostChildren, ecLostPreSibling, ecLostNextSibling] then cdsOrgBillsStandardGrade.AsCurrency := cdsOrgBillsStandardGrade.AsCurrency + (- StdDeductMark(bcAll, AEC, ACount)); case AEC of ecLostChildren: cdsOrgBillsLostChildrenCount.AsInteger := ACount; ecLostPreSibling: cdsOrgBillsLostPreSiblingCount.AsInteger := ACount; ecLostNextSibling: cdsOrgBillsLostNextSiblingCount.AsInteger := ACount; end; cdsOrgBillsDeductGrade.AsCurrency := cdsOrgBillsDeductGrade.AsCurrency + cMark; if Abs(cdsOrgBillsDeductGrade.AsCurrency) > cdsOrgBillsStandardGrade.AsCurrency then cdsOrgBillsDeductGrade.AsCurrency := - cdsOrgBillsStandardGrade.AsCurrency; cdsOrgBillsUserModified.AsBoolean := True; cdsOrgBills.Post; end; procedure TDMDataBase.CancelError(AEC: TErrorCategory); var sHint, sError: string; cMark: Currency; vBC: TBillCategory; // AHint: 字段值（全，包括本清单的所有错误提示）；AError：要处理的错误 procedure DeleteHint(var AHint, AError: string); var iPos, LEr, LSpr: Integer; begin iPos := Pos(AError, AHint); if iPos = 0 then Exit; LEr := Length(AError); LSpr := Length(HintSeparator); // 删除提示 if iPos = 1 then begin if Length(AHint) > (LEr + LSpr) then Delete(AHint, 1, LEr + LSpr) else Delete(AHint, 1, LEr) end else Delete(AHint, iPos - LSpr, LEr + LSpr); end; begin {$IFNDEF _beEncrypt} MessageHint(0, '对不起，此版本不提供评分功能，请购买正式版。'); Exit; {$ENDIF} sHint := cdsOrgBillsErrorHint.AsString; vBC := BillCategory(cdsOrgBillsCode.AsString, cdsOrgBillsB_Code.AsString); case AEC of ecLostChildren: begin if cdsOrgBillsLostChildrenCount.AsInteger <= 0 then Exit; sError := Format(ErrorHintAry[Ord(AEC)], [cdsOrgBillsLostChildrenCount.AsInteger]); cMark := StdDeductMark(vBC, AEC, cdsOrgBillsLostChildrenCount.AsInteger); cdsOrgBills.Edit; cdsOrgBillsLostChildrenCount.Clear; end; ecLostPreSibling: begin if cdsOrgBillsLostPreSiblingCount.AsInteger <= 0 then Exit; sError := Format(ErrorHintAry[Ord(AEC)], [cdsOrgBillsLostPreSiblingCount.AsInteger]); cMark := StdDeductMark(vBC, AEC, cdsOrgBillsLostPreSiblingCount.AsInteger); cdsOrgBills.Edit; cdsOrgBillsLostPreSiblingCount.Clear; end; ecLostNextSibling: begin if cdsOrgBillsLostNextSiblingCount.AsInteger <= 0 then Exit; sError := Format(ErrorHintAry[Ord(AEC)], [cdsOrgBillsLostNextSiblingCount.AsInteger]); cMark := StdDeductMark(vBC, AEC, cdsOrgBillsLostNextSiblingCount.AsInteger); cdsOrgBills.Edit; cdsOrgBillsLostNextSiblingCount.Clear; end else begin sError := ErrorHintAry[Ord(AEC)]; // 错误不存在无法取消 if Pos(sError, sHint) = 0 then Exit; cMark := StdDeductMark(vBC, AEC, 1); cdsOrgBills.Edit; end; end; DeleteHint(sHint, sError); cdsOrgBillsErrorHint.AsString := sHint; // 扣分加回 cdsOrgBillsDeductGrade.AsCurrency := cdsOrgBillsDeductGrade.AsCurrency - cMark; // 暂时没有加到正分的情况 if cdsOrgBillsDeductGrade.AsCurrency > 0 then cdsOrgBillsDeductGrade.Clear; // 标准分加回 if AEC in [ecLostPreSibling, ecLostChildren, ecLostNextSibling] then cdsOrgBillsStandardGrade.AsCurrency := cdsOrgBillsStandardGrade.AsCurrency + cMark; // 深度超出要改字段 if AEC = ecSuperscale then cdsOrgBillsIsSuperscale.AsBoolean := False; cdsOrgBillsUserModified.AsBoolean := True; cdsOrgBills.Post; end; procedure TDMDataBase.ClearUserFlags; begin cdsBills.First; while not cdsBills.Eof do begin if cdsBillsUserModified.AsBoolean = True then begin cdsBills.Edit; cdsBillsUserModified.Clear; cdsBills.Post; end; cdsBills.Next; end; end; function TDMDataBase.StdDeductMark(ABillCategory: TBillCategory; AErrorCategory: TErrorCategory; ACount: Integer): Currency; begin Result := 0; case AErrorCategory of ecRepeatLine: Result := -0.5; // 深度超出是在最后算附加分 ecSuperscale, ecCodeError, ecB_CodeError, ecCodeStep: Result := 0; ecLostChildren, ecLostPreSibling, ecLostNextSibling: Result := -1 * ACount else begin case ABillCategory of bcYSXMJ: begin case AErrorCategory of ecNameError, ecUnitError, ecDesignQuantityPosError, ecNoUnits: Result := -0.5; ecQuantityError, ecNoDesignQuantity, ecNoDesignQuantity2: Result := -1; end; end; bcQDZMH: begin case AErrorCategory of ecNameError, ecUnitError, ecNoUnits: Result := -1; ecQuantityError, ecNoQuantity: Result := -2; end; end; end; end end; end; function TDMDataBase.StdMark(ACode, AB_Code: string): Currency; // 软基、边坡、桥梁、隧道等分部分项工程中预算项目节标准分值为1 function IsSpecial(ACode: string): Boolean; begin Result := False; ACode := Trim(ACode); //1-2-1-4-1 软弱地基处理 软基 //1-2-1-6 路基防护与加固工程 边坡 //1-4 桥梁涵洞工程 桥梁 //1-6 隧道工程 隧道 //1-5-5-N-1-1-4-1 软弱地基处理 软基 //1-5-5-N-2-1-4-1 软弱地基处理 软基 //1-5-5-N-1-1-6 路基防护与加固工程 边坡 //1-5-5-N-2-1-6 路基防护与加固工程 边坡 //1-5-5-N-2-1-5-8 高边坡排水 边坡 if (ACode = '1-2-1-4-1') or (ACode = '1-2-1-6') or (ACode = '1-4') or (ACode = '1-6') or (Pos('1-2-1-4-1-', ACode) = 1) or (Pos('1-2-1-6-', ACode) = 1) or (Pos('1-4-', ACode) = 1) or (Pos('1-6-', ACode) = 1) or ( (Pos('1-5-5-', ACode) = 1) and ( (Pos('-1-1-4-1', ACode) > 0) or (Pos('-2-1-4-1', ACode) > 0) or (Pos('-1-1-6', ACode) > 0) or (Pos('-2-1-6', ACode) > 0) or (Pos('-2-1-5-8', ACode) > 0)) ) then Result := True; end; begin Case BillCategory(ACode, AB_Code) of bcTZGCL: Result := 1; bcYSXMJ: begin if IsSpecial(ACode) then Result := 1.5 else Result := 1; end; bcQDZMH: result := 2; end; end; function TDMDataBase.StdMark(AItem: TScBillsItem): Currency; begin StdMark(AItem.Code, AItem.B_Code); end; function GetAllChildrenCount(ANode: TZjIDTreeNode): Integer; function GetCount(ANode: TZjIDTreeNode): Integer; begin if not Assigned(ANode) then Exit; Result := 0; Result := Result + ANode.ChildCount; if Assigned(ANode.FirstChild) then Result := Result + GetCount(ANode.FirstChild); if Assigned(ANode.NextSibling) then Result := Result + GetCount(ANode.NextSibling); end; begin if not Assigned(ANode) then Exit; if Assigned(ANode.FirstChild) then Result := GetCount(ANode.FirstChild) + ANode.ChildCount else Result := 0; end; function TDMDataBase.Stat: Currency; begin cdsBills.ApplyUpdates(0); cdsStat.DisableControls; // 总统计 aqStatTotal.Close; aqStatTotal.Open; cdsStatTotal.First; while not cdsStatTotal.Eof do cdsStatTotal.Delete; aqStatTotal.First; while not aqStatTotal.Eof do begin cdsStatTotal.Append; cdsStatTotalID.AsInteger := aqStatTotalID.AsInteger; cdsStatTotalStandardGradeTotal.AsCurrency := aqStatTotalStandardGradeTotal.AsCurrency; cdsStatTotalDeductGradeTotal.AsCurrency := aqStatTotalDeductGradeTotal.AsCurrency; cdsStatTotalYsCountTotal.AsInteger := aqStatTotalYsCountTotal.AsInteger; cdsStatTotalQdCountTotal.AsInteger := aqStatTotalQdCountTotal.AsInteger; cdsStatTotalResultMarkTotal.AsCurrency := aqStatTotalResultMarkTotal.AsCurrency; cdsStatTotalAdditionalMark.AsCurrency := aqStatTotalAdditionalMark.AsCurrency; cdsStatTotalQualityMark.AsCurrency := aqStatTotalQualityMark.AsCurrency; cdsStatTotal.Post; aqStatTotal.Next; end; // 分章节统计 aqStat.Close; aqStat.Open; // 旧项目的ChapterID值没有处理，都为0，GradeStat表需要ChapterID值作为主键。 // 这种情况下需要先调用Grade方法生成ChapterID值。 if aqStatChapterID.AsInteger = 0 then exit; cdsStat.First; while not cdsStat.Eof do cdsStat.Delete; aqStat.First; while not aqStat.Eof do begin cdsStat.Append; cdsStatChapterID.AsInteger := aqStatChapterID.AsInteger; cdsStatCode.AsString := aqStatCode.AsString; cdsStatName.AsString := aqStatName.AsString; cdsStatStandardGrade.AsCurrency := aqStatStandardGrade.AsCurrency; cdsStatDeductGrade.AsCurrency := aqStatDeductGrade.AsCurrency; cdsStatYsCount.AsInteger := aqStatYsCount.AsInteger; cdsStatQdCount.AsInteger := aqStatQdCount.AsInteger; cdsStatActureMark.AsCurrency := aqStatActureMark.AsCurrency; cdsStatTotalMark.AsCurrency := aqStatTotalMark.AsCurrency; cdsStatStdMarkPercent.AsCurrency := aqStatStdMarkPercent.AsCurrency; cdsStatResultMark.AsCurrency := aqStatResultMark.AsCurrency; cdsStat.Post; aqStat.Next; end; if Assigned(FOnStat) then FOnStat(aqStatTotalAdditionalMark.AsCurrency, aqStatTotalYsCountTotal.AsInteger, aqStatTotalQdCountTotal.AsInteger); cdsStat.EnableControls; end; procedure TDMDataBase.cdsOrgBillsDeductGradeGetText(Sender: TField; var Text: String; DisplayText: Boolean); begin if Sender.AsCurrency = 0 then Text := '' else if Sender.AsCurrency > 0 then Text := '+' + CurrToStr(Sender.AsCurrency) else Text := CurrToStr(Sender.AsCurrency); end; procedure TDMDataBase.SyncGradeFromTreeNodeToDataSet(AItem: TScBillsItem); begin if cdsBills.Locate('ID', AItem.ID, []) then begin FNeedSyncTree := False; cdsBills.Edit; cdsBillsErrorHint.AsString := AItem.ErrorHint; cdsBillsIsSuperscale.AsBoolean := AItem.IsSuperscale; cdsBillsStandardGrade.AsCurrency := AItem.StandardGrade; cdsBillsDeductGrade.AsCurrency := AItem.DeductGrade; cdsBillsIsIgNore.AsBoolean := AItem.IsIgNore; cdsBillsUserModified.AsBoolean := AItem.UserModified; cdsBillsLostPreSiblingCount.AsInteger := AItem.LostPreSiblingCount; cdsBillsLostChildrenCount.AsInteger := AItem.LostNextSiblingCount; cdsBillsLostNextSiblingCount.AsInteger := AItem.LostNextSiblingCount; cdsBillsNameErrorFlag.AsInteger := AItem.NameErrorFlag; cdsBillsUnitsErrorFlag.AsInteger := AItem.UnitsErrorFlag; cdsBillsRightName.AsString := AItem.RightName; cdsBillsRightUnits.AsString := AItem.RightUnits; if cdsBillsChapterID.AsInteger <> AItem.ChapterID then cdsBillsChapterID.AsInteger := AItem.ChapterID; cdsBills.Post; FNeedSyncTree := True; end; end; procedure TDMDataBase.SetUserModifiedGrade; begin cdsOrgBills.Edit; cdsOrgBillsUserModified.AsBoolean := True; cdsOrgBills.Post; end; procedure TDMDataBase.SyncGradeFromDataSetToTreeNode(ACDS: TClientDataSet); var vItem: TScBillsItem; begin vItem := FBillsTree[ACDS.FieldByName('ID').AsInteger]; if Assigned(vItem) then begin vItem.Code := ACDS.FieldByName('Code').asString; vItem.B_Code := ACDS.FieldByName('B_Code').asString; vItem.Name := ACDS.FieldByName('Name').asString; vItem.Units := ACDS.FieldByName('Units').AsString; vItem.Quantity := ACDS.FieldByName('Quantity').AsFloat; vItem.DesignQuantity := ACDS.FieldByName('DesignQuantity').AsFloat; vItem.DesignQuantity2 := ACDS.FieldByName('DesignQuantity2').AsFloat; vItem.ErrorHint := ACDS.FieldByName('ErrorHint').AsString; vItem.IsSuperscale := ACDS.FieldByName('IsSuperscale').AsBoolean; vItem.StandardGrade := ACDS.FieldByName('StandardGrade').AsCurrency; vItem.DeductGrade := ACDS.FieldByName('DeductGrade').AsCurrency; vItem.IsIgNore := ACDS.FieldByName('IsIgNore').AsBoolean; vItem.UserModified := ACDS.FieldByName('UserModified').AsBoolean; vItem.LostPreSiblingCount := ACDS.FieldByName('LostPreSiblingCount').AsInteger; vItem.LostNextSiblingCount := ACDS.FieldByName('LostChildrenCount').AsInteger; vItem.LostNextSiblingCount := ACDS.FieldByName('LostNextSiblingCount').AsInteger; vItem.NameErrorFlag := ACDS.FieldByName('NameErrorFlag').AsInteger; vItem.UnitsErrorFlag := ACDS.FieldByName('UnitsErrorFlag').AsInteger; vItem.RightName := ACDS.FieldByName('RightName').AsString; vItem.RightUnits := ACDS.FieldByName('RightUnits').AsString; vItem.IsAccQuantity := ACDS.FieldByName('IsAccQuantity').AsBoolean; end; end; procedure TDMDataBase.cdsBillsLostNextSiblingCountChange(Sender: TField); begin Sender.Tag := 1; end; procedure TDMDataBase.cdsOrgBillsLostNextSiblingCountChange( Sender: TField); begin Sender.Tag := 1; end; procedure TDMDataBase.aqStatCalcFields(DataSet: TDataSet); var cSGT: Currency; begin if aqStatStandardGrade.AsCurrency = 0 then aqStatActureMark.AsCurrency := 0 else aqStatActureMark.AsCurrency := (aqStatStandardGrade.AsCurrency + aqStatDeductGrade.AsCurrency) / aqStatStandardGrade.AsCurrency * 100; aqStatTotalMark.AsCurrency := 100; if aqStatTotal.RecordCount > 0 then cSGT := aqStatTotalStandardGradeTotal.AsCurrency else cSGT := 0; if cSGT = 0 then aqStatStdMarkPercent.AsCurrency := 0 else aqStatStdMarkPercent.AsCurrency := aqStatStandardGrade.AsCurrency / cSGT * 100; aqStatResultMark.AsCurrency := aqStatActureMark.AsCurrency * aqStatStdMarkPercent.AsCurrency / 100; end; function TDMDataBase.LooseCompareIsSame(AStr1, AStr2: string): Boolean; begin AStr1 := Trim(AStr1); AStr2 := Trim(AStr2); // 识别全角、半角括号：（）() AStr1 := StringReplace(AStr1, '（', '(', [rfReplaceAll]); AStr1 := StringReplace(AStr1, '）', ')', [rfReplaceAll]); AStr2 := StringReplace(AStr2, '（', '(', [rfReplaceAll]); AStr2 := StringReplace(AStr2, '）', ')', [rfReplaceAll]); if SameText(AStr1, AStr2) then Result := True else Result := False; end; function TDMDataBase.GetHasGatherQ: Boolean; var iID: Integer; begin Result := False; iID := cdsOrgBillsID.AsInteger; cdsDrawingQuantity.Filter := 'BillsID=' + IntToStr(iID); cdsDrawingQuantity.Filtered := True; try cdsDrawingQuantity.First; while not cdsDrawingQuantity.Eof do begin if cdsDrawingQuantityIsGatherQ.AsBoolean = True then begin Result := True; Break; end; cdsDrawingQuantity.Next; end; finally cdsDrawingQuantity.Filtered := False; end; end; // 生成SerialNo、ChapterID、FullCode procedure TDMDataBase.Save_SerialNo_ChapterID_FullCode; var iSerialNo, iChapterID: Integer; strFullCode, sBCodeAlpha: string; bIsLeaf: Boolean; function GetChapterID(vNode: TZjIDTreeNode): Integer; begin while (vNode.Level > 1) do vNode := vNode.Parent; Result := vNode.ID; end; function IsNecessary: Boolean; begin Result := (cdsBillsSerialNo.AsInteger <> iSerialNo) or (cdsBillsFullCode.AsString <> strFullCode) or (cdsBillsChapterID.AsInteger <> iChapterID) or (cdsBillsIsLeaf.AsBoolean <> bIsLeaf) or (cdsBillsB_CodeAlpha.AsString <> sBCodeAlpha); end; procedure SaveSerialnoAndFullCodeAndChapterIDAndIsLeaf; begin cdsBills.Edit; cdsBillsSerialNo.AsInteger := iSerialNo; cdsBillsFullCode.AsString := strFullCode; cdsBillsChapterID.AsInteger := iChapterID; cdsBillsIsLeaf.AsBoolean := bIsLeaf; cdsBillsB_CodeAlpha.AsString := sBCodeAlpha; cdsBills.Post; end; procedure SaveIfNecessary; begin if IsNecessary then SaveSerialnoAndFullCodeAndChapterIDAndIsLeaf; end; procedure PrepareSerialnoAndFullCodeAndChapterIDAndIsLeaf(ANode: TZjIDTreeNode); begin iSerialNo := ANode.MajorIndex; strFullCode := GetBillsFullCode(ANode.ID); sBCodeAlpha := FormatBCodeAlpha(TScBillsItem(ANode).B_Code); iChapterID := GetChapterID(ANode); bIsLeaf := not ANode.HasChildren; end; procedure PrepareAndSave(ANode: TZjIDTreeNode); begin if cdsBills.FindKey([ANode.ID]) then begin PrepareSerialnoAndFullCodeAndChapterIDAndIsLeaf(ANode); SaveIfNecessary; end; end; var I, iCurID: Integer; begin // TimeBegin('Save_SerialNo_ChapterID_FullCode'); iCurID := cdsOrgBillsID.AsInteger; CloneActive(False); FEnabledUITreeEvt(False); try for I := 0 to FBillsTree.Count - 1 do PrepareAndSave(FBillsTree.Items[I]); finally FEnabledUITreeEvt(True); CloneActive(True); cdsOrgBills.Locate('ID', iCurID, []); end; // TimeEnd(); end; procedure TDMDataBase.aqStatTotalCalcFields(DataSet: TDataSet); var cAddMark: Currency; begin if aqStatTotalStandardGradeTotal.AsCurrency = 0 then aqStatTotalResultMarkTotal.AsCurrency := 0 else aqStatTotalResultMarkTotal.AsCurrency := (aqStatTotalStandardGradeTotal.AsCurrency + aqStatTotalDeductGradeTotal.AsCurrency) / aqStatTotalStandardGradeTotal.AsCurrency * 100; cAddMark := FloatToCurr(aqStatTotalYsCountTotal.AsInteger / 5 + aqStatTotalQdCountTotal.AsInteger / 50); if cAddMark > 5 then cAddMark := 5; aqStatTotalAdditionalMark.AsCurrency := cAddMark; aqStatTotalQualityMark.AsCurrency := aqStatTotalResultMarkTotal.AsCurrency + cAddMark; end; procedure TDMDataBase.ClearAllUnitPrices; begin cdsBills.First; while not cdsBills.Eof do begin if cdsBillsUnitPrice.AsCurrency <> 0 then begin cdsBills.Edit; cdsBillsUnitPrice.AsCurrency := 0; cdsBills.Post; end; cdsBills.Next; end; end; procedure TDMDataBase.cdsOrgDrawingQuantityAfterDelete(DataSet: TDataSet); begin // Modified by GiLi 2012-3-19 10:40:46 // 未勾选填工程量，删除细目也删除Bills清单量的BUG GatherDQQty(cdsOrgBillsID.AsInteger, FCurIsGatherQ); end; procedure TDMDataBase.GatherBillsQuantity; procedure GatherQuantityIfNotHasChildren(ANode: TZjIDTreeNode); begin if not ANode.HasChildren then GatherDQQty(ANode.ID, False); end; var I: Integer; begin for I := 0 to FBillsTree.Count - 1 do GatherQuantityIfNotHasChildren(FBillsTree.Items[I]); end; function TDMDataBase.GetBQStdTreeFile: string; begin Result := FBQStdTreeFile; end; function TDMDataBase.GetPBStdTreeFile: string; begin Result := FPBStdTreeFile; end; procedure TDMDataBase.ReadBillGradeStdFile; var vIni: TIniFile; sPath: string; begin sPath := ExtractFilePath(Application.ExeName); // 造价软件是SmartCostBD.ini。这里使用的“项目清单20XX版.dat”跟造价程序不共用。 // 因为我发现它们的表结构不一致，只好分开。 chenshilong vIni := TIniFile.Create(sPath + 'config.ini'); try FPBStdTreeFile := sPath + vIni.ReadString('BillsGrade', 'ProjectBillLib', 'Data\项目清单20XX版.dat'); FBQStdTreeFile := sPath + vIni.ReadString('BillsGrade', 'QuantityBillLib', 'Data\工程量清单20XX版.dat'); finally vIni.Free; end; end; procedure TDMDataBase.ClearBillsFieldsTagAfterHandle; begin cdsOrgBillsParentID.Tag := 0; cdsOrgBillsNextSiblingID.Tag := 0; cdsOrgBillsCode.Tag := 0; cdsOrgBillsB_Code.Tag := 0; cdsOrgBillsName.Tag := 0; cdsOrgBillsUnits.Tag := 0; end; function TDMDataBase.IsContainXXItem(ACode: string): Boolean; var I, J: Integer; // sCurItem, sBaseItem: string; // iBaseSize, iCurSize: Integer; sPreACode1, sPreACode2, sPreACode, sPrePCode: string; iACodeLen, i_Count: Integer; begin // Modified by GiLi 2012-5-2 11:07:45 // 识别1-5-6-n 不进行汇总 // Result := False; // sBaseItem := '1-5-6'; // ACode := GetPreCode(ACode); // iBaseSize := Length(sBaseItem); // for I := 0 to FGatherXXItems.Count - 1 do // begin // sCurItem := FGatherXXItems[I]; // iCurSize := Length(sCurItem); // if iCurSize > iBaseSize then // begin // sCurItem := LeftStr(sCurItem, iBaseSize); // if SameText(sCurItem, sBaseItem) then // begin // Result := True; // Break; // end; // end; // if (ACode = FGatherXXItems[I]) then // begin // Result := True; // Break; // end; // end; // chenshilong, 2012-09-11 Result := False; iACodeLen := Length(ACode); // 取前缀：如1-5-6-8，结果1-5-6- for J := iACodeLen downto 1 do begin if ACode[J] = '-' then begin sPreACode1 := Copy(ACode, 1, J); Break; end; end; // 取掩码前缀：如1-5-6-8，结果1-5-m- i_Count := 0; for J := iACodeLen downto 1 do begin if ACode[J] = '-' then begin Inc(i_Count); if i_Count = 2 then begin sPreACode2 := Copy(ACode, 1, J) + 'm-'; Break; end; end; end; for I := 0 to FGatherXXItems.Count - 1 do begin sPrePCode := FGatherXXItems[I] + '-'; if Pos('m', sPrePCode) > 0 then sPreACode := sPreACode2 else sPreACode := sPreACode1; if sPreACode = sPrePCode then begin Result := True; Break; end; end; end; function TDMDataBase.HasSelected: Boolean; var I: Integer; begin Result := False; for I := 0 to FBillsTree.Count - 1 do begin if TScBillsItem(FBillsTree.Items[I]).Selected then begin Result := True; Break; end; end; end; procedure TDMDataBase.ClearBlankGatherXXItems; var I: integer; begin for I := FGatherXXItems.Count - 1 downto 0 do if FGatherXXItems[I] = '' then FGatherXXItems.Delete(I); end; procedure TDMDataBase.RefreshByItem(AItem: TScBillsItem); begin if cdsOrgBills.Locate('ID', AItem.ID, []) then begin FNeedSyncTree := False; cdsOrgBills.Edit; cdsOrgBillsErrorHint.AsString := AItem.ErrorHint; cdsOrgBillsIsSuperscale.AsBoolean := AItem.IsSuperscale; cdsOrgBillsStandardGrade.AsCurrency := AItem.StandardGrade; cdsOrgBillsDeductGrade.AsCurrency := AItem.DeductGrade; cdsOrgBillsIsIgNore.AsBoolean := AItem.IsIgNore; cdsOrgBillsUserModified.AsBoolean := AItem.UserModified; cdsOrgBillsLostPreSiblingCount.AsInteger := AItem.LostPreSiblingCount; cdsOrgBillsLostChildrenCount.AsInteger := AItem.LostNextSiblingCount; cdsOrgBillsLostNextSiblingCount.AsInteger := AItem.LostNextSiblingCount; cdsOrgBillsNameErrorFlag.AsInteger := AItem.NameErrorFlag; cdsOrgBillsUnitsErrorFlag.AsInteger := AItem.UnitsErrorFlag; cdsOrgBillsRightName.AsString := AItem.RightName; cdsOrgBillsRightUnits.AsString := AItem.RightUnits; if cdsOrgBillsChapterID.AsInteger <> AItem.ChapterID then cdsOrgBillsChapterID.AsInteger := AItem.ChapterID; cdsOrgBills.Post; end; end; procedure TDMDataBase.DeleteLastParentUnit(AID: Integer); procedure DeleteUnitByNode(ANode: TScBillsItem); begin while ANode <> nil do begin if ANode.Parent <> nil then begin if TScBillsItem(ANode.FirstChild) = nil then begin if TScBillsItem(ANode.Parent).B_Code <> '' then begin TScBillsItem(ANode.Parent).Units := ''; if cdsBills.Locate('ID', ANode.Parent.ID, []) then begin cdsBills.Edit; cdsBillsUnits.AsString := ''; cdsBills.Post; end; if cdsOrgBills.Locate('ID', ANode.Parent.ID, []) then begin cdsOrgBills.Edit; cdsOrgBillsUnits.AsString := ''; cdsOrgBills.Post; end; end; end; end; DeleteUnitByNode(TScBillsItem(ANode.NextSibling)); ANode := TScBillsItem(ANode.FirstChild); end; end; var CurNode: TScBillsItem; begin CurNode := BillsTree.FindNode(AID); DeleteUnitByNode(CurNode) end; procedure TDMDataBase.AccQuantityToParentItem(AParentID: Integer; AQuantity1, AQuantity2: Double); begin if cdsBills.FindKey([AParentID]) then begin cdsBills.Edit; cdsBillsDesignQuantity.Value := ScRoundTo(cdsBillsDesignQuantity.AsFloat + AQuantity1, -3); cdsBillsDesignQuantity2.Value := ScRoundTo(cdsBillsDesignQuantity2.AsFloat + AQuantity2, -3); cdsBills.Post; if cdsBillsIsAccQuantity.AsBoolean then AccQuantityToParentItem(cdsBillsParentID.AsInteger, AQuantity1, AQuantity2); end; end; procedure TDMDataBase.CalculateParentQuantity; var DesignQuantity, DesignQuantity2: Double; begin if cdsOrgBillsB_Code.AsString = '' then begin { if cdsOrgBillsIsAccQuantity.AsBoolean then AccQuantityToParentItem(cdsOrgBillsParentID.AsInteger, cdsOrgBillsDesignQuantity.AsFloat, cdsOrgBillsDesignQuantity2.AsFloat) else AccQuantityToParentItem(cdsOrgBillsParentID.AsInteger, -cdsOrgBillsDesignQuantity.AsFloat, -cdsOrgBillsDesignQuantity2.AsFloat) } // 当有填父项量时，将自己的数量填到父项中 GatherChildDQuantity(cdsOrgBillsParentID.AsInteger); // 当其本身的数量是子项通过填父项量统计而来时，修改本身的值不允许， // 但是前面也没做处理，所以在这里做处理：将本身的值通过子项的 // 填父项量在统计一般 GatherChildDQuantity(cdsOrgBillsID.AsInteger); end; end; function TDMDataBase.HasCalcPQChildItem(ABillsID: Integer): Boolean; var vItem, vChildItem: TScBillsItem; I: Integer; begin Result := False; vItem := BillsTree.BillsItem[ABillsID]; if vItem.HasChildren then begin for I := 0 to vItem.ChildCount - 1 do begin vChildItem := TScBillsItem(vItem.ChildNodes[I]); if vChildItem.IsAccQuantity then begin Result := True; Exit; end; end; end; end; procedure TDMDataBase.CancelChildItemIsAQ(ABillsID: Integer); var vItem, vChildItem: TScBillsItem; I, ChildID: Integer; begin FOnCancelIsAQ := True; vItem := BillsTree.BillsItem[ABillsID]; if vItem.HasChildren then begin for I := 0 to vItem.ChildCount - 1 do begin vChildItem := TScBillsItem(vItem.ChildNodes[I]); ChildID := vChildItem.ID; if cdsBills.FindKey([ChildID]) then begin cdsBills.Edit; cdsBillsIsAccQuantity.AsBoolean := False; cdsBills.Post; end; end; end; FOnCancelIsAQ := False; end; procedure TDMDataBase.cdsOrgBillsIsAccQuantityChange(Sender: TField); begin if not FOnCancelIsAQ then Sender.Tag := 1; end; procedure TDMDataBase.GatherChildDQuantity(ABillsID: Integer); var vItem, vChildItem: TScBillsItem; I: Integer; DesignQuantity, DesignQuantity2: Double; begin DesignQuantity := 0; DesignQuantity2 := 0; vItem := BillsTree.BillsItem[ABillsID]; if vItem = nil then Exit; for I := 0 to vItem.ChildCount - 1 do begin vChildItem := TScBillsItem(vItem.ChildNodes[I]); if vChildItem.IsAccQuantity then begin DesignQuantity := ScRoundTo(DesignQuantity + vChildItem.DesignQuantity, -3); DesignQuantity2 := ScRoundTo(DesignQuantity2 + vChildItem.DesignQuantity2, -3); end; end; if (cdsBills.FindKey([ABillsID])) and ((DesignQuantity <> 0) or (DesignQuantity2 <> 0)) then begin cdsBills.Edit; cdsBillsDesignQuantity.AsFloat := DesignQuantity; cdsBillsDesignQuantity2.AsFloat := DesignQuantity2; cdsBills.Post; end; end; function TDMDataBase.FindIDRecord(AItems: TList; AID: Integer): PIDRecord; var I: Integer; begin for I := 0 to AItems.Count - 1 do begin Result := AItems[I]; if Result.NextID = AID then Exit; end; Result := nil; end; procedure TDMDataBase.CloneActive(IsActive: Boolean); begin // cdsOrgBills.Active := IsActive; 恢复后少数据 // cdsBillsLookup.Active := IsActive; // cdsXMJBills.Active := IsActive; 这句会报错 // MainFrm.StdBillsCtrl.DMStdBillsLib.CloneActive(IsActive); if IsActive then begin cdsOrgBills.CloneCursor(cdsBills, True); cdsBillsLookup.CloneCursor(cdsBills, True); EnterXMJBills; end else begin cdsOrgBills.Active := IsActive; cdsBillsLookup.Active := IsActive; LeaveXMJBills; end; end; end.