* implemented some usefull custom variant types * fixed memleak in uutlGenericsmaster
| @@ -11,7 +11,7 @@ | |||
| <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> | |||
| </SearchPaths> | |||
| </CompilerOptions> | |||
| <Files Count="26"> | |||
| <Files Count="31"> | |||
| <Item1> | |||
| <Filename Value="uutlAlgorithm.pas"/> | |||
| <UnitName Value="uutlAlgorithm"/> | |||
| @@ -116,6 +116,26 @@ | |||
| <Filename Value="uutlXmlHelper.pas"/> | |||
| <UnitName Value="uutlXmlHelper"/> | |||
| </Item26> | |||
| <Item27> | |||
| <Filename Value="uutlStored.pas"/> | |||
| <UnitName Value="uutlStored"/> | |||
| </Item27> | |||
| <Item28> | |||
| <Filename Value="uutlVariantObject.pas"/> | |||
| <UnitName Value="uutlVariantObject"/> | |||
| </Item28> | |||
| <Item29> | |||
| <Filename Value="uutlVariantProperty.pas"/> | |||
| <UnitName Value="uutlVariantProperty"/> | |||
| </Item29> | |||
| <Item30> | |||
| <Filename Value="uutlVariantEnum.pas"/> | |||
| <UnitName Value="uutlVariantEnum"/> | |||
| </Item30> | |||
| <Item31> | |||
| <Filename Value="uutlVariantSet.pas"/> | |||
| <UnitName Value="uutlVariantSet"/> | |||
| </Item31> | |||
| </Files> | |||
| <RequiredPkgs Count="2"> | |||
| <Item1> | |||
| @@ -11,7 +11,8 @@ uses | |||
| uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlCompression, uutlEmbeddedProfiler, uutlEnumerator, | |||
| uutlEvent, uutlEventManager, uutlFilter, uutlGenerics, uutlInterfaces, uutlKeyCodes, uutlLinq, uutlListBase, | |||
| uutlLogger, uutlMCF, uutlObservable, uutlSScanf, uutlStreamHelper, uutlSyncObjs, uutlThreads, uutlTypes, | |||
| uutlXmlHelper, LazarusPackageIntf; | |||
| uutlXmlHelper, uutlStored, uutlVariantObject, uutlVariantProperty, uutlVariantEnum, uutlVariantSet, | |||
| LazarusPackageIntf; | |||
| implementation | |||
| @@ -33,7 +33,7 @@ | |||
| <PackageName Value="FCL"/> | |||
| </Item3> | |||
| </RequiredPackages> | |||
| <Units Count="38"> | |||
| <Units Count="40"> | |||
| <Unit0> | |||
| <Filename Value="tests.lpr"/> | |||
| <IsPartOfProject Value="True"/> | |||
| @@ -186,6 +186,14 @@ | |||
| <Filename Value="uutlSetHelperTests.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| </Unit37> | |||
| <Unit38> | |||
| <Filename Value="uutlVariantEnumTest.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| </Unit38> | |||
| <Unit39> | |||
| <Filename Value="uutlVariantSetTest.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| </Unit39> | |||
| </Units> | |||
| </ProjectOptions> | |||
| <CompilerOptions> | |||
| @@ -15,9 +15,9 @@ uses | |||
| uTestHelper, | |||
| // units unter test | |||
| uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlEnumerator, | |||
| uutlFilter, uutlGenerics, uutlInterfaces, uutlLinq, uutlListBase, uutlLogger, | |||
| uutlStreamHelper, uutlSyncObjs, uutlTypes, uutlXmlHelper, uutlObservable, uutlSetHelperTests; | |||
| uutlAlgorithm, uutlArrayContainer, uutlCommon, uutlComparer, uutlEnumerator, uutlFilter, uutlGenerics, uutlInterfaces, | |||
| uutlLinq, uutlListBase, uutlLogger, uutlStreamHelper, uutlSyncObjs, uutlTypes, uutlXmlHelper, uutlObservable, | |||
| uutlSetHelperTests, uutlVariantEnumTest, uutlVariantSetTest; | |||
| {$R *.res} | |||
| @@ -4,21 +4,29 @@ | |||
| <PathDelim Value="\"/> | |||
| <Version Value="10"/> | |||
| <BuildModes Active="Default"/> | |||
| <Units Count="68"> | |||
| <Units Count="82"> | |||
| <Unit0> | |||
| <Filename Value="tests.lpr"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="54" Y="12"/> | |||
| <UsageCount Value="81"/> | |||
| <EditorIndex Value="10"/> | |||
| <CursorPos Y="5"/> | |||
| <UsageCount Value="92"/> | |||
| <Loaded Value="True"/> | |||
| </Unit0> | |||
| <Unit1> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="7"/> | |||
| <TopLine Value="1003"/> | |||
| <CursorPos Y="1021"/> | |||
| <UsageCount Value="81"/> | |||
| <TopLine Value="1897"/> | |||
| <CursorPos X="3" Y="1900"/> | |||
| <ExtraEditorCount Value="1"/> | |||
| <ExtraEditor1> | |||
| <EditorIndex Value="2"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="2008"/> | |||
| <CursorPos Y="2043"/> | |||
| </ExtraEditor1> | |||
| <UsageCount Value="92"/> | |||
| <Loaded Value="True"/> | |||
| </Unit1> | |||
| <Unit2> | |||
| @@ -26,32 +34,32 @@ | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="11" Y="13"/> | |||
| <UsageCount Value="81"/> | |||
| <UsageCount Value="92"/> | |||
| </Unit2> | |||
| <Unit3> | |||
| <Filename Value="..\uutlCommon.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="206"/> | |||
| <CursorPos X="10" Y="225"/> | |||
| <UsageCount Value="81"/> | |||
| <EditorIndex Value="8"/> | |||
| <TopLine Value="264"/> | |||
| <CursorPos X="29" Y="283"/> | |||
| <UsageCount Value="92"/> | |||
| <Loaded Value="True"/> | |||
| </Unit3> | |||
| <Unit4> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="100"/> | |||
| <CursorPos X="72" Y="113"/> | |||
| <UsageCount Value="81"/> | |||
| <Loaded Value="True"/> | |||
| <UsageCount Value="92"/> | |||
| </Unit4> | |||
| <Unit5> | |||
| <Filename Value="uutlListTest.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="3"/> | |||
| <TopLine Value="573"/> | |||
| <CursorPos Y="588"/> | |||
| <UsageCount Value="81"/> | |||
| <Loaded Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="50"/> | |||
| <CursorPos X="3" Y="65"/> | |||
| <UsageCount Value="92"/> | |||
| </Unit5> | |||
| <Unit6> | |||
| <Filename Value="uutlQueueTests.pas"/> | |||
| @@ -59,7 +67,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="250"/> | |||
| <CursorPos X="49" Y="260"/> | |||
| <UsageCount Value="81"/> | |||
| <UsageCount Value="92"/> | |||
| </Unit6> | |||
| <Unit7> | |||
| <Filename Value="uutlStackTests.pas"/> | |||
| @@ -67,22 +75,23 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="246"/> | |||
| <CursorPos X="24" Y="263"/> | |||
| <UsageCount Value="81"/> | |||
| <UsageCount Value="92"/> | |||
| </Unit7> | |||
| <Unit8> | |||
| <Filename Value="uTestHelper.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="4"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="3" Y="12"/> | |||
| <UsageCount Value="81"/> | |||
| <Loaded Value="True"/> | |||
| <UsageCount Value="92"/> | |||
| </Unit8> | |||
| <Unit9> | |||
| <Filename Value="..\uutlComparer.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="90" Y="6"/> | |||
| <UsageCount Value="71"/> | |||
| <EditorIndex Value="9"/> | |||
| <TopLine Value="174"/> | |||
| <CursorPos X="10" Y="190"/> | |||
| <UsageCount Value="82"/> | |||
| <Loaded Value="True"/> | |||
| </Unit9> | |||
| <Unit10> | |||
| <Filename Value="..\uutlAlgorithm.pas"/> | |||
| @@ -90,14 +99,14 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="138"/> | |||
| <CursorPos Y="153"/> | |||
| <UsageCount Value="81"/> | |||
| <UsageCount Value="92"/> | |||
| </Unit10> | |||
| <Unit11> | |||
| <Filename Value="uutlHashSetTests.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="32" Y="13"/> | |||
| <UsageCount Value="81"/> | |||
| <UsageCount Value="92"/> | |||
| </Unit11> | |||
| <Unit12> | |||
| <Filename Value="uutlAlgorithmTests.pas"/> | |||
| @@ -105,7 +114,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="72"/> | |||
| <CursorPos X="43" Y="87"/> | |||
| <UsageCount Value="80"/> | |||
| <UsageCount Value="91"/> | |||
| </Unit12> | |||
| <Unit13> | |||
| <Filename Value="uutlMapTests.pas"/> | |||
| @@ -113,15 +122,15 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="206"/> | |||
| <CursorPos X="66" Y="221"/> | |||
| <UsageCount Value="79"/> | |||
| <UsageCount Value="90"/> | |||
| </Unit13> | |||
| <Unit14> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="1"/> | |||
| <TopLine Value="90"/> | |||
| <CursorPos X="5" Y="105"/> | |||
| <UsageCount Value="78"/> | |||
| <EditorIndex Value="12"/> | |||
| <TopLine Value="325"/> | |||
| <CursorPos X="42" Y="341"/> | |||
| <UsageCount Value="89"/> | |||
| <Loaded Value="True"/> | |||
| </Unit14> | |||
| <Unit15> | |||
| @@ -130,7 +139,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="615"/> | |||
| <CursorPos X="34" Y="631"/> | |||
| <UsageCount Value="78"/> | |||
| <UsageCount Value="89"/> | |||
| </Unit15> | |||
| <Unit16> | |||
| <Filename Value="..\uutlFilter.pas"/> | |||
| @@ -138,16 +147,15 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="17"/> | |||
| <CursorPos X="13" Y="159"/> | |||
| <UsageCount Value="74"/> | |||
| <UsageCount Value="85"/> | |||
| </Unit16> | |||
| <Unit17> | |||
| <Filename Value="..\uutlInterfaces.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="2"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="34"/> | |||
| <CursorPos X="5" Y="40"/> | |||
| <UsageCount Value="74"/> | |||
| <Loaded Value="True"/> | |||
| <UsageCount Value="85"/> | |||
| </Unit17> | |||
| <Unit18> | |||
| <Filename Value="..\uutlLinq.pas"/> | |||
| @@ -155,7 +163,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="391"/> | |||
| <CursorPos X="31" Y="417"/> | |||
| <UsageCount Value="65"/> | |||
| <UsageCount Value="76"/> | |||
| </Unit18> | |||
| <Unit19> | |||
| <Filename Value="uutlLinqTests.pas"/> | |||
| @@ -163,13 +171,13 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="622"/> | |||
| <CursorPos X="23" Y="650"/> | |||
| <UsageCount Value="65"/> | |||
| <UsageCount Value="76"/> | |||
| </Unit19> | |||
| <Unit20> | |||
| <Filename Value="..\uutlTypes.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <UsageCount Value="65"/> | |||
| <UsageCount Value="76"/> | |||
| </Unit20> | |||
| <Unit21> | |||
| <Filename Value="..\uutlSyncObjs.pas"/> | |||
| @@ -177,7 +185,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="241"/> | |||
| <CursorPos X="20" Y="263"/> | |||
| <UsageCount Value="59"/> | |||
| <UsageCount Value="70"/> | |||
| </Unit21> | |||
| <Unit22> | |||
| <Filename Value="..\uutlLogger.pas"/> | |||
| @@ -185,7 +193,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="419"/> | |||
| <CursorPos X="55" Y="434"/> | |||
| <UsageCount Value="57"/> | |||
| <UsageCount Value="68"/> | |||
| </Unit22> | |||
| <Unit23> | |||
| <Filename Value="..\uutlXmlHelper.pas"/> | |||
| @@ -193,7 +201,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="188"/> | |||
| <CursorPos X="26" Y="203"/> | |||
| <UsageCount Value="58"/> | |||
| <UsageCount Value="69"/> | |||
| </Unit23> | |||
| <Unit24> | |||
| <Filename Value="..\uutlStreamHelper.pas"/> | |||
| @@ -201,7 +209,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="216"/> | |||
| <CursorPos X="10" Y="241"/> | |||
| <UsageCount Value="57"/> | |||
| <UsageCount Value="68"/> | |||
| </Unit24> | |||
| <Unit25> | |||
| <Filename Value="..\uutlCompression.pas"/> | |||
| @@ -210,7 +218,7 @@ | |||
| <WindowIndex Value="-1"/> | |||
| <TopLine Value="-1"/> | |||
| <CursorPos X="-1" Y="-1"/> | |||
| <UsageCount Value="57"/> | |||
| <UsageCount Value="68"/> | |||
| </Unit25> | |||
| <Unit26> | |||
| <Filename Value="..\uutlEmbeddedProfiler.pas"/> | |||
| @@ -219,7 +227,7 @@ | |||
| <WindowIndex Value="-1"/> | |||
| <TopLine Value="-1"/> | |||
| <CursorPos X="-1" Y="-1"/> | |||
| <UsageCount Value="57"/> | |||
| <UsageCount Value="68"/> | |||
| </Unit26> | |||
| <Unit27> | |||
| <Filename Value="..\uutlKeyCodes.pas"/> | |||
| @@ -228,7 +236,7 @@ | |||
| <WindowIndex Value="-1"/> | |||
| <TopLine Value="-1"/> | |||
| <CursorPos X="-1" Y="-1"/> | |||
| <UsageCount Value="57"/> | |||
| <UsageCount Value="68"/> | |||
| </Unit27> | |||
| <Unit28> | |||
| <Filename Value="..\uutlMCF.pas"/> | |||
| @@ -237,7 +245,7 @@ | |||
| <WindowIndex Value="-1"/> | |||
| <TopLine Value="-1"/> | |||
| <CursorPos X="-1" Y="-1"/> | |||
| <UsageCount Value="57"/> | |||
| <UsageCount Value="68"/> | |||
| </Unit28> | |||
| <Unit29> | |||
| <Filename Value="..\uutlSScanf.pas"/> | |||
| @@ -246,7 +254,7 @@ | |||
| <WindowIndex Value="-1"/> | |||
| <TopLine Value="-1"/> | |||
| <CursorPos X="-1" Y="-1"/> | |||
| <UsageCount Value="57"/> | |||
| <UsageCount Value="68"/> | |||
| </Unit29> | |||
| <Unit30> | |||
| <Filename Value="..\uutlThreads.pas"/> | |||
| @@ -255,14 +263,14 @@ | |||
| <WindowIndex Value="-1"/> | |||
| <TopLine Value="-1"/> | |||
| <CursorPos X="-1" Y="-1"/> | |||
| <UsageCount Value="57"/> | |||
| <UsageCount Value="68"/> | |||
| </Unit30> | |||
| <Unit31> | |||
| <Filename Value="..\uutlEvent.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="11" Y="35"/> | |||
| <UsageCount Value="56"/> | |||
| <UsageCount Value="67"/> | |||
| </Unit31> | |||
| <Unit32> | |||
| <Filename Value="..\uutlEventManager.pas"/> | |||
| @@ -270,7 +278,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="246"/> | |||
| <CursorPos X="39" Y="264"/> | |||
| <UsageCount Value="56"/> | |||
| <UsageCount Value="67"/> | |||
| </Unit32> | |||
| <Unit33> | |||
| <Filename Value="..\uutlObservable.pas"/> | |||
| @@ -278,7 +286,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="556"/> | |||
| <CursorPos X="45" Y="572"/> | |||
| <UsageCount Value="56"/> | |||
| <UsageCount Value="67"/> | |||
| </Unit33> | |||
| <Unit34> | |||
| <Filename Value="uutlObservableListTests.pas"/> | |||
| @@ -286,7 +294,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="36"/> | |||
| <CursorPos X="53" Y="52"/> | |||
| <UsageCount Value="48"/> | |||
| <UsageCount Value="59"/> | |||
| </Unit34> | |||
| <Unit35> | |||
| <Filename Value="uutlObservableHashSetTests.pas"/> | |||
| @@ -294,7 +302,7 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="46"/> | |||
| <CursorPos X="25" Y="62"/> | |||
| <UsageCount Value="28"/> | |||
| <UsageCount Value="39"/> | |||
| </Unit35> | |||
| <Unit36> | |||
| <Filename Value="uutlObservableMapTests.pas"/> | |||
| @@ -302,360 +310,462 @@ | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="46"/> | |||
| <CursorPos X="22" Y="51"/> | |||
| <UsageCount Value="27"/> | |||
| <UsageCount Value="38"/> | |||
| </Unit36> | |||
| <Unit37> | |||
| <Filename Value="uutlSetHelperTests.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="44"/> | |||
| <CursorPos X="64" Y="54"/> | |||
| <UsageCount Value="24"/> | |||
| <EditorIndex Value="11"/> | |||
| <TopLine Value="45"/> | |||
| <CursorPos Y="67"/> | |||
| <UsageCount Value="35"/> | |||
| <Loaded Value="True"/> | |||
| </Unit37> | |||
| <Unit38> | |||
| <Filename Value="uutlVariantEnumTest.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="3"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="30"/> | |||
| <CursorPos X="62" Y="34"/> | |||
| <UsageCount Value="31"/> | |||
| <Loaded Value="True"/> | |||
| </Unit38> | |||
| <Unit39> | |||
| <Filename Value="..\uutlExceptions.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="21" Y="3"/> | |||
| <UsageCount Value="32"/> | |||
| </Unit38> | |||
| <Unit39> | |||
| </Unit39> | |||
| <Unit40> | |||
| <Filename Value="_uutlInterfaces.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="42" Y="6"/> | |||
| <UsageCount Value="33"/> | |||
| </Unit39> | |||
| <Unit40> | |||
| </Unit40> | |||
| <Unit41> | |||
| <Filename Value="uutlArrayTests.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="9"/> | |||
| <CursorPos X="25" Y="38"/> | |||
| <UsageCount Value="32"/> | |||
| </Unit40> | |||
| <Unit41> | |||
| </Unit41> | |||
| <Unit42> | |||
| <Filename Value="..\uutlGenerics2.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <WindowIndex Value="-1"/> | |||
| <TopLine Value="1902"/> | |||
| <CursorPos Y="1905"/> | |||
| <UsageCount Value="7"/> | |||
| </Unit41> | |||
| <Unit42> | |||
| </Unit42> | |||
| <Unit43> | |||
| <Filename Value="..\uutlCommon2.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="9"/> | |||
| <CursorPos X="15" Y="26"/> | |||
| <UsageCount Value="7"/> | |||
| </Unit42> | |||
| <Unit43> | |||
| </Unit43> | |||
| <Unit44> | |||
| <Filename Value="uutlInterfaces2.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="49"/> | |||
| <CursorPos X="35" Y="60"/> | |||
| <UsageCount Value="7"/> | |||
| </Unit43> | |||
| <Unit44> | |||
| </Unit44> | |||
| <Unit45> | |||
| <Filename Value="..\uutlAlgorithm2.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="66"/> | |||
| <CursorPos X="5" Y="93"/> | |||
| <UsageCount Value="7"/> | |||
| </Unit44> | |||
| <Unit45> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\objpas.pp"/> | |||
| </Unit45> | |||
| <Unit46> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\objpas.pp"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="63"/> | |||
| <CursorPos X="20" Y="75"/> | |||
| <UsageCount Value="15"/> | |||
| </Unit45> | |||
| <Unit46> | |||
| </Unit46> | |||
| <Unit47> | |||
| <Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlAlgorithm.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="48"/> | |||
| <CursorPos X="45" Y="56"/> | |||
| <UsageCount Value="7"/> | |||
| </Unit46> | |||
| <Unit47> | |||
| </Unit47> | |||
| <Unit48> | |||
| <Filename Value="..\uutlEnumerator2.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="126"/> | |||
| <CursorPos X="22" Y="128"/> | |||
| <UsageCount Value="6"/> | |||
| </Unit47> | |||
| <Unit48> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
| </Unit48> | |||
| <Unit49> | |||
| <Filename Value="..\..\..\components\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="54"/> | |||
| <CursorPos Y="69"/> | |||
| <UsageCount Value="16"/> | |||
| </Unit48> | |||
| <Unit49> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\TestFramework.pas"/> | |||
| </Unit49> | |||
| <Unit50> | |||
| <Filename Value="..\..\..\components\fptest\src\TestFramework.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="2243"/> | |||
| <CursorPos Y="2258"/> | |||
| <UsageCount Value="10"/> | |||
| </Unit49> | |||
| <Unit50> | |||
| </Unit50> | |||
| <Unit51> | |||
| <Filename Value="..\internal_uutlInterfaces.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos Y="11"/> | |||
| <UsageCount Value="6"/> | |||
| </Unit50> | |||
| <Unit51> | |||
| </Unit51> | |||
| <Unit52> | |||
| <Filename Value="..\uutlUtils.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="46" Y="3"/> | |||
| <UsageCount Value="7"/> | |||
| </Unit51> | |||
| <Unit52> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\classes\classesh.inc"/> | |||
| </Unit52> | |||
| <Unit53> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\classes\classesh.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="118"/> | |||
| <CursorPos X="3" Y="143"/> | |||
| <UsageCount Value="13"/> | |||
| </Unit52> | |||
| <Unit53> | |||
| </Unit53> | |||
| <Unit54> | |||
| <Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlCommon.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="474"/> | |||
| <CursorPos X="16" Y="500"/> | |||
| <UsageCount Value="9"/> | |||
| </Unit53> | |||
| <Unit54> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\ascdef.inc"/> | |||
| </Unit54> | |||
| <Unit55> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\ascdef.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="202"/> | |||
| <CursorPos X="10" Y="217"/> | |||
| <UsageCount Value="8"/> | |||
| </Unit54> | |||
| <Unit55> | |||
| </Unit55> | |||
| <Unit56> | |||
| <Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlSyncObjs.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="64"/> | |||
| <CursorPos X="13" Y="76"/> | |||
| <UsageCount Value="14"/> | |||
| </Unit55> | |||
| <Unit56> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\sysutilh.inc"/> | |||
| </Unit56> | |||
| <Unit57> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\sysutils\sysutilh.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="83"/> | |||
| <CursorPos X="4" Y="98"/> | |||
| <UsageCount Value="14"/> | |||
| </Unit56> | |||
| <Unit57> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\func.inc"/> | |||
| </Unit57> | |||
| <Unit58> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\func.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="244"/> | |||
| <CursorPos X="10" Y="259"/> | |||
| <UsageCount Value="9"/> | |||
| </Unit57> | |||
| <Unit58> | |||
| </Unit58> | |||
| <Unit59> | |||
| <Filename Value="G:\Eigene Datein\Projekte\_Active Projekte\TotoStarRedesign\utils\uutlXmlHelper.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <CursorPos X="29" Y="30"/> | |||
| <UsageCount Value="8"/> | |||
| </Unit58> | |||
| <Unit59> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\packages\fcl-base\src\contnrs.pp"/> | |||
| </Unit59> | |||
| <Unit60> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\packages\fcl-base\src\contnrs.pp"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="136"/> | |||
| <CursorPos X="3" Y="151"/> | |||
| <UsageCount Value="9"/> | |||
| </Unit59> | |||
| <Unit60> | |||
| </Unit60> | |||
| <Unit61> | |||
| <Filename Value="..\uutlEmbeddedProfiler.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <WindowIndex Value="-1"/> | |||
| <TopLine Value="-1"/> | |||
| <CursorPos X="-1" Y="-1"/> | |||
| <UsageCount Value="19"/> | |||
| </Unit60> | |||
| <Unit61> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\inc\objpash.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="190"/> | |||
| <CursorPos X="23" Y="205"/> | |||
| <UsageCount Value="14"/> | |||
| </Unit61> | |||
| <Unit62> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\osutilsh.inc"/> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\inc\objpash.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="248"/> | |||
| <CursorPos X="8" Y="264"/> | |||
| <UsageCount Value="15"/> | |||
| </Unit62> | |||
| <Unit63> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\sysutils\osutilsh.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="40"/> | |||
| <CursorPos X="3" Y="62"/> | |||
| <UsageCount Value="12"/> | |||
| </Unit62> | |||
| <Unit63> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\struct.inc"/> | |||
| </Unit63> | |||
| <Unit64> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\struct.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="5662"/> | |||
| <CursorPos X="8" Y="5677"/> | |||
| <UsageCount Value="11"/> | |||
| </Unit63> | |||
| <Unit64> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\win\wininc\base.inc"/> | |||
| </Unit64> | |||
| <Unit65> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\win\wininc\base.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="448"/> | |||
| <CursorPos X="12" Y="463"/> | |||
| <UsageCount Value="11"/> | |||
| </Unit64> | |||
| <Unit65> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
| <EditorIndex Value="5"/> | |||
| <TopLine Value="158"/> | |||
| <CursorPos Y="185"/> | |||
| <UsageCount Value="11"/> | |||
| <Loaded Value="True"/> | |||
| </Unit65> | |||
| <Unit66> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
| <IsVisibleTab Value="True"/> | |||
| <EditorIndex Value="8"/> | |||
| <TopLine Value="3311"/> | |||
| <CursorPos X="30" Y="3325"/> | |||
| <UsageCount Value="11"/> | |||
| <Loaded Value="True"/> | |||
| <Filename Value="..\..\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="53"/> | |||
| <CursorPos X="35" Y="66"/> | |||
| <UsageCount Value="12"/> | |||
| </Unit66> | |||
| <Unit67> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFrameworkIfaces.pas"/> | |||
| <EditorIndex Value="6"/> | |||
| <Filename Value="..\..\fptest\src\TestFramework.pas"/> | |||
| <EditorIndex Value="1"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="2786"/> | |||
| <CursorPos Y="2808"/> | |||
| <UsageCount Value="14"/> | |||
| <Loaded Value="True"/> | |||
| </Unit67> | |||
| <Unit68> | |||
| <Filename Value="..\..\fptest\src\TestFrameworkIfaces.pas"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="35"/> | |||
| <CursorPos X="3" Y="51"/> | |||
| <UsageCount Value="10"/> | |||
| </Unit68> | |||
| <Unit69> | |||
| <Filename Value="..\uutlVariantEnum.pas"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="81"/> | |||
| <CursorPos X="34" Y="105"/> | |||
| <UsageCount Value="16"/> | |||
| <Loaded Value="True"/> | |||
| </Unit67> | |||
| </Unit69> | |||
| <Unit70> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\variants.pp"/> | |||
| <EditorIndex Value="5"/> | |||
| <UsageCount Value="14"/> | |||
| <Loaded Value="True"/> | |||
| </Unit70> | |||
| <Unit71> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\inc\varianth.inc"/> | |||
| <EditorIndex Value="6"/> | |||
| <TopLine Value="114"/> | |||
| <CursorPos X="27" Y="136"/> | |||
| <UsageCount Value="13"/> | |||
| <Loaded Value="True"/> | |||
| </Unit71> | |||
| <Unit72> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\inc\variant.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <UsageCount Value="11"/> | |||
| </Unit72> | |||
| <Unit73> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\rtl\objpas\sysconst.pp"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="107"/> | |||
| <CursorPos X="3" Y="123"/> | |||
| <UsageCount Value="11"/> | |||
| </Unit73> | |||
| <Unit74> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\varutilh.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="43"/> | |||
| <CursorPos X="10" Y="59"/> | |||
| <UsageCount Value="11"/> | |||
| </Unit74> | |||
| <Unit75> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\cvarutil.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="258"/> | |||
| <CursorPos X="41" Y="272"/> | |||
| <UsageCount Value="11"/> | |||
| </Unit75> | |||
| <Unit76> | |||
| <Filename Value="..\..\..\fpc\3.1.1\source\packages\rtl-objpas\src\inc\varerror.inc"/> | |||
| <EditorIndex Value="-1"/> | |||
| <TopLine Value="2"/> | |||
| <CursorPos X="3" Y="23"/> | |||
| <UsageCount Value="11"/> | |||
| </Unit76> | |||
| <Unit77> | |||
| <Filename Value="..\uutlVariantSet.pas"/> | |||
| <TopLine Value="80"/> | |||
| <CursorPos X="36" Y="95"/> | |||
| <UsageCount Value="14"/> | |||
| <Loaded Value="True"/> | |||
| </Unit77> | |||
| <Unit78> | |||
| <Filename Value="..\uutlVariantObject.pas"/> | |||
| <EditorIndex Value="1"/> | |||
| <UsageCount Value="12"/> | |||
| <Loaded Value="True"/> | |||
| </Unit78> | |||
| <Unit79> | |||
| <Filename Value="..\uutlVariantProperty.pas"/> | |||
| <EditorIndex Value="4"/> | |||
| <TopLine Value="24"/> | |||
| <UsageCount Value="12"/> | |||
| <Loaded Value="True"/> | |||
| </Unit79> | |||
| <Unit80> | |||
| <Filename Value="uutlVariantSetTest.pas"/> | |||
| <IsPartOfProject Value="True"/> | |||
| <EditorIndex Value="2"/> | |||
| <TopLine Value="17"/> | |||
| <CursorPos Y="43"/> | |||
| <UsageCount Value="22"/> | |||
| <Loaded Value="True"/> | |||
| </Unit80> | |||
| <Unit81> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <IsVisibleTab Value="True"/> | |||
| <EditorIndex Value="3"/> | |||
| <TopLine Value="1726"/> | |||
| <CursorPos X="16" Y="1749"/> | |||
| <ExtraEditorCount Value="1"/> | |||
| <ExtraEditor1> | |||
| <IsVisibleTab Value="True"/> | |||
| <EditorIndex Value="4"/> | |||
| <WindowIndex Value="1"/> | |||
| <TopLine Value="1480"/> | |||
| <CursorPos X="85" Y="1507"/> | |||
| </ExtraEditor1> | |||
| <UsageCount Value="10"/> | |||
| <Loaded Value="True"/> | |||
| </Unit81> | |||
| </Units> | |||
| <OtherDefines Count="3"> | |||
| <Define0 Value="UTL_ADVANCED_ENUMERATORS"/> | |||
| <Define1 Value="UTL_NESTED_PROCVARS"/> | |||
| <Define2 Value="UTL_ENUMERATORS"/> | |||
| </OtherDefines> | |||
| <JumpHistory Count="30" HistoryIndex="29"> | |||
| <JumpHistory Count="28" HistoryIndex="27"> | |||
| <Position1> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <Caret Line="139" TopLine="119"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="1433" Column="6" TopLine="1416"/> | |||
| </Position1> | |||
| <Position2> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <Caret Line="143" TopLine="119"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="395" Column="20" TopLine="368"/> | |||
| </Position2> | |||
| <Position3> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <Caret Line="135" Column="35" TopLine="119"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="1732" Column="18" TopLine="1723"/> | |||
| </Position3> | |||
| <Position4> | |||
| <Filename Value="uutlListTest.pas"/> | |||
| <Caret Line="612" Column="42" TopLine="594"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="1733" Column="32" TopLine="1723"/> | |||
| </Position4> | |||
| <Position5> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <Caret Line="105" TopLine="89"/> | |||
| <Filename Value="..\uutlVariantSet.pas"/> | |||
| <Caret Line="16" Column="73"/> | |||
| </Position5> | |||
| <Position6> | |||
| <Filename Value="uutlListTest.pas"/> | |||
| <Caret Line="625" TopLine="610"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="1733" Column="32" TopLine="1723"/> | |||
| </Position6> | |||
| <Position7> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
| <Caret Line="184" TopLine="158"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="1727" Column="33" TopLine="1723"/> | |||
| </Position7> | |||
| <Position8> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
| <Caret Line="3327" TopLine="3306"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="620" Column="31" TopLine="605"/> | |||
| </Position8> | |||
| <Position9> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
| <Caret Line="3329" TopLine="3306"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="549" Column="57" TopLine="533"/> | |||
| </Position9> | |||
| <Position10> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
| <Caret Line="3332" TopLine="3306"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="584" Column="50" TopLine="563"/> | |||
| </Position10> | |||
| <Position11> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
| <Caret Line="3333" TopLine="3307"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="561" Column="36" TopLine="546"/> | |||
| </Position11> | |||
| <Position12> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
| <Caret Line="3335" TopLine="3309"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="2044" Column="12" TopLine="2023"/> | |||
| </Position12> | |||
| <Position13> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\TestFramework.pas"/> | |||
| <Caret Line="3337" TopLine="3311"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="629" Column="23" TopLine="597"/> | |||
| </Position13> | |||
| <Position14> | |||
| <Filename Value="C:\Zusatzprogramme\Lazarus\components_extra\fptest\src\FPCUnitCompatibleInterface.inc"/> | |||
| <Caret Line="185" TopLine="158"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="1917" Column="12" TopLine="1901"/> | |||
| </Position14> | |||
| <Position15> | |||
| <Filename Value="uutlListTest.pas"/> | |||
| <Caret Line="626" TopLine="610"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="1926" Column="27" TopLine="1899"/> | |||
| </Position15> | |||
| <Position16> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <Caret Line="396" TopLine="380"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="1917" Column="17" TopLine="1901"/> | |||
| </Position16> | |||
| <Position17> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <Caret Line="397" TopLine="380"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="2000" Column="3" TopLine="1997"/> | |||
| </Position17> | |||
| <Position18> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <Caret Line="398" TopLine="380"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="1971" Column="27" TopLine="1949"/> | |||
| </Position18> | |||
| <Position19> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <Caret Line="402" TopLine="380"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="1989" Column="13" TopLine="1968"/> | |||
| </Position19> | |||
| <Position20> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <Caret Line="403" TopLine="380"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="561" Column="11" TopLine="553"/> | |||
| </Position20> | |||
| <Position21> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <Caret Line="405" TopLine="380"/> | |||
| <Filename Value="..\uutlGenerics.pas"/> | |||
| <Caret Line="1900" Column="3" TopLine="1897"/> | |||
| </Position21> | |||
| <Position22> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <Caret Line="407" TopLine="381"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="1730" Column="2" TopLine="1723"/> | |||
| </Position22> | |||
| <Position23> | |||
| <Filename Value="uutlListTest.pas"/> | |||
| <Caret Line="627" TopLine="610"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="1769" Column="17" TopLine="1758"/> | |||
| </Position23> | |||
| <Position24> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <Caret Line="103" TopLine="89"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="1426" Column="25" TopLine="1410"/> | |||
| </Position24> | |||
| <Position25> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <Caret Line="104" TopLine="89"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="1774" Column="4" TopLine="1752"/> | |||
| </Position25> | |||
| <Position26> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <Caret Line="400" Column="28" TopLine="381"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="398" Column="15" TopLine="373"/> | |||
| </Position26> | |||
| <Position27> | |||
| <Filename Value="..\uutlEnumerator.pas"/> | |||
| <Caret Line="105" Column="24" TopLine="89"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="281" Column="34" TopLine="256"/> | |||
| </Position27> | |||
| <Position28> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <Caret Line="110" Column="29" TopLine="100"/> | |||
| <Filename Value="..\..\bitSpaceControls\uPropertyTree.pas"/> | |||
| <Caret Line="273" Column="21" TopLine="261"/> | |||
| </Position28> | |||
| <Position29> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <Caret Line="106" TopLine="100"/> | |||
| </Position29> | |||
| <Position30> | |||
| <Filename Value="..\uutlListBase.pas"/> | |||
| <Caret Line="113" Column="72" TopLine="100"/> | |||
| </Position30> | |||
| </JumpHistory> | |||
| </ProjectSession> | |||
| <Debugging> | |||
| @@ -665,10 +775,13 @@ | |||
| <InitialEnabled Value="False"/> | |||
| </Item1> | |||
| </BreakPointGroups> | |||
| <Watches Count="1"> | |||
| <Watches Count="2"> | |||
| <Item1> | |||
| <Expression Value="fCurrent"/> | |||
| <Expression Value="TEnumVarData(v)"/> | |||
| </Item1> | |||
| <Item2> | |||
| <Expression Value="TTestEnum(aSet)"/> | |||
| </Item2> | |||
| </Watches> | |||
| </Debugging> | |||
| </CONFIG> | |||
| @@ -22,7 +22,7 @@ uses | |||
| uutlGenerics; | |||
| type | |||
| TTestEnum = ( | |||
| TSetHelperTestEnum = ( | |||
| teTest0 = 0, | |||
| teTest1 = 1, | |||
| teTest2 = 2, | |||
| @@ -32,8 +32,8 @@ type | |||
| teTest8 = 8, | |||
| teTest9 = 9 | |||
| ); | |||
| TTestSet = set of TTestEnum; | |||
| TTestSetH = specialize TutlSetHelper<TTestEnum, TTestSet>; | |||
| TSetHelperTestSet = set of TSetHelperTestEnum; | |||
| TSetHelperTestSetH = specialize TutlSetHelper<TSetHelperTestEnum, TSetHelperTestSet>; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlSetHelperTests//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| @@ -42,31 +42,31 @@ procedure TutlSetHelperTests.proc_ToString; | |||
| var | |||
| str: String; | |||
| begin | |||
| str := TTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8]); | |||
| str := TSetHelperTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8]); | |||
| AssertEquals('teTest0, teTest1, teTest2, teTest3, teTest4, teTest8', str); | |||
| str := TTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8], '_'); | |||
| str := TSetHelperTestSetH.ToString([teTest0, teTest1, teTest2, teTest3, teTest4, teTest8], '_'); | |||
| AssertEquals('teTest0_teTest1_teTest2_teTest3_teTest4_teTest8', str); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlSetHelperTests.proc_TryToSet; | |||
| var | |||
| s: TTestSet; | |||
| s: TSetHelperTestSet; | |||
| begin | |||
| AssertTrue(TTestSetH.TryToSet('teTest0, teTest1, teTest2, teTest3, teTest8, teTest9', s)); | |||
| AssertTrue(TSetHelperTestSetH.TryToSet('teTest0, teTest1, teTest2, teTest3, teTest8, teTest9', s)); | |||
| AssertTrue([teTest0, teTest1, teTest2, teTest3, teTest8, teTest9] = s); | |||
| AssertTrue(TTestSetH.TryToSet('teTest0_asd_teTest1_asd_teTest2_asd_teTest3_asd_teTest8_asd_teTest9', '_asd_', s)); | |||
| AssertTrue(TSetHelperTestSetH.TryToSet('teTest0_asd_teTest1_asd_teTest2_asd_teTest3_asd_teTest8_asd_teTest9', '_asd_', s)); | |||
| AssertTrue([teTest0, teTest1, teTest2, teTest3, teTest8, teTest9] = s); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlSetHelperTests.proc_Compare; | |||
| begin | |||
| AssertEquals( 0, TTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest1, teTest2])); | |||
| AssertEquals(-1, TTestSetH.Compare([ teTest1, teTest2], [teTest0, teTest1, teTest2])); | |||
| AssertEquals( 1, TTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest2])); | |||
| AssertEquals( 0, TSetHelperTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest1, teTest2])); | |||
| AssertEquals(-1, TSetHelperTestSetH.Compare([ teTest1, teTest2], [teTest0, teTest1, teTest2])); | |||
| AssertEquals( 1, TSetHelperTestSetH.Compare([teTest0, teTest1, teTest2], [teTest0, teTest2])); | |||
| end; | |||
| initialization | |||
| @@ -0,0 +1,94 @@ | |||
| unit uutlVariantEnumTest; | |||
| {$mode objfpc}{$H+} | |||
| interface | |||
| uses | |||
| Classes, SysUtils, TestFramework, | |||
| uutlVariantEnum; | |||
| type | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlVariantEnumTest = class(TTestCase) | |||
| published | |||
| procedure VariantToString; | |||
| procedure VariantToEnum; | |||
| procedure VariantToInt; | |||
| end; | |||
| implementation | |||
| uses | |||
| uutlGenerics; | |||
| type | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TTestEnum = ( | |||
| teTest2 = 2, | |||
| teTest3 = 3, | |||
| teTest5 = 5, | |||
| teTest9 = 9 | |||
| ); | |||
| TTestEnumH = specialize TutlEnumHelper<TTestEnum>; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlVariantEnumTest/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantEnumTest.VariantToString; | |||
| begin | |||
| AssertEquals('2', String(VarMakeEnum(Ord(teTest2)))); | |||
| AssertEquals('3', String(VarMakeEnum(Ord(teTest3)))); | |||
| AssertEquals('5', String(VarMakeEnum(Ord(teTest5)))); | |||
| AssertEquals('9', String(VarMakeEnum(Ord(teTest9)))); | |||
| AssertEquals('teTest2', String(VarMakeEnum(Ord(teTest2), TTestEnumH))); | |||
| AssertEquals('teTest3', String(VarMakeEnum(Ord(teTest3), TTestEnumH))); | |||
| AssertEquals('teTest5', String(VarMakeEnum(Ord(teTest5), TTestEnumH))); | |||
| AssertEquals('teTest9', String(VarMakeEnum(Ord(teTest9), TTestEnumH))); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantEnumTest.VariantToEnum; | |||
| var | |||
| e: TTestEnum; | |||
| begin | |||
| AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest2)), e, true)); | |||
| AssertEquals(Integer(teTest2), Integer(e)); | |||
| AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest3)), e, true)); | |||
| AssertEquals(Integer(teTest3), Integer(e)); | |||
| AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest5)), e, true)); | |||
| AssertEquals(Integer(teTest5), Integer(e)); | |||
| AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest9)), e, true)); | |||
| AssertEquals(Integer(teTest9), Integer(e)); | |||
| AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest2), TTestEnumH), e, true)); | |||
| AssertEquals(Integer(teTest2), Integer(e)); | |||
| AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest3), TTestEnumH), e, true)); | |||
| AssertEquals(Integer(teTest3), Integer(e)); | |||
| AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest5), TTestEnumH), e, true)); | |||
| AssertEquals(Integer(teTest5), Integer(e)); | |||
| AssertTrue (TTestEnumH.TryToEnum(VarMakeEnum(Ord(teTest9), TTestEnumH), e, true)); | |||
| AssertEquals(Integer(teTest9), Integer(e)); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantEnumTest.VariantToInt; | |||
| begin | |||
| // cause of a bug in FPC this test will always fail with a invalid cast exception | |||
| AssertEquals(2, Integer(VarMakeEnum(Ord(teTest2)))); | |||
| AssertEquals(3, Integer(VarMakeEnum(Ord(teTest3)))); | |||
| AssertEquals(5, Integer(VarMakeEnum(Ord(teTest5)))); | |||
| AssertEquals(9, Integer(VarMakeEnum(Ord(teTest9)))); | |||
| AssertEquals(2, Integer(VarMakeEnum(Ord(teTest2), TTestEnumH))); | |||
| AssertEquals(3, Integer(VarMakeEnum(Ord(teTest3), TTestEnumH))); | |||
| AssertEquals(5, Integer(VarMakeEnum(Ord(teTest5), TTestEnumH))); | |||
| AssertEquals(9, Integer(VarMakeEnum(Ord(teTest9), TTestEnumH))); | |||
| end; | |||
| initialization | |||
| RegisterTest(TutlVariantEnumTest.Suite); | |||
| end. | |||
| @@ -0,0 +1,48 @@ | |||
| unit uutlVariantSetTest; | |||
| {$mode objfpc}{$H+} | |||
| interface | |||
| uses | |||
| Classes, SysUtils, TestFramework, | |||
| uutlVariantSet; | |||
| type | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlVariantSetTest = class(TTestCase) | |||
| published | |||
| procedure VariantToString; | |||
| end; | |||
| implementation | |||
| uses | |||
| uutlGenerics; | |||
| type | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TTestEnum = ( | |||
| teTest2 = 2, | |||
| teTest3 = 3, | |||
| teTest5 = 5, | |||
| teTest9 = 9 | |||
| ); | |||
| TTestSet = set of TTestEnum; | |||
| TTestSetH = specialize TutlSetHelper<TTestEnum, TTestSet>; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlVariantSetTest//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantSetTest.VariantToString; | |||
| begin | |||
| AssertEquals('teTest2, teTest3, teTest5, teTest9', String(VarMakeSet(TTestSet([teTest2, teTest3, teTest5, teTest9]), SizeOf(TTestSet), TTestSetH))); | |||
| AssertEquals('teTest2, teTest5', String(VarMakeSet(TTestSet([teTest2, teTest5]), SizeOf(TTestSet), TTestSetH))); | |||
| AssertEquals('teTest3', String(VarMakeSet(TTestSet([teTest3]), SizeOf(TTestSet), TTestSetH))); | |||
| end; | |||
| initialization | |||
| RegisterTest(TutlVariantSetTest.Suite); | |||
| end. | |||
| @@ -80,7 +80,8 @@ end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean); | |||
| begin | |||
| utlFinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem); | |||
| if not utlFinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem) then | |||
| Finalize(aItem); | |||
| FillByte(aItem, SizeOf(aItem), 0); | |||
| end; | |||
| @@ -90,7 +90,7 @@ function GetMicroTime (): QWord; | |||
| function GetPlatformIdentitfier(): String; | |||
| function utlRateLimited (const Reference: QWord; const Interval: QWord): boolean; | |||
| procedure utlFinalizeObject (var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean); | |||
| function utlFinalizeObject (var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean): Boolean; | |||
| function utlFilterBuilder (): IutlFilterBuilder; | |||
| implementation | |||
| @@ -261,10 +261,11 @@ begin | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure utlFinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean); | |||
| function utlFinalizeObject(var obj; const aTypeInfo: PTypeInfo; const aFreeObject: Boolean): Boolean; | |||
| var | |||
| o: TObject; | |||
| begin | |||
| result := true; | |||
| case aTypeInfo^.Kind of | |||
| tkClass: begin | |||
| if (aFreeObject) then begin | |||
| @@ -290,6 +291,9 @@ begin | |||
| tkString: begin | |||
| String(Obj) := ''; | |||
| end; | |||
| else | |||
| result := false; | |||
| end; | |||
| end; | |||
| @@ -0,0 +1,13 @@ | |||
| unit uutlEnumVariant; | |||
| {$mode objfpc}{$H+} | |||
| interface | |||
| uses | |||
| Classes, SysUtils; | |||
| implementation | |||
| end. | |||
| @@ -453,6 +453,7 @@ type | |||
| function TryGetValue (constref aKey: TKey; out aValue: TValue): Boolean; | |||
| function IndexOf (constref aKey: TKey): Integer; | |||
| function Contains (constref aKey: TKey): Boolean; | |||
| function Remove (constref aKey: TKey): Boolean; | |||
| procedure Delete (constref aKey: TKey); | |||
| procedure DeleteAt (const aIndex: Integer); | |||
| procedure Clear; | |||
| @@ -482,49 +483,153 @@ type | |||
| constructor Create(const aValue, aExpectedType: String); | |||
| end; | |||
| generic TutlEnumHelper<T> = class | |||
| TutlEnumHelperBaseClass = class of TutlEnumHelperBase; | |||
| TutlEnumHelperBase = class | |||
| public type | |||
| TIntArray = array of Integer; | |||
| TStringArray = array of String; | |||
| private type | |||
| TValuesMap = specialize TutlMap<string, TIntArray>; | |||
| TNamesMap = specialize TutlMap<string, TStringArray>; | |||
| private class var | |||
| fValuesMap: TValuesMap; | |||
| fNamesMap: TNamesMap; | |||
| protected | |||
| class procedure RegisterType (const aValues: TIntArray; const aNames: TStringArray); | |||
| class procedure UnregisterType(); | |||
| public | |||
| class function ToString (const aValue: Integer; const aAllowOrd: Boolean = false): String; reintroduce; | |||
| class function TryToEnum (const aStr: String; out aValue: Integer; const aAllowOrd: Boolean = false): Boolean; | |||
| class function ToEnum (const aStr: String; const aAllowOrd: Boolean = false): Integer; overload; | |||
| class function ToEnum (const aStr: String; const aDefault: Integer; const aAllowOrd: Boolean = false): Integer; overload; | |||
| class function IntValues: TIntArray; | |||
| class function Names: TStringArray; | |||
| public | |||
| class constructor Initialize; | |||
| class destructor Finalize; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| generic TutlEnumHelper<T> = class(TutlEnumHelperBase) | |||
| public type | |||
| TEnumType = T; | |||
| TValueArray = array of T; | |||
| TStringArray = array of String; | |||
| private class var | |||
| fTypeInfo: PTypeInfo; | |||
| fValues: TValueArray; | |||
| fNames: TStringArray; | |||
| fIntValues: TIntArray; | |||
| fTypeInfo: PTypeInfo; | |||
| public | |||
| class function ToString (aValue: T): String; reintroduce; | |||
| class function TryToEnum (aStr: String; out aValue: T): Boolean; | |||
| class function ToEnum (aStr: String): T; overload; | |||
| class function ToEnum (aStr: String; const aDefault: T): T; overload; | |||
| class function ToString (const aValue: T; const aAllowOrd: Boolean = false): String; reintroduce; | |||
| class function TryToEnum (const aStr: String; out aValue: T; const aAllowOrd: Boolean = false): Boolean; | |||
| class function ToEnum (const aStr: String; const aAllowOrd: Boolean = false): T; overload; | |||
| class function ToEnum (const aStr: String; const aDefault: T; const aAllowOrd: Boolean = false): T; overload; | |||
| class function Values: TValueArray; inline; | |||
| class function IntValues: TIntArray; inline; | |||
| class function Names: TStringArray; inline; | |||
| class function TypeInfo: PTypeInfo; inline; | |||
| class constructor Initialize; | |||
| class destructor Finalize; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlSetHelperBase = class | |||
| private type | |||
| TEnumHelperMap = specialize TutlMap<string, TutlEnumHelperBaseClass>; | |||
| private class var | |||
| fEnumHelpers: TEnumHelperMap; | |||
| private | |||
| class function IsSet (const aSet; const aSize: Integer; const aValue: Integer): Boolean; | |||
| class procedure SetValue (var aSet; const aSize: Integer; const aValue: Integer); | |||
| class procedure ClearValue(var aSet; const aSize: Integer; const aValue: Integer); | |||
| protected | |||
| class procedure RegisterEnumHelper(const aHelper: TutlEnumHelperBaseClass); | |||
| class procedure UnregisterEnumHelper; | |||
| public | |||
| class function ToString( | |||
| const aSet; | |||
| const aSize: Integer; | |||
| const aSeparator: String = ', '; | |||
| const aAllowOrd: Boolean = false): String; reintroduce; | |||
| class function TryToSet( | |||
| const aStr: String; | |||
| out aSet; | |||
| const aSize: Integer; | |||
| const aAllowOrd: Boolean = false): Boolean; | |||
| class function TryToSet( | |||
| const aStr: String; | |||
| const aSeparator: String; | |||
| out aSet; | |||
| const aSize: Integer; | |||
| const aAllowOrd: Boolean = false): Boolean; | |||
| class function Compare( | |||
| const aSet1; | |||
| const aSet2; | |||
| const aSize: Integer): Integer; | |||
| class function EnumHelper: TutlEnumHelperBaseClass; | |||
| class constructor Initialize; | |||
| class destructor Finalize; | |||
| end; | |||
| TutlSetHelperBaseClass = class of TutlSetHelperBase; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| generic TutlSetHelper<TEnum, TSet> = class | |||
| generic TutlSetHelper<TEnum, TSet> = class(TutlSetHelperBase) | |||
| public type | |||
| TEnumHelper = specialize TutlEnumHelper<TEnum>; | |||
| TEnumType = TEnum; | |||
| TSetType = TSet; | |||
| private | |||
| class function IsSet (constref aSet: TSet; aEnum: TEnum): Boolean; | |||
| class procedure SetValue (var aSet: TSet; aEnum: TEnum); | |||
| class procedure ClearValue(var aSet: TSet; aEnum: TEnum); | |||
| public | |||
| class function ToString (const aValue: TSet; const aSeperator: String = ', '): String; reintroduce; | |||
| class function TryToSet (const aStr: String; out aValue: TSet): Boolean; overload; | |||
| class function TryToSet (const aStr: String; const aSeperator: String; out aValue: TSet): Boolean; overload; | |||
| class function ToSet (const aStr: String; const aDefault: TSet): TSet; overload; | |||
| class function ToSet (const aStr: String): TSet; overload; | |||
| class function Compare (const aSet1, aSet2: TSet): Integer; | |||
| class function ToString( | |||
| const aValue: TSet; | |||
| const aSeparator: String = ', '; | |||
| const aAllowOrd: Boolean = false): String; overload; | |||
| class function TryToSet( | |||
| const aStr: String; | |||
| out aValue: TSet; | |||
| const aAllowOrd: Boolean = false): Boolean; overload; | |||
| class function TryToSet( | |||
| const aStr: String; | |||
| const aSeparator: String; | |||
| out aValue: TSet; | |||
| const aAllowOrd: Boolean = false): Boolean; overload; | |||
| class function ToSet( | |||
| const aStr: String; | |||
| const aDefault: TSet; | |||
| const aAllowOrd: Boolean = false): TSet; overload; | |||
| class function ToSet( | |||
| const aStr: String; | |||
| const aAllowOrd: Boolean = false): TSet; overload; | |||
| class function Compare( | |||
| const aSet1, aSet2: TSet): Integer; overload; | |||
| class constructor Initialize; | |||
| class destructor Finalize; | |||
| end; | |||
| implementation | |||
| @@ -1129,8 +1234,10 @@ end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlCustomMap.THashSet.Release(var aItem: TKeyValuePair; const aFreeItem: Boolean); | |||
| begin | |||
| utlFinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem); | |||
| utlFinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem); | |||
| if not utlFinalizeObject(aItem.Key, TypeInfo(aItem.Key), fOwner.OwnsKeys and aFreeItem) then | |||
| Finalize(aItem.Key); | |||
| if not utlFinalizeObject(aItem.Value, TypeInfo(aItem.Value), fOwner.OwnsValues and aFreeItem) then | |||
| Finalize(aItem.Key); | |||
| inherited Release(aItem, aFreeItem); | |||
| end; | |||
| @@ -1448,12 +1555,18 @@ begin | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlCustomMap.Delete(constref aKey: TKey); | |||
| function TutlCustomMap.Remove(constref aKey: TKey): Boolean; | |||
| var | |||
| kvp: TKeyValuePair; | |||
| begin | |||
| kvp.Key := aKey; | |||
| if not fHashSetRef.Remove(kvp) then | |||
| result := fHashSetRef.Remove(kvp); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlCustomMap.Delete(constref aKey: TKey); | |||
| begin | |||
| if not Remove(aKey) then | |||
| raise EInvalidOperation.Create('key not found'); | |||
| end; | |||
| @@ -1523,10 +1636,107 @@ begin | |||
| inherited Create(Format('%s is not a %s', [aValue, aExpectedType])); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlEnumHelperBase//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class procedure TutlEnumHelperBase.RegisterType(const aValues: TIntArray; const aNames: TStringArray); | |||
| begin | |||
| fValuesMap.Add(ClassName, aValues); | |||
| fNamesMap.Add (ClassName, aNames); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class procedure TutlEnumHelperBase.UnregisterType; | |||
| begin | |||
| fValuesMap.Remove(ClassName); | |||
| fNamesMap.Remove(ClassName); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelperBase.ToString(const aValue: Integer; const aAllowOrd: Boolean = false): String; | |||
| var | |||
| i: Integer; | |||
| iArr: TIntArray; | |||
| sArr: TStringArray; | |||
| begin | |||
| iArr := fValuesMap[ClassName]; | |||
| sArr := fNamesMap[ClassName]; | |||
| for i := low(iArr) to high(iArr) do begin | |||
| if (iArr[i] = aValue) then begin | |||
| result := sArr[i]; | |||
| exit; | |||
| end; | |||
| end; | |||
| if aAllowOrd | |||
| then result := IntToStr(aValue) | |||
| else result := ''; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelperBase.TryToEnum(const aStr: String; out aValue: Integer; const aAllowOrd: Boolean = false): Boolean; | |||
| var | |||
| i: Integer; | |||
| iArr: TIntArray; | |||
| sArr: TStringArray; | |||
| begin | |||
| iArr := fValuesMap[ClassName]; | |||
| sArr := fNamesMap[ClassName]; | |||
| for i := low(sArr) to high(sArr) do begin | |||
| if (sArr[i] = aStr) then begin | |||
| result := true; | |||
| aValue := iArr[i]; | |||
| exit; | |||
| end; | |||
| end; | |||
| if aAllowOrd | |||
| then result := TryStrToInt(aStr, aValue) | |||
| else result := false; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelperBase.ToEnum(const aStr: String; const aAllowOrd: Boolean): Integer; | |||
| begin | |||
| if not TryToEnum(aStr, result, aAllowOrd) then | |||
| raise EConvertError.Create(aStr + ' is an unknown enum value'); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelperBase.ToEnum(const aStr: String; const aDefault: Integer; const aAllowOrd: Boolean): Integer; | |||
| begin | |||
| if not TryToEnum(aStr, result, aAllowOrd) then | |||
| result := aDefault; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelperBase.IntValues: TIntArray; | |||
| begin | |||
| result := fValuesMap[ClassName]; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelperBase.Names: TStringArray; | |||
| begin | |||
| result := fNamesMap[ClassName]; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class constructor TutlEnumHelperBase.Initialize; | |||
| begin | |||
| fNamesMap := TNamesMap.Create(true, true); | |||
| fValuesMap := TValuesMap.Create(true, true); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class destructor TutlEnumHelperBase.Finalize; | |||
| begin | |||
| FreeAndNil(fNamesMap); | |||
| FreeAndNil(fValuesMap); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlEnumHelper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelper.ToString(aValue: T): String; | |||
| class function TutlEnumHelper.ToString(const aValue: T; const aAllowOrd: Boolean): String; | |||
| begin | |||
| {$Push} | |||
| {$IOChecks OFF} | |||
| @@ -1537,9 +1747,10 @@ begin | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelper.TryToEnum(aStr: String; out aValue: T): Boolean; | |||
| class function TutlEnumHelper.TryToEnum(const aStr: String; out aValue: T; const aAllowOrd: Boolean): Boolean; | |||
| var | |||
| a: T; | |||
| i: Integer; | |||
| begin | |||
| a := T(0); | |||
| Result := false; | |||
| @@ -1552,20 +1763,25 @@ begin | |||
| Result := IOResult <> 106; | |||
| {$Pop} | |||
| if Result then | |||
| aValue := a; | |||
| aValue := a | |||
| else if aAllowOrd then begin | |||
| result := TryStrToInt(aStr, i); | |||
| if result then | |||
| aValue := T(i); | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelper.ToEnum(aStr: String): T; | |||
| class function TutlEnumHelper.ToEnum(const aStr: String; const aAllowOrd: Boolean): T; | |||
| begin | |||
| if not TryToEnum(aStr, result) then | |||
| if not TryToEnum(aStr, result, aAllowOrd) then | |||
| raise EEnumConvertException.Create(aStr, TypeInfo^.Name); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelper.ToEnum(aStr: String; const aDefault: T): T; | |||
| class function TutlEnumHelper.ToEnum(const aStr: String; const aDefault: T; const aAllowOrd: Boolean): T; | |||
| begin | |||
| if not TryToEnum(aStr, result) then | |||
| if not TryToEnum(aStr, result, aAllowOrd) then | |||
| result := aDefault; | |||
| end; | |||
| @@ -1575,6 +1791,12 @@ begin | |||
| result := fValues; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelper.IntValues: TIntArray; | |||
| begin | |||
| result := fIntValues; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlEnumHelper.Names: TStringArray; | |||
| begin | |||
| @@ -1595,6 +1817,7 @@ var | |||
| PName: PShortString; | |||
| i: integer; | |||
| en: T; | |||
| sl: TStringList; | |||
| begin | |||
| { | |||
| See FPC Bug http://bugs.freepascal.org/view.php?id=27622 | |||
| @@ -1613,97 +1836,142 @@ begin | |||
| } | |||
| tdEnum := GetTypeData(FTypeInfo); | |||
| PName := @tdEnum^.NameList; | |||
| SetLength(fValues, 0); | |||
| SetLength(fNames, 0); | |||
| i:= 0; | |||
| while Length(PName^) > 0 do begin | |||
| SetLength(fValues, i+1); | |||
| SetLength(fNames, i+1); | |||
| { | |||
| Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry. | |||
| This can normally not be the same as a valid enum value, because it is in the same identifier | |||
| namespace. However, with scoped enums we might have the same name for module and element, because | |||
| the full identifier for the element would be TypeName.ElementName. | |||
| In either case, the next PShortString will point to a zero-length string, and the loop is left | |||
| with the last element being invalid (either empty or whatever value the unit-named element has). | |||
| } | |||
| fNames[i] := PName^; | |||
| if TryToEnum(PName^, en) then | |||
| fValues[i]:= en; | |||
| sl := TStringList.Create; | |||
| try | |||
| while Length(PName^) > 0 do begin | |||
| { | |||
| Memory layout for TTypeData has the declaring EnumUnitName after the last NameList entry. | |||
| This can normally not be the same as a valid enum value, because it is in the same identifier | |||
| namespace. However, with scoped enums we might have the same name for module and element, because | |||
| the full identifier for the element would be TypeName.ElementName. | |||
| In either case, the next PShortString will point to a zero-length string, and the loop is left | |||
| with the last element being invalid (either empty or whatever value the unit-named element has). | |||
| } | |||
| sl.Add(PName^); | |||
| if TryToEnum(PName^, en) then | |||
| sl.Objects[sl.Count-1] := TObject({%H-}Pointer(PtrUInt(en))); | |||
| inc(PByte(PName), Length(PName^) + 1); | |||
| end; | |||
| inc(i); | |||
| inc(PByte(PName), Length(PName^) + 1); | |||
| sl.Delete(sl.Count-1); // remove the EnumUnitName item | |||
| SetLength(fValues, sl.Count); | |||
| SetLength(fIntValues, sl.Count); | |||
| SetLength(fNames, sl.Count); | |||
| for i := 0 to sl.Count-1 do begin | |||
| fNames[i] := sl[i]; | |||
| fValues[i] := T(PtrUInt(sl.Objects[i])); | |||
| fIntValues[i] := Integer(fValues[i]); | |||
| end; | |||
| finally | |||
| FreeAndNil(sl); | |||
| end; | |||
| // remove the EnumUnitName item | |||
| SetLength(fValues, High(fValues)); | |||
| SetLength(fNames, High(fNames)); | |||
| RegisterType(fIntValues, fNames); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlSetHelper///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class destructor TutlEnumHelper.Finalize; | |||
| begin | |||
| Finalize(fNames); | |||
| Finalize(fValues); | |||
| Finalize(fIntValues); | |||
| UnregisterType; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.IsSet(constref aSet: TSet; aEnum: TEnum): Boolean; | |||
| //TutlSetHelperBase///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelperBase.IsSet(const aSet; const aSize: Integer; const aValue: Integer): Boolean; | |||
| begin | |||
| if (aValue >= 8*aSize) then | |||
| raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1); | |||
| result := ((PByte(@aSet)[aValue shr 3] and (1 shl (aValue and 7))) <> 0); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class procedure TutlSetHelperBase.SetValue(var aSet; const aSize: Integer; const aValue: Integer); | |||
| begin | |||
| result := ((PByte(@aSet)[Integer(aEnum) shr 3] and (1 shl (Integer(aEnum) and 7))) <> 0); | |||
| if (aValue >= 8*aSize) then | |||
| raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1); | |||
| PByte(@aSet)[aValue shr 3] := PByte(@aSet)[aValue shr 3] or (1 shl (aValue and 7)); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class procedure TutlSetHelper.SetValue(var aSet: TSet; aEnum: TEnum); | |||
| class procedure TutlSetHelperBase.ClearValue(var aSet; const aSize: Integer; const aValue: Integer); | |||
| begin | |||
| PByte(@aSet)[Integer(aEnum) shr 3] := PByte(@aSet)[Integer(aEnum) shr 3] or (1 shl (Integer(aEnum) and 7)); | |||
| if (aValue >= 8*aSize) then | |||
| raise EOutOfRangeException.Create(aValue, 0, 8*aSize-1); | |||
| PByte(@aSet)[aValue shr 3] := PByte(@aSet)[aValue shr 3] and not (1 shl (aValue and 7)); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class procedure TutlSetHelper.ClearValue(var aSet: TSet; aEnum: TEnum); | |||
| class procedure TutlSetHelperBase.RegisterEnumHelper(const aHelper: TutlEnumHelperBaseClass); | |||
| begin | |||
| PByte(@aSet)[Integer(aEnum) shr 3] := PByte(@aSet)[Integer(aEnum) shr 3] and not (1 shl (Integer(aEnum) and 7)); | |||
| fEnumHelpers.Add(ClassName, aHelper); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.ToString(const aValue: TSet; const aSeperator: String): String; | |||
| class procedure TutlSetHelperBase.UnregisterEnumHelper; | |||
| begin | |||
| fEnumHelpers.Remove(ClassName); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelperBase.ToString(const aSet; const aSize: Integer; const aSeparator: String; | |||
| const aAllowOrd: Boolean): String; | |||
| var | |||
| e: TEnum; | |||
| i: Integer; | |||
| h: TutlEnumHelperBaseClass; | |||
| arr: TutlEnumHelperBase.TIntArray; | |||
| begin | |||
| h := EnumHelper; | |||
| if not Assigned(h) then | |||
| raise EInvalidOperation.Create('enum helper class is not set'); | |||
| result := ''; | |||
| for e in TEnumHelper.Values do begin | |||
| if IsSet(aValue, e) then begin | |||
| arr := h.IntValues; | |||
| for i in arr do begin | |||
| if IsSet(aSet, aSize, i) then begin | |||
| if result > '' then | |||
| result := result + aSeperator; | |||
| result := result + TEnumHelper.ToString(e); | |||
| result := result + aSeparator; | |||
| result := result + h.ToString(i, aAllowOrd); | |||
| end; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.TryToSet(const aStr: String; out aValue: TSet): Boolean; | |||
| class function TutlSetHelperBase.TryToSet(const aStr: String; out aSet; const aSize: Integer; const aAllowOrd: Boolean): Boolean; | |||
| begin | |||
| result := TryToSet(aStr, ',', aValue); | |||
| result := TryToSet(aStr, ',', aSet, aSize, aAllowOrd); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.TryToSet(const aStr: String; const aSeperator: String; out aValue: TSet): Boolean; | |||
| class function TutlSetHelperBase.TryToSet(const aStr: String; const aSeparator: String; out aSet; const aSize: Integer; const aAllowOrd: Boolean): Boolean; | |||
| var | |||
| i, j: Integer; | |||
| i, j, e: Integer; | |||
| s: String; | |||
| e: TEnum; | |||
| h: TutlEnumHelperBaseClass; | |||
| begin | |||
| if (aSeperator = '') then | |||
| raise EArgumentException.Create('''aSeperator'' can not be empty'); | |||
| if (aSeparator = '') then | |||
| raise EArgumentException.Create('''aSeparator'' can not be empty'); | |||
| h := EnumHelper; | |||
| if not Assigned(h) then | |||
| raise EInvalidOperation.Create('enum helper class is not set'); | |||
| result := true; | |||
| aValue := []; | |||
| i := 1; | |||
| j := 1; | |||
| i := 1; | |||
| j := 1; | |||
| FillByte(aSet{%H-}, aSize, 0); | |||
| while (i <= Length(aStr)) do begin | |||
| if (Copy(aStr, i, Length(aSeperator)) = aSeperator) then begin | |||
| if (Copy(aStr, i, Length(aSeparator)) = aSeparator) then begin | |||
| s := Trim(copy(aStr, j, i - j)); | |||
| if (s <> '') then begin | |||
| result := result and TEnumHelper.TryToEnum(s, e); | |||
| result := result and h.TryToEnum(s, e); | |||
| if not result then | |||
| exit; | |||
| SetValue(aValue, e); | |||
| j := i + Length(aSeperator); | |||
| SetValue(aSet, aSize, e); | |||
| j := i + Length(aSeparator); | |||
| end; | |||
| end; | |||
| inc(i); | |||
| @@ -1711,42 +1979,104 @@ begin | |||
| s := Trim(copy(aStr, j, i - j)); | |||
| if (s <> '') then begin | |||
| result := result and TEnumHelper.TryToEnum(s, e); | |||
| result := result and h.TryToEnum(s, e); | |||
| if not result then | |||
| exit; | |||
| SetValue(aValue, e); | |||
| end | |||
| SetValue(aSet, aSize, e); | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelperBase.Compare(const aSet1; const aSet2; const aSize: Integer): Integer; | |||
| var | |||
| e: Integer; | |||
| h: TutlEnumHelperBaseClass; | |||
| begin | |||
| h := EnumHelper; | |||
| if not Assigned(h) then | |||
| raise EInvalidOperation.Create('enum helper class is not set'); | |||
| result := 0; | |||
| for e in h.IntValues do begin | |||
| if IsSet(aSet1, aSize, e) and not IsSet(aSet2, aSize, e) then begin | |||
| result := 1; | |||
| break; | |||
| end else | |||
| if not IsSet(aSet1, aSize, e) and IsSet(aSet2, aSize, e) then begin | |||
| result := -1; | |||
| break; | |||
| end; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelperBase.EnumHelper: TutlEnumHelperBaseClass; | |||
| begin | |||
| result := fEnumHelpers[ClassName]; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class constructor TutlSetHelperBase.Initialize; | |||
| begin | |||
| fEnumHelpers := TEnumHelperMap.Create(true, true); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class destructor TutlSetHelperBase.Finalize; | |||
| begin | |||
| FreeAndNil(fEnumHelpers); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlSetHelper///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.ToString(const aValue: TSet; const aSeparator: String; const aAllowOrd: Boolean): String; | |||
| begin | |||
| result := ToString(aValue, SizeOf(aValue), aSeparator, aAllowOrd); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.TryToSet(const aStr: String; out aValue: TSet; const aAllowOrd: Boolean): Boolean; | |||
| begin | |||
| result := TryToSet(aStr, ',', aValue, SizeOf(aValue), aAllowOrd); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.TryToSet(const aStr: String; const aSeparator: String; out aValue: TSet; const aAllowOrd: Boolean): Boolean; | |||
| begin | |||
| result := TryToSet(aStr, aSeparator, aValue, SizeOf(aValue), aAllowOrd); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.ToSet(const aStr: String; const aDefault: TSet): TSet; | |||
| class function TutlSetHelper.ToSet(const aStr: String; const aDefault: TSet; const aAllowOrd: Boolean): TSet; | |||
| begin | |||
| if not TryToSet(aStr, result) then | |||
| if not TryToSet(aStr, ',', result, SizeOf(result), aAllowOrd) then | |||
| result := aDefault; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.ToSet(const aStr: String): TSet; | |||
| class function TutlSetHelper.ToSet(const aStr: String; const aAllowOrd: Boolean): TSet; | |||
| begin | |||
| if not TryToSet(aStr, result) then | |||
| if not TryToSet(aStr, ',', result, SizeOf(result), aAllowOrd) then | |||
| raise EEnumConvertException.CreateFmt('"%s" is an invalid value', [aStr]); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlSetHelper.Compare(const aSet1, aSet2: TSet): Integer; | |||
| var | |||
| e: TEnum; | |||
| begin | |||
| result := 0; | |||
| for e in TEnumHelper.Values do begin | |||
| if IsSet(aSet1, e) and not IsSet(aSet2, e) then begin | |||
| result := 1; | |||
| break; | |||
| end else if not IsSet(aSet1, e) and IsSet(aSet2, e) then begin | |||
| result := -1; | |||
| break; | |||
| end; | |||
| end; | |||
| result := Compare(aSet1, aSet2, SizeOf(aSet1)); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class constructor TutlSetHelper.Initialize; | |||
| begin | |||
| RegisterEnumHelper(TEnumHelper); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class destructor TutlSetHelper.Finalize; | |||
| begin | |||
| UnregisterEnumHelper(); | |||
| end; | |||
| end. | |||
| @@ -0,0 +1,496 @@ | |||
| unit uutlStored; | |||
| {$mode objfpc}{$H+} | |||
| interface | |||
| uses | |||
| Classes, SysUtils, | |||
| DOM, | |||
| uutlMCF; | |||
| type | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| IutlStored = interface(IUnknown) | |||
| ['{1AAA369A-B938-4430-AFAA-E4B5FD9D5A8D}'] | |||
| function GetStoredCount(): Integer; // returns the number of stored values | |||
| function GetStoredName (const aIndex: Integer): String; // returns the name of the stored value | |||
| function GetStoredValue(const aIndex: Integer): Variant; // returns the stored value as string | |||
| procedure SetStoredValue(const aIndex: Integer; const aValue: Variant); // set the stored value | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| IutlStoredWriter = interface(IUnknown) | |||
| ['{AE592B18-DDC2-408A-BB26-DAA24E2A7C34}'] | |||
| procedure Write(constref aObj: IutlStored; const aStream: TStream); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| IutlStoredReader = interface(IUnknown) | |||
| ['{B596DCD9-5F34-45F9-82C7-790F5407E1E8}'] | |||
| function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlStoredWriter = class( | |||
| TInterfacedObject | |||
| , IutlStoredWriter) | |||
| public { IutlStoredWriter } | |||
| procedure Write(constref aObj: IutlStored; const aStream: TStream); virtual; | |||
| constructor Create; virtual; | |||
| public | |||
| class function CreateWriter: IutlStoredWriter; | |||
| end; | |||
| TutlStoredWriterClass = class of TutlStoredWriter; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlStoredReader = class( | |||
| TInterfacedObject | |||
| , IutlStoredReader) | |||
| public { IutlStoredReader } | |||
| function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; virtual; | |||
| constructor Create; virtual; | |||
| public | |||
| class function CreateReader: IutlStoredReader; | |||
| end; | |||
| TutlStoredReaderClass = class of TutlStoredReader; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlStoredXmlWriter = class(TutlStoredWriter) | |||
| private | |||
| fRootName: String; | |||
| protected | |||
| property RootName: String read fRootName write fRootName; | |||
| procedure Write(constref aObj: IutlStored; const aElement: TDOMElement); virtual; | |||
| public | |||
| procedure Write(constref aObj: IutlStored; const aStream: TStream); override; | |||
| constructor Create; override; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlStoredXmlReader = class(TutlStoredReader) | |||
| protected | |||
| function CreateObject(constref aOwner: IutlStored; const aElement: TDOMElement): IutlStored; virtual; | |||
| procedure Read (constref aObj: IutlStored; const aElement: TDOMElement); virtual; | |||
| public | |||
| function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; override; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlStoredMcfWriter = class(TutlStoredWriter) | |||
| protected | |||
| procedure Write(constref aObj: IutlStored; const aName: String; const aParent: TutlMCFSection); virtual; | |||
| procedure Write(constref aObj: IutlStored; const aSection: TutlMCFSection); virtual; | |||
| public | |||
| procedure Write(constref aObj: IutlStored; const aStream: TStream); override; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlStoredMcfReader = class(TutlStoredReader) | |||
| private | |||
| function TryFindStoredName(const aObj: IutlStored; const aName: String; out aIndex: Integer): Boolean; | |||
| protected | |||
| function CreateObject(constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): IutlStored; virtual; | |||
| function ReadValue (constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): Variant; virtual; | |||
| procedure ReadSection (constref aObj: IutlStored; const aSection: TutlMCFSection); virtual; | |||
| public | |||
| function Read(constref aObj: IutlStored; const aStream: TStream): Boolean; override; | |||
| end; | |||
| implementation | |||
| uses | |||
| XMLWrite, XMLRead, variants, | |||
| uutlXmlHelper, uutlSyncObjs; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlStoredWriter////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlStoredWriter.Write(constref aObj: IutlStored; const aStream: TStream); | |||
| begin | |||
| // DUMMY | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| constructor TutlStoredWriter.Create; | |||
| begin | |||
| inherited Create; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlStoredWriter.CreateWriter: IutlStoredWriter; | |||
| begin | |||
| result := TutlStoredWriterClass(ClassType).Create; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlStoredReader////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlStoredReader.Read(constref aObj: IutlStored; const aStream: TStream): Boolean; | |||
| begin | |||
| result := false; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| constructor TutlStoredReader.Create; | |||
| begin | |||
| inherited Create; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlStoredReader.CreateReader: IutlStoredReader; | |||
| begin | |||
| result := TutlStoredReaderClass(ClassType).Create; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlStoredXmlWriter/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlStoredXmlWriter.Write(constref aObj: IutlStored; const aElement: TDOMElement); | |||
| var | |||
| i, c: Integer; | |||
| s: DOMString; | |||
| v: Variant; | |||
| vt: TVarType; | |||
| intf: IUnknown; | |||
| lock: IutlLockable; | |||
| stored: IutlStored; | |||
| begin | |||
| if not Supports(aObj, IutlLockable, lock) then | |||
| lock := nil; | |||
| if Assigned(lock) then | |||
| lock.Lock; | |||
| try | |||
| with TutlXmlHelper.Create(aElement) do begin | |||
| c := aObj.GetStoredCount; | |||
| for i := 0 to c-1 do begin | |||
| s := DOMString(aObj.GetStoredName(i)); | |||
| v := aObj.GetStoredValue(i); | |||
| vt := VarType(v); | |||
| case vt of | |||
| varunknown: begin | |||
| intf := IUnknown(v); | |||
| if Supports(intf, IutlStored, stored) then | |||
| Write(stored, AppendNode(s)); | |||
| end; | |||
| else | |||
| SetAttribString(s, String(v)); | |||
| end; | |||
| end; | |||
| end; | |||
| finally | |||
| if Assigned(lock) then | |||
| lock.Unlock; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlStoredXmlWriter.Write(constref aObj: IutlStored; const aStream: TStream); | |||
| var | |||
| doc: TXMLDocument; | |||
| root: TDOMElement; | |||
| begin | |||
| doc := TXMLDocument.Create; | |||
| try | |||
| root := doc.CreateElement(DOMString(fRootName)); | |||
| doc.AppendChild(root); | |||
| Write(aObj, root); | |||
| WriteXMLFile(doc, aStream); | |||
| finally | |||
| FreeAndNil(doc); | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| constructor TutlStoredXmlWriter.Create; | |||
| begin | |||
| inherited Create; | |||
| fRootName := 'root'; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlStoredXmlReader/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlStoredXmlReader.CreateObject(constref aOwner: IutlStored; const aElement: TDOMElement): IutlStored; | |||
| begin | |||
| result := nil; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlStoredXmlReader.Read(constref aObj: IutlStored; const aElement: TDOMElement); | |||
| var | |||
| i, j: Integer; | |||
| s: DOMString; | |||
| v: Variant; | |||
| vt: TVarType; | |||
| intf: IUnknown; | |||
| stored: IutlStored; | |||
| attribs: TDOMNamedNodeMap; | |||
| attrib: TDOMNode; | |||
| el: TDOMElement; | |||
| function TryFindStoredName(const aName: String; out aIndex: Integer): Boolean; | |||
| var | |||
| c, i: Integer; | |||
| begin | |||
| result := true; | |||
| c := aObj.GetStoredCount; | |||
| for i := 0 to c-1 do begin | |||
| aIndex := i; | |||
| if (aObj.GetStoredName(aIndex) = aName) then | |||
| exit; | |||
| end; | |||
| aIndex := -1; | |||
| result := false; | |||
| end; | |||
| begin | |||
| with TutlXmlHelper.Create(aElement) do begin | |||
| attribs := aElement.Attributes; | |||
| for i := 0 to attribs.Length-1 do begin | |||
| attrib := attribs.Item[i]; | |||
| s := attrib.NodeName; | |||
| v := attrib.TextContent; | |||
| if not TryFindStoredName(String(s), j) then | |||
| continue; | |||
| aObj.SetStoredValue(j, v); | |||
| end; | |||
| for el in Nodes('') do begin | |||
| s := el.NodeName; | |||
| v := Unassigned; | |||
| stored := nil; | |||
| if TryFindStoredName(String(s), j) then begin | |||
| v := aObj.GetStoredValue(j); | |||
| vt := VarType(v); | |||
| case vt of | |||
| varunknown: begin | |||
| intf := v; | |||
| if not Supports(intf, IutlStored, stored) then | |||
| stored := nil; | |||
| end; | |||
| else | |||
| raise EInvalidOperation.Create('expected ' + String(s) + ' to be an stored object'); | |||
| end; | |||
| end else | |||
| j := -1; | |||
| if not Assigned(stored) then | |||
| stored := CreateObject(aObj, el); | |||
| if not Assigned(stored) then | |||
| continue; | |||
| Read(stored, el); | |||
| aObj.SetStoredValue(j, stored); | |||
| end; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlStoredXmlReader.Read(constref aObj: IutlStored; const aStream: TStream): Boolean; | |||
| var | |||
| doc: TXMLDocument; | |||
| p: Int64; | |||
| begin | |||
| p := aStream.Position; | |||
| doc := TXMLDocument.Create; | |||
| try try | |||
| result := true; | |||
| ReadXMLFile(doc, aStream); | |||
| Read(aObj, (doc.FirstChild as TDOMElement)); | |||
| except | |||
| result := false; | |||
| aStream.Position := p; | |||
| end; | |||
| finally | |||
| FreeAndNil(doc); | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlStoredMcfWriter/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlStoredMcfWriter.Write(constref aObj: IutlStored; const aName: String; const aParent: TutlMCFSection); | |||
| begin | |||
| Write(aObj, aParent.Section(aName)); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlStoredMcfWriter.Write(constref aObj: IutlStored; const aSection: TutlMCFSection); | |||
| var | |||
| lock: IutlLockable; | |||
| i, c: Integer; | |||
| s: String; | |||
| v: Variant; | |||
| vt: TVarType; | |||
| intf: IUnknown; | |||
| stored: IutlStored; | |||
| begin | |||
| if not Supports(aObj, IutlLockable, lock) then | |||
| lock := nil; | |||
| if Assigned(lock) then | |||
| lock.Lock; | |||
| try | |||
| c := aObj.GetStoredCount; | |||
| for i := 0 to c-1 do begin | |||
| s := aObj.GetStoredName (i); | |||
| v := aObj.GetStoredValue(i); | |||
| vt := VarType(v); | |||
| case vt of | |||
| varunknown: begin | |||
| intf := IUnknown(v); | |||
| if Supports(intf, IutlStored, stored) then | |||
| Write(stored, s, aSection); | |||
| end; | |||
| varboolean: | |||
| aSection.SetBool(s, v); | |||
| {$IFNDEF FPUNONE} | |||
| varsingle, | |||
| vardouble: | |||
| aSection.SetFloat(s, v); | |||
| {$ENDIF} | |||
| vardecimal, | |||
| varshortint, | |||
| varbyte, | |||
| varword, | |||
| varlongword, | |||
| varint64, | |||
| varqword, | |||
| varsmallint, | |||
| varinteger: | |||
| aSection.SetInt(s, v); | |||
| else | |||
| aSection.SetString(s, String(v)); | |||
| end; | |||
| end; | |||
| finally | |||
| if Assigned(lock) then | |||
| lock.Unlock; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlStoredMcfWriter.Write(constref aObj: IutlStored; const aStream: TStream); | |||
| var | |||
| mcf: TutlMCFFile; | |||
| begin | |||
| mcf := TutlMCFFile.Create(nil); | |||
| try | |||
| Write(aObj, mcf); | |||
| mcf.SaveToStream(aStream); | |||
| finally | |||
| FreeAndNil(mcf); | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlStoredMcfReader/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlStoredMcfReader.TryFindStoredName(const aObj: IutlStored; const aName: String; out aIndex: Integer): Boolean; | |||
| var | |||
| c, i: Integer; | |||
| begin | |||
| result := true; | |||
| c := aObj.GetStoredCount; | |||
| for i := 0 to c-1 do begin | |||
| aIndex := i; | |||
| if (aObj.GetStoredName(aIndex) = aName) then | |||
| exit; | |||
| end; | |||
| aIndex := -1; | |||
| result := false; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlStoredMcfReader.CreateObject(constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): IutlStored; | |||
| begin | |||
| result := nil; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlStoredMcfReader.ReadValue(constref aOwner: IutlStored; const aName: String; const aParent: TutlMCFSection): Variant; | |||
| begin | |||
| result := aParent.GetString(aName); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlStoredMcfReader.ReadSection(constref aObj: IutlStored; const aSection: TutlMCFSection); | |||
| var | |||
| i, j, c: Integer; | |||
| s: String; | |||
| v: Variant; | |||
| vt: TVarType; | |||
| intf: IUnknown; | |||
| stored: IutlStored; | |||
| begin | |||
| c := aSection.ValueCount; | |||
| for i := 0 to c-1 do begin | |||
| s := aSection.ValueNameAt[i]; | |||
| v := ReadValue(aObj, s, aSection); | |||
| if (VarType(v) <> varempty) and TryFindStoredName(aObj, s, j) then | |||
| aObj.SetStoredValue(j, v); | |||
| end; | |||
| c := aSection.SectionCount; | |||
| for i := 0 to c-1 do begin | |||
| s := aSection.SectionNameAt[i]; | |||
| v := Unassigned; | |||
| stored := nil; | |||
| if TryFindStoredName(aObj, s, j) then begin | |||
| v := aObj.GetStoredValue(j); | |||
| vt := VarType(v); | |||
| case vt of | |||
| varunknown: begin | |||
| intf := v; | |||
| if not Supports(intf, IutlStored, stored) then | |||
| stored := nil; | |||
| end; | |||
| else | |||
| raise EInvalidOperation.Create('expected ' + s + ' to be an stored object'); | |||
| end; | |||
| end else | |||
| j := -1; | |||
| if not Assigned(stored) then | |||
| stored := CreateObject(aObj, s, aSection); | |||
| if not Assigned(stored) then | |||
| continue; | |||
| ReadSection(stored, aSection.Section(s)); | |||
| aObj.SetStoredValue(j, stored); | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlStoredMcfReader.Read(constref aObj: IutlStored; const aStream: TStream): Boolean; | |||
| var | |||
| p: Int64; | |||
| mcf: TutlMCFFile; | |||
| begin | |||
| p := aStream.Position; | |||
| mcf := TutlMCFFile.Create(nil); | |||
| try try | |||
| result := true; | |||
| mcf.LoadFromStream(aStream); | |||
| ReadSection(aObj, mcf); | |||
| except | |||
| result := false; | |||
| aStream.Position := p; | |||
| end; | |||
| finally | |||
| FreeAndNil(mcf); | |||
| end; | |||
| end; | |||
| end. | |||
| @@ -0,0 +1,105 @@ | |||
| unit uutlTypeInfo; | |||
| {$mode objfpc}{$H+} | |||
| {$ModeSwitch advancedrecords} | |||
| interface | |||
| uses | |||
| Classes, SysUtils, variants; | |||
| type | |||
| ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlVariantType = ( | |||
| vtNull, | |||
| // boolean | |||
| vtBool, | |||
| vtByteBool, | |||
| vtWordBool, | |||
| vtLongBool, | |||
| // signed | |||
| vtShortInt, | |||
| vtSmallInt, | |||
| vtLongInt, | |||
| vtInt64, | |||
| // unsigned | |||
| vtByte, | |||
| vtWord, | |||
| vtLongWord, | |||
| vtQuadWord, | |||
| // floating point | |||
| vtSingle, | |||
| vtDouble, | |||
| vtExtended, | |||
| // characters | |||
| vtAnsiChar, | |||
| vtWideChar, | |||
| // strings | |||
| vtShortString, | |||
| vtAnsiString, | |||
| vtWideString, | |||
| vtUnicodeString, | |||
| vtUTF8String | |||
| ); | |||
| ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlVariant = packed record | |||
| private | |||
| function GetVarType: TutlVariantType; | |||
| public | |||
| property VarType: TutlVariantType read GetVarType; | |||
| private | |||
| case fType: TutlVariantType of | |||
| vtNull: (); | |||
| // boolean | |||
| vtBool: (fBool: Boolean); | |||
| vtByteBool: (fByteBool: ByteBool); | |||
| vtWordBool: (fWordBool: WordBool); | |||
| vtLongBool: (fLongBool: LongBool); | |||
| // signed | |||
| vtShortInt: (fShortInt: ShortInt); | |||
| vtSmallInt: (fSmallInt: SmallInt); | |||
| vtLongInt: (fLongInt: LongInt); | |||
| vtInt64: (fInt64: Int64); | |||
| // unsigned | |||
| vtByte: (fByte: Byte); | |||
| vtWord: (fWord: Word); | |||
| vtLongWord: (fLongWord: LongWord); | |||
| vtQuadWord: (fQuadWord: QWord); | |||
| // floating point | |||
| vtSingle: (fFloat: Single); | |||
| vtDouble: (fDouble: Double); | |||
| vtExtended: (fExtended: Extended); | |||
| // characters | |||
| vtAnsiChar: (fAnsiChar: AnsiChar); | |||
| vtWideChar: (fWideChar: WideChar); | |||
| // strings | |||
| vtShortString: (fShortString: ShortString); | |||
| end; | |||
| implementation | |||
| ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlVariant//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlVariant.GetVarType: TutlVariantType; | |||
| begin | |||
| result := fType; | |||
| end; | |||
| end. | |||
| @@ -0,0 +1,206 @@ | |||
| unit uutlVariantEnum; | |||
| {$mode objfpc}{$H+} | |||
| interface | |||
| uses | |||
| Classes, SysUtils, variants, | |||
| uutlGenerics; | |||
| function VarEnum: TVarType; inline; | |||
| function VarIsEnum(const aValue: Variant): Boolean; inline; | |||
| function VarAsEnum(const aValue: Variant): Variant; inline; | |||
| function VarMakeEnum(const aValue: Integer): Variant; | |||
| function VarMakeEnum(const aValue: Integer; const aHelper: TutlEnumHelperBaseClass): Variant; | |||
| function VarGetEnumHelper(const aValue: Variant): TutlEnumHelperBaseClass; | |||
| implementation | |||
| type | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| PEnumVarData = ^TEnumVarData; | |||
| TEnumVarData = packed record | |||
| vType: TVarType; | |||
| case Integer of | |||
| 0: ( | |||
| vValue: Integer; | |||
| vHelper: TutlEnumHelperBaseClass; | |||
| ); | |||
| 1: (vBytes : array[0..13] of byte); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlVariantEnum = class(TCustomVariantType) | |||
| public | |||
| procedure Cast (var Dest: TVarData; const Source: TVarData); override; | |||
| procedure CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); override; | |||
| procedure Copy (var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override; | |||
| procedure Clear (var V: TVarData); override; | |||
| end; | |||
| var | |||
| VariantEnum: TutlVariantEnum; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarEnum: TVarType; | |||
| begin | |||
| result := VariantEnum.VarType; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarIsEnum(const aValue: Variant): Boolean; | |||
| begin | |||
| result := (VarType(aValue) = VariantEnum.VarType); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarAsEnum(const aValue: Variant): Variant; | |||
| begin | |||
| if not VarIsEnum(aValue) | |||
| then VarCast(result, aValue, VarEnum) | |||
| else result := aValue; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarMakeEnum(const aValue: Integer): Variant; | |||
| begin | |||
| result := VarMakeEnum(aValue, nil); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarMakeEnum(const aValue: Integer; const aHelper: TutlEnumHelperBaseClass): Variant; | |||
| begin | |||
| with PEnumVarData(@TVarData(result))^ do begin | |||
| vType := VariantEnum.VarType; | |||
| vValue := aValue; | |||
| vHelper := aHelper; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarGetEnumHelper(const aValue: Variant): TutlEnumHelperBaseClass; | |||
| begin | |||
| if not VarIsEnum(aValue) then | |||
| VarBadTypeError; | |||
| result := PEnumVarData(@TVarData(aValue))^.vHelper; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlVariantEnum/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantEnum.Cast(var Dest: TVarData; const Source: TVarData); | |||
| function CheckValue(const aValue: Integer): Boolean; | |||
| var | |||
| i: Integer; | |||
| begin | |||
| with PEnumVarData(@Dest)^ do begin | |||
| result := true; | |||
| if not Assigned(vHelper) then | |||
| exit; | |||
| for i in vHelper.IntValues do | |||
| if (i = aValue) then | |||
| exit; | |||
| result := false; | |||
| end; | |||
| end; | |||
| var | |||
| LSource: TVarData; | |||
| begin | |||
| if (Dest.vtype <> VariantEnum.VarType) then | |||
| RaiseCastError; | |||
| VarDataInit(LSource{%H-}); | |||
| try | |||
| VarDataCopyNoInd(LSource, Source); | |||
| case LSource.vtype of | |||
| varsmallint, | |||
| varinteger, | |||
| vardecimal, | |||
| varshortint, | |||
| varbyte, | |||
| varword, | |||
| varlongword, | |||
| varint64, | |||
| varqword: with PEnumVarData(@Dest)^ do begin | |||
| if not CheckValue(Variant(LSource)) then | |||
| RaiseCastError; | |||
| vValue := Variant(Source); | |||
| end; | |||
| else | |||
| with PEnumVarData(@Dest)^ do begin | |||
| if not Assigned(vHelper) then | |||
| RaiseCastError; | |||
| if not vHelper.TryToEnum(Variant(LSource), vValue, true) then | |||
| RaiseCastError; | |||
| end; | |||
| end; | |||
| finally | |||
| VarDataClear(LSource); | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantEnum.CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); | |||
| var | |||
| tmp: TVarData; | |||
| begin | |||
| if (Source.vtype <> VarType) then | |||
| RaiseCastError; | |||
| with PEnumVarData(@Source)^ do begin | |||
| case aVarType of | |||
| varolestr: | |||
| if Assigned(vHelper) then begin | |||
| VarDataFromOleStr(Dest, WideString(vHelper.ToString(vValue, true))); | |||
| exit; | |||
| end; | |||
| varstring: | |||
| if Assigned(vHelper) then begin | |||
| VarDataFromStr(Dest, vHelper.ToString(vValue, true)); | |||
| exit; | |||
| end; | |||
| end; | |||
| VarDataInit(tmp{%H-}); | |||
| try | |||
| tmp.vtype := varinteger; | |||
| tmp.vinteger := vValue; | |||
| VarDataCastTo(Dest, tmp, aVarType); | |||
| finally | |||
| VarDataClear(tmp); | |||
| end; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantEnum.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); | |||
| var | |||
| src, dst: PEnumVarData; | |||
| begin | |||
| if (Dest.vtype <> varempty) and (Dest.vtype <> Source.vtype) then | |||
| RaiseInvalidOp; | |||
| src := PEnumVarData(@Source); | |||
| dst := PEnumVarData(@Dest); | |||
| dst^.vType := src^.vType; | |||
| dst^.vHelper := src^.vHelper; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantEnum.Clear(var V: TVarData); | |||
| begin | |||
| // DUMMY | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| initialization | |||
| VariantEnum := TutlVariantEnum.Create; | |||
| finalization | |||
| FreeAndNil(VariantEnum); | |||
| end. | |||
| @@ -0,0 +1,149 @@ | |||
| unit uutlVariantObject; | |||
| {$mode objfpc}{$H+} | |||
| interface | |||
| uses | |||
| Classes, SysUtils, variants; | |||
| function VarObject: TVarType; inline; | |||
| function VarIsObject(const aValue: Variant): Boolean; inline; | |||
| function VarAsObject(const aValue: Variant): Variant; inline; | |||
| operator :=(const aValue: TObject): Variant; inline; | |||
| operator :=(const aValue: Variant): TObject; inline; | |||
| implementation | |||
| type | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlVariantObject = class(TCustomVariantType) | |||
| public | |||
| function IsClear (const V: TVarData): Boolean; override; | |||
| procedure Cast (var Dest: TVarData; const Source: TVarData); override; | |||
| procedure CastTo (var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); override; | |||
| procedure Clear (var V: TVarData); override; | |||
| procedure Copy (var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override; | |||
| public | |||
| class function FromObject(const aObj: TObject): Variant; | |||
| class function ToObject (const aVar: Variant): TObject; | |||
| end; | |||
| var | |||
| VariantObject: TutlVariantObject; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarObject: TVarType; | |||
| begin | |||
| result := VariantObject.VarType; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarIsObject(const aValue: Variant): Boolean; | |||
| begin | |||
| result := (TVarData(aValue).vtype = VarObject); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarAsObject(const aValue: Variant): Variant; | |||
| begin | |||
| if not VarIsObject(aValue) | |||
| then VarCast(result, aValue, VarObject) | |||
| else result := aValue; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| operator := (const aValue: TObject): Variant; | |||
| begin | |||
| result := TutlVariantObject.FromObject(aValue); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| operator := (const aValue: Variant): TObject; | |||
| begin | |||
| result := TutlVariantObject.ToObject(aValue); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlVariantObject///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlVariantObject.IsClear(const V: TVarData): Boolean; | |||
| begin | |||
| result := (V.vpointer = nil); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantObject.Cast(var Dest: TVarData; const Source: TVarData); | |||
| begin | |||
| RaiseCastError; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantObject.CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); | |||
| var | |||
| tmp: TVarData; | |||
| begin | |||
| if (Source.vtype <> VarType) then | |||
| RaiseCastError; | |||
| case aVarType of | |||
| varolestr: | |||
| VarDataFromOleStr(Dest, WideString(Format('$%p', [Source.vpointer]))); | |||
| varstring: | |||
| VarDataFromStr(Dest, Format('$%p', [Source.vpointer])); | |||
| else | |||
| VarDataInit(tmp{%H-}); | |||
| try | |||
| tmp.vtype := varqword; | |||
| tmp.vqword := QWord(Source.vpointer); | |||
| VarDataCastTo(Dest, tmp, aVarType); | |||
| finally | |||
| VarDataClear(tmp); | |||
| end; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantObject.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); | |||
| begin | |||
| if (Dest.vtype <> varempty) and (Dest.vtype <> Source.vtype) then | |||
| RaiseInvalidOp; | |||
| Dest := Source; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantObject.Clear(var V: TVarData); | |||
| begin | |||
| V.vpointer := nil; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlVariantObject.FromObject(const aObj: TObject): Variant; | |||
| begin | |||
| TVarData(result).vtype := VarObject; | |||
| TVarData(result).vpointer := aObj; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlVariantObject.ToObject(const aVar: Variant): TObject; | |||
| var | |||
| v: Variant; | |||
| begin | |||
| v := VarAsObject(aVar); | |||
| result := TObject(TVarData(v).vpointer); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| initialization | |||
| VariantObject := TutlVariantObject.Create; | |||
| finalization | |||
| FreeAndNil(VariantObject); | |||
| end. | |||
| @@ -0,0 +1,157 @@ | |||
| unit uutlVariantProperty; | |||
| {$mode objfpc}{$H+} | |||
| interface | |||
| uses | |||
| Classes, SysUtils, variants, typinfo; | |||
| function VarProperty: TVarType; inline; | |||
| function VarIsProperty(const aValue: Variant): Boolean; inline; | |||
| function VarAsProperty(const aValue: Variant): Variant; inline; | |||
| operator :=(const aValue: PPropInfo): Variant; | |||
| operator :=(const aValue: Variant): PPropInfo; | |||
| implementation | |||
| type | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlVariantPropInfo = class(TCustomVariantType) | |||
| public | |||
| function IsClear (const V: TVarData): Boolean; override; | |||
| procedure Cast (var Dest: TVarData; const Source: TVarData); override; | |||
| procedure CastTo (var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); override; | |||
| procedure Clear (var V: TVarData); override; | |||
| procedure Copy (var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override; | |||
| public | |||
| class function FromPropInfo(const aPropInfo: PPropInfo): Variant; | |||
| class function ToPropInfo (const aValue: Variant): PPropInfo; | |||
| end; | |||
| var | |||
| VariantProperty: TutlVariantPropInfo; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarProperty: TVarType; | |||
| begin | |||
| result := VariantProperty.VarType; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarIsProperty(const aValue: Variant): Boolean; | |||
| begin | |||
| result := (VarType(aValue) = VarProperty); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarAsProperty(const aValue: Variant): Variant; | |||
| begin | |||
| if not VarIsProperty(aValue) | |||
| then VarCast(result, aValue, VarProperty) | |||
| else result := aValue; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| operator := (const aValue: PPropInfo): Variant; | |||
| begin | |||
| result := TutlVariantPropInfo.FromPropInfo(aValue); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| operator := (const aValue: Variant): PPropInfo; | |||
| begin | |||
| result := TutlVariantPropInfo.ToPropInfo(aValue); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlVariantProperty/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlVariantPropInfo.IsClear(const V: TVarData): Boolean; | |||
| begin | |||
| result := not Assigned(V.vpointer); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantPropInfo.Cast(var Dest: TVarData; const Source: TVarData); | |||
| begin | |||
| RaiseCastError; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantPropInfo.CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); | |||
| begin | |||
| if (Source.vtype <> VarType) then | |||
| RaiseCastError; | |||
| case aVarType of | |||
| varolestr: | |||
| if IsClear(Source) | |||
| then VarDataFromOleStr(Dest, '') | |||
| else VarDataFromOleStr(Dest, WideString(PPropInfo(Source.vpointer)^.Name)); | |||
| varstring: | |||
| if IsClear(Source) | |||
| then VarDataFromStr(Dest, '') | |||
| else VarDataFromStr(Dest, PPropInfo(Source.vpointer)^.Name); | |||
| else | |||
| RaiseCastError; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantPropInfo.Clear(var V: TVarData); | |||
| begin | |||
| if Assigned(V.vpointer) then begin | |||
| Dispose(PPropInfo(V.vpointer)); | |||
| V.vpointer := nil; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantPropInfo.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); | |||
| begin | |||
| if (Dest.vtype <> varempty) and (Dest.vtype <> Source.vtype) then | |||
| RaiseInvalidOp; | |||
| Dest.vtype := Source.vtype; | |||
| if Assigned(Source.vpointer) then begin | |||
| if not Assigned(Dest.vpointer) then | |||
| Dest.vpointer := New(PPropInfo); | |||
| PPropInfo(Dest.vpointer)^ := PPropInfo(Source.vpointer)^; | |||
| end else if Assigned(Dest.vpointer) then begin | |||
| Dispose(PPropInfo(Dest.vpointer)); | |||
| Dest.vpointer := nil; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlVariantPropInfo.FromPropInfo(const aPropInfo: PPropInfo): Variant; | |||
| begin | |||
| with TVarData(result) do begin | |||
| vPointer := new(PPropInfo); | |||
| vType := VarProperty; | |||
| PPropInfo(vPointer)^ := aPropInfo^; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| class function TutlVariantPropInfo.ToPropInfo(const aValue: Variant): PPropInfo; | |||
| begin | |||
| with TVarData(aValue) do begin | |||
| result := PPropInfo(vpointer); | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| initialization | |||
| VariantProperty := TutlVariantPropInfo.Create; | |||
| finalization | |||
| FreeAndNil(VariantProperty); | |||
| end. | |||
| @@ -0,0 +1,172 @@ | |||
| unit uutlVariantSet; | |||
| {$mode objfpc}{$H+} | |||
| interface | |||
| uses | |||
| Classes, SysUtils, variants, | |||
| uutlGenerics; | |||
| function VarSet: TVarType; inline; | |||
| function VarIsSet(const aValue: Variant): Boolean; inline; | |||
| function VarAsSet(const aValue: Variant): Variant; inline; | |||
| function VarMakeSet(const aValue; const aSize: Integer): Variant; | |||
| function VarMakeSet(const aValue; const aSize: Integer; const aHelper: TutlSetHelperBaseClass): Variant; | |||
| function VarGetSetHelper(const aValue: Variant): TutlSetHelperBaseClass; | |||
| implementation | |||
| type | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| PSetData = ^TSetData; | |||
| TSetData = packed record | |||
| Data: array[0..31] of Byte; | |||
| Size: Integer; | |||
| Helper: TutlSetHelperBaseClass; | |||
| end; | |||
| PSetVarData = ^TSetVarData; | |||
| TSetVarData = packed record | |||
| vType: TVarType; | |||
| case Integer of | |||
| 0: (vData: PSetData); | |||
| 1: (vBytes: array[0..13] of Byte); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| TutlVariantSet = class(TCustomVariantType) | |||
| public | |||
| procedure Cast (var Dest: TVarData; const Source: TVarData); override; | |||
| procedure CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); override; | |||
| procedure Copy (var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override; | |||
| procedure Clear (var V: TVarData); override; | |||
| end; | |||
| var | |||
| VariantSet: TutlVariantSet; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarSet: TVarType; | |||
| begin | |||
| result := VariantSet.VarType; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarIsSet(const aValue: Variant): Boolean; | |||
| begin | |||
| result := (VarType(aValue) = VarSet); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarAsSet(const aValue: Variant): Variant; | |||
| begin | |||
| if not VarIsSet(aValue) | |||
| then VarCast(result, aValue, VarSet) | |||
| else result := aValue; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarMakeSet(const aValue; const aSize: Integer): Variant; | |||
| begin | |||
| result := VarMakeSet(aValue, aSize, nil); | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarMakeSet(const aValue; const aSize: Integer; const aHelper: TutlSetHelperBaseClass): Variant; | |||
| begin | |||
| with PSetVarData(@TVarData(result))^ do begin | |||
| New (vData); | |||
| FillByte(vData^.Data, SizeOf(vData^.Data), 0); | |||
| Move (aValue, vData^.Data, aSize); | |||
| vType := VarSet; | |||
| vData^.Size := aSize; | |||
| vData^.Helper := aHelper; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function VarGetSetHelper(const aValue: Variant): TutlSetHelperBaseClass; | |||
| begin | |||
| if not VarIsSet(aValue) then | |||
| VarBadTypeError; | |||
| with PSetVarData(@TVarData(aValue))^ do begin | |||
| if not Assigned(vData) then | |||
| VarInvalidOp; | |||
| result := vData^.Helper; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //TutlVariantSet//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantSet.Cast(var Dest: TVarData; const Source: TVarData); | |||
| begin | |||
| if (Dest.vType <> VariantSet.VarType) then | |||
| RaiseCastError; | |||
| with PSetVarData(@Dest)^ do begin | |||
| if not Assigned(vData^.Helper) then | |||
| RaiseCastError; | |||
| if not vData^.Helper.TryToSet(Variant(Source), vData^.Data, vData^.Size) then | |||
| RaiseCastError; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantSet.CastTo(var Dest: TVarData; const Source: TVarData; const aVarType: TVarType); | |||
| begin | |||
| if (Source.vtype <> VarType) then | |||
| RaiseCastError; | |||
| with PSetVarData(@Source)^ do begin | |||
| if not Assigned(vData^.Helper) then | |||
| RaiseCastError; | |||
| case aVarType of | |||
| varolestr: | |||
| VarDataFromOleStr(Dest, WideString(vData^.Helper.ToString(vData^.Data, vData^.Size))); | |||
| varstring: | |||
| VarDataFromStr(Dest, vData^.Helper.ToString(vData^.Data, vData^.Size)); | |||
| else | |||
| RaiseCastError; | |||
| end; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantSet.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); | |||
| var | |||
| src, dst: PSetVarData; | |||
| begin | |||
| if (Dest.vtype <> varempty) and (Dest.vtype <> Source.vtype) then | |||
| RaiseInvalidOp; | |||
| src := PSetVarData(@Source); | |||
| dst := PSetVarData(@Dest); | |||
| dst^.vType := src^.vType; | |||
| if not Assigned(dst^.vData) then | |||
| new(dst^.vData); | |||
| dst^.vData^ := src^.vData^; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| procedure TutlVariantSet.Clear(var V: TVarData); | |||
| begin | |||
| with PSetVarData(@V)^ do begin | |||
| if Assigned(vData) then begin | |||
| Dispose(vData); | |||
| vData := nil; | |||
| end; | |||
| end; | |||
| end; | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| initialization | |||
| VariantSet := TutlVariantSet.Create; | |||
| finalization | |||
| FreeAndNil(VariantSet); | |||
| end. | |||
| @@ -217,13 +217,17 @@ end; | |||
| ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||
| function TutlNodeEnumerator.MoveNext: Boolean; | |||
| var | |||
| c: Integer; | |||
| begin | |||
| c := fParent.ChildNodes.Count; | |||
| repeat | |||
| inc(fIndex) | |||
| until (fIndex {%H-}>= fParent.ChildNodes.Count) | |||
| or ( (fName = '') | |||
| or (fName = fParent.ChildNodes[fIndex].NodeName)); | |||
| result := (fIndex {%H-}< fParent.ChildNodes.Count); | |||
| until (fIndex >= c) | |||
| or ( (fParent.ChildNodes[fIndex] is TDOMElement) | |||
| and ( (fName = '') | |||
| or (fName = fParent.ChildNodes[fIndex].NodeName))); | |||
| result := (fIndex < c); | |||
| end; | |||
| ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// | |||