123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240 |
- unit rmGclBillsCompareDm;
- // Report Memory Gcl Bills Compare DataModule
- // For [05.�뵙궐싹깊] 連깊01 묏넋좆헌데�뵙궐싹깊(0뵀憩瑯)
- interface
- uses
- SysUtils, Classes, ProjectData, sdDB, DB, DBClient, sdIDTree;
- type
- TCompareGclNode = class
- private
- FB_Code: string;
- FIndexCode: string;
- FName: string;
- FUnits: string;
- FSQuantity: Double;
- FSPrice: Double;
- FSTotalPrice: Double;
- FCQuantity: Double;
- FCPrice: Double;
- FCTotalPrice: Double;
- FMemoStr: string;
- function GetDPrice: Double;
- function GetDQuantity: Double;
- function GetDTotalPrice: Double;
- public
- property B_Code: string read FB_Code write FB_Code;
- property IndexCode: string read FIndexCode write FIndexCode;
- property Name: string read FName write FName;
- property Units: string read FUnits write FUnits;
- // 覩괩
- property SQuantity: Double read FSQuantity write FSQuantity;
- property SPrice: Double read FSPrice write FSPrice;
- property STotalPrice: Double read FSTotalPrice write FSTotalPrice;
- // �뵙
- property CQuantity: Double read FCQuantity write FCQuantity;
- property CPrice: Double read FCPrice write FCPrice;
- property CTotalPrice: Double read FCTotalPrice write FCTotalPrice;
- // �뵙 - 覩괩
- property DQuantity: Double read GetDQuantity;
- property DPrice: Double read GetDPrice;
- property DTotalPrice: Double read GetDTotalPrice;
- property MemoStr: string read FMemoStr;
- end;
- TrmGclBillsCompareData = class(TDataModule)
- cdsBills: TClientDataSet;
- cdsBillsB_Code: TStringField;
- cdsBillsCodeIndex: TStringField;
- cdsBillsName: TWideStringField;
- cdsBillsUnits: TWideStringField;
- cdsBillsSQuantity: TFloatField;
- cdsBillsSPrice: TFloatField;
- cdsBillsSTotalPrice: TFloatField;
- cdsBillsCQuantity: TFloatField;
- cdsBillsCPrice: TFloatField;
- cdsBillsCTotalPrice: TFloatField;
- cdsBillsDQuantity: TFloatField;
- cdsBillsDPrice: TFloatField;
- cdsBillsDTotalPrice: TFloatField;
- cdsBillsMemoStr: TWideStringField;
- private
- FNodeList: TList;
- procedure LoadGclNodeData(AGclNode: TCompareGclNode; ARec: TsdDataRecord; AIsSource: Boolean);
- procedure FilterGclBills(ANode: TsdIDTreeNode; AIsSource: Boolean);
- procedure FilterBills(ANode: TsdIDTreeNode; AIsSource: Boolean);
- procedure WriteBills;
- public
- constructor Create;
- destructor Destroy; override;
- function AssignData(ASProjectData, ACProjectData: TProjectData): TDataSet;
- end;
- implementation
- uses
- Globals, UtilMethods, ZhAPI;
- {$R *.dfm}
- { TCompareGclNode }
- function TCompareGclNode.GetDPrice: Double;
- begin
- {Result := FCPrice;
- if Result = 0 then
- Result := FSPrice;}
- Result := CPrice - SPrice;
- end;
- function TCompareGclNode.GetDQuantity: Double;
- begin
- Result := CQuantity - SQuantity;
- end;
- function TCompareGclNode.GetDTotalPrice: Double;
- begin
- Result := CTotalPrice - STotalPrice;
- end;
- { TGclBillsCompareData }
- function TrmGclBillsCompareData.AssignData(
- ASProjectData, ACProjectData: TProjectData): TDataSet;
- begin
- cdsBills.Active := True;
- cdsBills.EmptyDataSet;
- ClearObjects(FNodeList);
- try
- FilterBills(ASProjectData.BillsCompileData.BillsCompileTree.FirstNode, True);
- FilterBills(ACProjectData.BillsCompileData.BillsCompileTree.FirstNode, False);
- WriteBills;
- finally
- Result := cdsBills;
- end;
- end;
- constructor TrmGclBillsCompareData.Create;
- begin
- inherited Create(nil);
- FNodeList := TList.Create;
- cdsBills.IndexFieldNames := 'CodeIndex';
- end;
- destructor TrmGclBillsCompareData.Destroy;
- begin
- ClearObjects(FNodeList);
- FNodeList.Free;
- inherited;
- end;
- procedure TrmGclBillsCompareData.FilterBills(ANode: TsdIDTreeNode;
- AIsSource: Boolean);
- begin
- if not Assigned(ANode) then Exit;
- if ANode.HasChildren then
- FilterBills(ANode.FirstChild, AIsSource)
- else
- FilterGclBills(ANode, AIsSource);
- FilterBills(ANode.NextSibling, AIsSource);
- end;
- procedure TrmGclBillsCompareData.FilterGclBills(ANode: TsdIDTreeNode;
- AIsSource: Boolean);
- function CreateGclNode(ARec: TsdDataRecord): TCompareGclNode;
- begin
- Result := TCompareGclNode.Create;
- FNodeList.Add(Result);
- Result.FB_Code := ARec.ValueByName('B_Code').AsString;
- Result.FIndexCode := B_CodeToIndexCode(ARec.ValueByName('B_Code').AsString);
- Result.FName := ARec.ValueByName('Name').AsString;
- Result.FUnits := ARec.ValueByName('Units').AsString;
- end;
- function GetGclNode(ARec: TsdDataRecord): TCompareGclNode;
- var
- I: Integer;
- GclNode: TCompareGclNode;
- begin
- Result := nil;
- for I := 0 to FNodeList.Count - 1 do
- begin
- GclNode := TCompareGclNode(FNodeList.Items[I]);
- if SameText(GclNode.FB_Code, ARec.ValueByName('B_Code').AsString) and
- SameText(GclNode.FName, ARec.ValueByName('Name').AsString) and
- SameText(GclNode.FUnits, ARec.ValueByName('Units').AsString) then
- begin
- Result := GclNode;
- Break;
- end;
- end;
- if not Assigned(Result) then
- Result := CreateGclNode(ARec);
- end;
- var
- Rec: TsdDataRecord;
- GclNode: TCompareGclNode;
- begin
- if not Assigned(ANode) then Exit;
- Rec := ANode.Rec;
- if Rec.ValueByName('B_Code').AsString = '' then Exit;
- GclNode := GetGclNode(Rec);
- LoadGclNodeData(GclNode, Rec, AIsSource);
- end;
- procedure TrmGclBillsCompareData.LoadGclNodeData(AGclNode: TCompareGclNode;
- ARec: TsdDataRecord; AIsSource: Boolean);
- begin
- if AIsSource then
- begin
- AGclNode.FSQuantity := AGclNode.FSQuantity + ARec.ValueByName('Quantity').AsFloat;
- AGclNode.FSPrice := ARec.ValueByName('Price').AsFloat;
- AGclNode.FSTotalPrice := AGclNode.FSTotalPrice + ARec.ValueByName('TotalPrice').AsFloat;
- end
- else
- begin
- AGclNode.FCQuantity := AGclNode.FCQuantity + ARec.ValueByName('Quantity').AsFloat;
- AGclNode.FCPrice := ARec.ValueByName('Price').AsFloat;
- AGclNode.FCTotalPrice := AGclNode.FCTotalPrice + ARec.ValueByName('TotalPrice').AsFloat;
- end;
- end;
- procedure TrmGclBillsCompareData.WriteBills;
- var
- I: Integer;
- GclNode: TCompareGclNode;
- begin
- for I := 0 to FNodeList.Count - 1 do
- begin
- GclNode := TCompareGclNode(FNodeList.Items[I]);
- cdsBills.Append;
- cdsBillsB_Code.AsString := GclNode.B_Code;
- cdsBillsCodeIndex.AsString := GclNode.IndexCode;
- cdsBillsName.AsString := GclNode.Name;
- cdsBillsUnits.AsString := GclNode.Units;
- cdsBillsSQuantity.AsFloat := GclNode.SQuantity;
- cdsBillsSPrice.AsFloat := GclNode.SPrice;
- cdsBillsSTotalPrice.AsFloat := GclNode.STotalPrice;
- cdsBillsCQuantity.AsFloat := GclNode.CQuantity;
- cdsBillsCPrice.AsFloat := GclNode.CPrice;
- cdsBillsCTotalPrice.AsFloat := GclNode.CTotalPrice;
- cdsBillsDQuantity.AsFloat := GclNode.DQuantity;
- cdsBillsDPrice.AsFloat := GclNode.DPrice;
- cdsBillsDTotalPrice.AsFloat := GclNode.DTotalPrice;
- cdsBillsMemoStr.AsString := GclNode.MemoStr;
- cdsBills.Post;
- end;
- end;
- end.
|