| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723 |
- unit ScKindsOfTrees;
- interface
- uses
- Contnrs,
- Classes,
- DB,
- ZjIDTree,
- ADODB,
- DBClient,
- ConstVarUnit,
- Windows;
- type
- TDrawingQuantityItem = class
- private
- FID: Integer;
- FBillsID: Integer;
- FSerinalNo: Integer;
- FName: string;
- FUnits: string;
- FDesignQuantity1: Double;
- FDesignQuantity2: Double;
- FMemoContext: string;
- public
- procedure Assign(aSrcItem: TDrawingQuantityItem);
- property ID: Integer read FID write FID;
- property BillsID: Integer read FBillsID write FBillsID;
- property SerinalNo: Integer read FSerinalNo write FSerinalNo;
- property Name: string read FName write FName;
- property Units: string read FUnits write FUnits;
- property DesignQuantity1: Double read FDesignQuantity1 write FDesignQuantity1;
- property DesignQuantity2: Double read FDesignQuantity2 write FDesignQuantity2;
- property MemoContext: string read FMemoContext write FMemoContext;
- end;
- TExprsNode = class
- private
- FMajorID: Integer;
- FMinorID: Integer;
- FRecdID: Integer;
- FExprs: string;
- FExprs1: string;
- public
- end;
- {导入Excel用的树}
- TScExcelItem = class
- private
- FID: Integer;
- FParent: TScExcelItem;
- FNextSibling: TScExcelItem;
- FFirstChild: TScExcelItem;
- FLastChild: TScExcelItem;
- FCode: string;
- FBCode: string;
- FName: string;
- FUnits: string;
- FQuantity: Double;
- FQuantity1: Double;
- FQuantity2: Double;
- FPrice: Double;
- FTotalPrice: Double;
- FMemoString: string;
- {父节点的编号, 以'-'结尾的字符串, 如:'1-1-'}
- FParentCode: string;
- function GetParentID: Integer;
- function GetNextSiblingID: Integer;
- public
- function HasChildren: Boolean;
- procedure AssignFirstChild(ANode: TScExcelItem);
- procedure MoveLastChild(ANode: TScExcelItem);
- property ParentCode: string read FParentCode write FParentCode;
- property ID: Integer read FID write FID;
- property ParentID: Integer read GetParentID;
- property NextSiblingID: Integer read GetNextSiblingID;
- property Parent: TScExcelItem read FParent write FParent;
- property NextSibling: TScExcelItem read FNextSibling write FNextSibling;
- property FirstChild: TScExcelItem read FFirstChild;
- property LastChild: TScExcelItem read FLastChild;
- property Code: string read FCode write FCode;
- property BCode: string read FBCode write FBCode;
- property Name: string read FName write FName;
- property Units: string read FUnits write FUnits;
- property Quantity: Double read FQuantity write FQuantity;
- property Quantity1: Double read FQuantity1 write FQuantity1;
- property Quantity2: Double read FQuantity2 write FQuantity2;
- property Price: Double read FPrice write FPrice;
- property TotalPrice: Double read FTotalPrice write FTotalPrice;
- property MemoString: string read FMemoString write FMemoString;
- end;
- TScExcelItemTree = class
- private
- FRoot: TScExcelItem;
- FList: TObjectList;
- FDrawQList: TObjectList;
- FBillsData: TObject;
- FPartID: Integer;
- {指向项目列的最后一个节点}
- FPNode: TScExcelItem;
- {指向清单列的最后一个节点}
- FBNode: TScExcelItem;
- FMaxNodeID: Integer;
- FMaxDrawQID: Integer;
- // 保存所有子节点列表
- FPartOne: TStringList;
- FPartTwo: TStringList;
- FPartThree: TStringList;
- function GetFirstNode: TScExcelItem;
- function InsertOmissionCode(const ACode: string): TScExcelItem;
- function InsertOmissionBCode(const ABCode: string): TScExcelItem;
- function InsertCode(const ACode: string): TScExcelItem;
- function InsertBCode(const ABCode: string): TScExcelItem;
- function InsertNull(const AIsPreDefine: Boolean = False): TScExcelItem;
- function FindNode(const AID: Integer): TScExcelItem;
- procedure ModifyNodePosition(ANode: TScExcelItem; const AParentID, ANextSiblingID: Integer);
- function Add(const AID, AParentID, ANextSiblingID: Integer): TScExcelItem;
- procedure InternalInsertNode(ANode: TScExcelItem);
- procedure RefreshBills;
- procedure RefreshDrawingQuantity;
- public
- constructor Create(aBillsData: TObject);
- destructor Destroy; override;
- function AddNodeByCode(const ACode: string; const ABCode: string = '';
- const AName: string = ''): TScExcelItem;
- function AddDrawQuantity: TDrawingQuantityItem;
- procedure RefreshDataBase;
- {添加一二三部分高端节点}
- procedure AddFirstNode(const AID: Integer);
- function LastNextSiblingID: Integer;
- procedure ViewBillTreeParts;
- procedure DeleteNode(AObject: TObject);
- property FirstNode: TScExcelItem read GetFirstNode;
- property PNode: TScExcelItem read FPNode write FPNode;
- property BNode: TScExcelItem read FBNode write FBNode;
- property MaxNodeID: Integer read FMaxNodeID write FMaxNodeID;
- property MaxDrawQID: Integer read FMaxDrawQID write FMaxDrawQID;
- property PartOne: TStringList read FPartOne;
- property PartTwo: TStringList read FPartTwo;
- property PartThree: TStringList read FPartThree;
- end;
-
- {汇总用的树}
- TCacheGatherTree = class;
- TCacheGatherNode = class
- private
- FID: Integer;
- FCode: string;
- FBCode: string;
- FName: string;
- FUnits: string;
- FUnitPrice: Double;
- FTotalPrice: Double;
- FMemostring: string;
- FQuantity: Double;
- FDesignPrice: Double;
- FDesignQuantity1: Double;
- FDesignQuantity2: Double;
- FOldCode: string;
- FOldBCode: string;
- FIsPreDefine: Boolean;
- FOwner: TCacheGatherTree;
- FDQList: TList;
- FExprsList: TList;
- FParent: TCacheGatherNode;
- FNextSibling: TCacheGatherNode;
- FPreSibling: TCacheGatherNode;
- FFirstChild: TCacheGatherNode;
- FLastChild: TCacheGatherNode;
- procedure DeleteDQItems;
- function GetParentID: Integer;
- function GetNextSiblingID: Integer;
- public
- constructor Create(aOwner: TCacheGatherTree);
- destructor Destroy; override;
- procedure DeleteChildren;
- procedure RemoveFromParent;
- { Assign }
- procedure AssignDraw(aNode: TCacheGatherNode);
- procedure Assign(aNode: TCacheGatherNode; aIncludeDraw: Boolean = True);
- procedure MoveFirstChild(ANode: TCacheGatherNode);
- procedure MoveLastChild(ANode: TCacheGatherNode);
- procedure MovePreSibling(ANode: TCacheGatherNode);
- function HasChildren: Boolean;
- property Parent: TCacheGatherNode read FParent;
- property NextSibling: TCacheGatherNode read FNextSibling;
- property FirstChild: TCacheGatherNode read FFirstChild;
- property LastChild: TCacheGatherNode read FLastChild;
- property DQList: TList read FDQList write FDQList;
- property ID: Integer read FID write FID;
- property ParentID: Integer read GetParentID;
- property NextSiblingID: Integer read GetNextSiblingID;
- property Code: string read FCode write FCode;
- property BCode: string read FBCode write FBCode;
- property Name: string read FName write FName;
- property Units: string read FUnits write FUnits;
- property Quantity: Double read FQuantity write FQuantity;
- property DesignQuantity1: Double read FDesignQuantity1 write FDesignQuantity1;
- property DesignQuantity2: Double read FDesignQuantity2 write FDesignQuantity2;
- property UnitPrice: Double read FUnitPrice write FUnitPrice;
- property DesignPrice: Double read FDesignPrice write FDesignPrice;
- property TotalPrice: Double read FTotalPrice write FTotalPrice;
- property MemoString: string read FMemostring write FMemostring;
- property OldCode: string read FOldCode write FOldCode;
- property OldBCode: string read FOldBCode write FOldBCode;
- property IsPreDefined: Boolean read FIsPreDefine write FIsPreDefine;
- end;
- TCacheGatherTree = class
- private
- FMinIDList: TList;
- FCacheList: TObjectList;
- FRoot: TCacheGatherNode;
- FProject: TObject;
- FMaxID: Integer;
- FMaxDQID: Integer;
- FBillsCode: string;
- FTokenID: Integer;
- function GetFirstNode: TCacheGatherNode;
- procedure MergeCacheList;
- function SerialSearch(const AID: Integer): TCacheGatherNode;
- function DichotomySearch(const AID: Integer): TCacheGatherNode;
- function FindCacheNode(const AID: Integer): TCacheGatherNode;
- // 按编号排序节点 [Litao 2012.1.12]
- procedure SortCacheTreeNodes(AParent: TCacheGatherNode);
- procedure AddChildren(AParent: TCacheGatherNode; AList: TList);
- procedure MoveChildren(AParent: TCacheGatherNode; AList: TList);
- procedure SortChildren(AParent: TCacheGatherNode);
- procedure DeleteBySerialSearch(const ANode: TCacheGatherNode);
- procedure DeleteByDichotomySearch(const ANode: TCacheGatherNode);
- procedure DeleteNode(ANode: TCacheGatherNode);
- {合并两个节点}
- procedure CombineDrawQ(ASrcQList, ADestQList: TList; aDestID: Integer);
- procedure CombineNodeQuantity(ASrc, ADest: TCacheGatherNode);
- {Asrc移到ADest前面}
- procedure MovePreNode(ASrc, ADest: TCacheGatherNode);
- function IncludeToken(const aCode: string): Boolean;
- function ConvertCode(const aCode, aGCode: string): string;
- function SplitAndConvertCode(const aCode, aGCode: string; ASpliter: Char = '-'): string;
- procedure AddBillsExprs(ABillsID: Integer; ACacheNode: TCacheGatherNode);
- {汇总部分}
- function ModifyBillsCode(const ACode: string): string; overload;
- procedure ModifyBillsCode(GNode: TCacheGatherNode; const aParentCode: string); overload;
- procedure PlusItems(xNode: TZjIDTreeNode; GNode: TCacheGatherNode; aLevel: Integer; IsCode: Boolean);
- procedure InternalDetail(AGNode: TCacheGatherNode; ANode: TZjIDTreeNode; const AParentCode: string);
- procedure AddGatherNode(AGatherNode: TCacheGatherNode;
- AZjNode: TZjIDTreeNode; aLevel: Integer; const aBCode, aName: string);
- procedure AdjustStructor(AParNode, AChdNode: TCacheGatherNode);
- procedure AddBillsNode(ANode: TZjIDTreeNode; AGatherParent: TCacheGatherNode);
- procedure GatherCurNode(ANode: TZjIDTreeNode; AGatherParent: TCacheGatherNode; aLevel: Integer);
- public
- constructor Create;
- destructor Destroy; override;
- function AddCacheNode(const AID, AParentID, ANextSiblingID: Integer): TCacheGatherNode;
- function TraverseDBIntoSelf(AProject: TObject): Boolean;
- procedure TraverseOwnerIntoDB(AProject: TObject);
- property FirstNode: TCacheGatherNode read GetFirstNode;
- end;
- { Merge Gather Tree }
- TMergeGatherTree = class(TCacheGatherTree)
- private
- FIsOpen1: Boolean;
- FIsOpen2: Boolean;
- FBillsTree1: TZjIDTree;
- FBillsTree2: TZjIDTree;
- FCdsDraw1: TClientDataSet;
- FCdsDraw2: TClientDataSet;
- FCdsExprs: TClientDataSet;
- FMergeByCode: Boolean;
- procedure InitMaxID;
- // 为桩号重新编号
- procedure ReCodeNode(ANode: TCacheGatherNode);
- { Add Bills }
- procedure AddDrawItems(aCdsDraw: TClientDataSet; aBillsID: Integer; aCGNode: TCacheGatherNode);
- procedure AddExprs(AORecID: Integer; AGNode: TCacheGatherNode);
- procedure AssignTo(aNode: TZjIDTreeNode; aGatherNode: TCacheGatherNode);
- procedure AssignByOpened(aBillsTree: TObject; aNode: TZjIDTreeNode; aGatherNode: TCacheGatherNode);
- procedure AddNode(aNode: TZjIDTreeNode; aGatherNode: TCacheGatherNode; aBillsTree: TZjIDTree;
- aCdsDraw: TClientDataSet; aIsOpened: Boolean);
- function AddSingleNode(aNode: TZjIDTreeNode; aGatherNode: TCacheGatherNode; aBillsTree: TZjIDTree;
- aCdsDraw: TClientDataSet; aIsOpened: Boolean): TCacheGatherNode;
- { Update Bills }
- procedure UpdateDrawItems(aBillsID: Integer; aCGNode: TCacheGatherNode);
- procedure UpdateQuantity(aNode: TZjIDTreeNode; aGatherNode: TCacheGatherNode);
- procedure UpdateQuantityByOpened(aNode: TZjIDTreeNode; aGatherNode: TCacheGatherNode);
- procedure UpdateNode(aNode: TZjIDTreeNode; aGatherNode: TCacheGatherNode);
- { Update Gather }
- function AddSingleGatherNode(aSrcNode, aDstNode: TCacheGatherNode): TCacheGatherNode;
- procedure AddGatherNode(aSrcNode, aDstNode: TCacheGatherNode);
- procedure UpdateGatherDrawItems(aSrcNode, aDstNode: TCacheGatherNode);
- procedure UpdateGatherQuantity(aSrcNode, aDstNode: TCacheGatherNode);
- procedure UpdateGatherNode(aSrcNode, aDstNode: TCacheGatherNode);
- { write }
- procedure WriteBills(aNode: TCacheGatherNode; aTable: TDataSet);
- procedure WriteDraw(aNode: TCacheGatherNode; aTable: TDataSet);
- procedure WriteExprs(aNode: TCacheGatherNode; ADataset: TDataSet);
- public
- procedure GatherBillsTree(aBillsTree: TZjIDTree);
- procedure UpdateBillsTree(aBillsTree: TZjIDTree);
- procedure GatherTree(aGatherTree: TMergeGatherTree);
- procedure WriteTo(aBillsTable, aDrawTable, aExprsTable: TDataSet);
- property IsOpen1: Boolean read FIsOpen1 write FIsOpen1;
- property IsOpen2: Boolean read FIsOpen2 write FIsOpen2;
- property CdsDraw1: TClientDataSet read FCdsDraw1 write FCdsDraw1;
- property CdsDraw2: TClientDataSet read FCdsDraw2 write FCdsDraw2;
- property BillsTree1: TZjIDTree read FBillsTree1 write FBillsTree1;
- property BillsTree2: TZjIDTree read FBillsTree2 write FBillsTree2;
- property CdsExprs: TClientDataSet read FCdsExprs write FCdsExprs;
- property MergeByCode: Boolean read FMergeByCode write FMergeByCode;
- end;
- TSplitGatherTree = Class(TMergeGatherTree)
- private
- FOwnerName: string;
- procedure SearchParents(aNode: TZjIDTreeNode; aParList: TList);
- function FindChildNode(aNode: TZjIDTreeNode; aCgnNode: TCacheGatherNode): TCacheGatherNode;
- function AddSingleNode(aNode: TZjIDTreeNode; aCgnNode: TCacheGatherNode): TCacheGatherNode; overload;
- function AddParent(aNode: TZjIDTreeNode): TCacheGatherNode;
- procedure GenerateGatherTree(aNode: TZjIDTreeNode);
- public
- procedure SplitBillsTree(aBillsTree: TZjIDTree; aCdsDraw: TClientDataSet; const aOwnerName: string);
- end;
- implementation
- uses
- SysUtils,
- DataBase,
- ScProjectManager,
- ConstMethodUnit,
- Math,
- ScBillsTree,
- ScExprsDM,
- ScConfig,
- ScProgressFrm;
- const
- TokenArray: array [0..10] of Char = ('N', 'M', 'Q', 'L', 'P', 'R', 'S', 'T', 'X', 'Y', 'Z');
- { TScExcelItemTree }
- function TScExcelItemTree.Add(const AID, AParentID,
- ANextSiblingID: Integer): TScExcelItem;
- var
- paNode: TScExcelItem;
- begin
- Result := TScExcelItem.Create;
- Result.ID := AID;
- {修改节点关系}
- ModifyNodePosition(Result, AParentID, ANextSiblingID);
- FList.Add(Result);
- end;
- function TScExcelItemTree.AddDrawQuantity: TDrawingQuantityItem;
- begin
- Result := TDrawingQuantityItem.Create;
- Result.ID := FMaxDrawQID;
- if Assigned(FBNode) then
- Result.BillsID := FBNode.ID
- else Result.BillsID := FPNode.ID;
- FDrawQList.Add(Result);
- Inc(FMaxDrawQID);
- end;
- procedure TScExcelItemTree.AddFirstNode(const AID: Integer);
- function AddPartNode(const ID: Integer): TScExcelItem;
- begin
- Result := Add(ID, -1, -1);
- Result.ParentCode := '';
- Result.Code := IntToStr(ID);
- end;
- begin
- PNode := AddPartNode(1);
- AddPartNode(2);
- AddPartNode(3);
- FPartID := 2;
- end;
- function TScExcelItemTree.AddNodeByCode(const ACode,
- ABCode, AName: string): TScExcelItem;
- begin
- if not SameText(ACode, '') then {Code}
- begin
- if Pos('…', ACode) = 0 then
- begin
- if FPNode = nil then
- begin
- Result := nil;
- Exit;
- end;
- Result := InsertCode(ACode);
- if Assigned(FBNode) then FBNode := nil;
- end
- else Result := nil;
- end
- else if not SameText(ABCode, '') then {BCode}
- begin
- if Pos('…', ABCode) = 0 then
- Result := InsertBCode(ABCode)
- else Result := nil;
- end
- else {...}
- begin
- Result := InsertNull;
- if Assigned(FBNode) then FBNode := nil;
- end;
-
- Inc(FMaxNodeID);
- end;
- constructor TScExcelItemTree.Create(aBillsData: TObject);
- begin
- FBillsData := aBillsData;
- FList := TObjectList.Create;
- FRoot := TScExcelItem.Create;
- FRoot.ID := -1;
- FPartOne := TStringList.Create;
- FPartTwo := TStringList.Create;
- FPartThree := TStringList.Create;
- FPartID := 1;
- FDrawQList := TObjectList.Create;
- end;
- procedure TScExcelItemTree.DeleteNode(AObject: TObject);
- begin
- FList.Remove(AObject);
- AObject.Free;
- end;
- destructor TScExcelItemTree.Destroy;
- begin
- FreeAndNil(FDrawQList);
- FreeAndNil(FList);
- FreeAndNil(FRoot);
- FreeAndNil(FPartOne);
- FreeAndNil(FPartTwo);
- FreeAndNil(FPartThree);
- inherited;
- end;
- function TScExcelItemTree.FindNode(const AID: Integer): TScExcelItem;
- var
- ilow, ihigh, imid: Integer;
- eNode: TScExcelItem;
- begin
- Result := nil;
- ilow := 0;
- ihigh := FList.Count - 1;
- while ilow <= ihigh do
- begin
- imid := (ilow + ihigh) div 2;
- eNode := TScExcelItem(FList[imid]);
- if eNode.ID = AID then
- begin
- Result := eNode;
- Break;
- end;
- if eNode.ID < AID then ilow := imid + 1
- else ihigh := imid - 1;
- end;
- end;
- function TScExcelItemTree.GetFirstNode: TScExcelItem;
- begin
- Result := FRoot.FirstChild;
- end;
- function TScExcelItemTree.InsertBCode(const ABCode: string): TScExcelItem;
- begin
- if not Assigned(FBNode) or (FBNode = FPNode) then
- begin
- Result := Add(FMaxNodeID, FPNode.ID, -1);
- Result.ParentCode := Format('%s-', [ABCode]);
- Result.BCode := ABCode;
- FBNode := Result;
- end
- else
- begin
- if Pos(FBNode.ParentCode, ABCode) = 1 then
- begin
- if Pos(Format('%s-', [FBNode.BCode]), ABCode) <> 1 then
- begin
- Result := Add(FMaxNodeID, FBNode.ParentID, -1);
- Result.ParentCode := FBNode.ParentCode;
- Result.BCode := ABCode;
- FBNode := Result;
- end
- else
- begin
- Result := Add(FMaxNodeID, FBNode.ID, -1);
- Result.ParentCode := Format('%s-', [FBNode.BCode]);
- Result.BCode := ABCode;
- FBNode := Result;
- end;
- end
- else
- begin
- FBNode := FBNode.Parent;
- Result := InsertBCode(ABCode);
- end;
- end;
- end;
- function TScExcelItemTree.InsertCode(const ACode: string): TScExcelItem;
- var
- iErr: Integer;
- sCode: string;
- begin
- if Pos(FPNode.ParentCode, ACode) = 1 then
- begin
- if (Pos(FPNode.Code + '-', ACode) <> 1) or (FPNode.Code = ACode) then
- begin
- Result := Add(FMaxNodeID, FPNode.ParentID, -1);
- Result.ParentCode := FPNode.ParentCode;
- Result.Code := ACode;
- FPNode := Result;
- end
- else
- begin
- Result := Add(FMaxNodeID, FPNode.ID, -1);
- Result.ParentCode := Format('%s-', [FPNode.Code]);
- Result.Code := ACode;
- FPNode := Result;
- end;
- end
- else
- begin
- if SameText(FPNode.ParentCode, '') then
- begin
- if Pos('-', ACode) <> 0 then
- begin
- Result := Add(FMaxNodeID, FPNode.ID, -1);
- sCode := Format('%s-', [FPNode.Code]);
- {1部分下面有3-1时情况}
- if Pos(sCode, ACode) = 0 then
- sCode := Format('%s-', [ACode]);
- Result.ParentCode := sCode;
- Result.Code := ACode;
- FPNode := Result;
- end
- else
- begin
- Val(ACode, FPartID, iErr);
- Result := FindNode(FPartID);
- FPNode := Result;
- Inc(FPartID);
- end;
- end
- else
- begin
- FPNode := FPNode.Parent;
- Result := InsertCode(ACode);
- end;
- end;
- end;
- function TScExcelItemTree.InsertNull(
- const AIsPreDefine: Boolean): TScExcelItem;
- begin
- case AIsPreDefine of
- False:
- if Assigned(FBNode) then
- Result := Add(FMaxNodeID, FBNode.ParentID, -1)
- else
- Result := Add(FMaxNodeID, FPNode.ID, -1);
- True: Result := Add(FMaxNodeID, -1, -1);
- end;
- end;
- function TScExcelItemTree.InsertOmissionBCode(
- const ABCode: string): TScExcelItem;
- begin
- if Assigned(FBNode) then
- Result := Add(FMaxNodeID, FBNode.ParentID, -1)
- else Result := Add(FMaxNodeID, FPNode.ID, -1);
- Result.ParentCode := '…';
- Result.Code := ABCode;
- FBNode := Result;
- end;
- function TScExcelItemTree.InsertOmissionCode(
- const ACode: string): TScExcelItem;
- begin
- Result := Add(FMaxNodeID, FPNode.ParentID, -1);
- Result.ParentCode := '…';
- Result.Code := ACode;
- FPNode := Result;
- end;
- procedure TScExcelItemTree.InternalInsertNode(ANode: TScExcelItem);
- begin
- TDMDataBase(FBillsData).AddBillsItem(ANode);
- if ANode.HasChildren then
- InternalInsertNode(ANode.FirstChild);
- if Assigned(ANode.NextSibling) then
- InternalInsertNode(ANode.NextSibling);
- end;
- function TScExcelItemTree.LastNextSiblingID: Integer;
- var
- xlsItem: TScExcelItem;
- begin
- xlsItem := FirstNode;
- Result := -1;
- while Assigned(xlsItem) do
- begin
- Result := xlsItem.FID;
- xlsItem := xlsItem.NextSibling;
- end;
- end;
- procedure TScExcelItemTree.ModifyNodePosition(ANode: TScExcelItem;
- const AParentID, ANextSiblingID: Integer);
- var
- atNode, etNode: TScExcelItem;
- begin
- {没考滤NextSibling为非-1情况}
- if AParentID = -1 then
- begin
- if Assigned(FRoot.FFirstChild) then
- FRoot.MoveLastChild(ANode)
- else
- FRoot.AssignFirstChild(ANode);
- end
- else
- begin
- atNode := FindNode(AParentID);
- ANode.Parent := atNode;
- if Assigned(atNode.FirstChild) then
- atNode.MoveLastChild(ANode)
- else atNode.AssignFirstChild(ANode);
- end;
- end;
- procedure TScExcelItemTree.RefreshBills;
- var
- xlsNode, temNode: TScExcelItem;
- begin
- {取第一个节点,即建安费节点}
- xlsNode := FirstNode;
- {如果第一个节点不为空,并且有子节点,则读取并写入数据}
- if Assigned(xlsNode) then
- begin
- TDMDataBase(FBillsData).EnabledUITreeEvt(False);
- TDMDataBase(FBillsData).DisconnectBillsTree;
- try
- if xlsNode.HasChildren then
- begin
- TDMDataBase(FBillsData).DeletePartSubItem(PartOne);
- InternalInsertNode(xlsNode.FirstChild);
- end;
- temNode := xlsNode;
- xlsNode := xlsNode.NextSibling;
- // 添加兄弟节点情况
- while Assigned(xlsNode) do
- begin
- if xlsNode.HasChildren then
- begin
- if xlsNode.ID = 2 then
- begin
- TDMDataBase(FBillsData).DeletePartSubItem(PartTwo);
- end
- else if xlsNode.ID = 3 then
- begin
- TDMDataBase(FBillsData).DeletePartSubItem(PartThree);
- end;
- InternalInsertNode(TScExcelItem(xlsNode).FirstChild);
- end;
- temNode := xlsNode;
- xlsNode := xlsNode.NextSibling;
- end;
- finally
- TDMDataBase(FBillsData).ConnectionBillsTree;
- TDMDataBase(FBillsData).EnabledUITreeEvt(True);
- end;
- end;
- end;
- procedure TScExcelItemTree.RefreshDataBase;
- begin
- RefreshBills;
- RefreshDrawingQuantity;
- end;
- procedure TScExcelItemTree.RefreshDrawingQuantity;
- var
- I: Integer;
- DQItem: TDrawingQuantityItem;
- begin
- with TDMDataBase(FBillsData) do
- begin
- for I := 0 to FDrawQList.Count - 1 do
- begin
- DQItem := TDrawingQuantityItem(FDrawQList[I]);
- AddDrawQItem(DQItem);
- end;
- end;
- end;
- procedure TScExcelItemTree.ViewBillTreeParts;
- var
- I: Integer;
- strIDList: string;
-
- procedure AddToList(ANode: TZjIDTreeNode; AStrList: TStringList);
- begin
- if not SameText(strIDList, '') then
- begin
- strIDList := Format('%s or ID=%d', [strIDList, ANode.ID]);
- Inc(I);
- if I = 500 then
- begin
- AStrList.Add(strIDList);
- strIDList := '';
- I := 1;
- end;
- end
- else
- begin
- strIDList := Format('ID=%d', [ANode.ID]);
- Inc(I);
- end;
- if Assigned(ANode.FirstChild) then AddToList(ANode.FirstChild, AStrList);
- if Assigned(ANode.NextSibling) then AddToList(ANode.NextSibling, AStrList);
- end;
- procedure AddIDToList(ANode: TZjIDTreeNode; AID: Integer);
- begin
- case AID of
- 1: if Assigned(ANode.FirstChild) then AddToList(ANode.FirstChild, FPartOne);
- 2: if Assigned(ANode.FirstChild) then AddToList(ANode.FirstChild, FPartTwo);
- 3: if Assigned(ANode.FirstChild) then AddToList(ANode.FirstChild, FPartThree);
- end;
- end;
- var
- zNode: TZjIDTreeNode;
- begin
- with TDMDataBase(FBillsData) do
- begin
- zNode := BillsTree.FirstNode;
- if Assigned(zNode) then
- begin
- // 1
- I := 1;
- strIDList := '';
- AddIDToList(zNode, 1);
- if not SameText(strIDList, '') then FPartOne.Add(strIDList);
- // 2
- if Assigned(zNode.NextSibling) then
- begin
- I := 1;
- strIDList := '';
- AddIDToList(zNode.NextSibling, 2);
- if not SameText(strIDList, '') then FPartTwo.Add(strIDList);
- zNode := zNode.NextSibling;
- end;
- // 3
- if Assigned(zNode.NextSibling) then
- begin
- I := 1;
- strIDList := '';
- AddIDToList(zNode.NextSibling, 3);
- if not SameText(strIDList, '') then FPartThree.Add(strIDList);
- end;
- end;
- end;
- end;
- { TScExcelItem }
- procedure TScExcelItem.AssignFirstChild(ANode: TScExcelItem);
- begin
- FFirstChild := ANode;
- FLastChild := ANode;
- end;
- function TScExcelItem.GetNextSiblingID: Integer;
- begin
- if Assigned(FNextSibling) then Result := FNextSibling.ID
- else Result := -1;
- end;
- function TScExcelItem.GetParentID: Integer;
- begin
- if Assigned(FParent) then Result := FParent.ID
- else Result := -1;
- end;
- function TScExcelItem.HasChildren: Boolean;
- begin
- if Assigned(FirstChild) then Result := True
- else Result := False;
- end;
- procedure TScExcelItem.MoveLastChild(ANode: TScExcelItem);
- begin
- FLastChild.NextSibling := ANode;
- FLastChild := ANode;
- end;
- { TCacheGatherNode }
- procedure TCacheGatherNode.Assign(aNode: TCacheGatherNode; aIncludeDraw: Boolean);
- begin
- FCode := aNode.FCode;
- FBCode := aNode.FBCode;
- FName := aNode.FName;
- FUnits := aNode.FUnits;
- FUnitPrice := aNode.FUnitPrice;
- FTotalPrice := aNode.FTotalPrice;
- FMemostring := aNode.FMemostring;
- FQuantity := aNode.FQuantity;
- FDesignPrice := aNode.FDesignPrice;
- FDesignQuantity1 := aNode.FDesignQuantity1;
- FDesignQuantity2 := aNode.FDesignQuantity2;
- if aIncludeDraw then AssignDraw(aNode);
- end;
- procedure TCacheGatherNode.AssignDraw(aNode: TCacheGatherNode);
- var
- I: Integer;
- dqiItem: TDrawingQuantityItem;
- dqiNewItem: TDrawingQuantityItem;
- begin
- for I := 0 to aNode.DQList.Count - 1 do
- begin
- dqiItem := TDrawingQuantityItem(aNode.DQList.List^[I]);
- dqiNewItem := TDrawingQuantityItem.Create;
- dqiNewItem.ID := FOwner.FMaxDQID;
- dqiNewItem.FBillsID := FID;
- dqiNewItem.Assign(dqiItem);
- FDQList.Add(dqiNewItem);
- Inc(FOwner.FMaxDQID);
- end;
- end;
- constructor TCacheGatherNode.Create(aOwner: TCacheGatherTree);
- begin
- FOwner := aOwner;
- FDQList := TList.Create;
- FExprsList := TList.Create;
- end;
- procedure TCacheGatherNode.DeleteChildren;
- var
- vNode, xNode: TCacheGatherNode;
- begin
- vNode := FirstChild;
- while Assigned(vNode) do
- begin
- xNode := vNode.NextSibling;
- vNode.DeleteChildren;
- vNode.DeleteDQItems;
- vNode.Free;
- vNode := xNode;
- end;
- end;
- procedure TCacheGatherNode.DeleteDQItems;
- var
- I: Integer;
- DQItem: TDrawingQuantityItem;
- begin
- for I := 0 to FDQList.Count - 1 do
- begin
- DQItem := TDrawingQuantityItem(FDQList.List^[I]);
- DQItem.Free;
- end;
- end;
- destructor TCacheGatherNode.Destroy;
- begin
- ClearObjectList(FDQList);
- FDQList.Free;
- ClearObjectList(FExprsList);
- FExprsList.Free;
- inherited;
- end;
- function TCacheGatherNode.GetNextSiblingID: Integer;
- begin
- if Assigned(FNextSibling) then
- Result := FNextSibling.ID
- else Result := -1;
- end;
- function TCacheGatherNode.GetParentID: Integer;
- begin
- if Assigned(FParent) then
- Result := FParent.ID
- else Result := -1;
- end;
- function TCacheGatherNode.HasChildren: Boolean;
- begin
- Result := Assigned(FFirstChild);
- end;
- procedure TCacheGatherNode.MoveFirstChild(ANode: TCacheGatherNode);
- begin
- FFirstChild := ANode;
- ANode.FParent := Self;
- FFirstChild.FParent := Self;
- if not Assigned(FLastChild) then
- FLastChild := FFirstChild;
- end;
- procedure TCacheGatherNode.MoveLastChild(ANode: TCacheGatherNode);
- begin
- FLastChild.FNextSibling := ANode;
- ANode.FParent := Self;
- ANode.FPreSibling := FLastChild;
- FLastChild := ANode;
- end;
- procedure TCacheGatherNode.MovePreSibling(ANode: TCacheGatherNode);
- begin
- if Assigned(FPreSibling) then
- begin
- FPreSibling.FNextSibling := ANode;
- ANode.FPreSibling := FPreSibling;
- end
- else if Assigned(FParent) then
- FParent.MoveFirstChild(ANode);
- FPreSibling := ANode;
- ANode.FParent := Self.FParent;
- end;
- procedure TCacheGatherNode.RemoveFromParent;
- begin
- if FParent <> nil then
- begin
- if FParent.FFirstChild = Self then
- FParent.FFirstChild := FNextSibling;
- if FParent.FLastChild = Self then
- FParent.FLastChild := FPreSibling;
- end;
- if Assigned(FPreSibling) then
- FPreSibling.FNextSibling := FNextSibling;
- if Assigned(FNextSibling) then
- FNextSibling.FPreSibling := FPreSibling;
- FPreSibling := nil;
- FNextSibling := nil;
- FParent := nil;
- end;
- { TCacheGatherTree }
- procedure TCacheGatherTree.AddBillsNode(ANode: TZjIDTreeNode; AGatherParent: TCacheGatherNode);
- var
- iID: Integer;
- blSelected: Boolean;
- gNode: TCacheGatherNode;
- begin
- blSelected := False;
- if TScBillsItem(ANode).Selected then
- begin
- if Assigned(AGatherParent) then
- begin
- FTokenID := 0;
- GatherCurNode(ANode, AGatherParent, 0);
- blSelected := True;
- end
- else Abort;
- end
- else
- begin
- iID := ANode.ID;
- if iID >= 100 then iID := FMaxID;
- if ANode.ParentID = -1 then
- gNode := AddCacheNode(iID, -1, -1)
- else
- begin
- if not Assigned(AGatherParent) then
- gNode := AddCacheNode(iID, -1, -1)
- else
- gNode := AddCacheNode(iID, AGatherParent.ID, -1);
- end;
- TProject(FProject).BillsData.ExtractBillsRecord(ANode.ID, gNode);
- if ANode.ID < 100 then
- AddBillsExprs(ANode.ID, gNode);
- if not ANode.HasChildren then
- TProject(FProject).BillsData.GetDQListByBillsID(ANode.ID, gNode, FMaxDQID);
- Inc(FMaxID);
- end;
- if Assigned(ANode.FirstChild) and not blSelected then AddBillsNode(ANode.FirstChild, gNode);
- if Assigned(ANode.NextSibling) then AddBillsNode(ANode.NextSibling, AGatherParent);
- end;
- function TCacheGatherTree.AddCacheNode(const AID, AParentID,
- ANextSiblingID: Integer): TCacheGatherNode;
- var
- vNode: TCacheGatherNode;
- begin
- Result := TCacheGatherNode.Create(Self);
- Result.ID := AID;
- if AParentID <> -1 then
- begin
- vNode := FindCacheNode(AParentID);
- Result.FParent := vNode;
- if (ANextSiblingID = -1) and vNode.HasChildren then vNode.MoveLastChild(Result)
- else if not vNode.HasChildren or (vNode.FirstChild.ID = ANextSiblingID) then
- vNode.MoveFirstChild(Result);
- end
- else
- begin
- Result.FParent := nil;
- if (ANextSiblingID = -1) and FRoot.HasChildren then FRoot.MoveLastChild(Result)
- else if not FRoot.HasChildren or (FRoot.FirstChild.ID = ANextSiblingID) then
- FRoot.MoveFirstChild(Result);
- end;
-
- if ANextSiblingID = -1 then
- Result.FNextSibling := nil
- else
- begin
- vNode := FindCacheNode(ANextSiblingID);
- Result.FNextSibling := vNode;
- vNode.MovePreSibling(Result);
- end;
- if AID < 100 then FMinIDList.Add(Result)
- else FCacheList.Add(Result);
- end;
- procedure TCacheGatherTree.CombineNodeQuantity(ASrc,
- ADest: TCacheGatherNode);
- begin
- ADest.Quantity := ADest.Quantity + ASrc.Quantity;
- ADest.DesignQuantity1 := ADest.DesignQuantity1 + ASrc.DesignQuantity1;
- ADest.DesignQuantity2 := ADest.DesignQuantity2 + ASrc.DesignQuantity2;
- ADest.TotalPrice := ADest.TotalPrice + ASrc.TotalPrice;
- // 2012.3.5 16:20 何晓勇修改
- ADest.Name := ASrc.Name;
- if Assigned(ASrc.DQList) and Assigned(ADest.DQList) then
- CombineDrawQ(ASrc.DQList, ADest.DQList, ADest.ID);
- end;
- constructor TCacheGatherTree.Create;
- begin
- FCacheList := TObjectList.Create;
- FMinIDList := TList.Create;
- FRoot := TCacheGatherNode.Create(Self);
- FRoot.ID := -1;
- FMaxID := 400;
- FMaxDQID := 1;
- end;
- procedure TCacheGatherTree.DeleteNode(ANode: TCacheGatherNode);
- var
- vNext, vPre: TCacheGatherNode;
- begin
- { ANode.RemoveFromParent;
- if Assigned(ANode.FPreSibling) then
- ANode.FPreSibling.FNextSibling := ANode.NextSibling;
- if Assigned(ANode.FNextSibling) then
- ANode.FNextSibling.FPreSibling := ANode.FPreSibling; }
- ANode.DeleteChildren;
- if ANode.ID < 100 then
- begin
- DeleteBySerialSearch(ANode);
- ANode.Free;
- end
- else DeleteByDichotomySearch(ANode);
- end;
- destructor TCacheGatherTree.Destroy;
- begin
- FCacheList.Free;
- FMinIDList.Free;
- FRoot.Free;
- inherited;
- end;
- function TCacheGatherTree.DichotomySearch(
- const AID: Integer): TCacheGatherNode;
- var
- ilow, ihigh, imid: Integer;
- eNode: TCacheGatherNode;
- begin
- Result := nil;
- ilow := 0;
- ihigh := FCacheList.Count - 1;
- while ilow <= ihigh do
- begin
- imid := (ilow + ihigh) div 2;
- eNode := TCacheGatherNode(FCacheList[imid]);
- if eNode.ID = AID then
- begin
- Result := eNode;
- Break;
- end;
- if eNode.ID < AID then ilow := imid + 1
- else ihigh := imid - 1;
- end;
- end;
- procedure TCacheGatherTree.DeleteByDichotomySearch(const ANode: TCacheGatherNode);
- var
- ilow, ihigh, imid: Integer;
- eNode: TCacheGatherNode;
- begin
- ilow := 0;
- ihigh := FCacheList.Count - 1;
- while ilow <= ihigh do
- begin
- imid := (ilow + ihigh) div 2;
- eNode := TCacheGatherNode(FCacheList[imid]);
- if eNode.ID = ANode.ID then
- begin
- FCacheList.Delete(imid);
- Break;
- end;
- if eNode.ID < ANode.ID then ilow := imid + 1
- else ihigh := imid - 1;
- end;
- end;
- function TCacheGatherTree.FindCacheNode(
- const AID: Integer): TCacheGatherNode;
- begin
- if AID < 100 then Result := SerialSearch(AID)
- else Result := DichotomySearch(AID);
- end;
- procedure TCacheGatherTree.GatherCurNode(ANode: TZjIDTreeNode;
- AGatherParent: TCacheGatherNode; aLevel: Integer);
- var
- I, cValue: Integer;
- sCode, sBCode, sName, sParentCode: string;
- blHasOldCode, blIsCode, blFlag: Boolean;
- cNode, zNode: TZjIDTreeNode;
- gNode, gNextNode, gParNode: TCacheGatherNode;
- begin
- for I := 0 to ANode.ChildCount - 1 do
- begin
- blHasOldCode := False;
- blFlag := False;
- cNode := ANode.ChildNodes[I];
- if Assigned(AGatherParent) then
- begin
- sBCode := AGatherParent.BCode;
- if (aLevel = 0) and Assigned(ANode.Parent) and
- TScBillsItem(ANode.Parent).Selected then
- begin
- sParentCode := FBillsCode + '-' + TokenArray[FTokenID];
- end
- else
- begin
- sParentCode := AGatherParent.Code;
- if (aLevel = 0) and (AGatherParent.Code <> '') then
- begin
- if IncludeToken(AGatherParent.Code) then
- sParentCode := AGatherParent.Code + '-' + TokenArray[FTokenID]
- else
- TProject(FProject).BillsData.ExtractBillsCode(ANode.ID, sParentCode, sBCode, sName);
- sParentCode := ModifyBillsCode(sParentCode);
- end;
- end;
- end
- else
- TProject(FProject).BillsData.ExtractBillsCode(ANode.ID, sParentCode, sBCode, sName);
- if TScBillsItem(cNode).Selected then
- begin
- Inc(FTokenID);
- FBillsCode := sParentCode;
- GatherCurNode(cNode, AGatherParent, 0);
- Dec(FTokenID);
- Continue;
- end;
- TProject(FProject).BillsData.ExtractBillsCode(cNode.ID, sCode, sBCode, sName);
- gNode := AGatherParent.FirstChild;
- while Assigned(gNode) do
- begin
- // if (gNode.Code <> '') or (gNode.BCode <> '') then
- // begin
- if (gNode.Code <> '') and (sCode <> '') then
- begin
- // 1-6-1-2-1 : 1-6-1-N-1
- //sCode := ConvertCode(sCode, gNode.Code);
- sCode := SplitAndConvertCode(sCode, gNode.Code);
- if ScConfigInfo.MatchCodeOnly then
- cValue := CompareCodes(sCode, '', '', gNode.Code, '', '')
- else
- cValue := CompareCodes(sCode, '', sName, gNode.Code, '', gNode.Name);
- blIsCode := True;
- end
- else if (gNode.BCode <> '') and (sBCode <> '') then
- begin
- blIsCode := False;
- if ScConfigInfo.MatchCodeOnly then
- cValue := CompareCodes('', sBCode, '', '', gNode.BCode, '')
- else
- cValue := CompareCodes('', sBCode, sName, '', gNode.BCode, gNode.Name);
- if cValue <> 0 then
- begin
- if Pos(gNode.BCode + '-', sBCode) = 1 then
- begin
- // 101-1与101-1-1 cNode作为gnode的子项添加
- //GatherCurNode(cNode, gNode, aLevel + 1);
- AddGatherNode(gNode, cNode, aLevel + 1, sBCode, sName);
- blHasOldCode := True;
- Break;
- end;
- end;
- end
- { TODO : gnode.code = scode = gnode.bcode = sbcode = '' }
- else if (gNode.Code = sCode) and (gNode.BCode = sBCode) then
- begin
- { TODO : 只有名称的默认当清单加设计数量 }
- blIsCode := False;
- cValue := CompareCodes('', '', sName, '', '', gNode.Name);
- end
- else cValue := 1;
- if cValue = 0 then
- begin
- PlusItems(cNode, gNode, aLevel + 1, blIsCode);
- blHasOldCode := True;
- Break;
- end
- else if cValue < 0 then
- begin
- if ((sBCode <> '') and (Pos(sBCode + '-', gNode.BCode) = 1)) or
- ((sCode <> '') and (Pos(sCode + '-', gNode.Code) = 1)) then
- begin
- gParNode := gNode;
- blFlag := True;
- Break;
- end;
- end;
- // end;
- gNode := gNode.NextSibling;
- end;
- if not blHasOldCode then
- begin
- gNode := AddCacheNode(FMaxID, AGatherParent.ID, -1);
- InternalDetail(gNode, cNode, sParentCode);
- Inc(FMaxID);
- if cNode.HasChildren then
- GatherCurNode(cNode, gNode, aLevel + 1);
- {调整结构,如:207-1-6在207-1前面, 把207-1-6调整为207-1的子节点}
- if blFlag then
- begin
- while Assigned(gParNode) do
- begin
- gNextNode := gParNode.NextSibling;
- if (gNode.ID <> gParNode.ID)
- and
- (
- (Pos(gNode.BCode + '-', gParNode.BCode) = 1)
- or
- (Pos(gNode.Code + '-', gParNode.Code) = 1)
- )
- then
- AdjustStructor(gNode, gParNode);
- gParNode := gNextNode;
- end;
- end;
- end;
- end;
- end;
- function TCacheGatherTree.GetFirstNode: TCacheGatherNode;
- begin
- Result := FRoot.FirstChild;
- end;
- procedure TCacheGatherTree.MergeCacheList;
- var
- I: Integer;
- vNode: TCacheGatherNode;
- begin
- for I := FMinIDList.Count -1 downto 0 do
- begin
- vNode := TCacheGatherNode(FMinIDList[I]);
- FCacheList.Add(vNode);
- end;
- end;
- procedure TCacheGatherTree.MovePreNode(ASrc, ADest: TCacheGatherNode);
- begin
- ASrc.FPreSibling := ADest.FPreSibling;
- if Assigned(ADest.FPreSibling) then
- ADest.FPreSibling.FNextSibling := ASrc;
- ASrc.FParent := ADest.FParent;
- ASrc.FNextSibling := ADest;
- ADest.FPreSibling := ASrc;
- end;
- function TCacheGatherTree.SerialSearch(
- const AID: Integer): TCacheGatherNode;
- var
- I: Integer;
- vNode: TCacheGatherNode;
- begin
- Result := nil;
- for I := 0 to FMinIDList.Count - 1 do
- begin
- vNode := TCacheGatherNode(FMinIDList[I]);
- if vNode.ID = AID then
- begin
- Result := vNode;
- Break;
- end;
- end;
- end;
- procedure TCacheGatherTree.DeleteBySerialSearch(const ANode: TCacheGatherNode);
- var
- I: Integer;
- vNode: TCacheGatherNode;
- begin
- for I := 0 to FMinIDList.Count - 1 do
- begin
- vNode := TCacheGatherNode(FMinIDList[I]);
- if vNode.ID = ANode.ID then
- begin
- FMinIDList.Delete(I);
- Break;
- end;
- end;
- end;
- function TCacheGatherTree.TraverseDBIntoSelf(AProject: TObject): Boolean;
- begin
- Result := True;
- FProject := AProject;
- if TProject(FProject).BillsData.BillsTree.FirstNode <> nil then
- begin
- try
- AddBillsNode(TProject(FProject).BillsData.BillsTree.FirstNode, nil);
- except
- Result := False;
- end;
- end;
- end;
- procedure TCacheGatherTree.TraverseOwnerIntoDB(AProject: TObject);
- var
- project: TProject;
- procedure AddDQItem(ANode: TCacheGatherNode);
- var
- I: Integer;
- DQItem: TDrawingQuantityItem;
- begin
- for I := 0 to ANode.FDQList.Count - 1 do
- begin
- DQItem := TDrawingQuantityItem(ANode.FDQList[I]);
- project.BillsData.AddDrawQItem(DQItem, I + 1);
- end;
- end;
- procedure AddExprs(ANode: TCacheGatherNode);
- var
- I: Integer;
- expNode: TExprsNode;
- begin
- for I := 0 to ANode.FExprsList.Count - 1 do
- begin
- expNode := TExprsNode(ANode.FExprsList[I]);
- with project.BillsData.DMExprs do
- begin
- cdsExprs.Append;
- cdsExprsMajorID.Value := expNode.FMajorID;
- cdsExprsMinorID.Value := expNode.FMinorID;
- cdsExprsRecdID.Value := expNode.FRecdID;
- cdsExprsExprs.Value := expNode.FExprs;
- cdsExprsExprs1.Value := expNode.FExprs1;
- cdsExprs.Post;
- end;
- end;
- end;
- procedure AddBillsAndDrawingItemAndExprs(ANode: TCacheGatherNode);
- begin
- project.BillsData.AddBillsItem(ANode);
- AddDQItem(ANode);
- AddExprs(ANode);
- end;
- procedure AddCacheNodes;
- var
- I: Integer;
- begin
- for I := 0 to FCacheList.Count - 1 do
- AddBillsAndDrawingItemAndExprs(TCacheGatherNode(FCacheList.List^[I]));
- end;
- begin
- project := TProject(AProject);
- project.BillsData.DisconnectBillsTree;
- try
- project.BillsData.DeleteAllBills;
- MergeCacheList;
- SortCacheTreeNodes(FRoot.FFirstChild);
- AddCacheNodes;
- project.Save(False);
- finally
- project.BillsData.ConnectionBillsTree;
- project.BillsData.SaveSerialNo;
- end;
- end;
- function TCacheGatherTree.ModifyBillsCode(const ACode: string): string;
- var
- I: Integer;
- begin
- Result := ACode;
- for I := Length(ACode) downto 1 do
- begin
- if ACode[I] = '-' then
- begin
- Result := Copy(Result, 1, I);
- Break;
- end;
- end;
- if Result[Length(Result)] = '-' then
- Result := Result + TokenArray[FTokenID]
- else
- Result := Result + '-' + TokenArray[FTokenID];
- end;
- procedure TCacheGatherTree.ModifyBillsCode(GNode: TCacheGatherNode;
- const aParentCode: string);
- var
- I, iLen: Integer;
- sCode: string;
- begin
- iLen := 0;
- for I := 1 to Length(aParentCode) do
- begin
- if aParentCode[I] = '-' then Inc(iLen);
- end;
- Inc(iLen);
- sCode := GNode.Code;
- for I := 1 to Length(sCode) do
- begin
- if sCode[I] = '-' then
- begin
- Dec(iLen);
- if iLen = 0 then
- begin
- Delete(sCode, 1, I - 1);
- Break;
- end;
- end;
- end;
- GNode.Code := aParentCode + sCode;
- end;
- procedure TCacheGatherTree.PlusItems(xNode: TZjIDTreeNode;
- GNode: TCacheGatherNode; aLevel: Integer; IsCode: Boolean);
- begin
- with TProject(FProject).BillsData do
- begin
- if IsCode then
- PlusDesignQuantitys(xNode.ID, GNode)
- else
- begin
- PlusBillsQuantity(xNode.ID, GNode);
- if not xNode.HasChildren then
- PlusDQDesignQuantitys(xNode.ID, GNode, FMaxDQID);
- end;
- if xNode.HasChildren then GatherCurNode(xNode, GNode, aLevel);
- end;
- end;
- procedure TCacheGatherTree.InternalDetail(
- AGNode: TCacheGatherNode; ANode: TZjIDTreeNode;
- const AParentCode: string);
- begin
- TProject(FProject).BillsData.ExtractBillsRecord(ANode.ID, AGNode);
- if Assigned(ANode) and (AGNode.Code <> '') then
- ModifyBillsCode(AGNode, AParentCode);
- if not ANode.HasChildren then
- TProject(FProject).BillsData.GetDQListByBillsID(ANode.ID, AGNode, FMaxDQID);
- end;
- procedure TCacheGatherTree.AddGatherNode(AGatherNode: TCacheGatherNode;
- AZjNode: TZjIDTreeNode; aLevel: Integer; const aBCode, aName: string);
- var
- cValue: Integer;
- blFlag: Boolean;
- gNode: TCacheGatherNode;
- begin
- blFlag := False;
- gNode := AGatherNode.FirstChild;
- while Assigned(gNode) do
- begin
- if ScConfigInfo.MatchCodeOnly then
- cValue := CompareCodes('', aBCode, '', '', gNode.BCode, '')
- else
- cValue := CompareCodes('', aBCode, aName, '', gNode.BCode, gNode.Name);
- if cValue = 0 then
- begin
- PlusItems(AZjNode, gNode, aLevel, False);
- blFlag := True;
- Break;
- end;
- if Pos(gNode.BCode + '-', aBCode) = 1 then
- begin
- AddGatherNode(gNode, AZjNode, aLevel, aBCode, aName);
- blFlag := True;
- Break;
- end;
- gNode := gNode.NextSibling;
- end;
- if not blFlag then
- begin
- gNode := AddCacheNode(FMaxID, AGatherNode.ID, -1);
- InternalDetail(gNode, AZjNode, '');
- Inc(FMaxID);
- if AZjNode.HasChildren then
- {GatherCurNode(AZjNode, gNode, aLevel);//} AddBillsNode(AZjNode.FirstChild, gNode);
- end;
- end;
- procedure TCacheGatherTree.AdjustStructor(AParNode,
- AChdNode: TCacheGatherNode);
- var
- xValue: Integer;
- blFlag: Boolean;
- ChildNode, SecChdNode, SecNextNode: TCacheGatherNode;
- begin
- AChdNode.RemoveFromParent;
- if Assigned(AChdNode) then
- begin
- blFlag := False;
- ChildNode := AParNode.FirstChild;
- while Assigned(ChildNode) do
- begin
- xValue := CompareCodes('', AChdNode.BCode, '', '', ChildNode.BCode, '');
- if xValue = 0 then
- begin
- {两节点相加数据,合并}
- CombineNodeQuantity(AChdNode, ChildNode);
- SecChdNode := AChdNode.FirstChild;
- while Assigned(SecChdNode) do
- begin
- SecNextNode := SecChdNode.NextSibling;
- AdjustStructor(ChildNode, SecChdNode);
- SecChdNode := SecNextNode;
- end;
- // 这里2012.3.5.16.20
- DeleteNode(AChdNode);
- //DeleteNode(ChildNode);
- blFlag := True;
- Break;
- end;
- if Pos(ChildNode.BCode + '-', AChdNode.BCode) = 1 then
- begin
- AdjustStructor(ChildNode, AChdNode);
- blFlag := True;
- Break;
- end;
- ChildNode := ChildNode.NextSibling;
- end;
- if not blFlag then
- begin
- // AChdNode.RemoveFromParent;
- if AParNode.HasChildren then
- AParNode.MoveLastChild(AChdNode)
- else
- AParNode.MoveFirstChild(AChdNode);
- end;
- end;
- end;
- function TCacheGatherTree.IncludeToken(const aCode: string): Boolean;
- var
- I: Integer;
- begin
- Result := False;
- for I := 1 to Length(aCode) do
- begin
- if aCode[I] in ['N', 'M', 'Q', 'L', 'P', 'R', 'S', 'T', 'X', 'Y', 'Z'] then
- begin
- Result := True;
- Break;
- end;
- end;
- end;
- function TCacheGatherTree.ConvertCode(const aCode, aGCode: string): string;
- var
- I, J, iDelLen: Integer;
- begin
- Result := aCode;
- for I := 1 to Length(aGCode) do
- begin
- if aGCode[I] in ['N', 'M', 'Q', 'L', 'P', 'R', 'S', 'T', 'X', 'Y', 'Z'] then
- begin
- if I >= Length(Result) then Exit;
-
- Result[I] := aGCode[I];
- J := I + 1;
- iDelLen := 0;
- while Result[J] <> '-' do
- begin
- Inc(iDelLen);
- Inc(J);
- end;
- Delete(Result, I + 1, iDelLen);
- end;
- end;
- end;
- procedure TCacheGatherTree.CombineDrawQ(ASrcQList, ADestQList: TList; aDestID: Integer);
- var
- I, J: Integer;
- blFlag: Boolean;
- srcQItem, destQItem, newItem: TDrawingQuantityItem;
- begin
- for I := 0 to ASrcQList.Count - 1 do
- begin
- blFlag := False;
- srcQItem := TDrawingQuantityItem(ASrcQList.List^[I]);
- for J := 0 to ADestQList.Count - 1 do
- begin
- destQItem := TDrawingQuantityItem(ADestQList.List^[J]);
- if SameText(destQItem.Name, srcQItem.Name) then
- begin
- destQItem.DesignQuantity1 := srcQItem.DesignQuantity1 + destQItem.DesignQuantity1;
- destQItem.DesignQuantity2 := srcQItem.DesignQuantity2 + destQItem.DesignQuantity2;
- blFlag := True;
- Break;
- end;
- end;
- if not blFlag then
- begin
- newItem := TDrawingQuantityItem.Create;
- newItem.ID := srcQItem.ID;
- newItem.BillsID := aDestID;
- newItem.Name := srcQItem.Name;
- newItem.Units := srcQItem.Units;
- newItem.DesignQuantity1 := srcQItem.DesignQuantity1;
- newItem.DesignQuantity2 := srcQItem.DesignQuantity2;
- newItem.MemoContext := srcQItem.MemoContext;
- ADestQList.Add(newItem);
- end;
- end;
- end;
- procedure TCacheGatherTree.AddBillsExprs(ABillsID: Integer;
- ACacheNode: TCacheGatherNode);
- var
- expNode: TExprsNode;
- begin
- if ACacheNode.FExprsList.Count > 0 then Exit;
- with TProject(FProject).BillsData.DMExprs do
- begin
- if cdsExprs.FindKey([1, 3, ABillsID]) then
- begin
- expNode := TExprsNode.Create;
- expNode.FMajorID := 1;
- expNode.FMinorID := 3;
- expNode.FRecdID := ACacheNode.FID;
- expNode.FExprs := cdsExprsExprs.AsString;
- expNode.FExprs1 := cdsExprsExprs1.AsString;
- ACacheNode.FExprsList.Add(expNode);
- end;
- end;
- end;
- function CompareCacheNode(AItem1, AItem2: Pointer): Integer;
- var
- Node1: TCacheGatherNode absolute AItem1;
- Node2: TCacheGatherNode absolute AItem2;
- begin
- if Node1.FCode <> '' then
- Result := CompareCode(Node1.FCode, Node2.FCode)
- else
- Result := CompareCode(Node1.FBCode, Node2.FBCode);
- end;
- procedure TCacheGatherTree.SortCacheTreeNodes(AParent: TCacheGatherNode);
- var
- lstChildren: TList;
- begin
- if AParent = nil then Exit;
-
- lstChildren := TList.Create;
- try
- AddChildren(AParent, lstChildren);
- lstChildren.Sort(CompareCacheNode);
- MoveChildren(AParent, lstChildren);
- SortChildren(AParent);
- finally
- lstChildren.Free;
- end;
- end;
- procedure TCacheGatherTree.AddChildren(AParent: TCacheGatherNode;
- AList: TList);
- var
- Node: TCacheGatherNode;
- begin
- Node := AParent.FirstChild;
- while Assigned(Node) do
- begin
- AList.Add(Node);
- Node := Node.NextSibling;
- end;
- end;
- procedure TCacheGatherTree.MoveChildren(AParent: TCacheGatherNode;
- AList: TList);
- var
- iIndex: Integer;
- Node, NextNode: TCacheGatherNode;
- begin
- iIndex := 0;
- while iIndex < AList.Count do
- begin
- Node := TCacheGatherNode(AList[iIndex]);
- if iIndex = 0 then
- begin
- AParent.FFirstChild := Node;
- Node.FPreSibling := nil;
- end;
- if iIndex = AList.Count - 1 then
- begin
- AParent.FLastChild := Node;
- Node.FNextSibling := nil;
- end;
- if iIndex + 1 < AList.Count then
- begin
- NextNode := TCacheGatherNode(AList[iIndex + 1]);
- Node.FNextSibling := NextNode;
- NextNode.FPreSibling := Node;
- end;
- Inc(iIndex);
- end;
- end;
- procedure TCacheGatherTree.SortChildren(AParent: TCacheGatherNode);
- var
- Node: TCacheGatherNode;
- begin
- Node := AParent.FirstChild;
- while Assigned(Node) do
- begin
- SortCacheTreeNodes(Node);
- Node := Node.NextSibling;
- end;
- end;
- function TCacheGatherTree.SplitAndConvertCode(const aCode, aGCode: string;
- ASpliter: Char): string;
- var
- sgsCode, sgsGCode: TStrings;
- iNum: Integer;
- sCurCodeNum: string;
- begin
- sgsCode := TStringList.Create;
- sgsGCode := TStringList.Create;
- try
- sgsCode.Delimiter := ASpliter;
- sgsCode.DelimitedText := aCode;
- sgsGCode.Delimiter := ASpliter;
- sgsGCode.DelimitedText := aGCode;
- for iNum := 0 to Min(sgsGCode.Count, sgsCode.Count) - 1 do
- begin
- sCurCodeNum := sgsGCode[iNum];
- if sCurCodeNum[1] in ['N', 'M', 'Q', 'L', 'P', 'R', 'S', 'T', 'X', 'Y', 'Z'] then
- sgsCode[iNum] := sgsGCode[iNum];
- end;
- finally
- Result := sgsCode.DelimitedText;
- sgsCode.Free;
- sgsGCode.Free;
- end;
- end;
- { TMergeGatherTree }
- procedure TMergeGatherTree.AddDrawItems(aCdsDraw: TClientDataSet; aBillsID: Integer;
- aCGNode: TCacheGatherNode);
- var
- dqiItem: TDrawingQuantityItem;
- begin
- with aCdsDraw do
- begin
- SetRange([aBillsID], [aBillsID]);
- while not Eof do
- begin
- dqiItem := TDrawingQuantityItem.Create;
- dqiItem.ID := FMaxDQID;
- dqiItem.BillsID := aCGNode.ID;
- dqiItem.Name := FieldByName(sName).AsString;
- dqiItem.Units := FieldByName(sUnits).AsString;
- dqiItem.DesignQuantity1 := FieldByName(sDQuantity1).AsFloat;
- dqiItem.DesignQuantity2 := FieldByName(sDQuantity2).AsFloat;
- dqiItem.MemoContext := FieldByName(sMemoContext).AsString;
- aCGNode.DQList.Add(dqiItem);
- Inc(FMaxDQID);
- Next;
- end;
- CancelRange;
- end;
- end;
- procedure TMergeGatherTree.AddExprs(AORecID: Integer; AGNode: TCacheGatherNode);
- var
- expNode: TExprsNode;
- begin
- if AGNode.FExprsList.Count > 0 then Exit;
- if CdsExprs.FindKey([1, 3, AORecID]) then
- begin
- expNode := TExprsNode.Create;
- expNode.FMajorID := 1;
- expNode.FMinorID := 3;
- expNode.FRecdID := AGNode.FID;
- expNode.FExprs := CdsExprs.FieldByName('Exprs').AsString;
- expNode.FExprs1 := CdsExprs.FieldByName('Exprs1').AsString;
- AGNode.FExprsList.Add(expNode);
- end;
- end;
- procedure TMergeGatherTree.AddGatherNode(aSrcNode,
- aDstNode: TCacheGatherNode);
- var
- cgnNode: TCacheGatherNode;
- begin
- cgnNode := AddSingleGatherNode(aSrcNode, aDstNode);
- if cgnNode = nil then Exit;
- AddGatherNode(aSrcNode.FirstChild, cgnNode);
- AddGatherNode(aSrcNode.NextSibling, aDstNode);
- end;
- procedure TMergeGatherTree.AddNode(aNode: TZjIDTreeNode;
- aGatherNode: TCacheGatherNode; aBillsTree: TZjIDTree;
- aCdsDraw: TClientDataSet;
- aIsOpened: Boolean);
- var
- cgnNode: TCacheGatherNode;
- begin
- cgnNode := AddSingleNode(aNode, aGatherNode, aBillsTree, aCdsDraw, aIsOpened);
- if cgnNode = nil then Exit;
- AddNode(aNode.FirstChild, cgnNode, aBillsTree, aCdsDraw, aIsOpened);
- AddNode(aNode.NextSibling, aGatherNode, aBillsTree, aCdsDraw, aIsOpened);
- end;
- function TMergeGatherTree.AddSingleGatherNode(aSrcNode,
- aDstNode: TCacheGatherNode): TCacheGatherNode;
- var
- iID: Integer;
- begin
- Result := nil;
- if aSrcNode = nil then Exit;
- if aSrcNode.ID < 100 then
- iID := aSrcNode.ID
- else
- begin
- iID := FMaxID;
- Inc(FMaxID);
- end;
- if Assigned(aDstNode) then
- Result := AddCacheNode(iID, aDstNode.ID, -1)
- else
- Result := AddCacheNode(iID, -1, -1);
- Result.Assign(aSrcNode);
- end;
- function TMergeGatherTree.AddSingleNode(aNode: TZjIDTreeNode;
- aGatherNode: TCacheGatherNode; aBillsTree: TZjIDTree;
- aCdsDraw: TClientDataSet; aIsOpened: Boolean): TCacheGatherNode;
- var
- iID: Integer;
- begin
- Result := nil;
- if aNode = nil then Exit;
- if aNode.ID < 100 then
- iID := aNode.ID
- else
- begin
- iID := FMaxID;
- Inc(FMaxID);
- end;
- if Assigned(aGatherNode) then
- Result := AddCacheNode(iID, aGatherNode.ID, -1)
- else
- Result := AddCacheNode(iID, -1, -1);
- if aIsOpened then
- begin
- AssignByOpened(aBillsTree, aNode, Result);
- TDMDataBase(TAdditinalTree(aBillsTree).Bills).GetDQListByBillsID(aNode.ID, Result, FMaxDQID);
- end
- else
- begin
- AssignTo(aNode, Result);
- AddDrawItems(aCdsDraw, aNode.ID, Result);
- end;
- AddExprs(aNode.ID, Result);
- ReCodeNode(Result);
- end;
- procedure TMergeGatherTree.AssignByOpened(aBillsTree: TObject; aNode: TZjIDTreeNode;
- aGatherNode: TCacheGatherNode);
- begin
- with TDMDataBase(TAdditinalTree(aBillsTree).Bills) do
- begin
- if cdsBills.FindKey([aNode.ID]) then
- begin
- aGatherNode.FCode := cdsBillsCode.AsString;
- aGatherNode.FBCode := cdsBillsB_Code.AsString;
- aGatherNode.FName := cdsBillsName.AsString;
- aGatherNode.FUnits := cdsBillsUnits.AsString;
- aGatherNode.FUnitPrice := cdsBillsUnitPrice.AsFloat;
- aGatherNode.FTotalPrice := cdsBillsTotalPrice.AsFloat;
- aGatherNode.FMemostring := cdsBillsMemoStr.AsString;
- aGatherNode.FQuantity := cdsBillsQuantity.AsFloat;
- aGatherNode.FDesignQuantity1 := cdsBillsDesignQuantity.AsFloat;
- aGatherNode.FDesignQuantity2 := cdsBillsDesignQuantity2.AsFloat;
- aGatherNode.FDesignPrice := cdsBillsDesignPrice.AsFloat;
- end;
- end;
- end;
- procedure TMergeGatherTree.AssignTo(aNode: TZjIDTreeNode;
- aGatherNode: TCacheGatherNode);
- begin
- aGatherNode.FCode := TAdditionalItem(aNode).Code;
- aGatherNode.FBCode := TAdditionalItem(aNode).B_Code;
- aGatherNode.FName := TAdditionalItem(aNode).Name;
- aGatherNode.FUnits := TAdditionalItem(aNode).Units;
- aGatherNode.FUnitPrice := TAdditionalItem(aNode).UnitPrice;
- aGatherNode.FTotalPrice := TAdditionalItem(aNode).TotalPrice;
- aGatherNode.FMemostring := TAdditionalItem(aNode).MemoStr;
- aGatherNode.FQuantity := TAdditionalItem(aNode).Quantity;
- aGatherNode.FDesignQuantity1 := TAdditionalItem(aNode).DesignQuantity;
- aGatherNode.FDesignQuantity2 := TAdditionalItem(aNode).DesignQuantity2;
- aGatherNode.FDesignPrice := TAdditionalItem(aNode).DesignPrice;
- end;
- procedure TMergeGatherTree.GatherBillsTree(aBillsTree: TZjIDTree);
- begin
- FBillsTree1 := aBillsTree;
-
- InitMaxID;
- if Assigned(FBillsTree1) then
- AddNode(FBillsTree1.FirstNode, nil, FBillsTree1, FCdsDraw1, FIsOpen1);
- { if Assigned(FBillsTree2) and (FBillsTree1 <> FBillsTree2) then
- UpdateNode(FBillsTree2.FirstNode, nil); }
- end;
- procedure TMergeGatherTree.GatherTree(aGatherTree: TMergeGatherTree);
- begin
- if Self <> aGatherTree then
- UpdateGatherNode(aGatherTree.FirstNode, nil);
- end;
- procedure TMergeGatherTree.InitMaxID;
- begin
- FMaxID := 100;
- FMaxDQID := 1;
- end;
- procedure TMergeGatherTree.ReCodeNode(ANode: TCacheGatherNode);
- function GetPreSiblingCount: Integer;
- var
- cgnNode: TCacheGatherNode;
- begin
- Result := 0;
- cgnNode := ANode.FPreSibling;
- while Assigned(cgnNode) do
- begin
- Inc(Result);
- cgnNode := cgnNode.FPreSibling;
- end;
- end;
- function GetPosition(const AName, AStr, AStrSpare: string): Integer;
- begin
- Result := Pos(AStr, AName);
- if Result = 0 then
- Result := Pos(AStrSpare, AName);
- end;
- function CheckNameIsPeg(const AName: string): Boolean;
- var
- iPosK, iPosPlus: Integer;
- fNum: Double;
- begin
- Result := False;
- iPosK := GetPosition(AName, 'K', 'k');
- iPosPlus := GetPosition(AName, '+', '+');
- if (iPosK = 0) or (iPosPlus = 0) or (iPosPlus < iPosK) then Exit;
- Result := TryStrToFloat(Copy(AName, iPosK + 1, iPosPlus - iPosK - 1), fNum);
- end;
- var
- cgnNode: TCacheGatherNode;
- strCode: string;
- begin
- if ANode = nil then Exit;
- if CheckNameIsPeg(ANode.FName) then
- begin
- cgnNode := ANode.FParent;
- if cgnNode <> nil then
- begin
- strCode := cgnNode.FCode;
- ANode.FCode := strCode + '-' + IntToStr(GetPreSiblingCount + 1);
- end
- else
- ANode.FCode := IntToStr(GetPreSiblingCount + 1);
- end;
- end;
- procedure TMergeGatherTree.UpdateBillsTree(aBillsTree: TZjIDTree);
- begin
- FBillsTree2 := aBillsTree;
-
- if Assigned(FBillsTree2) and (FBillsTree1 <> FBillsTree2) then
- UpdateNode(FBillsTree2.FirstNode, nil);
- end;
- procedure TMergeGatherTree.UpdateDrawItems(aBillsID: Integer;
- aCGNode: TCacheGatherNode);
- var
- I: Integer;
- bFounded: Boolean;
- dqiItem: TDrawingQuantityItem;
- begin
- with FCdsDraw2 do
- begin
- SetRange([aBillsID], [aBillsID]);
- while not Eof do
- begin
- bFounded := False;
- for I := 0 to aCGNode.DQList.Count - 1 do
- begin
- dqiItem := TDrawingQuantityItem(aCGNode.DQList.List^[I]);
- if SameText(dqiItem.Name, FieldByName(sName).AsString) then
- begin
- dqiItem.DesignQuantity1 := dqiItem.DesignQuantity1 + FieldByName(sDQuantity1).AsFloat;
- dqiItem.DesignQuantity2 := dqiItem.DesignQuantity2 + FieldByName(sDQuantity2).AsFloat;
- bFounded := True;
- Break;
- end;
- end;
- if not bFounded then
- begin
- dqiItem := TDrawingQuantityItem.Create;
- dqiItem.ID := FMaxDQID;
- dqiItem.BillsID := aCGNode.ID;
- dqiItem.Name := FieldByName(sName).AsString;
- dqiItem.Units := FieldByName(sUnits).AsString;
- dqiItem.DesignQuantity1 := FieldByName(sDQuantity1).AsFloat;
- dqiItem.DesignQuantity2 := FieldByName(sDQuantity2).AsFloat;
- dqiItem.MemoContext := FieldByName(sMemoContext).AsString;
- aCGNode.DQList.Add(dqiItem);
- Inc(FMaxDQID);
- end;
- Next;
- end;
- CancelRange;
- end;
- end;
- procedure TMergeGatherTree.UpdateGatherDrawItems(aSrcNode,
- aDstNode: TCacheGatherNode);
- var
- I : Integer;
- J : Integer;
- bFounded : Boolean;
- dqiSrcItem: TDrawingQuantityItem;
- dqiDstItem: TDrawingQuantityItem;
- begin
- for I := 0 to aSrcNode.DQList.Count - 1 do
- begin
- bFounded := False;
- dqiSrcItem := TDrawingQuantityItem(aSrcNode.DQList.List^[I]);
- for J := 0 to aDstNode.DQList.Count - 1 do
- begin
- dqiDstItem := TDrawingQuantityItem(aDstNode.DQList.List^[J]);
- if SameText(dqiSrcItem.FName, dqiDstItem.FName) then
- begin
- dqiDstItem.DesignQuantity1 := dqiDstItem.DesignQuantity1 + dqiSrcItem.DesignQuantity1;
- dqiDstItem.DesignQuantity2 := dqiDstItem.DesignQuantity2 + dqiSrcItem.DesignQuantity2;
- bFounded := True;
- Break;
- end;
- end;
- if not bFounded then
- begin
- dqiDstItem := TDrawingQuantityItem.Create;
-
- dqiDstItem.ID := FMaxDQID;
- dqiDstItem.FBillsID := aDstNode.ID;
- dqiDstItem.Assign(dqiSrcItem);
- aDstNode.DQList.Add(dqiDstItem);
- Inc(FMaxDQID);
- end;
- end;
- end;
- procedure TMergeGatherTree.UpdateGatherNode(aSrcNode,
- aDstNode: TCacheGatherNode);
- var
- bAdd: Boolean;
- iParentID: Integer;
- iCompare: Integer;
- cgnTemNode: TCacheGatherNode;
- cgnParNode: TCacheGatherNode;
- cgnNode: TCacheGatherNode;
- begin
- if aSrcNode = nil then Exit;
- if aDstNode = nil then
- begin
- cgnNode := FirstNode;
- iParentID := -1;
- end
- else
- begin
- cgnNode := aDstNode.FirstChild;
- iParentID := aDstNode.ID;
- end;
- bAdd := True;
- while Assigned(cgnNode) do
- begin
- if aSrcNode.FCode <> '' then
- iCompare := CompareCodes(aSrcNode.FCode, '', aSrcNode.FName, cgnNode.FCode, '', cgnNode.FName)
- else if aSrcNode.FBCode <> '' then
- iCompare := CompareCodes('', aSrcNode.FBCode, aSrcNode.FName, '', cgnNode.FBCode, cgnNode.FName)
- else
- iCompare := CompareCodes('', '', aSrcNode.FName, '', '', cgnNode.FName);
- if iCompare = 0 then
- begin
- UpdateGatherQuantity(aSrcNode, cgnNode);
- UpdateGatherDrawItems(aSrcNode, cgnNode);
- bAdd := False;
- Break;
- end
- else if iCompare > 0 then
- begin
- if ((cgnNode.FCode <> '') and (Pos(cgnNode.FCode + '-', aSrcNode.FCode) = 1)) or
- ((cgnNode.FBCode <> '') and (Pos(cgnNode.FBCode + '-', aSrcNode.FBCode) = 1))
- then
- begin
- UpdateGatherNode(aSrcNode, cgnNode);
- UpdateGatherNode(aSrcNode.NextSibling, aDstNode);
- Exit;
- end;
- end
- else
- begin
- if ((aSrcNode.FCode <> '') and (Pos(aSrcNode.FCode + '-', cgnNode.FCode) = 1)) or
- ((aSrcNode.FBCode <> '') and (Pos(aSrcNode.FBCode + '-', cgnNode.FBCode) = 1)) then
- begin
- cgnTemNode := cgnNode.NextSibling;
- cgnParNode := AddSingleGatherNode(aSrcNode, aDstNode);
- AddGatherNode(aSrcNode.FirstChild, cgnParNode);
- AdjustStructor(cgnParNode, cgnNode);
- while Assigned(cgnTemNode) do
- begin
- cgnNode := cgnTemNode;
- cgnTemNode := cgnTemNode.NextSibling;
- if (cgnNode.FBCode <> '') and (Pos(cgnParNode.FBCode + '-', cgnNode.FBCode) = 1) then
- AdjustStructor(cgnParNode, cgnNode);
- end;
- UpdateGatherNode(aSrcNode.NextSibling, aDstNode);
- Exit;
- end;
- end;
- cgnNode := cgnNode.NextSibling;
- end;
- if bAdd then
- begin
- if aSrcNode.ID < 100 then
- cgnNode := AddCacheNode(aSrcNode.ID, iParentID, -1)
- else
- begin
- cgnNode := AddCacheNode(FMaxID, iParentID, -1);
- Inc(FMaxID);
- end;
-
- cgnNode.Assign(aSrcNode);
- AddGatherNode(aSrcNode.FirstChild, cgnNode);
- end
- else
- UpdateGatherNode(aSrcNode.FirstChild, cgnNode);
-
- UpdateGatherNode(aSrcNode.NextSibling, aDstNode);
- end;
- procedure TMergeGatherTree.UpdateGatherQuantity(aSrcNode,
- aDstNode: TCacheGatherNode);
- begin
- aDstNode.FQuantity := aDstNode.FQuantity + aSrcNode.Quantity;
- aDstNode.FTotalPrice := aDstNode.FTotalPrice + aSrcNode.TotalPrice;
- aDstNode.FDesignQuantity1 := aDstNode.FDesignQuantity1 + aSrcNode.DesignQuantity1;
- aDstNode.FDesignQuantity2 := aDstNode.FDesignQuantity2 + aSrcNode.DesignQuantity2;
- if aDstNode.FCode <> '' then
- begin
- if aDstNode.FDesignQuantity1 = 0 then
- aDstNode.FDesignPrice := 0
- else
- aDstNode.FDesignPrice := RoundTo(aDstNode.FTotalPrice / aDstNode.FDesignQuantity1, -3);
- end
- else
- begin
- if aDstNode.FQuantity = 0 then
- aDstNode.FUnitPrice := 0
- else
- aDstNode.FUnitPrice := RoundTo(aDstNode.FTotalPrice / aDstNode.FQuantity, -3);
- end;
- end;
- procedure TMergeGatherTree.UpdateNode(aNode: TZjIDTreeNode;
- aGatherNode: TCacheGatherNode);
- function CompareNode(SrcNode: TScBillsItem; DestNode: TCacheGatherNode): Integer;
- var
- strSrcName, strDestName: string;
- begin
- if (not FMergeByCode) or ((SrcNode.SBillCode = '') and
- (SrcNode.SBillBCode = '') and (DestNode.FCode = '') and (DestNode.FBCode = '')) then
- begin
- strSrcName := SrcNode.SBillName;
- strDestName := DestNode.FName;
- end;
- Result := CompareCodes(SrcNode.SBillCode, SrcNode.SBillBCode, strSrcName,
- DestNode.FCode, DestNode.FBCode, strDestName);
- end;
- var
- bAdd: Boolean;
- iCompare: Integer;
- cgnNode: TCacheGatherNode;
- cgnTemNode: TCacheGatherNode;
- cgnParNode: TCacheGatherNode;
- begin
- if aNode = nil then Exit;
- if aGatherNode = nil then
- cgnNode := FirstNode
- else
- cgnNode := aGatherNode.FirstChild;
- bAdd := True;
- while Assigned(cgnNode) do
- begin
- iCompare := CompareNode(TScBillsItem(aNode), cgnNode);
- {if TScBillsItem(aNode).SBillCode <> '' then
- iCompare := CompareCodes(TScBillsItem(aNode).SBillCode, '', TScBillsItem(aNode).SBillName, cgnNode.FCode, '', cgnNode.FName)
- else if TScBillsItem(aNode).SBillBCode <> '' then
- iCompare := CompareCodes('', TScBillsItem(aNode).SBillBCode, TScBillsItem(aNode).SBillName, '', cgnNode.FBCode, cgnNode.FName)
- else
- iCompare := CompareCodes('', '', TScBillsItem(aNode).SBillName, '', '', cgnNode.FName); }
- if iCompare = 0 then
- begin
- if FIsOpen2 then
- begin
- UpdateQuantityByOpened(aNode, cgnNode);
- TDMDataBase(TAdditinalTree(FBillsTree2).Bills).PlusDQDesignQuantitys(aNode.ID, cgnNode, FMaxDQID);
- end
- else
- begin
- UpdateQuantity(aNode, cgnNode);
- UpdateDrawItems(aNode.ID, cgnNode);
- end;
- bAdd := False;
- Break;
- end
- else if iCompare > 0 then
- begin
- if ((cgnNode.FCode <> '') and (Pos(cgnNode.FCode + '-', TScBillsItem(aNode).SBillCode) = 1)) or
- ((cgnNode.FBCode <> '') and (Pos(cgnNode.FBCode + '-', TScBillsItem(aNode).SBillBCode) = 1)) then
- begin
- UpdateNode(aNode, cgnNode);
- // 去掉,重复计算了. 2011.6.17
- //UpdateNode(aNode.NextSibling, aGatherNode);
- Exit;
- end;
- end
- else
- begin
- if ((TScBillsItem(aNode).SBillCode <> '') and (Pos(TScBillsItem(aNode).SBillCode + '-', cgnNode.FCode) = 1)) or
- ((TScBillsItem(aNode).SBillBCode <> '') and (Pos(TScBillsItem(aNode).SBillBCode + '-', cgnNode.FBCode) = 1)) then
- begin
- cgnTemNode := cgnNode.NextSibling;
- cgnParNode := AddSingleNode(aNode, aGatherNode, FBillsTree2, FCdsDraw2, FIsOpen2);
- AddNode(aNode.FirstChild, cgnParNode, FBillsTree2, FCdsDraw2, FIsOpen2);
- AdjustStructor(cgnParNode, cgnNode);
- while Assigned(cgnTemNode) do
- begin
- cgnNode := cgnTemNode;
- cgnTemNode := cgnTemNode.NextSibling;
- if (cgnNode.FBCode <> '') then
- begin
- if (Pos(cgnParNode.FBCode + '-', cgnNode.FBCode) = 1) then
- AdjustStructor(cgnParNode, cgnNode);
- end;
- end;
- UpdateNode(aNode.NextSibling, aGatherNode);
- Exit;
- end;
- end;
- cgnNode := cgnNode.NextSibling;
- end;
- if bAdd then
- begin
- cgnNode := AddSingleNode(aNode, aGatherNode, FBillsTree2, FCdsDraw2, FIsOpen2);
- AddNode(aNode.FirstChild, cgnNode, FBillsTree2, FCdsDraw2, FIsOpen2);
- end
- else
- UpdateNode(aNode.FirstChild, cgnNode);
-
- UpdateNode(aNode.NextSibling, aGatherNode);
- end;
- procedure TMergeGatherTree.UpdateQuantity(aNode: TZjIDTreeNode;
- aGatherNode: TCacheGatherNode);
- begin
- aGatherNode.FQuantity := aGatherNode.FQuantity + TAdditionalItem(aNode).Quantity;
- aGatherNode.FTotalPrice := aGatherNode.FTotalPrice + TAdditionalItem(aNode).TotalPrice;
- aGatherNode.FDesignQuantity1 := aGatherNode.FDesignQuantity1 + TAdditionalItem(aNode).DesignQuantity;
- aGatherNode.FDesignQuantity2 := aGatherNode.FDesignQuantity2 + TAdditionalItem(aNode).DesignQuantity2;
- if aGatherNode.FCode <> '' then
- begin
- if aGatherNode.FDesignQuantity1 = 0 then
- aGatherNode.FDesignPrice := 0
- else
- aGatherNode.FDesignPrice := RoundTo(aGatherNode.FTotalPrice / aGatherNode.FDesignQuantity1, -3);
- end
- else
- begin
- if aGatherNode.FQuantity = 0 then
- aGatherNode.FUnitPrice := 0
- else
- aGatherNode.FUnitPrice := RoundTo(aGatherNode.FTotalPrice / aGatherNode.FQuantity, -3);
- end;
- end;
- procedure TMergeGatherTree.UpdateQuantityByOpened(aNode: TZjIDTreeNode;
- aGatherNode: TCacheGatherNode);
- begin
- with TDMDataBase(TAdditinalTree(FBillsTree2).Bills) do
- begin
- if cdsBills.FindKey([aNode.ID]) then
- begin
- aGatherNode.FTotalPrice := aGatherNode.FTotalPrice + cdsBillsTotalPrice.AsFloat;
- aGatherNode.FQuantity := aGatherNode.FQuantity + cdsBillsQuantity.AsFloat;
- aGatherNode.FDesignQuantity1 := aGatherNode.FDesignQuantity1 + cdsBillsDesignQuantity.AsFloat;
- aGatherNode.FDesignQuantity2 := aGatherNode.FDesignQuantity2 + cdsBillsDesignQuantity2.AsFloat;
- if aGatherNode.FCode <> '' then
- begin
- if aGatherNode.FDesignQuantity1 = 0 then
- aGatherNode.FDesignPrice := 0
- else
- aGatherNode.FDesignPrice := RoundTo(aGatherNode.FTotalPrice / aGatherNode.FDesignQuantity1, -3);
- end
- else
- begin
- if aGatherNode.FQuantity = 0 then
- aGatherNode.FUnitPrice := 0
- else
- aGatherNode.FUnitPrice := RoundTo(aGatherNode.FTotalPrice / aGatherNode.FQuantity, -3);
- end;
- end;
- end;
- end;
- procedure TMergeGatherTree.WriteBills(aNode: TCacheGatherNode;
- aTable: TDataSet);
- begin
- with aTable do
- begin
- Append;
- FieldByName(SID).AsInteger := aNode.ID;
- FieldByName(sParentID).AsInteger := aNode.ParentID;
- FieldByName(sNextSiblingID).AsInteger := aNode.NextSiblingID;
- FieldByName(sCode).AsString := aNode.Code;
- if SameText(aNode.Code, '') then
- begin
- if aNode.Quantity <> 0 then
- FieldByName(sQuantity).AsFloat := aNode.Quantity;
- end
- else
- begin
- FieldByName(sDesignQuantity).AsFloat := aNode.DesignQuantity1;
- FieldByName(sDesignQuantity2).AsFloat := aNode.DesignQuantity2;
- end;
- FieldByName(sB_Code).AsString := aNode.BCode;
- FieldByName(sName).AsString := aNode.Name;
- FieldByName(sUnits).AsString := aNode.Units;
- FieldByName(sUnitPrice).AsFloat := aNode.UnitPrice;
- FieldByName(STotalPrice).AsFloat := aNode.TotalPrice;
- FieldByName(sMemoStr).AsString := aNode.MemoString;
- FieldByName(sIsPreDefine).AsBoolean := aNode.ParentID = -1;
- Post;
- end;
- end;
- procedure TMergeGatherTree.WriteDraw(aNode: TCacheGatherNode;
- aTable: TDataSet);
- var
- I: Integer;
- DQItem: TDrawingQuantityItem;
- begin
- for I := 0 to aNode.FDQList.Count - 1 do
- begin
- DQItem := TDrawingQuantityItem(ANode.FDQList.List^[I]);
- with aTable do
- begin
- Append;
- FieldByName(SID).AsInteger := DQItem.ID;
- FieldByName(sSerinalNo).AsInteger := I + 1;
- FieldByName(sBillsID).AsInteger := DQItem.BillsID;
- FieldByName(sName).AsString := DQItem.Name;
- FieldByName(sUnits).AsString := DQItem.Units;
- if DQItem.DesignQuantity1 <> 0 then
- FieldByName(sDQuantity1).AsFloat := DQItem.DesignQuantity1;
- if DQItem.DesignQuantity2 <> 0 then
- FieldByName(sDQuantity2).AsFloat := DQItem.DesignQuantity2;
- FieldByName(sMemoContext).AsString := DQItem.MemoContext;
- Post;
- end;
- end;
- end;
- procedure TMergeGatherTree.WriteExprs(aNode: TCacheGatherNode;
- ADataset: TDataSet);
- var
- I: Integer;
- expNode: TExprsNode;
- begin
- for I := 0 to aNode.FExprsList.Count - 1 do
- begin
- expNode := TExprsNode(aNode.FExprsList[I]);
- ADataset.Append;
- ADataset.FieldByName('MajorID').Value := expNode.FMajorID;
- ADataset.FieldByName('MinorID').Value := expNode.FMinorID;
- ADataset.FieldByName('RecdID').Value := expNode.FRecdID;
- ADataset.FieldByName('Exprs').Value := expNode.FExprs;
- ADataset.FieldByName('Exprs1').Value := expNode.FExprs1;
- ADataset.Post;
- end;
- end;
- procedure TMergeGatherTree.WriteTo(aBillsTable, aDrawTable, aExprsTable: TDataSet);
- var
- I: Integer;
- cgnNode: TCacheGatherNode;
- begin
- MergeCacheList;
- // Access 最后一次 Post 不能提交到数据库,以前也碰到过!
- // 所以不能用Table, Query
- // 改成 ClientDataSet 试试,结果是可以的。
- // 第二次碰到这个问题了。如果不用加密的Access,结果是正确的
- // 所以是加密的问题
- CreateProgressForm(FCacheList.Count, '正在写入数据!');
- for I := 0 to FCacheList.Count - 1 do
- begin
- // AddProgressForm(I, '正在写入数据…');
- cgnNode := TCacheGatherNode(FCacheList[I]);
- WriteBills(cgnNode, aBillsTable);
- WriteDraw(cgnNode, aDrawTable);
- WriteExprs(cgnNode, aExprsTable);
- RefreshProgressForm(I, cgnNode.FName);
- end;
- CloseProgressForm;
- end;
- { TDrawingQuantityItem }
- procedure TDrawingQuantityItem.Assign(aSrcItem: TDrawingQuantityItem);
- begin
- FName := aSrcItem.FName;
- FUnits := aSrcItem.FUnits;
- FDesignQuantity1 := aSrcItem.FDesignQuantity1;
- FDesignQuantity2 := aSrcItem.FDesignQuantity2;
- FMemoContext := aSrcItem.FMemoContext;
- end;
- { TSplitGatherTree }
- function TSplitGatherTree.AddParent(
- aNode: TZjIDTreeNode): TCacheGatherNode;
- var
- I: Integer;
- ztnNode: TZjIDTreeNode;
- ParList: TList;
- cgnNode: TCacheGatherNode;
- begin
- ParList := TList.Create;
- try
- SearchParents(aNode, ParList);
- Result := nil;
- for I := ParList.Count - 1 downto 0 do
- begin
- ztnNode := TZjIDTreeNode(ParList.List^[I]);
- cgnNode := FindChildNode(ztnNode, Result);
- if cgnNode = nil then
- Result := AddSingleNode(ztnNode, Result)
- else
- Result := cgnNode;
- end;
- finally
- ParList.Free;
- end;
- end;
- function TSplitGatherTree.AddSingleNode(aNode: TZjIDTreeNode;
- aCgnNode: TCacheGatherNode): TCacheGatherNode;
- var
- iID: Integer;
- iParentID: Integer;
- begin
- if aNode = nil then Exit;
- { parentID }
- if aCgnNode = nil then
- iParentID := -1
- else
- iParentID := aCgnNode.ID;
- { ID }
- if aNode.ID < 100 then
- iID := aNode.ID
- else
- begin
- iID := FMaxID;
- Inc(FMaxID);
- end;
- Result := AddCacheNode(iID, iParentID, -1);
- { Assign }
- AssignTo(aNode, Result);
- AddDrawItems(FCdsDraw1, aNode.ID, Result);
- end;
- function TSplitGatherTree.FindChildNode(aNode: TZjIDTreeNode;
- aCgnNode: TCacheGatherNode): TCacheGatherNode;
- var
- iCompare: Integer;
- begin
- if aCgnNode = nil then
- Result := FirstNode
- else
- Result := aCgnNode.FirstChild;
- while Assigned(Result) do
- begin
- if TAdditionalItem(aNode).Code <> '' then
- iCompare := CompareCodes(TAdditionalItem(aNode).Code, '', TAdditionalItem(aNode).Name, Result.FCode, '', Result.FName)
- else if TAdditionalItem(aNode).B_Code <> '' then
- iCompare := CompareCodes('', TAdditionalItem(aNode).B_Code, TAdditionalItem(aNode).Name, '', Result.FBCode, Result.FName)
- else
- iCompare := CompareCodes('', '', TAdditionalItem(aNode).Name, '', '', Result.FName);
- if iCompare = 0 then
- begin
- Break;
- end;
- Result := Result.NextSibling;
- end;
- end;
- procedure TSplitGatherTree.GenerateGatherTree(aNode: TZjIDTreeNode);
- var
- cgnParent: TCacheGatherNode;
- begin
- if aNode = nil then Exit;
- if not aNode.HasChildren and
- (SameText(TAdditionalItem(aNode).OwnerName, FOwnerName) or
- (TAdditionalItem(aNode).OwnerName = ''))
- then
- begin
- cgnParent := AddParent(aNode);
- AddSingleNode(aNode, cgnParent);
- end;
- GenerateGatherTree(aNode.FirstChild);
- GenerateGatherTree(aNode.NextSibling);
- end;
- procedure TSplitGatherTree.SearchParents(aNode: TZjIDTreeNode;
- aParList: TList);
- begin
- while Assigned(aNode.Parent) do
- begin
- aParList.Add(aNode.Parent);
- aNode := aNode.Parent;
- end;
- end;
- procedure TSplitGatherTree.SplitBillsTree(aBillsTree: TZjIDTree;
- aCdsDraw: TClientDataSet; const aOwnerName: string);
- begin
- FBillsTree1 := aBillsTree;
- FCdsDraw1 := aCdsDraw;
- FOwnerName := aOwnerName;
- InitMaxID;
- GenerateGatherTree(FBillsTree1.FirstNode);
- end;
- end.
|