123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447 |
- unit rmXmjBGLDetailDm;
- interface
- uses
- SysUtils, Classes, DB, DBClient, ProjectData, sdIDTree, sdDB;
- type
- TBGLNode = class
- private
- FBGLCode: string;
- FBGLName: string;
- FBGLReason: string;
- FDirection: string;
- FBGLType: string;
- FDrawingCode: string;
- FApprovalCode: string;
- FBGLRelaFile: string;
- end;
- TXmjNode = class
- private
- FChildList: TList;
- FBGLList: TList;
- FCode: string;
- FName: string;
- FDgnQuantity1: Double;
- FDgnQuantity2: Double;
- FEndDealTotalPrice: Double;
- FEndGatherTotalPrice: Double;
- FTotalPrice: Double;
- FEndQcTotalPrice: Double;
- function GetChildCount: Integer;
- function GetChildNode(AIndex: Integer): TXmjNode;
- function GetBGLCount: Integer;
- function GetBGLNode(AIndex: Integer): TBGLNode;
- public
- constructor Create;
- destructor Destroy; override;
- function FindBGLNode(const ABGLCode: string): TBGLNode;
- property ChildCount: Integer read GetChildCount;
- property ChildNode[AIndex: Integer]: TXmjNode read GetChildNode;
- property BGLCount: Integer read GetBGLCount;
- property BGLNode[AIndex: Integer]: TBGLNode read GetBGLNode;
- end;
- TrmXmjBGLDetailData = class(TDataModule)
- cdsXmjBGLDetail: TClientDataSet;
- cdsXmjBGLDetailCode: TStringField;
- cdsXmjBGLDetailName: TWideStringField;
- cdsXmjBGLDetailDgnQuantity1: TFloatField;
- cdsXmjBGLDetailDgnQuantity2: TFloatField;
- cdsXmjBGLDetailDgnQuantity: TStringField;
- cdsXmjBGLDetailXmj_BGLName: TWideStringField;
- cdsXmjBGLDetailBGLCode: TWideStringField;
- cdsXmjBGLDetailBGLName: TWideStringField;
- cdsXmjBGLDetailBGLType: TWideStringField;
- cdsXmjBGLDetailReason: TWideStringField;
- cdsXmjBGLDetailDirection: TWideStringField;
- cdsXmjBGLDetailEndDealTotalPrice: TFloatField;
- cdsXmjBGLDetailEndGatherTotalPrice: TFloatField;
- cdsXmjBGLDetailBGTotalPrice: TFloatField;
- cdsXmjBGLDetailDrawingCode: TWideStringField;
- cdsXmjBGLDetailApprovalCode: TWideStringField;
- cdsXmjBGLDetailBGLRelaFile: TWideStringField;
- cdsXmjBGLDetailMemoStr: TWideStringField;
- cdsXmjBGLDetailTotalPrice: TFloatField;
- cdsXmjBGLDetailEndQcTotalPrice: TFloatField;
- cdsXmjBGLDetailFinalTotalPrice: TFloatField;
- private
- FProjectData: TProjectData;
- FClassXmjList: TList;
- function GetDgnQuantity(ANum1, ANum2: Double): string;
- procedure AddBGL(ABGLCode: string; AClassNode: TXmjNode);
- procedure AddBGLsData(ABGLCode: string; AClassNode: TXmjNode);
- procedure FilterNodeBGLData(ANode: TsdIDTreeNode; AClassNode: TXmjNode);
- procedure FilterBGLData(ANode: TsdIDTreeNode; AClassNode: TXmjNode);
- procedure AddDetailXmjNode(ANode: TsdIDTreeNode; AClassNode: TXmjNode);
- function CheckLeafXmj(ANode: TsdIDTreeNode): Boolean;
- function CheckHasBGL(ANode: TsdIDTreeNode): Boolean;
- procedure FilterDetailNode(ANode: TsdIDTreeNode; AClassNode: TXmjNode);
- procedure AddClassXmjNode(ANode: TsdIDTreeNode);
- function CheckChildNodeHasBGL(ANode: TsdIDTreeNode): Boolean;
- procedure FilterNode(ANode: TsdIDTreeNode);
- procedure WriteBGLNodeData(ABGLNode: TBGLNode);
- procedure WriteXmjNodeData(AXmjNode: TXmjNode; AIndex: Integer = -1);
- procedure WriteData;
- public
- function AssignData(AProjectData: TProjectData): TDataSet;
- end;
- implementation
- uses
- ZhAPI, DateUtils, BGLDm;
- {$R *.dfm}
- { TrmXmjBGLDetailData }
- procedure TrmXmjBGLDetailData.AddBGL(ABGLCode: string;
- AClassNode: TXmjNode);
- var
- BGLNode: TBGLNode;
- begin
- BGLNode := AClassNode.FindBGLNode(ABGLCode);
- if not Assigned(BGLNode) then
- begin
- BGLNode := TBGLNode.Create;
- BGLNode.FBGLCode := ABGLCode;
- with FProjectData.BGLData do
- begin
- if cdsBGL.Locate('Code', ABGLCode, []) then
- begin
- BGLNode.FBGLName := cdsBGLName.AsString;
- BGLNode.FBGLReason := cdsBGLPos_Reason.AsString;
- BGLNode.FDirection := cdsBGLDirection.AsString;
- BGLNode.FBGLType := '';
- BGLNode.FDrawingCode := cdsBGLDrawingCode.AsString;
- BGLNode.FApprovalCode := cdsBGLApprovalCode.AsString;
- BGLNode.FBGLRelaFile := '';
- end;
- end;
- AClassNode.FBGLList.Add(BGLNode);
- end;
- end;
- procedure TrmXmjBGLDetailData.AddBGLsData(ABGLCode: string;
- AClassNode: TXmjNode);
- var
- sgs: TStrings;
- i: Integer;
- begin
- if ABGLCode = '' then Exit;
- sgs := TStringList.Create;
- try
- sgs.Delimiter := ';';
- sgs.DelimitedText := ABGLCode;
- for i := 0 to sgs.Count - 1 do
- AddBGL(sgs.Strings[i], AClassNode);
- finally
- sgs.Free;
- end;
- end;
- procedure TrmXmjBGLDetailData.AddClassXmjNode(ANode: TsdIDTreeNode);
- var
- XmjNode: TXmjNode;
- StageRec: TsdDataRecord;
- begin
- if not Assigned(ANode) then Exit;
- XmjNode := TXmjNode.Create;
- FClassXmjList.Add(XmjNode);
- XmjNode.FCode := ANode.Rec.ValueByName('Code').AsString;
- XmjNode.FName := ANode.Rec.ValueByName('Name').AsString;
- XmjNode.FDgnQuantity1 := ANode.Rec.ValueByName('DgnQuantity1').AsFloat;
- XmjNode.FDgnQuantity2 := ANode.Rec.ValueByName('DgnQuantity2').AsFloat;
- XmjNode.FTotalPrice := ANode.Rec.ValueByName('TotalPrice').AsFloat;
- if FProjectData.PhaseData.Active then
- begin
- StageRec := FProjectData.PhaseData.StageData.StageRecord(ANode.ID);
- if Assigned(StageRec) then
- begin
- XmjNode.FEndDealTotalPrice := StageRec.ValueByName('EndDealTotalPrice').AsFloat;
- XmjNode.FEndGatherTotalPrice := StageRec.ValueByName('EndGatherTotalPrice').AsFloat;
- XmjNode.FEndQcTotalPrice := StageRec.ValueByName('EndQcTotalPrice').AsFloat;
- end;
- end;
- FilterDetailNode(ANode, XmjNode);
- end;
- procedure TrmXmjBGLDetailData.AddDetailXmjNode(ANode: TsdIDTreeNode;
- AClassNode: TXmjNode);
- var
- DetailNode: TXmjNode;
- StageRec: TsdDataRecord;
- begin
- DetailNode := TXmjNode.Create;
- AClassNode.FChildList.Add(DetailNode);
- DetailNode.FName := ANode.Rec.ValueByName('Name').AsString;
- DetailNode.FDgnQuantity1 := ANode.Rec.ValueByName('DgnQuantity1').AsFloat;
- DetailNode.FDgnQuantity2 := ANode.Rec.ValueByName('DgnQuantity2').AsFloat;
- DetailNode.FTotalPrice := ANode.Rec.ValueByName('TotalPrice').AsFloat;
- if FProjectData.PhaseData.Active then
- begin
- StageRec := FProjectData.PhaseData.StageData.StageRecord(ANode.ID);
- if Assigned(StageRec) then
- begin
- DetailNode.FEndDealTotalPrice := StageRec.ValueByName('EndDealTotalPrice').AsFloat;
- DetailNode.FEndGatherTotalPrice := StageRec.ValueByName('EndGatherTotalPrice').AsFloat;
- DetailNode.FEndQcTotalPrice := StageRec.ValueByName('EndQcTotalPrice').AsFloat;
- end;
- end;
- FilterBGLData(ANode, DetailNode);
- end;
- function TrmXmjBGLDetailData.AssignData(
- AProjectData: TProjectData): TDataSet;
- begin
- FProjectData := AProjectData;
- FClassXmjList := TList.Create;
- cdsXmjBGLDetail.Active := True;
- cdsXmjBGLDetail.EmptyDataSet;
- cdsXmjBGLDetail.DisableControls;
- try
- FilterNode(AProjectData.BillsCompileData.BillsCompileTree.FirstNode);
- WriteData;
- finally
- cdsXmjBGLDetail.EnableControls;
- Result := cdsXmjBGLDetail;
- ClearObjects(FClassXmjList);
- FClassXmjList.Free;
- end;
- end;
- function TrmXmjBGLDetailData.CheckChildNodeHasBGL(
- ANode: TsdIDTreeNode): Boolean;
- var
- iNext, iTotal: Integer;
- vChild: TsdIDTreeNode;
- begin
- Result := False;
- if not Assigned(ANode) then Exit;
- iNext := 1;
- iTotal := ANode.PosterityCount;
- vChild := ANode.NextNode;
- while (iNext <= iTotal) and not Result do
- begin
- if not vChild.HasChildren then
- Result := CheckHasBGL(vChild);
- vChild := vChild.NextNode;
- Inc(iNext);
- end;
- end;
- function TrmXmjBGLDetailData.CheckHasBGL(ANode: TsdIDTreeNode): Boolean;
- var
- StageRec: TsdDataRecord;
- begin
- Result := False;
- StageRec := FProjectData.PhaseData.StageData.StageRecord(ANode.ID);
- if Assigned(StageRec) then
- Result := (StageRec.ValueByName('EndQcTotalPrice').AsFloat <> 0)
- or (StageRec.ValueByName('EndPcTotalPrice').AsFloat <> 0);
- end;
- function TrmXmjBGLDetailData.CheckLeafXmj(ANode: TsdIDTreeNode): Boolean;
- var
- i: Integer;
- begin
- Result := True;
- for i := 0 to ANode.ChildCount - 1 do
- begin
- if ANode.ChildNodes[i].Rec.ValueByName('B_Code').AsString = '' then
- begin
- Result := False;
- Break;
- end;
- end;
- end;
- procedure TrmXmjBGLDetailData.FilterBGLData(ANode: TsdIDTreeNode;
- AClassNode: TXmjNode);
- var
- i: Integer;
- begin
- if not Assigned(ANode) then Exit;
- if ANode.HasChildren then
- for i := 0 to ANode.ChildCount - 1 do
- FilterBGLData(ANode.ChildNodes[i], AClassNode)
- else
- FilterNodeBGLData(ANode, AClassNode);
- end;
- procedure TrmXmjBGLDetailData.FilterDetailNode(ANode: TsdIDTreeNode;
- AClassNode: TXmjNode);
- var
- i: Integer;
- begin
- if not Assigned(ANode) and (ANode.Level < 2) then Exit;
- if ANode.Rec.ValueByName('B_Code').AsString <> '' then Exit;
- if CheckLeafXmj(ANode) and CheckHasBGL(ANode) then
- AddDetailXmjNode(ANode, AClassNode);
- if ANode.HasChildren then
- begin
- for i := 0 to ANode.ChildCount - 1 do
- FilterDetailNode(ANode.ChildNodes[i], AClassNode);
- end;
- end;
- procedure TrmXmjBGLDetailData.FilterNode(ANode: TsdIDTreeNode);
- begin
- if not Assigned(ANode) then Exit;
- if ANode.Level> 1 then Exit;
- if ANode.Level = 0 then
- FilterNode(ANode.FirstChild)
- else if CheckHasBGL(ANode) then
- AddClassXmjNode(ANode);
- FilterNode(ANode.NextSibling);
- end;
- procedure TrmXmjBGLDetailData.FilterNodeBGLData(ANode: TsdIDTreeNode;
- AClassNode: TXmjNode);
- var
- StageRec: TsdDataRecord;
- begin
- StageRec := FProjectData.PhaseData.StageData.StageRecord(ANode.ID);
- if not Assigned(StageRec) then Exit;
- AddBGLsData(StageRec.ValueByName('EndQcBGLCode').AsString, AClassNode);
- AddBGLsData(StageRec.ValueByName('EndPcBGLCode').AsString, AClassNode);
- end;
- function TrmXmjBGLDetailData.GetDgnQuantity(ANum1, ANum2: Double): string;
- begin
- Result := '';
- if ANum1 <> 0 then
- begin
- Result := FloatToStr(ANum1);
- if ANum2 <> 0 then
- Result := Result + '/' + FloatToStr(ANum2);
- end;
- end;
- procedure TrmXmjBGLDetailData.WriteBGLNodeData(ABGLNode: TBGLNode);
- begin
- cdsXmjBGLDetail.Append;
- cdsXmjBGLDetailXmj_BGLName.AsString := ABGLNode.FBGLName;
- cdsXmjBGLDetailBGLCode.AsString := ABGLNode.FBGLCode;
- cdsXmjBGLDetailBGLName.AsString := ABGLNode.FBGLName;
- cdsXmjBGLDetailReason.AsString := ABGLNode.FBGLReason;
- cdsXmjBGLDetailDirection.AsString := ABGLNode.FDirection;
- cdsXmjBGLDetailDrawingCode.AsString := ABGLNode.FDrawingCode;
- cdsXmjBGLDetailApprovalCode.AsString := ABGLNode.FApprovalCode;
- cdsXmjBGLDetailBGLRelaFile.AsString := ABGLNode.FBGLRelaFile;
- cdsXmjBGLDetail.Post;
- end;
- procedure TrmXmjBGLDetailData.WriteData;
- var
- i: Integer;
- begin
- for i := 0 to FClassXmjList.Count - 1 do
- WriteXmjNodeData(TXmjNode(FClassXmjList.Items[i]));
- end;
- procedure TrmXmjBGLDetailData.WriteXmjNodeData(AXmjNode: TXmjNode;
- AIndex: Integer);
- var
- i: Integer;
- begin
- cdsXmjBGLDetail.Append;
- if AIndex = -1 then
- cdsXmjBGLDetailCode.AsString := AXmjNode.FCode
- else
- cdsXmjBGLDetailCode.AsString := IntToStr(AIndex + 1);
- cdsXmjBGLDetailName.AsString := AXmjNode.FName;
- cdsXmjBGLDetailDgnQuantity1.AsFloat := AXmjNode.FDgnQuantity1;
- cdsXmjBGLDetailDgnQuantity2.AsFloat := AXmjNode.FDgnQuantity2;
- cdsXmjBGLDetailDgnQuantity.AsString := GetDgnQuantity(AXmjNode.FDgnQuantity1, AXmjNode.FDgnQuantity2);
- cdsXmjBGLDetailEndDealTotalPrice.AsFloat := AXmjNode.FEndDealTotalPrice;
- cdsXmjBGLDetailEndGatherTotalPrice.AsFloat := AXmjNode.FEndGatherTotalPrice;
- cdsXmjBGLDetailBGTotalPrice.AsFloat := AXmjNode.FEndGatherTotalPrice - AXmjNode.FEndDealTotalPrice;
- cdsXmjBGLDetailTotalPrice.AsFloat := AXmjNode.FTotalPrice;
- cdsXmjBGLDetailEndQcTotalPrice.AsFloat := AXmjNode.FEndQcTotalPrice;
- cdsXmjBGLDetailFinalTotalPrice.AsFloat := AXmjNode.FTotalPrice + AXmjNode.FEndQcTotalPrice;
- cdsXmjBGLDetailXmj_BGLName.AsString := AXmjNode.FName;
- cdsXmjBGLDetail.Post;
- for i := 0 to AXmjNode.BGLCount - 1 do
- WriteBGLNodeData(AXmjNode.BGLNode[i]);
- for i := 0 to AXmjNode.ChildCount - 1 do
- WriteXmjNodeData(AXmjNode.ChildNode[i], i);
- end;
- { TXmjNode }
- constructor TXmjNode.Create;
- begin
- FChildList := TList.Create;
- FBGLList := TList.Create;
- end;
- destructor TXmjNode.Destroy;
- begin
- ClearObjects(FBGLList);
- FBGLList.Free;
- ClearObjects(FChildList);
- FChildList.Free;
- inherited;
- end;
- function TXmjNode.FindBGLNode(const ABGLCode: string): TBGLNode;
- var
- i: Integer;
- begin
- Result := nil;
- for i := 0 to BGLCount - 1 do
- begin
- if BGLNode[i].FBGLCode = ABGLCode then
- begin
- Result := BGLNode[i];
- Break;
- end;
- end;
- end;
- function TXmjNode.GetBGLCount: Integer;
- begin
- Result := FBGLList.Count;
- end;
- function TXmjNode.GetBGLNode(AIndex: Integer): TBGLNode;
- begin
- Result := TBGLNode(FBGLList.Items[AIndex]);
- end;
- function TXmjNode.GetChildCount: Integer;
- begin
- Result := FChildList.Count;
- end;
- function TXmjNode.GetChildNode(AIndex: Integer): TXmjNode;
- begin
- Result := TXmjNode(FChildList.Items[AIndex]);
- end;
- end.
|