From 4cefb6c38299260aadb4d7d37cf41166d0cd2f27 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Tue, 28 Dec 2004 14:43:27 +0000 Subject: [PATCH] Added: new preliminary Binary Tree implementation (this time I actually understand the theory instead of copy/paste/adjust) --- Docs/html/ch01.html | 5 - Docs/html/ch01s02.html | 3 - Docs/html/ch01s03.html | 11 - Docs/html/ch02.html | 11 - Docs/html/ch02s02.html | 5 - Docs/html/html.css | 87 ------ Docs/html/index.html | 1 - Docs/singlehtml/html.css | 87 ------ Docs/singlehtml/index.html | 31 --- UnitTests/Units/UBits.pas | 2 +- UnitTests/Units/UTrees.pas | 110 ++++++++ UnitTests/X2UtUnitTests.cfg | 9 +- UnitTests/X2UtUnitTests.dof | 138 ++++------ UnitTests/X2UtUnitTests.dpr | 3 +- X2UtTrees.pas | 513 ++++++++++++++++++++++++++++++++++++ 15 files changed, 688 insertions(+), 328 deletions(-) delete mode 100644 Docs/html/ch01.html delete mode 100644 Docs/html/ch01s02.html delete mode 100644 Docs/html/ch01s03.html delete mode 100644 Docs/html/ch02.html delete mode 100644 Docs/html/ch02s02.html delete mode 100644 Docs/html/html.css delete mode 100644 Docs/html/index.html delete mode 100644 Docs/singlehtml/html.css delete mode 100644 Docs/singlehtml/index.html create mode 100644 UnitTests/Units/UTrees.pas create mode 100644 X2UtTrees.pas diff --git a/Docs/html/ch01.html b/Docs/html/ch01.html deleted file mode 100644 index 88b0906..0000000 --- a/Docs/html/ch01.html +++ /dev/null @@ -1,5 +0,0 @@ -Chapter 1. Introduction
Chapter 1. Introduction
Prev   Next

Chapter 1. Introduction

Table of Contents

Overview
Documentation
License

Overview

- X²Utils is an open-source set of utility classes and functions released under the zlib/libpng license, a copy of which is shown below. It's main function is reusability and convenience; anything which is used often deserves a spot in the library, assuming it is written with portability in mind. -

- The official website for X²Utils is located at http://x2utils.kamadev.net/. Contributions to the source code are appreciated, and after reviewing will be committed to the Subversion repository. -

Prev Up Next
X²Utils Home Documentation
diff --git a/Docs/html/ch01s02.html b/Docs/html/ch01s02.html deleted file mode 100644 index abc4e95..0000000 --- a/Docs/html/ch01s02.html +++ /dev/null @@ -1,3 +0,0 @@ -Documentation
Documentation
Prev Chapter 1. Introduction Next

Documentation

- The documentation for X²Utils is kept both as in-source comments and external docBook format. The in-source comments can be used in combination with Delphi Component Help Builder to generate reference documentation. The docBook sources must be kept in sync manually, but allow for detailed explanation of the various functions. -

Prev Up Next
Chapter 1. Introduction Home License
diff --git a/Docs/html/ch01s03.html b/Docs/html/ch01s03.html deleted file mode 100644 index 9df3ef2..0000000 --- a/Docs/html/ch01s03.html +++ /dev/null @@ -1,11 +0,0 @@ -License
License
Prev Chapter 1. Introduction Next

License

- Copyright (c) 2004 X²Software

This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software. -

- Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: -

  1. - The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. -
  2. - Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. -
  3. - This notice may not be removed or altered from any source distribution. -
Prev Up Next
Documentation Home Chapter 2. Environment information
diff --git a/Docs/html/ch02.html b/Docs/html/ch02.html deleted file mode 100644 index b838bb3..0000000 --- a/Docs/html/ch02.html +++ /dev/null @@ -1,11 +0,0 @@ -Chapter 2. Environment information
Chapter 2. Environment information
Prev   Next

Chapter 2. Environment information

Table of Contents

X2UtApp.pas
X2UtOS.pas

X2UtApp.pas

- Contains a TX2App class which can be initiated as a singleton using the App() function. It provides information related to the application, such as the executable path and version information. -

- Note that you should not free the return value of the App() function, the unit's finalization clause takes care of destroying the object when the application closes. This makes it suitable to use the App() function in a way similar to Delphi's Application object. -

Example 2.1. Using the App function

- MyDataFileLocation := App.Path + 'data.ini'; -

- The version information is accessible through App.Version. It contains the version numbers and various build flags as specified in the project options. You can also access the version strings through App.Version.Strings, which contain information such as the product name and copyright. -

- Useful for display purposes is the App.FormatVersion() function. It returns a string with the version information in the format "vX.X.X". If the optional Build parameter is set to True (default), "build X" is appended as well. -

Prev Up Next
License Home X2UtOS.pas
diff --git a/Docs/html/ch02s02.html b/Docs/html/ch02s02.html deleted file mode 100644 index 008c7d9..0000000 --- a/Docs/html/ch02s02.html +++ /dev/null @@ -1,5 +0,0 @@ -X2UtOS.pas
X2UtOS.pas
Prev Chapter 2. Environment information 

X2UtOS.pas

- Similar to X2UtApp.pas, this unit contains a TX2OS class which you can access using the OS() function. It provides information about the Operating System the application currently runs on. -

- OS.Version is an enumeration of versions recognized by X2UtOS. Extended information if available through OS.VersionEx, and an OS.FormatVersion() is provided for display purposes as well. -

Prev Up 
Chapter 2. Environment information Home 
diff --git a/Docs/html/html.css b/Docs/html/html.css deleted file mode 100644 index 21b51be..0000000 --- a/Docs/html/html.css +++ /dev/null @@ -1,87 +0,0 @@ -body -{ - background-color: #ffffff; - color: #000000; - font-family: verdana, tahoma, arial, sans-serif; - font-size: 10pt; -} - -td -{ - font-size: 10pt; -} - -a -{ - background-color: transparent; - color: #000080; - text-decoration: underline; -} - -a:hover -{ - background-color: #f0f0ff; - color: #000080; -} - -h1, h2, h3, h4, h5 -{ - background-color: transparent; - color: #800000; -} - -h3 -{ - font-size: 13pt; - font-weight: bold; -} - -h4 -{ - font-size: 10pt; - font-weight: bold; -} - -span.term -{ - font-weight: bold; -} - -div.sidebar -{ - background-color: #f0f0f0; - border-color: gray; - border-style: solid; - border-width: 1px; - color: #000000; - margin: 20px; - padding: 5px; -} - -pre.programlisting -{ - background-color: #f0f0f0; - border-color: gray; - border-style: solid; - border-width: 1px; - color: #000000; - font-size: 10pt; - padding: 2px; - white-space: pre; -} - -span.codestring -{ - background-color: transparent; - color: #008000; -} - -dl -{ - margin-top: 0px; -} - -dd -{ - margin-left: 20px; -} \ No newline at end of file diff --git a/Docs/html/index.html b/Docs/html/index.html deleted file mode 100644 index 0b1380c..0000000 --- a/Docs/html/index.html +++ /dev/null @@ -1 +0,0 @@ -X²Utils
X²Utils
   Next

X²Utils

M. van Renswoude

Table of Contents

1. Introduction
Overview
Documentation
License
2. Environment information
X2UtApp.pas
X2UtOS.pas

List of Examples

2.1. Using the App function
   Next
   Chapter 1. Introduction
diff --git a/Docs/singlehtml/html.css b/Docs/singlehtml/html.css deleted file mode 100644 index 21b51be..0000000 --- a/Docs/singlehtml/html.css +++ /dev/null @@ -1,87 +0,0 @@ -body -{ - background-color: #ffffff; - color: #000000; - font-family: verdana, tahoma, arial, sans-serif; - font-size: 10pt; -} - -td -{ - font-size: 10pt; -} - -a -{ - background-color: transparent; - color: #000080; - text-decoration: underline; -} - -a:hover -{ - background-color: #f0f0ff; - color: #000080; -} - -h1, h2, h3, h4, h5 -{ - background-color: transparent; - color: #800000; -} - -h3 -{ - font-size: 13pt; - font-weight: bold; -} - -h4 -{ - font-size: 10pt; - font-weight: bold; -} - -span.term -{ - font-weight: bold; -} - -div.sidebar -{ - background-color: #f0f0f0; - border-color: gray; - border-style: solid; - border-width: 1px; - color: #000000; - margin: 20px; - padding: 5px; -} - -pre.programlisting -{ - background-color: #f0f0f0; - border-color: gray; - border-style: solid; - border-width: 1px; - color: #000000; - font-size: 10pt; - padding: 2px; - white-space: pre; -} - -span.codestring -{ - background-color: transparent; - color: #008000; -} - -dl -{ - margin-top: 0px; -} - -dd -{ - margin-left: 20px; -} \ No newline at end of file diff --git a/Docs/singlehtml/index.html b/Docs/singlehtml/index.html deleted file mode 100644 index 7566fa0..0000000 --- a/Docs/singlehtml/index.html +++ /dev/null @@ -1,31 +0,0 @@ -X²Utils

X²Utils

M. van Renswoude

Table of Contents

1. Introduction
Overview
Documentation
License
2. Environment information
X2UtApp.pas
X2UtOS.pas

List of Examples

2.1. Using the App function

Chapter 1. Introduction

Table of Contents

Overview
Documentation
License

Overview

- X²Utils is an open-source set of utility classes and functions released under the zlib/libpng license, a copy of which is shown below. It's main function is reusability and convenience; anything which is used often deserves a spot in the library, assuming it is written with portability in mind. -

- The official website for X²Utils is located at http://x2utils.kamadev.net/. Contributions to the source code are appreciated, and after reviewing will be committed to the Subversion repository. -

Documentation

- The documentation for X²Utils is kept both as in-source comments and external docBook format. The in-source comments can be used in combination with Delphi Component Help Builder to generate reference documentation. The docBook sources must be kept in sync manually, but allow for detailed explanation of the various functions. -

License

- Copyright (c) 2004 X²Software

This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages arising from the use of this software. -

- Permission is granted to anyone to use this software for any purpose, including commercial applications, and to alter it and redistribute it freely, subject to the following restrictions: -

  1. - The origin of this software must not be misrepresented; you must not claim that you wrote the original software. If you use this software in a product, an acknowledgment in the product documentation would be appreciated but is not required. -
  2. - Altered source versions must be plainly marked as such, and must not be misrepresented as being the original software. -
  3. - This notice may not be removed or altered from any source distribution. -

Chapter 2. Environment information

Table of Contents

X2UtApp.pas
X2UtOS.pas

X2UtApp.pas

- Contains a TX2App class which can be initiated as a singleton using the App() function. It provides information related to the application, such as the executable path and version information. -

- Note that you should not free the return value of the App() function, the unit's finalization clause takes care of destroying the object when the application closes. This makes it suitable to use the App() function in a way similar to Delphi's Application object. -

Example 2.1. Using the App function

- MyDataFileLocation := App.Path + 'data.ini'; -

- The version information is accessible through App.Version. It contains the version numbers and various build flags as specified in the project options. You can also access the version strings through App.Version.Strings, which contain information such as the product name and copyright. -

- Useful for display purposes is the App.FormatVersion() function. It returns a string with the version information in the format "vX.X.X". If the optional Build parameter is set to True (default), "build X" is appended as well. -

X2UtOS.pas

- Similar to X2UtApp.pas, this unit contains a TX2OS class which you can access using the OS() function. It provides information about the Operating System the application currently runs on. -

- OS.Version is an enumeration of versions recognized by X2UtOS. Extended information if available through OS.VersionEx, and an OS.FormatVersion() is provided for display purposes as well. -

diff --git a/UnitTests/Units/UBits.pas b/UnitTests/Units/UBits.pas index ac1ada9..3a81f71 100644 --- a/UnitTests/Units/UBits.pas +++ b/UnitTests/Units/UBits.pas @@ -87,6 +87,6 @@ end; initialization - RegisterTest(TBitsTest.Suite); + RegisterTest('Bits', TBitsTest.Suite); end. diff --git a/UnitTests/Units/UTrees.pas b/UnitTests/Units/UTrees.pas new file mode 100644 index 0000000..e12fc89 --- /dev/null +++ b/UnitTests/Units/UTrees.pas @@ -0,0 +1,110 @@ +unit UTrees; + +interface +uses + TestFramework, + X2UtTrees; + +type + TBinaryTreeTest = class(TTestCase) + private + FMemory: Integer; + FTree: TX2BinaryTree; + protected + procedure SetUp(); override; + procedure TearDown(); override; + + procedure CheckTree(const AValue: String); + published + procedure Insert(); + procedure Delete(); + procedure Clear(); + end; + +implementation +uses + SysUtils; + + +{ TBinaryTreeTest } +procedure TBinaryTreeTest.SetUp; +begin + FMemory := GetHeapStatus().TotalAllocated; + FTree := TX2BinaryTree.Create(); + FTree.Insert(10); + FTree.Insert(25); + FTree.Insert(5); + FTree.Insert(8); + FTree.Insert(16); + FTree.Insert(1); +end; + +procedure TBinaryTreeTest.TearDown; +var + iLeak: Integer; + +begin + FreeAndNil(FTree); + + iLeak := FMemory - Integer(GetHeapStatus().TotalAllocated); + CheckEquals(0, iLeak, 'Memory leak'); +end; + + +procedure TBinaryTreeTest.CheckTree; +var + sTree: String; + +begin + sTree := ''; + + FTree.First(); + while not FTree.Eof do + begin + sTree := sTree + Format('-%d', [FTree.CurrentKey]); + FTree.Next(); + end; + + if Length(sTree) = 0 then + Check(Length(AValue) = 0, 'Tree is empty') + else + begin + System.Delete(sTree, 1, 1); + CheckEquals(AValue, sTree, 'Tree content is invalid') + end; +end; + + +procedure TBinaryTreeTest.Insert; +begin + // In these tests we also assume that iterating through the tree is done + // from top to bottom, left to right: + // + // 10 + // 5 25 + // 1 8 16 + CheckTree('10-5-1-8-25-16'); +end; + +procedure TBinaryTreeTest.Delete; +begin + FTree.Delete(8); + FTree.Delete(10); + + // 16 + // 5 25 + // 1 + CheckTree('16-5-1-25'); +end; + +procedure TBinaryTreeTest.Clear; +begin + FTree.Clear(); + CheckTree(''); +end; + + +initialization + RegisterTest('Trees.BinaryTree', TBinaryTreeTest.Suite); + +end. diff --git a/UnitTests/X2UtUnitTests.cfg b/UnitTests/X2UtUnitTests.cfg index fcec3dd..556e9fb 100644 --- a/UnitTests/X2UtUnitTests.cfg +++ b/UnitTests/X2UtUnitTests.cfg @@ -31,5 +31,10 @@ -M -$M16384,1048576 -K$00400000 --LE"c:\delphi6\Projects\Bpl" --LN"c:\delphi6\Projects\Bpl" +-LE"c:\program files\borland\delphi7\Projects\Bpl" +-LN"c:\program files\borland\delphi7\Projects\Bpl" +-w-SYMBOL_PLATFORM +-w-UNIT_PLATFORM +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST diff --git a/UnitTests/X2UtUnitTests.dof b/UnitTests/X2UtUnitTests.dof index 072d8f0..a1889c3 100644 --- a/UnitTests/X2UtUnitTests.dof +++ b/UnitTests/X2UtUnitTests.dof @@ -1,5 +1,5 @@ [FileVersion] -Version=6.0 +Version=7.0 [Compiler] A=8 B=0 @@ -30,6 +30,55 @@ Z=1 ShowHints=1 ShowWarnings=1 UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=0 +UnitLibrary=1 +UnitPlatform=0 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 [Linker] MapFile=0 OutputObjs=0 @@ -56,8 +105,12 @@ HostApplication= Launcher= UseLauncher=0 DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= [Version Info] -IncludeVerInfo=1 +IncludeVerInfo=0 AutoIncBuild=0 MajorVer=1 MinorVer=0 @@ -81,84 +134,3 @@ OriginalFilename= ProductName= ProductVersion=1.0.0.0 Comments= -[Excluded Packages] -C:\Delphi6\Bin\dcldb60.bpl=Borland Database Components -C:\Program Files\madCollection\madBasic\Delphi 6\madHelp_.bpl=madHelp 1.1 · www.madshi.net -c:\delphi6\Projects\Bpl\X2CompsD6.bpl=X²Software Components - Designtime -c:\delphi6\Projects\Bpl\VirtualTreesD6D.bpl=Virtual Treeview -c:\delphi6\Bin\dcl31w60.bpl=Delphi 1.0 Compatibility Components -c:\delphi6\Bin\dclact60.bpl=Borland ActionBar Components -c:\delphi6\Bin\applet60.bpl=Borland Control Panel Applet Package -C:\Delphi6\Bin\dbx60.bpl=Borland SQL Explorer UI Package -C:\Delphi6\Projects\Bpl\tb2k_d6.bpl=Toolbar2000 Components (Jordan Russell) -c:\delphi6\Projects\Bpl\tb2kdsgn_d6.bpl=Toolbar2000 Design Package (Jordan Russell) -c:\delphi6\Bin\DCLNMF60.bpl=NetMasters Fastnet Tools -c:\delphi6\Bin\dclado60.bpl=Borland ADO DB Components -c:\delphi6\Bin\dclclxdb60.bpl=Borland CLX Database Components -C:\Delphi6\Bin\dclclxstd60.bpl=Borland CLX Standard Components -c:\delphi6\Bin\dclie60.bpl=Internet Explorer Components -C:\Delphi6\Projects\Bpl\aSQLitepkg.bpl=Aducom Software -- SQLite RunTime Components -c:\delphi6\Projects\Bpl\asqlite.bpl=Aducom Software -- SQLite Design Time Components -c:\delphi6\Projects\Bpl\PCtrlExd6.bpl=PageControlEx -c:\delphi6\Projects\Bpl\JvCoreD6D.bpl=JVCL Core Components -c:\delphi6\Projects\Bpl\JvSystemD6D.bpl=JVCL System Components -c:\delphi6\Projects\Bpl\JvStdCtrlsD6D.bpl=JVCL Standard Controls -c:\delphi6\Projects\Bpl\JvCtrlsD6D.bpl=JVCL Visual Controls -c:\delphi6\Projects\Bpl\JvCmpD6D.bpl=JVCL Non-Visual Components -c:\delphi6\Projects\Bpl\JvCustomD6D.bpl=JVCL Custom Controls -c:\delphi6\Projects\Bpl\JvDlgsD6D.bpl=JVCL Dialog Components -c:\delphi6\Projects\Bpl\JvCryptD6D.bpl=JVCL Encryption and Compression Components -c:\delphi6\Projects\Bpl\JvMMD6D.bpl=JVCL Multimedia and Image Components -c:\delphi6\Projects\Bpl\JvNetD6D.bpl=JVCL Network Components -c:\delphi6\Projects\Bpl\JvAppFrmD6D.bpl=JVCL Application and Form Components -c:\delphi6\Projects\Bpl\JvDBD6D.bpl=JVCL Database Components -c:\delphi6\Projects\Bpl\JvBDED6D.bpl=JVCL BDE Components -c:\delphi6\Projects\Bpl\JvInterpreterD6D.bpl=JVCL Interpreter Components -c:\delphi6\Projects\Bpl\JvBandsD6D.bpl=JVCL Band Objects -c:\delphi6\Projects\Bpl\JvPluginD6D.bpl=JVCL Plugin Components -c:\delphi6\Projects\Bpl\JvJansD6D.bpl=JVCL Jans Components -c:\delphi6\Projects\Bpl\JvGlobusD6D.bpl=JVCL Globus Components -c:\delphi6\Projects\Bpl\JvPrintPreviewD6D.bpl=JVCL Print Preview Components -c:\delphi6\Projects\Bpl\JvPageCompsD6D.bpl=JVCL Page Style Components -c:\delphi6\Projects\Bpl\JvValidatorsD6D.bpl=JVCL Validators and Error Provider Components -c:\delphi6\Projects\Bpl\JvUIBD6D.bpl=JVCL Unified Interbase Components -c:\delphi6\Projects\Bpl\JvWizardD6D.bpl=JVCL Wizard Design Time Package -c:\delphi6\Projects\Bpl\JvTimeFrameworkD6D.bpl=JVCL Time Framework -c:\delphi6\Projects\Bpl\JvHMID6D.bpl=JVCL HMI Controls design time unit -c:\delphi6\Projects\Bpl\JvManagedThreadsD6D.bpl=JVCL Managed Threads -c:\delphi6\Projects\Bpl\JvXPCtrlsD6D.bpl=JVCL XP Controls -c:\delphi6\Projects\Bpl\JvDockingD6D.bpl=JVCL Docking Components -c:\delphi6\Projects\Bpl\JvDotNetCtrlsD6D.bpl=JVCL DotNet Controls -c:\delphi6\Projects\Bpl\dclIndyCore60.bpl=Indy 10 Core Design Time -c:\delphi6\Projects\Bpl\dclIndyProtocols60.bpl=Indy 10 Protocols Design Time -c:\delphi6\Projects\Bpl\SysILS.bpl=System ImageList -c:\delphi6\Projects\Bpl\DragDropD6.bpl=Drag and Drop Component Suite -C:\Projects\Components\DevExpress\OrgChart Suite\Lib\dcldxOrgCD6.bpl=ExpressOrgChart by Developer Express Inc. -C:\Projects\Components\DevExpress\OrgChart Suite\Lib\dcldxDBOrD6.bpl=ExpressDBOrgChart by Developer Express Inc. -c:\delphi6\Projects\Bpl\BalloonD6.bpl=Balloon 2.0 -c:\delphi6\Projects\Bpl\DIPasDocD6.bpl=DiPasDoc - Designtime -C:\Delphi6\Projects\Bpl\DIContainers_D6.bpl=The Delphi Inspiration -- DIContainers -c:\delphi6\Bin\dclshlctrls60.bpl=Shell Control Property and Component Editors -c:\delphi6\Bin\dclsmp60.bpl=Borland Sample Components -c:\delphi6\Bin\dclbde60.bpl=Borland BDE DB Components -c:\delphi6\Bin\dclcds60.bpl=Borland Base Cached ClientDataset Component -C:\Delphi6\Bin\dclmid60.bpl=Borland MyBase DataAccess Components -c:\delphi6\Bin\dclbdecds60.bpl=Borland Local BDE ClientDataset Components -c:\delphi6\Bin\dclib60.bpl=InterBase Data Access Components -c:\delphi6\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package -c:\delphi6\Bin\dcloffice2k60.bpl=Microsoft Office 2000 Sample Automation Server Wrapper Components -c:\delphi6\Bin\dcltee60.bpl=TeeChart Components -c:\delphi6\Bin\dcltqr60.bpl=TeeChart for QuickReport Components -c:\delphi6\Bin\dclnet60.bpl=Borland Internet Components -c:\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment -c:\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components -c:\delphi6\Bin\dclsoap60.bpl=Borland SOAP Components -c:\delphi6\Bin\dclocx60.bpl=Borland Sample Imported ActiveX Controls -c:\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components -C:\WINDOWS\System32\ibevnt60.bpl=Borland Interbase Event Alerter Component -C:\Program Files\madCollection\madRemote\Delphi 6\madRemote_.bpl=madRemote 1.1b · www.madshi.net -C:\Program Files\madCollection\madKernel\Delphi 6\madKernel_.bpl=madKernel 1.3 · www.madshi.net -C:\Program Files\madCollection\madCodeHook\Delphi 6\madCodeHook_.bpl=madCodeHook 2.1b · www.madshi.net -C:\Program Files\madCollection\madSecurity\Delphi 6\madSecurity_.bpl=madSecurity 1.1n · www.madshi.net -C:\Program Files\madCollection\madShell\Delphi 6\madShell_.bpl=madShell 1.3k · www.madshi.net -c:\delphi6\Projects\Bpl\PsychoTidyD6.bpl=PsychoTidy IDE Expert diff --git a/UnitTests/X2UtUnitTests.dpr b/UnitTests/X2UtUnitTests.dpr index 3065777..7bdbe52 100644 --- a/UnitTests/X2UtUnitTests.dpr +++ b/UnitTests/X2UtUnitTests.dpr @@ -3,7 +3,8 @@ program X2UtUnitTests; uses TestFramework, GUITestRunner, - UBits in 'Units\UBits.pas'; + UBits in 'Units\UBits.pas', + UTrees in 'Units\UTrees.pas'; begin RunRegisteredTests(); diff --git a/X2UtTrees.pas b/X2UtTrees.pas new file mode 100644 index 0000000..0f0f664 --- /dev/null +++ b/X2UtTrees.pas @@ -0,0 +1,513 @@ +{** Various tree implementations. + * + * Last changed: $Date$
+ * Revision: $Rev$
+ * Author: $Author$
+} +unit X2UtTrees; + +interface +uses + SysUtils; + +type + EBTKeyExists = class(Exception); + EBTKeyNotFound = class(Exception); + EBTCursorEof = class(Exception); + + {** Internal representation of a binary tree node. + * + * For the sake of easy lookups and cleaner code I chose to let nodes know + * who their parent is. It costs 4 bytes... but that's only 4 megabytes + * overhead for each million nodes, not much of a burden nowadays. + *} + RX2BTNode = ^PX2BTNode; + PX2BTNode = ^TX2BTNode; + TX2BTNode = record + Key: Cardinal; + Parent: PX2BTNode; + Left: PX2BTNode; + Right: PX2BTNode; + end; + + + {** Abstract cursor. + * + * Trees implement a descendant to traverse through the tree. + *} + TX2BTCustomCursor = class(TObject) + private + FRoot: RX2BTNode; + protected + function GetCurrentNode(): RX2BTNode; virtual; abstract; + function GetEof(): Boolean; virtual; abstract; + public + constructor Create(const ARoot: RX2BTNode); virtual; + + procedure First(); virtual; abstract; + procedure Next(); virtual; abstract; + + property CurrentNode: RX2BTNode read GetCurrentNode; + property Eof: Boolean read GetEof; + end; + + TX2BTCursorClass = class of TX2BTCustomCursor; + + + {** Default tree cursor. + * + * The default cursor traverses through the tree from top to bottom, left + * to right. + *} + TX2BTDefaultCursor = class(TX2BTCustomCursor) + private + FNode: RX2BTNode; + protected + function GetCurrentNode(): RX2BTNode; override; + function GetEof(): Boolean; override; + public + constructor Create(const ARoot: RX2BTNode); override; + destructor Destroy(); override; + + procedure First(); override; + procedure Next(); override; + end; + + + {** Binary Tree implementation. + * + * Implements the basic binary tree operations, allowing room for descendants + * to implement data storage and node management. + *} + TX2BinaryTree = class(TObject) + private + FCursor: TX2BTCustomCursor; + FRoot: PX2BTNode; + FLastNode: RX2BTNode; + + function GetRoot(): RX2BTNode; + function GetCurrentKey(): Cardinal; + function GetEof(): Boolean; + protected + procedure CursorNeeded(); + + property Root: RX2BTNode read GetRoot; + protected + // Methods which don't really need to be virtual + // (if you have a good reason; share it with me so I can make it + // virtual, until then it's kept normal for performance reasons) + procedure ClearNodes(); + + function FindLowestNode(const ANode: RX2BTNode): RX2BTNode; + function FindHighestNode(const ANode: RX2BTNode): RX2BTNode; + function FindNode(const AKey: Cardinal; out AParent: RX2BTNode): RX2BTNode; + function FindNodeOnly(const AKey: Cardinal): RX2BTNode; + + // Virtual methods (commonly needed in descendants) + function GetCursorClass(): TX2BTCursorClass; virtual; + + procedure AllocateNode(var ANode: PX2BTNode); virtual; + procedure DeallocateNode(var ANode: PX2BTNode); virtual; + + procedure InsertNode(const AKey: Cardinal); virtual; + procedure DeleteNode(const AKey: Cardinal); virtual; + + procedure DeleteLeafNode(const ANode: RX2BTNode); virtual; + public + constructor Create(); virtual; + destructor Destroy(); override; + + {** Removes all nodes from the tree. + *} + procedure Clear(); + + {** Checks if a key already exists within the tree. + * + * @param AKey the key to search for + * @result True if the key exists, False otherwise + *} + function Exists(const AKey: Cardinal): Boolean; + + {** Inserts a key into the tree. + * + * If a key already exists, an exception is raised. + * + * @param AKey the key for the new node + *} + procedure Insert(const AKey: Cardinal); + + {** Deletes a key from the tree. + * + * If the key could not be found, an exception is raised. + * + * @param AKey the key to delete + *} + procedure Delete(const AKey: Cardinal); + + {** Resets the cursor to the first node. + * + * Call First before iterating over all nodes. If no nodes are available, + * Eof will be set to True. + *} + procedure First(); + + {** Sets the cursor to the next node. + * + * Call Next while iterating over all nodes. If no more nodes are available, + * Eof will be set to True. + *} + procedure Next(); + + {** Returns the current key. + * + * Note: CurrentKey is only available when the cursor is valid. + *} + property CurrentKey: Cardinal read GetCurrentKey; + + {** Determines if there are more nodes available. + * + * Read Eof before accessing CurrentKey to determine if the cursor is + * positioned at a valid node. + *} + property Eof: Boolean read GetEof; + end; + +implementation +resourcestring + RSBTKeyExists = 'The key "%d" already exists in the tree.'; + RSBTKeyNotFound = 'The key "%d" could not be found in the tree.'; + RSBTCursorEof = 'Cursor is at Eof.'; + + + +{====================== TX2BTCustomCursor + Initialization +========================================} +constructor TX2BTCustomCursor.Create; +begin + inherited Create(); + + FRoot := ARoot; +end; + + +{===================== TX2BTDefaultCursor + Traversal +========================================} +constructor TX2BTDefaultCursor.Create; +begin + inherited; +end; + +destructor TX2BTDefaultCursor.Destroy; +begin + inherited; +end; + + +procedure TX2BTDefaultCursor.First; +begin + FNode := FRoot; +end; + +procedure TX2BTDefaultCursor.Next; +var + pChild: PX2BTNode; + +begin + if Eof then + raise EBTCursorEof.Create(RSBTCursorEof); + + if Assigned(FNode^^.Left) then + // Node has a left child + FNode := @FNode^^.Left + else if Assigned(FNode^^.Right) then + // Node has a right child + FNode := @FNode^^.Right + else + begin + // Traverse up the path. If we encounter a left direction, it means we + // can attempt to search the right part of that parent node. + repeat + pChild := FNode^; + FNode := @FNode^^.Parent; + + if Assigned(FNode^) then + begin + if FNode^^.Left = pChild then + begin + FNode := @FNode^^.Right; + break; + end; + end else + begin + FNode := nil; + break; + end; + until False; + end; +end; + + +function TX2BTDefaultCursor.GetCurrentNode; +begin + Result := FNode; +end; + +function TX2BTDefaultCursor.GetEof; +begin + Result := (not Assigned(FNode)) or (not Assigned(FNode^)); +end; + + +{========================== TX2BinaryTree + Initialization +========================================} +constructor TX2BinaryTree.Create; +begin + inherited; +end; + +destructor TX2BinaryTree.Destroy; +begin + ClearNodes(); + FreeAndNil(FCursor); + + inherited; +end; + + +{========================== TX2BinaryTree + Interface +========================================} +procedure TX2BinaryTree.Clear; +begin + ClearNodes(); +end; + +function TX2BinaryTree.Exists; +begin + Result := Assigned(FindNodeOnly(AKey)^); +end; + +procedure TX2BinaryTree.Insert; +begin + InsertNode(AKey); +end; + +procedure TX2BinaryTree.Delete; +begin + DeleteNode(AKey); +end; + + +procedure TX2BinaryTree.First; +begin + CursorNeeded(); + FCursor.First(); +end; + +procedure TX2BinaryTree.Next; +begin + CursorNeeded(); + FCursor.Next(); +end; + + +{========================== TX2BinaryTree + Internal node operations +========================================} +procedure TX2BinaryTree.AllocateNode; +begin + GetMem(ANode, SizeOf(TX2BTNode)); + FillChar(ANode^, SizeOf(TX2BTNode), #0); +end; + +procedure TX2BinaryTree.DeallocateNode; +begin + FreeMem(ANode, SizeOf(TX2BTNode)); + ANode := nil; +end; + + +procedure TX2BinaryTree.ClearNodes; +var + pNode: PX2BTNode; + pParent: PX2BTNode; + +begin + pNode := Root^; + + while Assigned(pNode) do + begin + if Assigned(pNode^.Left) then + // Move down on the left side + pNode := pNode^.Left + else if Assigned(pNode^.Right) then + // Move down on the right side + pNode := pNode^.Right + else + begin + // Disconnect node from parent + pParent := pNode^.Parent; + if Assigned(pParent) then + if pNode = pParent^.Left then + pParent^.Left := nil + else + pParent^.Right := nil; + + DeallocateNode(pNode); + + // Continue on the parent + if Assigned(pParent) then + pNode := pParent; + end; + end; + + FLastNode := nil; + Root^ := nil; +end; + + +function TX2BinaryTree.FindHighestNode; +begin + Result := ANode; + + while Assigned(Result^) and Assigned(Result^^.Right) do + Result := @Result^^.Right; +end; + +function TX2BinaryTree.FindLowestNode; +begin + Result := ANode; + + while Assigned(Result^) and Assigned(Result^^.Left) do + Result := @Result^^.Left; +end; + +function TX2BinaryTree.FindNode; +begin + // Quick check; was this node found previously + if Assigned(FLastNode) and Assigned(FLastNode^) and + (FLastNode^^.Key = AKey) then + begin + Result := FLastNode; + exit; + end; + + AParent := nil; + FLastNode := nil; + + Result := Root; + while Assigned(Result^) do + if AKey = Result^^.Key then + break + else + begin + AParent := Result; + + if AKey < Result^^.Key then + Result := @Result^^.Left + else + Result := @Result^^.Right; + end; + + if Assigned(Result^) then + FLastNode := Result; +end; + +function TX2BinaryTree.FindNodeOnly; +var + pDummy: RX2BTNode; + +begin + Result := FindNode(AKey, pDummy); +end; + + +procedure TX2BinaryTree.InsertNode; +var + pNode: RX2BTNode; + pParent: RX2BTNode; + +begin + pNode := FindNode(AKey, pParent); + if Assigned(pNode^) then + raise EBTKeyExists.CreateFmt(RSBTKeyExists, [AKey]); + + AllocateNode(pNode^); + FLastNode := pNode; + pNode^^.Key := AKey; + + if Assigned(pParent) then + pNode^^.Parent := pParent^; +end; + +procedure TX2BinaryTree.DeleteNode; +var + pNode: RX2BTNode; + +begin + //! Implement DeleteNode + pNode := FindNodeOnly(AKey); + if not Assigned(pNode^) then + raise EBTKeyNotFound.CreateFmt(RSBTKeyNotFound, [AKey]); + + // If the node to be deleted has either one or no branch, it can simply be + // taken out of the chain. If it has two branches, find the lowest key on + // the right branch and swap it. + // + // Ex. delete 7 from the tree: + // + // 8 8 + // 7 <-+ 4 + // 2 5 | >>> 2 5 + // 1 3 4 6 | 1 3 6 + // +----+ + if Assigned(pNode^^.Left) and Assigned(pNode^^.Right) then + begin + + end; + + // At this point, the node is a leaf node or has only one branch + DeleteLeafNode(pNode); +end; + +procedure TX2BinaryTree.DeleteLeafNode; +begin + //! Implement DeleteLeafNode +end; + + +procedure TX2BinaryTree.CursorNeeded; +begin + if not Assigned(FCursor) then + FCursor := GetCursorClass().Create(Root); +end; + + +function TX2BinaryTree.GetCursorClass; +begin + Result := TX2BTDefaultCursor; +end; + + +function TX2BinaryTree.GetRoot; +begin + Result := @FRoot; +end; + +function TX2BinaryTree.GetCurrentKey; +begin + if Eof then + raise EBTCursorEof.Create(RSBTCursorEof); + + Result := FCursor.CurrentNode^^.Key; +end; + +function TX2BinaryTree.GetEof; +begin + Result := Assigned(FCursor) and (FCursor.Eof); +end; + +end.