aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

* Updated Vampyre Imaging Lib 

* Fixed heContrs compilation
* Fixed region editing in frmLargeScaleCommand and frmRegionControl
* Fixed control alignment in frmMain
This commit is contained in:
Andreas Schneider 2013-11-03 14:12:48 +01:00
parent 4a5a835afd
commit 9676549ac3
25 changed files with 21231 additions and 21272 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

988
Client/CentrED.lpi
View File

@ -1,491 +1,497 @@
<?xml version="1.0"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="9"/> <Version Value="9"/>
<General> <General>
<Flags> <Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/> <MainUnitHasUsesSectionForAllUnits Value="False"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<Title Value="CentrED"/> <Title Value="CentrED"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
<Icon Value="0"/> <Icon Value="0"/>
</General> </General>
<LazDoc Paths="../doc"/> <LazDoc Paths="../doc"/>
<VersionInfo> <VersionInfo>
<UseVersionInfo Value="True"/> <UseVersionInfo Value="True"/>
<MinorVersionNr Value="6"/> <MinorVersionNr Value="6"/>
<RevisionNr Value="3"/> <RevisionNr Value="3"/>
<BuildNr Value="241"/> <BuildNr Value="241"/>
<StringTable CompanyName="AKS DataBasis" ProductName="CentrED" InternalName="CentrED" LegalCopyright="(c) 2012 Andreas Schneider" ProductVersion="0.6.3" FileDescription="UO CentrED" OriginalFilename="CentrED.exe"/> <StringTable CompanyName="AKS DataBasis" ProductName="CentrED" InternalName="CentrED" LegalCopyright="(c) 2012 Andreas Schneider" ProductVersion="0.6.3" FileDescription="UO CentrED" OriginalFilename="CentrED.exe"/>
</VersionInfo> </VersionInfo>
<BuildModes Count="3"> <BuildModes Count="3">
<Item1 Name="default" Default="True"/> <Item1 Name="default" Default="True"/>
<Item2 Name="Release Win32"> <Item2 Name="Release Win32">
<MacroValues Count="1"> <MacroValues Count="1">
<Macro1 Name="LCLWidgetType" Value="win32"/> <Macro1 Name="LCLWidgetType" Value="win32"/>
</MacroValues> </MacroValues>
<CompilerOptions> <CompilerOptions>
<Version Value="11"/> <Version Value="11"/>
<Target> <Target>
<Filename Value="../bin/CentrED"/> <Filename Value="../bin/CentrED"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/> <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/> <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/> <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>
<SyntaxOptions> <SyntaxOptions>
<CStyleOperator Value="False"/> <CStyleOperator Value="False"/>
</SyntaxOptions> </SyntaxOptions>
</Parsing> </Parsing>
<CodeGeneration> <CodeGeneration>
<SmartLinkUnit Value="True"/> <SmartLinkUnit Value="True"/>
<TargetCPU Value="i386"/> <TargetCPU Value="i386"/>
<TargetOS Value="win32"/> <TargetOS Value="win32"/>
<Optimizations> <Optimizations>
<OptimizationLevel Value="3"/> <OptimizationLevel Value="3"/>
</Optimizations> </Optimizations>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>
<GenerateDebugInfo Value="False"/> <GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/> <UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/> <StripSymbols Value="True"/>
</Debugging> </Debugging>
<LinkSmart Value="True"/> <LinkSmart Value="True"/>
<Options> <Options>
<Win32> <Win32>
<GraphicApplication Value="True"/> <GraphicApplication Value="True"/>
</Win32> </Win32>
</Options> </Options>
</Linking> </Linking>
<Other> <Other>
<CompilerMessages> <CompilerMessages>
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/> <IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
<UseMsgFile Value="True"/> <UseMsgFile Value="True"/>
</CompilerMessages> </CompilerMessages>
<CustomOptions Value="-FE../bin/ <CustomOptions Value="-FE../bin/
-dNoLogging"/> -dNoLogging"/>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
</Item2> </Item2>
<Item3 Name="Release Linux GTK2 x86"> <Item3 Name="Release Linux GTK2 x86">
<MacroValues Count="1"> <MacroValues Count="1">
<Macro1 Name="LCLWidgetType" Value="gtk2"/> <Macro2 Name="LCLWidgetType" Value="gtk2"/>
</MacroValues> </MacroValues>
<CompilerOptions> <CompilerOptions>
<Version Value="11"/> <Version Value="11"/>
<Target> <Target>
<Filename Value="../bin/CentrED"/> <Filename Value="../bin/CentrED"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/> <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/> <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/> <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>
<SyntaxOptions> <SyntaxOptions>
<CStyleOperator Value="False"/> <CStyleOperator Value="False"/>
</SyntaxOptions> </SyntaxOptions>
</Parsing> </Parsing>
<CodeGeneration> <CodeGeneration>
<SmartLinkUnit Value="True"/> <SmartLinkUnit Value="True"/>
<TargetCPU Value="i386"/> <TargetCPU Value="i386"/>
<TargetOS Value="linux"/> <TargetOS Value="linux"/>
<Optimizations> <Optimizations>
<OptimizationLevel Value="3"/> <OptimizationLevel Value="3"/>
</Optimizations> </Optimizations>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>
<GenerateDebugInfo Value="False"/> <GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/> <UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/> <StripSymbols Value="True"/>
</Debugging> </Debugging>
<LinkSmart Value="True"/> <LinkSmart Value="True"/>
<Options> <Options>
<Win32> <Win32>
<GraphicApplication Value="True"/> <GraphicApplication Value="True"/>
</Win32> </Win32>
</Options> </Options>
</Linking> </Linking>
<Other> <Other>
<CompilerMessages> <CompilerMessages>
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/> <IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
<UseMsgFile Value="True"/> <UseMsgFile Value="True"/>
</CompilerMessages> </CompilerMessages>
<CustomOptions Value="-FE../bin/ <CustomOptions Value="-FE../bin/
-dNoLogging"/> -dNoLogging"/>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
</Item3> </Item3>
</BuildModes> <SharedMatrixOptions Count="2">
<PublishOptions> <Item1 ID="851019893220" Modes="Release Win32" Type="IDEMacro" MacroName="LCLWidgetType" Value="win32"/>
<Version Value="2"/> <Item2 ID="521965364444" Modes="Release Linux GTK2 x86" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> </SharedMatrixOptions>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> </BuildModes>
</PublishOptions> <PublishOptions>
<RunParams> <Version Value="2"/>
<local> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<FormatVersion Value="1"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> </PublishOptions>
</local> <RunParams>
<environment> <local>
<UserOverrides Count="1"> <FormatVersion Value="1"/>
<Variable0 Name="HEAPTRC" Value="log=CentrED.trc"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</UserOverrides> </local>
</environment> <environment>
</RunParams> <UserOverrides Count="1">
<RequiredPackages Count="6"> <Variable0 Name="HEAPTRC" Value="log=CentrED.trc"/>
<Item1> </UserOverrides>
<PackageName Value="LCLBase"/> </environment>
<MinVersion Major="1" Valid="True" Release="1"/> </RunParams>
</Item1> <RequiredPackages Count="6">
<Item2> <Item1>
<PackageName Value="multiloglaz"/> <PackageName Value="LCLBase"/>
</Item2> <MinVersion Major="1" Release="1" Valid="True"/>
<Item3> </Item1>
<PackageName Value="LazOpenGLContext"/> <Item2>
<MinVersion Valid="True"/> <PackageName Value="multiloglaz"/>
</Item3> </Item2>
<Item4> <Item3>
<PackageName Value="LCL"/> <PackageName Value="LazOpenGLContext"/>
</Item4> <MinVersion Valid="True"/>
<Item5> </Item3>
<PackageName Value="lnetvisual"/> <Item4>
<MinVersion Minor="5" Valid="True" Release="3"/> <PackageName Value="LCL"/>
</Item5> </Item4>
<Item6> <Item5>
<PackageName Value="virtualtreeview_package"/> <PackageName Value="lnetvisual"/>
<MinVersion Major="4" Minor="5" Valid="True" Release="1"/> <MinVersion Minor="5" Release="3" Valid="True"/>
</Item6> </Item5>
</RequiredPackages> <Item6>
<Units Count="48"> <PackageName Value="virtualtreeview_package"/>
<Unit0> <MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
<Filename Value="CentrED.lpr"/> </Item6>
<IsPartOfProject Value="True"/> </RequiredPackages>
<UnitName Value="CentrED"/> <Units Count="48">
</Unit0> <Unit0>
<Unit1> <Filename Value="CentrED.lpr"/>
<Filename Value="UfrmMain.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <UnitName Value="CentrED"/>
<ComponentName Value="frmMain"/> </Unit0>
<ResourceBaseClass Value="Form"/> <Unit1>
<UnitName Value="UfrmMain"/> <Filename Value="UfrmMain.pas"/>
</Unit1> <IsPartOfProject Value="True"/>
<Unit2> <ComponentName Value="frmMain"/>
<Filename Value="UdmNetwork.pas"/> <HasResources Value="True"/>
<IsPartOfProject Value="True"/> <ResourceBaseClass Value="Form"/>
<ComponentName Value="dmNetwork"/> <UnitName Value="UfrmMain"/>
<ResourceBaseClass Value="DataModule"/> </Unit1>
<UnitName Value="UdmNetwork"/> <Unit2>
</Unit2> <Filename Value="UdmNetwork.pas"/>
<Unit3> <IsPartOfProject Value="True"/>
<Filename Value="UfrmLogin.pas"/> <ComponentName Value="dmNetwork"/>
<IsPartOfProject Value="True"/> <ResourceBaseClass Value="DataModule"/>
<ComponentName Value="frmLogin"/> <UnitName Value="UdmNetwork"/>
<ResourceBaseClass Value="Form"/> </Unit2>
<UnitName Value="UfrmLogin"/> <Unit3>
</Unit3> <Filename Value="UfrmLogin.pas"/>
<Unit4> <IsPartOfProject Value="True"/>
<Filename Value="UfrmInitialize.pas"/> <ComponentName Value="frmLogin"/>
<IsPartOfProject Value="True"/> <ResourceBaseClass Value="Form"/>
<ComponentName Value="frmInitialize"/> <UnitName Value="UfrmLogin"/>
<ResourceBaseClass Value="Form"/> </Unit3>
<UnitName Value="UfrmInitialize"/> <Unit4>
</Unit4> <Filename Value="UfrmInitialize.pas"/>
<Unit5> <IsPartOfProject Value="True"/>
<Filename Value="UfrmAccountControl.pas"/> <ComponentName Value="frmInitialize"/>
<IsPartOfProject Value="True"/> <ResourceBaseClass Value="Form"/>
<ComponentName Value="frmAccountControl"/> <UnitName Value="UfrmInitialize"/>
<ResourceBaseClass Value="Form"/> </Unit4>
<UnitName Value="UfrmAccountControl"/> <Unit5>
</Unit5> <Filename Value="UfrmAccountControl.pas"/>
<Unit6> <IsPartOfProject Value="True"/>
<Filename Value="UfrmEditAccount.pas"/> <ComponentName Value="frmAccountControl"/>
<IsPartOfProject Value="True"/> <HasResources Value="True"/>
<ComponentName Value="frmEditAccount"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmAccountControl"/>
<UnitName Value="UfrmEditAccount"/> </Unit5>
</Unit6> <Unit6>
<Unit7> <Filename Value="UfrmEditAccount.pas"/>
<Filename Value="Tools/UfrmDrawSettings.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmEditAccount"/>
<ComponentName Value="frmDrawSettings"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmEditAccount"/>
<UnitName Value="UfrmDrawSettings"/> </Unit6>
</Unit7> <Unit7>
<Unit8> <Filename Value="Tools/UfrmDrawSettings.pas"/>
<Filename Value="Tools/UfrmBoundaries.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmDrawSettings"/>
<ComponentName Value="frmBoundaries"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmDrawSettings"/>
<UnitName Value="UfrmBoundaries"/> </Unit7>
</Unit8> <Unit8>
<Unit9> <Filename Value="Tools/UfrmBoundaries.pas"/>
<Filename Value="Tools/UfrmElevateSettings.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmBoundaries"/>
<ComponentName Value="frmElevateSettings"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmBoundaries"/>
<UnitName Value="UfrmElevateSettings"/> </Unit8>
</Unit9> <Unit9>
<Unit10> <Filename Value="Tools/UfrmElevateSettings.pas"/>
<Filename Value="UOverlayUI.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmElevateSettings"/>
<UnitName Value="UOverlayUI"/> <ResourceBaseClass Value="Form"/>
</Unit10> <UnitName Value="UfrmElevateSettings"/>
<Unit11> </Unit9>
<Filename Value="UResourceManager.pas"/> <Unit10>
<IsPartOfProject Value="True"/> <Filename Value="UOverlayUI.pas"/>
<UnitName Value="UResourceManager"/> <IsPartOfProject Value="True"/>
</Unit11> <UnitName Value="UOverlayUI"/>
<Unit12> </Unit10>
<Filename Value="Tools/UfrmConfirmation.pas"/> <Unit11>
<IsPartOfProject Value="True"/> <Filename Value="UResourceManager.pas"/>
<ComponentName Value="frmConfirmation"/> <IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UResourceManager"/>
<UnitName Value="UfrmConfirmation"/> </Unit11>
</Unit12> <Unit12>
<Unit13> <Filename Value="Tools/UfrmConfirmation.pas"/>
<Filename Value="Tools/UfrmMoveSettings.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmConfirmation"/>
<ComponentName Value="frmMoveSettings"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmConfirmation"/>
<UnitName Value="UfrmMoveSettings"/> </Unit12>
</Unit13> <Unit13>
<Unit14> <Filename Value="Tools/UfrmMoveSettings.pas"/>
<Filename Value="UfrmAbout.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmMoveSettings"/>
<ComponentName Value="frmAbout"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmMoveSettings"/>
<UnitName Value="UfrmAbout"/> </Unit13>
</Unit14> <Unit14>
<Unit15> <Filename Value="UfrmAbout.pas"/>
<Filename Value="Tools/UfrmHueSettings.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmAbout"/>
<ComponentName Value="frmHueSettings"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmAbout"/>
<UnitName Value="UfrmHueSettings"/> </Unit14>
</Unit15> <Unit15>
<Unit16> <Filename Value="Tools/UfrmHueSettings.pas"/>
<Filename Value="UfrmRadar.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmHueSettings"/>
<ComponentName Value="frmRadarMap"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmHueSettings"/>
<UnitName Value="UfrmRadar"/> </Unit15>
</Unit16> <Unit16>
<Unit17> <Filename Value="UfrmRadar.pas"/>
<Filename Value="UfrmLargeScaleCommand.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmRadarMap"/>
<ComponentName Value="frmLargeScaleCommand"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmRadar"/>
<UnitName Value="UfrmLargeScaleCommand"/> </Unit16>
</Unit17> <Unit17>
<Unit18> <Filename Value="UfrmLargeScaleCommand.pas"/>
<Filename Value="Tools/UfrmVirtualLayer.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmLargeScaleCommand"/>
<ComponentName Value="frmVirtualLayer"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmLargeScaleCommand"/>
<UnitName Value="UfrmVirtualLayer"/> </Unit17>
</Unit18> <Unit18>
<Unit19> <Filename Value="Tools/UfrmVirtualLayer.pas"/>
<Filename Value="Tools/UfrmFilter.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmVirtualLayer"/>
<ComponentName Value="frmFilter"/> <ResourceBaseClass Value="Form"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UfrmVirtualLayer"/>
<UnitName Value="UfrmFilter"/> </Unit18>
</Unit19> <Unit19>
<Unit20> <Filename Value="Tools/UfrmFilter.pas"/>
<Filename Value="UGUIPlatformUtils.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmFilter"/>
<UnitName Value="UGUIPlatformUtils"/> <ResourceBaseClass Value="Form"/>
</Unit20> <UnitName Value="UfrmFilter"/>
<Unit21> </Unit19>
<Filename Value="UPlatformTypes.pas"/> <Unit20>
<IsPartOfProject Value="True"/> <Filename Value="UGUIPlatformUtils.pas"/>
<UnitName Value="UPlatformTypes"/> <IsPartOfProject Value="True"/>
</Unit21> <UnitName Value="UGUIPlatformUtils"/>
<Unit22> </Unit20>
<Filename Value="UfrmRegionControl.pas"/> <Unit21>
<IsPartOfProject Value="True"/> <Filename Value="UPlatformTypes.pas"/>
<ComponentName Value="frmRegionControl"/> <IsPartOfProject Value="True"/>
<HasResources Value="True"/> <UnitName Value="UPlatformTypes"/>
<ResourceBaseClass Value="Form"/> </Unit21>
<UnitName Value="UfrmRegionControl"/> <Unit22>
</Unit22> <Filename Value="UfrmRegionControl.pas"/>
<Unit23> <IsPartOfProject Value="True"/>
<Filename Value="UPacketHandlers.pas"/> <ComponentName Value="frmRegionControl"/>
<IsPartOfProject Value="True"/> <HasResources Value="True"/>
<UnitName Value="UPacketHandlers"/> <ResourceBaseClass Value="Form"/>
</Unit23> <UnitName Value="UfrmRegionControl"/>
<Unit24> </Unit22>
<Filename Value="UPackets.pas"/> <Unit23>
<IsPartOfProject Value="True"/> <Filename Value="UPacketHandlers.pas"/>
<UnitName Value="UPackets"/> <IsPartOfProject Value="True"/>
</Unit24> <UnitName Value="UPacketHandlers"/>
<Unit25> </Unit23>
<Filename Value="ULandscape.pas"/> <Unit24>
<IsPartOfProject Value="True"/> <Filename Value="UPackets.pas"/>
<UnitName Value="ULandscape"/> <IsPartOfProject Value="True"/>
</Unit25> <UnitName Value="UPackets"/>
<Unit26> </Unit24>
<Filename Value="UGameResources.pas"/> <Unit25>
<IsPartOfProject Value="True"/> <Filename Value="ULandscape.pas"/>
<UnitName Value="UGameResources"/> <IsPartOfProject Value="True"/>
</Unit26> <UnitName Value="ULandscape"/>
<Unit27> </Unit25>
<Filename Value="UAdminHandling.pas"/> <Unit26>
<IsPartOfProject Value="True"/> <Filename Value="UGameResources.pas"/>
<UnitName Value="UAdminHandling"/> <IsPartOfProject Value="True"/>
</Unit27> <UnitName Value="UGameResources"/>
<Unit28> </Unit26>
<Filename Value="Tools/UfrmToolWindow.pas"/> <Unit27>
<IsPartOfProject Value="True"/> <Filename Value="UAdminHandling.pas"/>
<ComponentName Value="frmToolWindow"/> <IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="UAdminHandling"/>
<UnitName Value="UfrmToolWindow"/> </Unit27>
</Unit28> <Unit28>
<Unit29> <Filename Value="Tools/UfrmToolWindow.pas"/>
<Filename Value="../Logging.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmToolWindow"/>
<UnitName Value="Logging"/> <ResourceBaseClass Value="Form"/>
</Unit29> <UnitName Value="UfrmToolWindow"/>
<Unit30> </Unit28>
<Filename Value="../UOLib/UStatics.pas"/> <Unit29>
<IsPartOfProject Value="True"/> <Filename Value="../Logging.pas"/>
<UnitName Value="UStatics"/> <IsPartOfProject Value="True"/>
</Unit30> <UnitName Value="Logging"/>
<Unit31> </Unit29>
<Filename Value="../UOLib/UWorldItem.pas"/> <Unit30>
<IsPartOfProject Value="True"/> <Filename Value="../UOLib/UStatics.pas"/>
<UnitName Value="UWorldItem"/> <IsPartOfProject Value="True"/>
</Unit31> <UnitName Value="UStatics"/>
<Unit32> </Unit30>
<Filename Value="../UOLib/UMap.pas"/> <Unit31>
<IsPartOfProject Value="True"/> <Filename Value="../UOLib/UWorldItem.pas"/>
<UnitName Value="UMap"/> <IsPartOfProject Value="True"/>
</Unit32> <UnitName Value="UWorldItem"/>
<Unit33> </Unit31>
<Filename Value="../UOLib/UTiledata.pas"/> <Unit32>
<IsPartOfProject Value="True"/> <Filename Value="../UOLib/UMap.pas"/>
<UnitName Value="UTiledata"/> <IsPartOfProject Value="True"/>
</Unit33> <UnitName Value="UMap"/>
<Unit34> </Unit32>
<Filename Value="UGLFont.pas"/> <Unit33>
<IsPartOfProject Value="True"/> <Filename Value="../UOLib/UTiledata.pas"/>
<UnitName Value="UGLFont"/> <IsPartOfProject Value="True"/>
</Unit34> <UnitName Value="UTiledata"/>
<Unit35> </Unit33>
<Filename Value="../UOLib/UAnimData.pas"/> <Unit34>
<IsPartOfProject Value="True"/> <Filename Value="UGLFont.pas"/>
<UnitName Value="UAnimData"/> <IsPartOfProject Value="True"/>
</Unit35> <UnitName Value="UGLFont"/>
<Unit36> </Unit34>
<Filename Value="../MulProvider/UTileDataProvider.pas"/> <Unit35>
<IsPartOfProject Value="True"/> <Filename Value="../UOLib/UAnimData.pas"/>
<UnitName Value="UTileDataProvider"/> <IsPartOfProject Value="True"/>
</Unit36> <UnitName Value="UAnimData"/>
<Unit37> </Unit35>
<Filename Value="../MulProvider/UAnimDataProvider.pas"/> <Unit36>
<IsPartOfProject Value="True"/> <Filename Value="../MulProvider/UTileDataProvider.pas"/>
<UnitName Value="UAnimDataProvider"/> <IsPartOfProject Value="True"/>
</Unit37> <UnitName Value="UTileDataProvider"/>
<Unit38> </Unit36>
<Filename Value="../MulProvider/UMulManager.pas"/> <Unit37>
<IsPartOfProject Value="True"/> <Filename Value="../MulProvider/UAnimDataProvider.pas"/>
<UnitName Value="UMulManager"/> <IsPartOfProject Value="True"/>
</Unit38> <UnitName Value="UAnimDataProvider"/>
<Unit39> </Unit37>
<Filename Value="../MulProvider/UArtProvider.pas"/> <Unit38>
<IsPartOfProject Value="True"/> <Filename Value="../MulProvider/UMulManager.pas"/>
<UnitName Value="UArtProvider"/> <IsPartOfProject Value="True"/>
</Unit39> <UnitName Value="UMulManager"/>
<Unit40> </Unit38>
<Filename Value="../MulProvider/UTexmapProvider.pas"/> <Unit39>
<IsPartOfProject Value="True"/> <Filename Value="../MulProvider/UArtProvider.pas"/>
<UnitName Value="UTexmapProvider"/> <IsPartOfProject Value="True"/>
</Unit40> <UnitName Value="UArtProvider"/>
<Unit41> </Unit39>
<Filename Value="../version.inc"/> <Unit40>
<IsPartOfProject Value="True"/> <Filename Value="../MulProvider/UTexmapProvider.pas"/>
</Unit41> <IsPartOfProject Value="True"/>
<Unit42> <UnitName Value="UTexmapProvider"/>
<Filename Value="ULightManager.pas"/> </Unit40>
<IsPartOfProject Value="True"/> <Unit41>
<UnitName Value="ULightManager"/> <Filename Value="../version.inc"/>
</Unit42> <IsPartOfProject Value="True"/>
<Unit43> </Unit41>
<Filename Value="../UOLib/ULight.pas"/> <Unit42>
<IsPartOfProject Value="True"/> <Filename Value="ULightManager.pas"/>
<UnitName Value="ULight"/> <IsPartOfProject Value="True"/>
</Unit43> <UnitName Value="ULightManager"/>
<Unit44> </Unit42>
<Filename Value="../MulProvider/ULightProvider.pas"/> <Unit43>
<IsPartOfProject Value="True"/> <Filename Value="../UOLib/ULight.pas"/>
<UnitName Value="ULightProvider"/> <IsPartOfProject Value="True"/>
</Unit44> <UnitName Value="ULight"/>
<Unit45> </Unit43>
<Filename Value="Tools/UfrmLightlevel.pas"/> <Unit44>
<IsPartOfProject Value="True"/> <Filename Value="../MulProvider/ULightProvider.pas"/>
<ComponentName Value="frmLightlevel"/> <IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/> <UnitName Value="ULightProvider"/>
<UnitName Value="UfrmLightlevel"/> </Unit44>
</Unit45> <Unit45>
<Unit46> <Filename Value="Tools/UfrmLightlevel.pas"/>
<Filename Value="../heContnrs.pas"/> <IsPartOfProject Value="True"/>
<IsPartOfProject Value="True"/> <ComponentName Value="frmLightlevel"/>
<UnitName Value="heContnrs"/> <ResourceBaseClass Value="Form"/>
</Unit46> <UnitName Value="UfrmLightlevel"/>
<Unit47> </Unit45>
<Filename Value="../UContnrExt.pas"/> <Unit46>
<IsPartOfProject Value="True"/> <Filename Value="../heContnrs.pas"/>
<UnitName Value="UContnrExt"/> <IsPartOfProject Value="True"/>
</Unit47> <UnitName Value="heContnrs"/>
</Units> </Unit46>
</ProjectOptions> <Unit47>
<CompilerOptions> <Filename Value="../UContnrExt.pas"/>
<Version Value="11"/> <IsPartOfProject Value="True"/>
<Target> <UnitName Value="UContnrExt"/>
<Filename Value="../bin/CentrED"/> </Unit47>
</Target> </Units>
<SearchPaths> </ProjectOptions>
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/> <CompilerOptions>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/> <Version Value="11"/>
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/> <Target>
</SearchPaths> <Filename Value="../bin/CentrED"/>
<Parsing> </Target>
<SyntaxOptions> <SearchPaths>
<CStyleOperator Value="False"/> <IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
</SyntaxOptions> <OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
</Parsing> <UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
<CodeGeneration> </SearchPaths>
<Checks> <Parsing>
<RangeChecks Value="True"/> <SyntaxOptions>
</Checks> <CStyleOperator Value="False"/>
<Optimizations> </SyntaxOptions>
<OptimizationLevel Value="0"/> </Parsing>
</Optimizations> <CodeGeneration>
</CodeGeneration> <Checks>
<Linking> <RangeChecks Value="True"/>
<Debugging> </Checks>
<DebugInfoType Value="dsStabs"/> <Optimizations>
</Debugging> <OptimizationLevel Value="0"/>
</Linking> </Optimizations>
<Other> </CodeGeneration>
<CompilerMessages> <Linking>
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/> <Debugging>
<UseMsgFile Value="True"/> <DebugInfoType Value="dsStabs"/>
</CompilerMessages> </Debugging>
<CustomOptions Value="-FE../bin/"/> </Linking>
<CompilerPath Value="$(CompPath)"/> <Other>
</Other> <CompilerMessages>
</CompilerOptions> <IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
</CONFIG> <UseMsgFile Value="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

84
Client/UfrmLargeScaleCommand.lfm
View File

@ -15,7 +15,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
OnShow = FormShow OnShow = FormShow
Position = poOwnerFormCenter Position = poOwnerFormCenter
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
LCLVersion = '0.9.31' LCLVersion = '1.3'
object nbActions: TNotebook object nbActions: TNotebook
AnchorSideLeft.Control = vstActions AnchorSideLeft.Control = vstActions
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
@ -27,21 +27,21 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Height = 349 Height = 349
Top = 0 Top = 0
Width = 468 Width = 468
PageIndex = 3 PageIndex = 0
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0 TabOrder = 0
TabStop = True TabStop = True
object pgArea: TPage object pgArea: TPage
ClientWidth = 468
ClientHeight = 349
object sbArea: TScrollBox object sbArea: TScrollBox
Left = 0 Left = 0
Height = 349 Height = 349
Top = 0 Top = 0
Width = 468 Width = 468
HorzScrollBar.Page = 464
VertScrollBar.Page = 345
Align = alClient Align = alClient
ClientHeight = 347 ClientHeight = 345
ClientWidth = 466 ClientWidth = 464
TabOrder = 0 TabOrder = 0
object pbArea: TPaintBox object pbArea: TPaintBox
Left = 0 Left = 0
@ -55,8 +55,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
end end
object pgCopyMove: TPage object pgCopyMove: TPage
ClientWidth = 936
ClientHeight = 698
object rgCMAction: TRadioGroup object rgCMAction: TRadioGroup
AnchorSideLeft.Control = pgCopyMove AnchorSideLeft.Control = pgCopyMove
AnchorSideTop.Control = pgCopyMove AnchorSideTop.Control = pgCopyMove
@ -198,7 +196,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnGrabOffsetClick OnClick = btnGrabOffsetClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -218,8 +215,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
end end
object pgModifyAltitude: TPage object pgModifyAltitude: TPage
ClientWidth = 468
ClientHeight = 349
object Label2: TLabel object Label2: TLabel
AnchorSideLeft.Control = rbSetTerrainAltitude AnchorSideLeft.Control = rbSetTerrainAltitude
AnchorSideTop.Control = rbSetTerrainAltitude AnchorSideTop.Control = rbSetTerrainAltitude
@ -325,8 +320,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
end end
object pgDrawTerrain: TPage object pgDrawTerrain: TPage
ClientWidth = 468
ClientHeight = 349
object gbDrawTerrainTiles: TGroupBox object gbDrawTerrainTiles: TGroupBox
AnchorSideLeft.Control = pgDrawTerrain AnchorSideLeft.Control = pgDrawTerrain
AnchorSideTop.Control = pgDrawTerrain AnchorSideTop.Control = pgDrawTerrain
@ -454,7 +447,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnClearTerrainClick OnClick = btnClearTerrainClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -506,7 +498,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnDeleteTerrainClick OnClick = btnDeleteTerrainClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -514,8 +505,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
end end
object pgDeleteStatics: TPage object pgDeleteStatics: TPage
ClientWidth = 1848
ClientHeight = 1264
object gbDeleteStaticsTiles: TGroupBox object gbDeleteStaticsTiles: TGroupBox
AnchorSideLeft.Control = pgDeleteStatics AnchorSideLeft.Control = pgDeleteStatics
AnchorSideTop.Control = pgDeleteStatics AnchorSideTop.Control = pgDeleteStatics
@ -643,7 +632,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnClearDStaticsTilesClick OnClick = btnClearDStaticsTilesClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -695,7 +683,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnDeleteDStaticsTilesClick OnClick = btnDeleteDStaticsTilesClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -773,8 +760,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
end end
end end
object pgInsertStatics: TPage object pgInsertStatics: TPage
ClientWidth = 1848
ClientHeight = 1264
object gbInserStaticsTiles: TGroupBox object gbInserStaticsTiles: TGroupBox
AnchorSideLeft.Control = pgInsertStatics AnchorSideLeft.Control = pgInsertStatics
AnchorSideTop.Control = pgInsertStatics AnchorSideTop.Control = pgInsertStatics
@ -899,7 +884,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnClearIStaticsTilesClick OnClick = btnClearIStaticsTilesClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -951,7 +935,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnDeleteIStaticsTilesClick OnClick = btnDeleteIStaticsTilesClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -1131,7 +1114,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideBottom.Control = btnDeleteArea AnchorSideBottom.Control = btnDeleteArea
Left = 4 Left = 4
Height = 119 Height = 119
Top = 155 Top = 153
Width = 144 Width = 144
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
@ -1154,7 +1137,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideRight.Control = vstActions AnchorSideRight.Control = vstActions
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 4 Left = 4
Height = 15 Height = 13
Top = 140 Top = 140
Width = 144 Width = 144
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
@ -1177,7 +1160,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
item item
Position = 0 Position = 0
Text = 'Actions' Text = 'Actions'
Width = 150 Width = 148
end> end>
Header.DefaultHeight = 17 Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoVisible] Header.Options = [hoAutoResize, hoVisible]
@ -1198,7 +1181,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 39 Left = 39
Height = 22 Height = 22
Hint = 'Add area' Hint = 'Add area'
Top = 278 Top = 276
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Glyph.Data = { Glyph.Data = {
@ -1237,7 +1220,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnAddAreaClick OnClick = btnAddAreaClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -1250,7 +1232,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 65 Left = 65
Height = 22 Height = 22
Hint = 'Delete area' Hint = 'Delete area'
Top = 278 Top = 276
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
@ -1291,7 +1273,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnDeleteAreaClick OnClick = btnDeleteAreaClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -1303,7 +1284,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
Left = 91 Left = 91
Height = 22 Height = 22
Hint = 'Delete all areas' Hint = 'Delete all areas'
Top = 278 Top = 276
Width = 22 Width = 22
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -1341,7 +1322,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnClearAreaClick OnClick = btnClearAreaClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -1351,9 +1331,9 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideTop.Control = seX1 AnchorSideTop.Control = seX1
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 15 Height = 13
Top = 311 Top = 310
Width = 9 Width = 6
Caption = 'X' Caption = 'X'
Enabled = False Enabled = False
ParentColor = False ParentColor = False
@ -1361,9 +1341,9 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object seX1: TSpinEdit object seX1: TSpinEdit
AnchorSideLeft.Control = seY1 AnchorSideLeft.Control = seY1
AnchorSideBottom.Control = seY1 AnchorSideBottom.Control = seY1
Left = 20 Left = 17
Height = 20 Height = 21
Top = 308 Top = 306
Width = 50 Width = 50
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
@ -1376,9 +1356,9 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideLeft.Control = seX1 AnchorSideLeft.Control = seX1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seX1 AnchorSideTop.Control = seX1
Left = 78 Left = 75
Height = 20 Height = 21
Top = 308 Top = 306
Width = 50 Width = 50
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Enabled = False Enabled = False
@ -1391,9 +1371,9 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideTop.Control = seY1 AnchorSideTop.Control = seY1
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 15 Height = 13
Top = 339 Top = 339
Width = 8 Width = 5
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Caption = 'Y' Caption = 'Y'
Enabled = False Enabled = False
@ -1403,9 +1383,9 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideLeft.Control = lblY AnchorSideLeft.Control = lblY
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideBottom.Control = btnGrab1 AnchorSideBottom.Control = btnGrab1
Left = 20 Left = 17
Height = 20 Height = 21
Top = 336 Top = 335
Width = 50 Width = 50
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
@ -1418,9 +1398,9 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
object seY2: TSpinEdit object seY2: TSpinEdit
AnchorSideLeft.Control = seX2 AnchorSideLeft.Control = seX2
AnchorSideTop.Control = seY1 AnchorSideTop.Control = seY1
Left = 78 Left = 75
Height = 20 Height = 21
Top = 336 Top = 335
Width = 50 Width = 50
Enabled = False Enabled = False
OnChange = seX1Change OnChange = seX1Change
@ -1432,7 +1412,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 34 Left = 31
Height = 22 Height = 22
Hint = 'Grab coordinates from the main window.' Hint = 'Grab coordinates from the main window.'
Top = 360 Top = 360
@ -1476,7 +1456,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnGrab1Click OnClick = btnGrab1Click
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -1486,7 +1465,7 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = btnGrab1 AnchorSideBottom.Control = btnGrab1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 92 Left = 89
Height = 22 Height = 22
Hint = 'Grab coordinates from the main window.' Hint = 'Grab coordinates from the main window.'
Top = 360 Top = 360
@ -1529,7 +1508,6 @@ object frmLargeScaleCommand: TfrmLargeScaleCommand
FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnGrab1Click OnClick = btnGrab1Click
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False

8
Client/UfrmLargeScaleCommand.pas
View File

@ -666,10 +666,18 @@ begin
if selected then if selected then
begin begin
nodeInfo := Sender.GetNodeData(Node); nodeInfo := Sender.GetNodeData(Node);
seX1.OnChange := nil;
seX2.OnChange := nil;
seY1.OnChange := nil;
seY2.OnChange := nil;
seX1.Value := nodeInfo^.Left; seX1.Value := nodeInfo^.Left;
seX2.Value := nodeInfo^.Right; seX2.Value := nodeInfo^.Right;
seY1.Value := nodeInfo^.Top; seY1.Value := nodeInfo^.Top;
seY2.Value := nodeInfo^.Bottom; seY2.Value := nodeInfo^.Bottom;
seX1.OnChange := @seX1Change;
seX2.OnChange := @seX1Change;
seY1.OnChange := @seX1Change;
seY2.OnChange := @seX1Change;
end; end;
pbArea.Repaint; pbArea.Repaint;
end; end;

5469
Client/UfrmMain.lfm
View File

File diff suppressed because it is too large Load Diff

70
Client/UfrmRegionControl.lfm
View File

@ -14,7 +14,7 @@ object frmRegionControl: TfrmRegionControl
OnShow = FormShow OnShow = FormShow
Position = poOwnerFormCenter Position = poOwnerFormCenter
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
LCLVersion = '0.9.29' LCLVersion = '1.3'
object sbArea: TScrollBox object sbArea: TScrollBox
AnchorSideLeft.Control = vstRegions AnchorSideLeft.Control = vstRegions
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
@ -26,6 +26,8 @@ object frmRegionControl: TfrmRegionControl
Height = 372 Height = 372
Top = 0 Top = 0
Width = 460 Width = 460
HorzScrollBar.Page = 456
VertScrollBar.Page = 368
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
ClientHeight = 368 ClientHeight = 368
ClientWidth = 456 ClientWidth = 456
@ -110,7 +112,6 @@ object frmRegionControl: TfrmRegionControl
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -147,7 +148,6 @@ object frmRegionControl: TfrmRegionControl
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = mnuAddRegionClick OnClick = mnuAddRegionClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -164,7 +164,6 @@ object frmRegionControl: TfrmRegionControl
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -202,7 +201,6 @@ object frmRegionControl: TfrmRegionControl
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = mnuDeleteRegionClick OnClick = mnuDeleteRegionClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -215,8 +213,8 @@ object frmRegionControl: TfrmRegionControl
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDeleteArea AnchorSideBottom.Control = btnDeleteArea
Left = 4 Left = 4
Height = 124 Height = 121
Top = 179 Top = 178
Width = 152 Width = 152
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
@ -241,7 +239,7 @@ object frmRegionControl: TfrmRegionControl
AnchorSideRight.Control = spRegionsArea AnchorSideRight.Control = spRegionsArea
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 4 Left = 4
Height = 14 Height = 13
Top = 165 Top = 165
Width = 152 Width = 152
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
@ -270,10 +268,9 @@ object frmRegionControl: TfrmRegionControl
Left = 43 Left = 43
Height = 22 Height = 22
Hint = 'Add area' Hint = 'Add area'
Top = 307 Top = 303
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -311,7 +308,6 @@ object frmRegionControl: TfrmRegionControl
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnAddAreaClick OnClick = btnAddAreaClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -323,12 +319,11 @@ object frmRegionControl: TfrmRegionControl
Left = 69 Left = 69
Height = 22 Height = 22
Hint = 'Delete area' Hint = 'Delete area'
Top = 307 Top = 303
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -366,7 +361,6 @@ object frmRegionControl: TfrmRegionControl
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnDeleteAreaClick OnClick = btnDeleteAreaClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -378,9 +372,8 @@ object frmRegionControl: TfrmRegionControl
Left = 95 Left = 95
Height = 22 Height = 22
Hint = 'Delete all areas' Hint = 'Delete all areas'
Top = 307 Top = 303
Width = 22 Width = 22
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -418,7 +411,6 @@ object frmRegionControl: TfrmRegionControl
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnClearAreaClick OnClick = btnClearAreaClick
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -428,9 +420,9 @@ object frmRegionControl: TfrmRegionControl
AnchorSideTop.Control = seX1 AnchorSideTop.Control = seX1
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 14 Height = 13
Top = 339 Top = 337
Width = 8 Width = 6
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Caption = 'X' Caption = 'X'
Enabled = False Enabled = False
@ -439,9 +431,9 @@ object frmRegionControl: TfrmRegionControl
object seX1: TSpinEdit object seX1: TSpinEdit
AnchorSideLeft.Control = seY1 AnchorSideLeft.Control = seY1
AnchorSideBottom.Control = seY1 AnchorSideBottom.Control = seY1
Left = 20 Left = 17
Height = 19 Height = 21
Top = 337 Top = 333
Width = 50 Width = 50
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
@ -454,9 +446,9 @@ object frmRegionControl: TfrmRegionControl
AnchorSideLeft.Control = seX1 AnchorSideLeft.Control = seX1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seX1 AnchorSideTop.Control = seX1
Left = 78 Left = 75
Height = 19 Height = 21
Top = 337 Top = 333
Width = 50 Width = 50
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Enabled = False Enabled = False
@ -469,9 +461,9 @@ object frmRegionControl: TfrmRegionControl
AnchorSideTop.Control = seY1 AnchorSideTop.Control = seY1
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 14 Height = 13
Top = 366 Top = 366
Width = 8 Width = 5
Caption = 'Y' Caption = 'Y'
Enabled = False Enabled = False
ParentColor = False ParentColor = False
@ -482,10 +474,10 @@ object frmRegionControl: TfrmRegionControl
AnchorSideRight.Control = seX1 AnchorSideRight.Control = seX1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnGrab1 AnchorSideBottom.Control = btnGrab1
Left = 20 Left = 17
Height = 19 Height = 21
Top = 364 Top = 362
Width = 50 Width = 53
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Enabled = False Enabled = False
@ -499,9 +491,9 @@ object frmRegionControl: TfrmRegionControl
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = seX2 AnchorSideRight.Control = seX2
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 78 Left = 75
Height = 19 Height = 21
Top = 364 Top = 362
Width = 50 Width = 50
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8 BorderSpacing.Top = 8
@ -515,14 +507,13 @@ object frmRegionControl: TfrmRegionControl
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 34 Left = 32
Height = 22 Height = 22
Hint = 'Grab coordinates from the main window.' Hint = 'Grab coordinates from the main window.'
Top = 387 Top = 387
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -560,7 +551,6 @@ object frmRegionControl: TfrmRegionControl
FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnGrab1Click OnClick = btnGrab1Click
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False
@ -570,13 +560,12 @@ object frmRegionControl: TfrmRegionControl
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = btnGrab1 AnchorSideBottom.Control = btnGrab1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 92 Left = 89
Height = 22 Height = 22
Hint = 'Grab coordinates from the main window.' Hint = 'Grab coordinates from the main window.'
Top = 387 Top = 387
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -614,7 +603,6 @@ object frmRegionControl: TfrmRegionControl
FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00CBCBCB7EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnGrab1Click OnClick = btnGrab1Click
ShowHint = True ShowHint = True
ParentShowHint = False ParentShowHint = False

10
Client/UfrmRegionControl.pas
View File

@ -460,7 +460,7 @@ var
node: PVirtualNode; node: PVirtualNode;
areaInfo: PRect; areaInfo: PRect;
begin begin
node := vstArea.GetFirstSelected; node := vstArea.GetFirstSelected;
if node <> nil then if node <> nil then
begin begin
areaInfo := vstArea.GetNodeData(node); areaInfo := vstArea.GetNodeData(node);
@ -494,10 +494,18 @@ begin
if selected then if selected then
begin begin
areaInfo := Sender.GetNodeData(Node); areaInfo := Sender.GetNodeData(Node);
seX1.OnChange := nil;
seX2.OnChange := nil;
seY1.OnChange := nil;
seY2.OnChange := nil;
seX1.Value := areaInfo^.Left; seX1.Value := areaInfo^.Left;
seX2.Value := areaInfo^.Right; seX2.Value := areaInfo^.Right;
seY1.Value := areaInfo^.Top; seY1.Value := areaInfo^.Top;
seY2.Value := areaInfo^.Bottom; seY2.Value := areaInfo^.Bottom;
seX1.OnChange := @seX1Change;
seX2.OnChange := @seX1Change;
seY1.OnChange := @seX1Change;
seY2.OnChange := @seX1Change;
end; end;
pbArea.Repaint; pbArea.Repaint;
end; end;

286
Imaging/Imaging.pas
View File

@ -1866,142 +1866,142 @@ var
OldFmt: TImageFormat; OldFmt: TImageFormat;
procedure XShear(var Src, Dst: TImageData; Row, Offset, Weight, Bpp: Integer); procedure XShear(var Src, Dst: TImageData; Row, Offset, Weight, Bpp: Integer);
var var
I, J, XPos: Integer; I, J, XPos: Integer;
PixSrc, PixLeft, PixOldLeft: TColor32Rec; PixSrc, PixLeft, PixOldLeft: TColor32Rec;
LineDst: PByteArray; LineDst: PByteArray;
SrcPtr: PColor32; SrcPtr: PColor32;
begin begin
SrcPtr := @PByteArray(Src.Bits)[Row * Src.Width * Bpp]; SrcPtr := @PByteArray(Src.Bits)[Row * Src.Width * Bpp];
LineDst := @PByteArray(Dst.Bits)[Row * Dst.Width * Bpp]; LineDst := @PByteArray(Dst.Bits)[Row * Dst.Width * Bpp];
PixOldLeft.Color := 0; PixOldLeft.Color := 0;
for I := 0 to Src.Width - 1 do for I := 0 to Src.Width - 1 do
begin begin
CopyPixel(SrcPtr, @PixSrc, Bpp); CopyPixel(SrcPtr, @PixSrc, Bpp);
for J := 0 to Bpp - 1 do for J := 0 to Bpp - 1 do
PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256); PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256);
XPos := I + Offset; XPos := I + Offset;
if (XPos >= 0) and (XPos < Dst.Width) then if (XPos >= 0) and (XPos < Dst.Width) then
begin begin
for J := 0 to Bpp - 1 do for J := 0 to Bpp - 1 do
PixSrc.Channels[J] := PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J]); PixSrc.Channels[J] := PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J]);
CopyPixel(@PixSrc, @LineDst[XPos * Bpp], Bpp); CopyPixel(@PixSrc, @LineDst[XPos * Bpp], Bpp);
end; end;
PixOldLeft := PixLeft; PixOldLeft := PixLeft;
Inc(PByte(SrcPtr), Bpp); Inc(PByte(SrcPtr), Bpp);
end; end;
XPos := Src.Width + Offset; XPos := Src.Width + Offset;
if XPos < Dst.Width then if XPos < Dst.Width then
CopyPixel(@PixOldLeft, @LineDst[XPos * Bpp], Bpp); CopyPixel(@PixOldLeft, @LineDst[XPos * Bpp], Bpp);
end; end;
procedure YShear(var Src, Dst: TImageData; Col, Offset, Weight, Bpp: Integer); procedure YShear(var Src, Dst: TImageData; Col, Offset, Weight, Bpp: Integer);
var var
I, J, YPos: Integer; I, J, YPos: Integer;
PixSrc, PixLeft, PixOldLeft: TColor32Rec; PixSrc, PixLeft, PixOldLeft: TColor32Rec;
SrcPtr: PByte; SrcPtr: PByte;
begin begin
SrcPtr := @PByteArray(Src.Bits)[Col * Bpp]; SrcPtr := @PByteArray(Src.Bits)[Col * Bpp];
PixOldLeft.Color := 0; PixOldLeft.Color := 0;
for I := 0 to Src.Height - 1 do for I := 0 to Src.Height - 1 do
begin begin
CopyPixel(SrcPtr, @PixSrc, Bpp); CopyPixel(SrcPtr, @PixSrc, Bpp);
for J := 0 to Bpp - 1 do for J := 0 to Bpp - 1 do
PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256); PixLeft.Channels[J] := MulDiv(PixSrc.Channels[J], Weight, 256);
YPos := I + Offset; YPos := I + Offset;
if (YPos >= 0) and (YPos < Dst.Height) then if (YPos >= 0) and (YPos < Dst.Height) then
begin begin
for J := 0 to Bpp - 1 do for J := 0 to Bpp - 1 do
PixSrc.Channels[J] := PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J]); PixSrc.Channels[J] := PixSrc.Channels[J] - (PixLeft.Channels[J] - PixOldLeft.Channels[J]);
CopyPixel(@PixSrc, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp); CopyPixel(@PixSrc, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp);
end; end;
PixOldLeft := PixLeft; PixOldLeft := PixLeft;
Inc(SrcPtr, Src.Width * Bpp); Inc(SrcPtr, Src.Width * Bpp);
end; end;
YPos := Src.Height + Offset; YPos := Src.Height + Offset;
if YPos < Dst.Height then if YPos < Dst.Height then
CopyPixel(@PixOldLeft, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp); CopyPixel(@PixOldLeft, @PByteArray(Dst.Bits)[(YPos * Dst.Width + Col) * Bpp], Bpp);
end; end;
procedure Rotate45(var Image: TImageData; Angle: Single); procedure Rotate45(var Image: TImageData; Angle: Single);
var var
TempImage1, TempImage2: TImageData; TempImage1, TempImage2: TImageData;
AngleRad, AngleTan, AngleSin, AngleCos, Shear: Single; AngleRad, AngleTan, AngleSin, AngleCos, Shear: Single;
I, DstWidth, DstHeight, SrcWidth, SrcHeight, Bpp: Integer; I, DstWidth, DstHeight, SrcWidth, SrcHeight, Bpp: Integer;
SrcFmt, TempFormat: TImageFormat; SrcFmt, TempFormat: TImageFormat;
Info: TImageFormatInfo; Info: TImageFormatInfo;
begin begin
AngleRad := Angle * Pi / 180; AngleRad := Angle * Pi / 180;
AngleSin := Sin(AngleRad); AngleSin := Sin(AngleRad);
AngleCos := Cos(AngleRad); AngleCos := Cos(AngleRad);
AngleTan := Sin(AngleRad / 2) / Cos(AngleRad / 2); AngleTan := Sin(AngleRad / 2) / Cos(AngleRad / 2);
SrcWidth := Image.Width; SrcWidth := Image.Width;
SrcHeight := Image.Height; SrcHeight := Image.Height;
SrcFmt := Image.Format; SrcFmt := Image.Format;
if not (SrcFmt in [ifR8G8B8..ifX8R8G8B8, ifGray8..ifGray32, ifA16Gray16]) then if not (SrcFmt in [ifR8G8B8..ifX8R8G8B8, ifGray8..ifGray32, ifA16Gray16]) then
ConvertImage(Image, ifA8R8G8B8); ConvertImage(Image, ifA8R8G8B8);
TempFormat := Image.Format; TempFormat := Image.Format;
GetImageFormatInfo(TempFormat, Info); GetImageFormatInfo(TempFormat, Info);
Bpp := Info.BytesPerPixel; Bpp := Info.BytesPerPixel;
// 1st shear (horizontal) // 1st shear (horizontal)
DstWidth := Trunc(SrcWidth + SrcHeight * Abs(AngleTan) + 0.5); DstWidth := Trunc(SrcWidth + SrcHeight * Abs(AngleTan) + 0.5);
DstHeight := SrcHeight; DstHeight := SrcHeight;
NewImage(DstWidth, DstHeight, TempFormat, TempImage1); NewImage(DstWidth, DstHeight, TempFormat, TempImage1);
for I := 0 to DstHeight - 1 do for I := 0 to DstHeight - 1 do
begin begin
if AngleTan >= 0 then if AngleTan >= 0 then
Shear := (I + 0.5) * AngleTan Shear := (I + 0.5) * AngleTan
else else
Shear := (I - DstHeight + 0.5) * AngleTan; Shear := (I - DstHeight + 0.5) * AngleTan;
XShear(Image, TempImage1, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp); XShear(Image, TempImage1, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp);
end; end;
// 2nd shear (vertical) // 2nd shear (vertical)
FreeImage(Image); FreeImage(Image);
DstHeight := Trunc(SrcWidth * Abs(AngleSin) + SrcHeight * AngleCos + 0.5) + 1; DstHeight := Trunc(SrcWidth * Abs(AngleSin) + SrcHeight * AngleCos + 0.5) + 1;
NewImage(DstWidth, DstHeight, TempFormat, TempImage2); NewImage(DstWidth, DstHeight, TempFormat, TempImage2);
if AngleSin >= 0 then if AngleSin >= 0 then
Shear := (SrcWidth - 1) * AngleSin Shear := (SrcWidth - 1) * AngleSin
else else
Shear := (SrcWidth - DstWidth) * -AngleSin; Shear := (SrcWidth - DstWidth) * -AngleSin;
for I := 0 to DstWidth - 1 do for I := 0 to DstWidth - 1 do
begin begin
YShear(TempImage1, TempImage2, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp); YShear(TempImage1, TempImage2, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp);
Shear := Shear - AngleSin; Shear := Shear - AngleSin;
end; end;
// 3rd shear (horizontal) // 3rd shear (horizontal)
FreeImage(TempImage1); FreeImage(TempImage1);
DstWidth := Trunc(SrcHeight * Abs(AngleSin) + SrcWidth * AngleCos + 0.5) + 1; DstWidth := Trunc(SrcHeight * Abs(AngleSin) + SrcWidth * AngleCos + 0.5) + 1;
NewImage(DstWidth, DstHeight, TempFormat, Image); NewImage(DstWidth, DstHeight, TempFormat, Image);
if AngleSin >= 0 then if AngleSin >= 0 then
Shear := (SrcWidth - 1) * AngleSin * -AngleTan Shear := (SrcWidth - 1) * AngleSin * -AngleTan
else else
Shear := ((SrcWidth - 1) * -AngleSin + (1 - DstHeight)) * AngleTan; Shear := ((SrcWidth - 1) * -AngleSin + (1 - DstHeight)) * AngleTan;
for I := 0 to DstHeight - 1 do for I := 0 to DstHeight - 1 do
begin begin
XShear(TempImage2, Image, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp); XShear(TempImage2, Image, I, Floor(Shear), Trunc(255 * (Shear - Floor(Shear)) + 1), Bpp);
Shear := Shear + AngleTan; Shear := Shear + AngleTan;
end; end;
FreeImage(TempImage2); FreeImage(TempImage2);
if Image.Format <> SrcFmt then if Image.Format <> SrcFmt then
ConvertImage(Image, SrcFmt); ConvertImage(Image, SrcFmt);
end; end;
procedure RotateMul90(var Image: TImageData; Angle: Integer); procedure RotateMul90(var Image: TImageData; Angle: Integer);
var var
@ -2009,7 +2009,7 @@ var
X, Y, BytesPerPixel: Integer; X, Y, BytesPerPixel: Integer;
RotPix, Pix: PByte; RotPix, Pix: PByte;
begin begin
InitImage(RotImage); InitImage(RotImage);
BytesPerPixel := ImageFormatInfos[Image.Format].BytesPerPixel; BytesPerPixel := ImageFormatInfos[Image.Format].BytesPerPixel;
if ((Angle = 90) or (Angle = 270)) and (Image.Width <> Image.Height) then if ((Angle = 90) or (Angle = 270)) and (Image.Width <> Image.Height) then
@ -2061,9 +2061,9 @@ var
FreeMemNil(Image.Bits); FreeMemNil(Image.Bits);
RotImage.Palette := Image.Palette; RotImage.Palette := Image.Palette;
Image := RotImage; Image := RotImage;
end; end;
begin begin
Result := False; Result := False;
@ -2073,7 +2073,7 @@ begin
Angle := Angle - 360; Angle := Angle - 360;
while Angle < 0 do while Angle < 0 do
Angle := Angle + 360; Angle := Angle + 360;
if (Angle = 0) or (Abs(Angle) = 360) then if (Angle = 0) or (Abs(Angle) = 360) then
begin begin
Result := True; Result := True;
@ -2099,9 +2099,9 @@ begin
RotateMul90(Image, 270); RotateMul90(Image, 270);
Angle := Angle - 270; Angle := Angle - 270;
end; end;
if Angle <> 0 then if Angle <> 0 then
Rotate45(Image, Angle); Rotate45(Image, Angle);
if OldFmt <> Image.Format then if OldFmt <> Image.Format then
ConvertImage(Image, OldFmt); ConvertImage(Image, OldFmt);

1714
Imaging/ImagingBitmap.pas
View File

File diff suppressed because it is too large Load Diff

4354
Imaging/ImagingCanvases.pas
View File

File diff suppressed because it is too large Load Diff

1994
Imaging/ImagingClasses.pas
View File

File diff suppressed because it is too large Load Diff

490
Imaging/ImagingColors.pas
View File

@ -1,245 +1,245 @@
{ {
$Id: ImagingColors.pas 173 2009-09-04 17:05:52Z galfar $ $Id: ImagingColors.pas 173 2009-09-04 17:05:52Z galfar $
Vampyre Imaging Library Vampyre Imaging Library
by Marek Mauder by Marek Mauder
http://imaginglib.sourceforge.net http://imaginglib.sourceforge.net
The contents of this file are used with permission, subject to the Mozilla The contents of this file are used with permission, subject to the Mozilla
Public License Version 1.1 (the "License"); you may not use this file except Public License Version 1.1 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at in compliance with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis, Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License. the specific language governing rights and limitations under the License.
Alternatively, the contents of this file may be used under the terms of the Alternatively, the contents of this file may be used under the terms of the
GNU Lesser General Public License (the "LGPL License"), in which case the GNU Lesser General Public License (the "LGPL License"), in which case the
provisions of the LGPL License are applicable instead of those above. provisions of the LGPL License are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms If you wish to allow use of your version of this file only under the terms
of the LGPL License and not to allow others to use your version of this file of the LGPL License and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the LGPL replace them with the notice and other provisions required by the LGPL
License. If you do not delete the provisions above, a recipient may use License. If you do not delete the provisions above, a recipient may use
your version of this file under either the MPL or the LGPL License. your version of this file under either the MPL or the LGPL License.
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
} }
{ This unit contains functions for manipulating and converting color values.} { This unit contains functions for manipulating and converting color values.}
unit ImagingColors; unit ImagingColors;
interface interface
{$I ImagingOptions.inc} {$I ImagingOptions.inc}
uses uses
SysUtils, ImagingTypes, ImagingUtility; SysUtils, ImagingTypes, ImagingUtility;
{ Converts RGB color to YUV.} { Converts RGB color to YUV.}
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte); procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
{ Converts YIV to RGB color.} { Converts YIV to RGB color.}
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte); procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
{ Converts RGB color to YCbCr as used in JPEG.} { Converts RGB color to YCbCr as used in JPEG.}
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte); procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
{ Converts YCbCr as used in JPEG to RGB color.} { Converts YCbCr as used in JPEG to RGB color.}
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte); procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
{ Converts RGB color to YCbCr as used in JPEG.} { Converts RGB color to YCbCr as used in JPEG.}
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word); procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
{ Converts YCbCr as used in JPEG to RGB color.} { Converts YCbCr as used in JPEG to RGB color.}
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word); procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
{ Converts RGB color to CMY.} { Converts RGB color to CMY.}
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte); procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
{ Converts CMY to RGB color.} { Converts CMY to RGB color.}
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte); procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
{ Converts RGB color to CMY.} { Converts RGB color to CMY.}
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word); procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
{ Converts CMY to RGB color.} { Converts CMY to RGB color.}
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word); procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
{ Converts RGB color to CMYK.} { Converts RGB color to CMYK.}
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte); procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
{ Converts CMYK to RGB color.} { Converts CMYK to RGB color.}
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte); procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
{ Converts RGB color to CMYK.} { Converts RGB color to CMYK.}
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word); procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
{ Converts CMYK to RGB color.} { Converts CMYK to RGB color.}
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word); procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
{ Converts RGB color to YCoCg.} { Converts RGB color to YCoCg.}
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte); procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
{ Converts YCoCg to RGB color.} { Converts YCoCg to RGB color.}
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte); procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
implementation implementation
procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte); procedure RGBToYUV(R, G, B: Byte; var Y, U, V: Byte);
begin begin
Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16); Y := ClampToByte(Round( 0.257 * R + 0.504 * G + 0.098 * B) + 16);
V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128); V := ClampToByte(Round( 0.439 * R - 0.368 * G - 0.071 * B) + 128);
U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128); U := ClampToByte(Round(-0.148 * R - 0.291 * G + 0.439 * B) + 128);
end; end;
procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte); procedure YUVToRGB(Y, U, V: Byte; var R, G, B: Byte);
var var
CY, CU, CV: LongInt; CY, CU, CV: LongInt;
begin begin
CY := Y - 16; CY := Y - 16;
CU := U - 128; CU := U - 128;
CV := V - 128; CV := V - 128;
R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV)); R := ClampToByte(Round(1.164 * CY - 0.002 * CU + 1.596 * CV));
G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV)); G := ClampToByte(Round(1.164 * CY - 0.391 * CU - 0.813 * CV));
B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV)); B := ClampToByte(Round(1.164 * CY + 2.018 * CU - 0.001 * CV));
end; end;
procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte); procedure RGBToYCbCr(R, G, B: Byte; var Y, Cb, Cr: Byte);
begin begin
Y := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B)); Y := ClampToByte(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 128)); Cb := ClampToByte(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 128));
Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 128)); Cr := ClampToByte(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 128));
end; end;
procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte); procedure YCbCrToRGB(Y, Cb, Cr: Byte; var R, G, B: Byte);
begin begin
R := ClampToByte(Round(Y + 1.40200 * (Cr - 128))); R := ClampToByte(Round(Y + 1.40200 * (Cr - 128)));
G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128))); G := ClampToByte(Round(Y - 0.34414 * (Cb - 128) - 0.71414 * (Cr - 128)));
B := ClampToByte(Round(Y + 1.77200 * (Cb - 128))); B := ClampToByte(Round(Y + 1.77200 * (Cb - 128)));
end; end;
procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word); procedure RGBToYCbCr16(R, G, B: Word; var Y, Cb, Cr: Word);
begin begin
Y := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B)); Y := ClampToWord(Round( 0.29900 * R + 0.58700 * G + 0.11400 * B));
Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 32768)); Cb := ClampToWord(Round(-0.16874 * R - 0.33126 * G + 0.50000 * B + 32768));
Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 32768)); Cr := ClampToWord(Round( 0.50000 * R - 0.41869 * G - 0.08131 * B + 32768));
end; end;
procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word); procedure YCbCrToRGB16(Y, Cb, Cr: Word; var R, G, B: Word);
begin begin
R := ClampToWord(Round(Y + 1.40200 * (Cr - 32768))); R := ClampToWord(Round(Y + 1.40200 * (Cr - 32768)));
G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768))); G := ClampToWord(Round(Y - 0.34414 * (Cb - 32768) - 0.71414 * (Cr - 32768)));
B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768))); B := ClampToWord(Round(Y + 1.77200 * (Cb - 32768)));
end; end;
procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte); procedure RGBToCMY(R, G, B: Byte; var C, M, Y: Byte);
begin begin
C := 255 - R; C := 255 - R;
M := 255 - G; M := 255 - G;
Y := 255 - B; Y := 255 - B;
end; end;
procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte); procedure CMYToRGB(C, M, Y: Byte; var R, G, B: Byte);
begin begin
R := 255 - C; R := 255 - C;
G := 255 - M; G := 255 - M;
B := 255 - Y; B := 255 - Y;
end; end;
procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word); procedure RGBToCMY16(R, G, B: Word; var C, M, Y: Word);
begin begin
C := 65535 - R; C := 65535 - R;
M := 65535 - G; M := 65535 - G;
Y := 65535 - B; Y := 65535 - B;
end; end;
procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word); procedure CMYToRGB16(C, M, Y: Word; var R, G, B: Word);
begin begin
R := 65535 - C; R := 65535 - C;
G := 65535 - M; G := 65535 - M;
B := 65535 - Y; B := 65535 - Y;
end; end;
procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte); procedure RGBToCMYK(R, G, B: Byte; var C, M, Y, K: Byte);
begin begin
RGBToCMY(R, G, B, C, M, Y); RGBToCMY(R, G, B, C, M, Y);
K := Min(C, Min(M, Y)); K := Min(C, Min(M, Y));
if K = 255 then if K = 255 then
begin begin
C := 0; C := 0;
M := 0; M := 0;
Y := 0; Y := 0;
end end
else else
begin begin
C := ClampToByte(Round((C - K) / (255 - K) * 255)); C := ClampToByte(Round((C - K) / (255 - K) * 255));
M := ClampToByte(Round((M - K) / (255 - K) * 255)); M := ClampToByte(Round((M - K) / (255 - K) * 255));
Y := ClampToByte(Round((Y - K) / (255 - K) * 255)); Y := ClampToByte(Round((Y - K) / (255 - K) * 255));
end; end;
end; end;
procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte); procedure CMYKToRGB(C, M, Y, K: Byte; var R, G, B: Byte);
begin begin
R := (255 - (C - MulDiv(C, K, 255) + K)); R := (255 - (C - MulDiv(C, K, 255) + K));
G := (255 - (M - MulDiv(M, K, 255) + K)); G := (255 - (M - MulDiv(M, K, 255) + K));
B := (255 - (Y - MulDiv(Y, K, 255) + K)); B := (255 - (Y - MulDiv(Y, K, 255) + K));
end; end;
procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word); procedure RGBToCMYK16(R, G, B: Word; var C, M, Y, K: Word);
begin begin
RGBToCMY16(R, G, B, C, M, Y); RGBToCMY16(R, G, B, C, M, Y);
K := Min(C, Min(M, Y)); K := Min(C, Min(M, Y));
if K = 65535 then if K = 65535 then
begin begin
C := 0; C := 0;
M := 0; M := 0;
Y := 0; Y := 0;
end end
else else
begin begin
C := ClampToWord(Round((C - K) / (65535 - K) * 65535)); C := ClampToWord(Round((C - K) / (65535 - K) * 65535));
M := ClampToWord(Round((M - K) / (65535 - K) * 65535)); M := ClampToWord(Round((M - K) / (65535 - K) * 65535));
Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535)); Y := ClampToWord(Round((Y - K) / (65535 - K) * 65535));
end; end;
end; end;
procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word); procedure CMYKToRGB16(C, M, Y, K: Word; var R, G, B: Word);
begin begin
R := 65535 - (C - MulDiv(C, K, 65535) + K); R := 65535 - (C - MulDiv(C, K, 65535) + K);
G := 65535 - (M - MulDiv(M, K, 65535) + K); G := 65535 - (M - MulDiv(M, K, 65535) + K);
B := 65535 - (Y - MulDiv(Y, K, 65535) + K); B := 65535 - (Y - MulDiv(Y, K, 65535) + K);
end; end;
procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte); procedure RGBToYCoCg(R, G, B: Byte; var Y, Co, Cg: Byte);
begin begin
// C and Delphi's SHR behaviour differs for negative numbers, use div instead. // C and Delphi's SHR behaviour differs for negative numbers, use div instead.
Y := ClampToByte(( R + G shl 1 + B + 2) div 4); Y := ClampToByte(( R + G shl 1 + B + 2) div 4);
Co := ClampToByte(( R shl 1 - B shl 1 + 2) div 4 + 128); Co := ClampToByte(( R shl 1 - B shl 1 + 2) div 4 + 128);
Cg := ClampToByte((-R + G shl 1 - B + 2) div 4 + 128); Cg := ClampToByte((-R + G shl 1 - B + 2) div 4 + 128);
end; end;
procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte); procedure YCoCgToRGB(Y, Co, Cg: Byte; var R, G, B: Byte);
var var
CoInt, CgInt: Integer; CoInt, CgInt: Integer;
begin begin
CoInt := Co - 128; CoInt := Co - 128;
CgInt := Cg - 128; CgInt := Cg - 128;
R := ClampToByte(Y + CoInt - CgInt); R := ClampToByte(Y + CoInt - CgInt);
G := ClampToByte(Y + CgInt); G := ClampToByte(Y + CgInt);
B := ClampToByte(Y - CoInt - CgInt); B := ClampToByte(Y - CoInt - CgInt);
end; end;
{ {
File Notes: File Notes:
-- TODOS ---------------------------------------------------- -- TODOS ----------------------------------------------------
- nothing now - nothing now
-- 0.26.3 Changes/Bug Fixes --------------------------------- -- 0.26.3 Changes/Bug Fixes ---------------------------------
- Added RGB<>YCoCg conversion functions. - Added RGB<>YCoCg conversion functions.
- Fixed RGB>>CMYK conversions. - Fixed RGB>>CMYK conversions.
-- 0.23 Changes/Bug Fixes ----------------------------------- -- 0.23 Changes/Bug Fixes -----------------------------------
- Added RGB<>CMY(K) converion functions for 16 bit channels - Added RGB<>CMY(K) converion functions for 16 bit channels
(needed by PSD loading code). (needed by PSD loading code).
-- 0.21 Changes/Bug Fixes ----------------------------------- -- 0.21 Changes/Bug Fixes -----------------------------------
- Added some color space conversion functions and LUTs - Added some color space conversion functions and LUTs
(RGB/YUV/YCrCb/CMY/CMYK). (RGB/YUV/YCrCb/CMY/CMYK).
-- 0.17 Changes/Bug Fixes ----------------------------------- -- 0.17 Changes/Bug Fixes -----------------------------------
- unit created (empty!) - unit created (empty!)
} }
end. end.

2
Imaging/ImagingComponents.pas
View File

@ -336,7 +336,7 @@ implementation
uses uses
{$IF Defined(LCL)} {$IF Defined(LCL)}
{$IF Defined(LCLGTK2)} {$IF Defined(LCLGTK2)}
GLib2, GDK2, GTK2, GTK2Def, GTK2Proc, GLib2, GDK2, GTK2, GTKDef, GTKProc,
{$ELSEIF Defined(LCLGTK)} {$ELSEIF Defined(LCLGTK)}
GDK, GTK, GTKDef, GTKProc, GDK, GTK, GTKDef, GTKProc,
{$IFEND} {$IFEND}

1728
Imaging/ImagingDds.pas
View File

File diff suppressed because it is too large Load Diff

1782
Imaging/ImagingExport.pas
View File

File diff suppressed because it is too large Load Diff

8576
Imaging/ImagingFormats.pas
View File

File diff suppressed because it is too large Load Diff

2478
Imaging/ImagingGif.pas
View File

File diff suppressed because it is too large Load Diff

1148
Imaging/ImagingIO.pas
View File

File diff suppressed because it is too large Load Diff

1203
Imaging/ImagingJpeg.pas
View File

File diff suppressed because it is too large Load Diff

5146
Imaging/ImagingNetworkGraphics.pas
View File

File diff suppressed because it is too large Load Diff

17
Imaging/ImagingOptions.inc
View File

@ -83,14 +83,6 @@
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
{$IF (Defined(DCC) and (CompilerVersion >= 18.5))}
{$IFDEF RELEASE}
{$UNDEF DEBUG} // If we are using Delphi 2007+ where you can set
// DEBUG/RELEASE mode in project options and RELEASE
// is currently set we undef DEBUG mode
{$ENDIF}
{$IFEND}
{$IF Defined(IMAGING_DEBUG)} {$IF Defined(IMAGING_DEBUG)}
{$ASSERTIONS ON} {$ASSERTIONS ON}
{$DEBUGINFO ON} {$DEBUGINFO ON}
@ -128,18 +120,13 @@
// Define if compiler supports inlining of functions and procedures // Define if compiler supports inlining of functions and procedures
// Note that FPC inline support crashed in older versions (1.9.8) // Note that FPC inline support crashed in older versions (1.9.8)
{$IF (Defined(DCC) and (CompilerVersion >= 17)) or (Defined(FPC) and Defined(CPU86))} {$IF (Defined(FPC) and Defined(CPU86))}
{$DEFINE HAS_INLINE} {$DEFINE HAS_INLINE}
{$IFEND} {$IFEND}
// Define if compiler supports advanced records with methods
{$IF (Defined(DCC) and (CompilerVersion >= 18)) }
{$DEFINE HAS_ADVANCED_RECORDS}
{$IFEND}
// Define if compiler supports operator overloading // Define if compiler supports operator overloading
// (unfortunately Delphi and FPC operator overloaing is not compatible) // (unfortunately Delphi and FPC operator overloaing is not compatible)
{$IF (Defined(DCC) and (CompilerVersion >= 18)) or Defined(FPC)} {$IF Defined(FPC)}
{$DEFINE HAS_OPERATOR_OVERLOADING} {$DEFINE HAS_OPERATOR_OVERLOADING}
{$IFEND} {$IFEND}

2040
Imaging/ImagingPortableMaps.pas
View File

File diff suppressed because it is too large Load Diff

1246
Imaging/ImagingTarga.pas
View File

File diff suppressed because it is too large Load Diff

998
Imaging/ImagingTypes.pas
View File

@ -1,499 +1,499 @@
{ {
$Id: ImagingTypes.pas 171 2009-09-02 01:34:19Z galfar $ $Id: ImagingTypes.pas 171 2009-09-02 01:34:19Z galfar $
Vampyre Imaging Library Vampyre Imaging Library
by Marek Mauder by Marek Mauder
http://imaginglib.sourceforge.net http://imaginglib.sourceforge.net
The contents of this file are used with permission, subject to the Mozilla The contents of this file are used with permission, subject to the Mozilla
Public License Version 1.1 (the "License"); you may not use this file except Public License Version 1.1 (the "License"); you may not use this file except
in compliance with the License. You may obtain a copy of the License at in compliance with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis, Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License. the specific language governing rights and limitations under the License.
Alternatively, the contents of this file may be used under the terms of the Alternatively, the contents of this file may be used under the terms of the
GNU Lesser General Public License (the "LGPL License"), in which case the GNU Lesser General Public License (the "LGPL License"), in which case the
provisions of the LGPL License are applicable instead of those above. provisions of the LGPL License are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms If you wish to allow use of your version of this file only under the terms
of the LGPL License and not to allow others to use your version of this file of the LGPL License and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the LGPL replace them with the notice and other provisions required by the LGPL
License. If you do not delete the provisions above, a recipient may use License. If you do not delete the provisions above, a recipient may use
your version of this file under either the MPL or the LGPL License. your version of this file under either the MPL or the LGPL License.
For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
} }
{ This unit contains basic types and constants used by Imaging library.} { This unit contains basic types and constants used by Imaging library.}
unit ImagingTypes; unit ImagingTypes;
{$I ImagingOptions.inc} {$I ImagingOptions.inc}
interface interface
const const
{ Current Major version of Imaging.} { Current Major version of Imaging.}
ImagingVersionMajor = 0; ImagingVersionMajor = 0;
{ Current Minor version of Imaging.} { Current Minor version of Imaging.}
ImagingVersionMinor = 26; ImagingVersionMinor = 26;
{ Current patch of Imaging.} { Current patch of Imaging.}
ImagingVersionPatch = 4; ImagingVersionPatch = 4;
{ Imaging Option Ids whose values can be set/get by SetOption/ { Imaging Option Ids whose values can be set/get by SetOption/
GetOption functions.} GetOption functions.}
{ Defines Jpeg compression quality, ranges from 1 (ugly/small) to 100 (nice/large). { Defines Jpeg compression quality, ranges from 1 (ugly/small) to 100 (nice/large).
Default value is 90.} Default value is 90.}
ImagingJpegQuality = 10; ImagingJpegQuality = 10;
{ Specifies whether Jpeg images are saved in progressive format, { Specifies whether Jpeg images are saved in progressive format,
can be 0 or 1. Default value is 0.} can be 0 or 1. Default value is 0.}
ImagingJpegProgressive = 11; ImagingJpegProgressive = 11;
{ Specifies whether Windows Bitmaps are saved using RLE compression { Specifies whether Windows Bitmaps are saved using RLE compression
(only for 1/4/8 bit images), can be 0 or 1. Default value is 1.} (only for 1/4/8 bit images), can be 0 or 1. Default value is 1.}
ImagingBitmapRLE = 12; ImagingBitmapRLE = 12;
{ Specifies whether Targa images are saved using RLE compression, { Specifies whether Targa images are saved using RLE compression,
can be 0 or 1. Default value is 0.} can be 0 or 1. Default value is 0.}
ImagingTargaRLE = 13; ImagingTargaRLE = 13;
{ Value of this option is non-zero if last loaded DDS file was cube map.} { Value of this option is non-zero if last loaded DDS file was cube map.}
ImagingDDSLoadedCubeMap = 14; ImagingDDSLoadedCubeMap = 14;
{ Value of this option is non-zero if last loaded DDS file was volume texture.} { Value of this option is non-zero if last loaded DDS file was volume texture.}
ImagingDDSLoadedVolume = 15; ImagingDDSLoadedVolume = 15;
{ Value of this option is number of mipmap levels of last loaded DDS image.} { Value of this option is number of mipmap levels of last loaded DDS image.}
ImagingDDSLoadedMipMapCount = 16; ImagingDDSLoadedMipMapCount = 16;
{ Value of this option is depth (slices of volume texture or faces of { Value of this option is depth (slices of volume texture or faces of
cube map) of last loaded DDS image.} cube map) of last loaded DDS image.}
ImagingDDSLoadedDepth = 17; ImagingDDSLoadedDepth = 17;
{ If it is non-zero next saved DDS file should be stored as cube map.} { If it is non-zero next saved DDS file should be stored as cube map.}
ImagingDDSSaveCubeMap = 18; ImagingDDSSaveCubeMap = 18;
{ If it is non-zero next saved DDS file should be stored as volume texture.} { If it is non-zero next saved DDS file should be stored as volume texture.}
ImagingDDSSaveVolume = 19; ImagingDDSSaveVolume = 19;
{ Sets the number of mipmaps which should be stored in the next saved DDS file. { Sets the number of mipmaps which should be stored in the next saved DDS file.
Only applies to cube maps and volumes, ordinary 2D textures save all Only applies to cube maps and volumes, ordinary 2D textures save all
levels present in input.} levels present in input.}
ImagingDDSSaveMipMapCount = 20; ImagingDDSSaveMipMapCount = 20;
{ Sets the depth (slices of volume texture or faces of cube map) { Sets the depth (slices of volume texture or faces of cube map)
of the next saved DDS file.} of the next saved DDS file.}
ImagingDDSSaveDepth = 21; ImagingDDSSaveDepth = 21;
{ Sets precompression filter used when saving PNG images. Allowed values { Sets precompression filter used when saving PNG images. Allowed values
are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth), are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth),
5 (use 0 for indexed/gray images and 4 for RGB/ARGB images), 5 (use 0 for indexed/gray images and 4 for RGB/ARGB images),
6 (adaptive filtering - use best filter for each scanline - very slow). 6 (adaptive filtering - use best filter for each scanline - very slow).
Note that filters 3 and 4 are much slower than filters 1 and 2. Note that filters 3 and 4 are much slower than filters 1 and 2.
Default value is 5.} Default value is 5.}
ImagingPNGPreFilter = 25; ImagingPNGPreFilter = 25;
{ Sets ZLib compression level used when saving PNG images. { Sets ZLib compression level used when saving PNG images.
Allowed values are in range 0 (no compresstion) to 9 (best compression). Allowed values are in range 0 (no compresstion) to 9 (best compression).
Default value is 5.} Default value is 5.}
ImagingPNGCompressLevel = 26; ImagingPNGCompressLevel = 26;
{ Boolean option that specifies whether PNG images with more frames (APNG format) { Boolean option that specifies whether PNG images with more frames (APNG format)
are animated by Imaging (according to frame disposal/blend methods) or just are animated by Imaging (according to frame disposal/blend methods) or just
raw frames are loaded and sent to user (if you want to animate APNG yourself). raw frames are loaded and sent to user (if you want to animate APNG yourself).
Default value is 1.} Default value is 1.}
ImagingPNGLoadAnimated = 27; ImagingPNGLoadAnimated = 27;
{ Specifies whether MNG animation frames are saved with lossy or lossless { Specifies whether MNG animation frames are saved with lossy or lossless
compression. Lossless frames are saved as PNG images and lossy frames are compression. Lossless frames are saved as PNG images and lossy frames are
saved as JNG images. Allowed values are 0 (False) and 1 (True). saved as JNG images. Allowed values are 0 (False) and 1 (True).
Default value is 0.} Default value is 0.}
ImagingMNGLossyCompression = 28; ImagingMNGLossyCompression = 28;
{ Defines whether alpha channel of lossy compressed MNG frames { Defines whether alpha channel of lossy compressed MNG frames
(when ImagingMNGLossyCompression is 1) is lossy compressed too. (when ImagingMNGLossyCompression is 1) is lossy compressed too.
Allowed values are 0 (False) and 1 (True). Default value is 0.} Allowed values are 0 (False) and 1 (True). Default value is 0.}
ImagingMNGLossyAlpha = 29; ImagingMNGLossyAlpha = 29;
{ Sets precompression filter used when saving MNG frames as PNG images. { Sets precompression filter used when saving MNG frames as PNG images.
For details look at ImagingPNGPreFilter.} For details look at ImagingPNGPreFilter.}
ImagingMNGPreFilter = 30; ImagingMNGPreFilter = 30;
{ Sets ZLib compression level used when saving MNG frames as PNG images. { Sets ZLib compression level used when saving MNG frames as PNG images.
For details look at ImagingPNGCompressLevel.} For details look at ImagingPNGCompressLevel.}
ImagingMNGCompressLevel = 31; ImagingMNGCompressLevel = 31;
{ Specifies compression quality used when saving MNG frames as JNG images. { Specifies compression quality used when saving MNG frames as JNG images.
For details look at ImagingJpegQuality.} For details look at ImagingJpegQuality.}
ImagingMNGQuality = 32; ImagingMNGQuality = 32;
{ Specifies whether images are saved in progressive format when saving MNG { Specifies whether images are saved in progressive format when saving MNG
frames as JNG images. For details look at ImagingJpegProgressive.} frames as JNG images. For details look at ImagingJpegProgressive.}
ImagingMNGProgressive = 33; ImagingMNGProgressive = 33;
{ Specifies whether alpha channels of JNG images are lossy compressed. { Specifies whether alpha channels of JNG images are lossy compressed.
Allowed values are 0 (False) and 1 (True). Default value is 0.} Allowed values are 0 (False) and 1 (True). Default value is 0.}
ImagingJNGLossyAlpha = 40; ImagingJNGLossyAlpha = 40;
{ Sets precompression filter used when saving lossless alpha channels. { Sets precompression filter used when saving lossless alpha channels.
For details look at ImagingPNGPreFilter.} For details look at ImagingPNGPreFilter.}
ImagingJNGAlphaPreFilter = 41; ImagingJNGAlphaPreFilter = 41;
{ Sets ZLib compression level used when saving lossless alpha channels. { Sets ZLib compression level used when saving lossless alpha channels.
For details look at ImagingPNGCompressLevel.} For details look at ImagingPNGCompressLevel.}
ImagingJNGAlphaCompressLevel = 42; ImagingJNGAlphaCompressLevel = 42;
{ Defines compression quality used when saving JNG images (and lossy alpha channels). { Defines compression quality used when saving JNG images (and lossy alpha channels).
For details look at ImagingJpegQuality.} For details look at ImagingJpegQuality.}
ImagingJNGQuality = 43; ImagingJNGQuality = 43;
{ Specifies whether JNG images are saved in progressive format. { Specifies whether JNG images are saved in progressive format.
For details look at ImagingJpegProgressive.} For details look at ImagingJpegProgressive.}
ImagingJNGProgressive = 44; ImagingJNGProgressive = 44;
{ Specifies whether PGM files are stored in text or in binary format. { Specifies whether PGM files are stored in text or in binary format.
Allowed values are 0 (store as text - very! large files) and 1 (save binary). Allowed values are 0 (store as text - very! large files) and 1 (save binary).
Default value is 1.} Default value is 1.}
ImagingPGMSaveBinary = 50; ImagingPGMSaveBinary = 50;
{ Specifies whether PPM files are stored in text or in binary format. { Specifies whether PPM files are stored in text or in binary format.
Allowed values are 0 (store as text - very! large files) and 1 (save binary). Allowed values are 0 (store as text - very! large files) and 1 (save binary).
Default value is 1.} Default value is 1.}
ImagingPPMSaveBinary = 51; ImagingPPMSaveBinary = 51;
{ Boolean option that specifies whether GIF images with more frames { Boolean option that specifies whether GIF images with more frames
are animated by Imaging (according to frame disposal methods) or just are animated by Imaging (according to frame disposal methods) or just
raw frames are loaded and sent to user (if you want to animate GIF yourself). raw frames are loaded and sent to user (if you want to animate GIF yourself).
Default value is 1. Default value is 1.
Raw frames are 256 color indexed images (ifIndex8), whereas Raw frames are 256 color indexed images (ifIndex8), whereas
animated frames are always in 32bit ifA8R8G8B8 format (simplifies animating).} animated frames are always in 32bit ifA8R8G8B8 format (simplifies animating).}
ImagingGIFLoadAnimated = 56; ImagingGIFLoadAnimated = 56;
{ This option is used when reducing number of colors used in { This option is used when reducing number of colors used in
image (mainly when converting from ARGB image to indexed image (mainly when converting from ARGB image to indexed
format). Mask is 'anded' (bitwise AND) with every pixel's format). Mask is 'anded' (bitwise AND) with every pixel's
channel value when creating color histogram. If $FF is used channel value when creating color histogram. If $FF is used
all 8bits of color channels are used which can result in very all 8bits of color channels are used which can result in very
slow proccessing of large images with many colors so you can slow proccessing of large images with many colors so you can
use lower masks to speed it up (FC, F8 and F0 are good use lower masks to speed it up (FC, F8 and F0 are good
choices). Allowed values are in range <0, $FF> and default is choices). Allowed values are in range <0, $FF> and default is
$FE. } $FE. }
ImagingColorReductionMask = 128; ImagingColorReductionMask = 128;
{ This option can be used to override image data format during image { This option can be used to override image data format during image
loading. If set to format different from ifUnknown all loaded images loading. If set to format different from ifUnknown all loaded images
are automaticaly converted to this format. Useful when you have are automaticaly converted to this format. Useful when you have
many files in various formats but you want them all in one format for many files in various formats but you want them all in one format for
further proccessing. Allowed values are in further proccessing. Allowed values are in
range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))> and range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))> and
default value is ifUnknown.} default value is ifUnknown.}
ImagingLoadOverrideFormat = 129; ImagingLoadOverrideFormat = 129;
{ This option can be used to override image data format during image { This option can be used to override image data format during image
saving. If set to format different from ifUnknown all images saving. If set to format different from ifUnknown all images
to be saved are automaticaly internaly converted to this format. to be saved are automaticaly internaly converted to this format.
Note that image file formats support only a subset of Imaging data formats Note that image file formats support only a subset of Imaging data formats
so final saved file may in different format than this override. so final saved file may in different format than this override.
Allowed values are in range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))> Allowed values are in range <Ord(Low(TImageFormat)), Ord(High(TImageFormat))>
and default value is ifUnknown.} and default value is ifUnknown.}
ImagingSaveOverrideFormat = 130; ImagingSaveOverrideFormat = 130;
{ Specifies resampling filter used when generating mipmaps. It is used { Specifies resampling filter used when generating mipmaps. It is used
in GenerateMipMaps low level function and Direct3D and OpenGL extensions. in GenerateMipMaps low level function and Direct3D and OpenGL extensions.
Allowed values are in range Allowed values are in range
<Ord(Low(ImagingFormats.TSamplingFilter)), Ord(High(ImagingFormats.TSamplingFilter))> <Ord(Low(ImagingFormats.TSamplingFilter)), Ord(High(ImagingFormats.TSamplingFilter))>
and default value is 1 (linear filter).} and default value is 1 (linear filter).}
ImagingMipMapFilter = 131; ImagingMipMapFilter = 131;
{ Returned by GetOption if given Option Id is invalid.} { Returned by GetOption if given Option Id is invalid.}
InvalidOption = -$7FFFFFFF; InvalidOption = -$7FFFFFFF;
{ Indices that can be used to access channel values in array parts { Indices that can be used to access channel values in array parts
of structures like TColor32Rec. Note that this order can be of structures like TColor32Rec. Note that this order can be
used only for ARGB images. For ABGR image you must swap Red and Blue.} used only for ARGB images. For ABGR image you must swap Red and Blue.}
ChannelBlue = 0; ChannelBlue = 0;
ChannelGreen = 1; ChannelGreen = 1;
ChannelRed = 2; ChannelRed = 2;
ChannelAlpha = 3; ChannelAlpha = 3;
type type
{ Enum defining image data format. In formats with more channels, { Enum defining image data format. In formats with more channels,
first channel after "if" is stored in the most significant bits and channel first channel after "if" is stored in the most significant bits and channel
before end is stored in the least significant.} before end is stored in the least significant.}
TImageFormat = ( TImageFormat = (
ifUnknown = 0, ifUnknown = 0,
ifDefault = 1, ifDefault = 1,
{ Indexed formats using palette.} { Indexed formats using palette.}
ifIndex8 = 10, ifIndex8 = 10,
{ Grayscale/Luminance formats.} { Grayscale/Luminance formats.}
ifGray8 = 40, ifGray8 = 40,
ifA8Gray8 = 41, ifA8Gray8 = 41,
ifGray16 = 42, ifGray16 = 42,
ifGray32 = 43, ifGray32 = 43,
ifGray64 = 44, ifGray64 = 44,
ifA16Gray16 = 45, ifA16Gray16 = 45,
{ ARGB formats.} { ARGB formats.}
ifX5R1G1B1 = 80, ifX5R1G1B1 = 80,
ifR3G3B2 = 81, ifR3G3B2 = 81,
ifR5G6B5 = 82, ifR5G6B5 = 82,
ifA1R5G5B5 = 83, ifA1R5G5B5 = 83,
ifA4R4G4B4 = 84, ifA4R4G4B4 = 84,
ifX1R5G5B5 = 85, ifX1R5G5B5 = 85,
ifX4R4G4B4 = 86, ifX4R4G4B4 = 86,
ifR8G8B8 = 87, ifR8G8B8 = 87,
ifA8R8G8B8 = 88, ifA8R8G8B8 = 88,
ifX8R8G8B8 = 89, ifX8R8G8B8 = 89,
ifR16G16B16 = 90, ifR16G16B16 = 90,
ifA16R16G16B16 = 91, ifA16R16G16B16 = 91,
ifB16G16R16 = 92, ifB16G16R16 = 92,
ifA16B16G16R16 = 93, ifA16B16G16R16 = 93,
{ Floating point formats.} { Floating point formats.}
ifR32F = 170, ifR32F = 170,
ifA32R32G32B32F = 171, ifA32R32G32B32F = 171,
ifA32B32G32R32F = 172, ifA32B32G32R32F = 172,
ifR16F = 173, ifR16F = 173,
ifA16R16G16B16F = 174, ifA16R16G16B16F = 174,
ifA16B16G16R16F = 175, ifA16B16G16R16F = 175,
{ Special formats.} { Special formats.}
ifDXT1 = 220, ifDXT1 = 220,
ifDXT3 = 221, ifDXT3 = 221,
ifDXT5 = 222, ifDXT5 = 222,
ifBTC = 223, ifBTC = 223,
ifATI1N = 224, ifATI1N = 224,
ifATI2N = 225); ifATI2N = 225);
{ Color value for 32 bit images.} { Color value for 32 bit images.}
TColor32 = LongWord; TColor32 = LongWord;
PColor32 = ^TColor32; PColor32 = ^TColor32;
{ Color value for 64 bit images.} { Color value for 64 bit images.}
TColor64 = type Int64; TColor64 = type Int64;
PColor64 = ^TColor64; PColor64 = ^TColor64;
{ Color record for 24 bit images, which allows access to individual color { Color record for 24 bit images, which allows access to individual color
channels.} channels.}
TColor24Rec = packed record TColor24Rec = packed record
case LongInt of case LongInt of
0: (B, G, R: Byte); 0: (B, G, R: Byte);
1: (Channels: array[0..2] of Byte); 1: (Channels: array[0..2] of Byte);
end; end;
PColor24Rec = ^TColor24Rec; PColor24Rec = ^TColor24Rec;
TColor24RecArray = array[0..MaxInt div SizeOf(TColor24Rec) - 1] of TColor24Rec; TColor24RecArray = array[0..MaxInt div SizeOf(TColor24Rec) - 1] of TColor24Rec;
PColor24RecArray = ^TColor24RecArray; PColor24RecArray = ^TColor24RecArray;
{ Color record for 32 bit images, which allows access to individual color { Color record for 32 bit images, which allows access to individual color
channels.} channels.}
TColor32Rec = packed record TColor32Rec = packed record
case LongInt of case LongInt of
0: (Color: TColor32); 0: (Color: TColor32);
1: (B, G, R, A: Byte); 1: (B, G, R, A: Byte);
2: (Channels: array[0..3] of Byte); 2: (Channels: array[0..3] of Byte);
3: (Color24Rec: TColor24Rec); 3: (Color24Rec: TColor24Rec);
end; end;
PColor32Rec = ^TColor32Rec; PColor32Rec = ^TColor32Rec;
TColor32RecArray = array[0..MaxInt div SizeOf(TColor32Rec) - 1] of TColor32Rec; TColor32RecArray = array[0..MaxInt div SizeOf(TColor32Rec) - 1] of TColor32Rec;
PColor32RecArray = ^TColor32RecArray; PColor32RecArray = ^TColor32RecArray;
{ Color record for 48 bit images, which allows access to individual color { Color record for 48 bit images, which allows access to individual color
channels.} channels.}
TColor48Rec = packed record TColor48Rec = packed record
case LongInt of case LongInt of
0: (B, G, R: Word); 0: (B, G, R: Word);
1: (Channels: array[0..2] of Word); 1: (Channels: array[0..2] of Word);
end; end;
PColor48Rec = ^TColor48Rec; PColor48Rec = ^TColor48Rec;
TColor48RecArray = array[0..MaxInt div SizeOf(TColor48Rec) - 1] of TColor48Rec; TColor48RecArray = array[0..MaxInt div SizeOf(TColor48Rec) - 1] of TColor48Rec;
PColor48RecArray = ^TColor48RecArray; PColor48RecArray = ^TColor48RecArray;
{ Color record for 64 bit images, which allows access to individual color { Color record for 64 bit images, which allows access to individual color
channels.} channels.}
TColor64Rec = packed record TColor64Rec = packed record
case LongInt of case LongInt of
0: (Color: TColor64); 0: (Color: TColor64);
1: (B, G, R, A: Word); 1: (B, G, R, A: Word);
2: (Channels: array[0..3] of Word); 2: (Channels: array[0..3] of Word);
3: (Color48Rec: TColor48Rec); 3: (Color48Rec: TColor48Rec);
end; end;
PColor64Rec = ^TColor64Rec; PColor64Rec = ^TColor64Rec;
TColor64RecArray = array[0..MaxInt div SizeOf(TColor64Rec) - 1] of TColor64Rec; TColor64RecArray = array[0..MaxInt div SizeOf(TColor64Rec) - 1] of TColor64Rec;
PColor64RecArray = ^TColor64RecArray; PColor64RecArray = ^TColor64RecArray;
{ Color record for 128 bit floating point images, which allows access to { Color record for 128 bit floating point images, which allows access to
individual color channels.} individual color channels.}
TColorFPRec = packed record TColorFPRec = packed record
case LongInt of case LongInt of
0: (B, G, R, A: Single); 0: (B, G, R, A: Single);
1: (Channels: array[0..3] of Single); 1: (Channels: array[0..3] of Single);
end; end;
PColorFPRec = ^TColorFPRec; PColorFPRec = ^TColorFPRec;
TColorFPRecArray = array[0..MaxInt div SizeOf(TColorFPRec) - 1] of TColorFPRec; TColorFPRecArray = array[0..MaxInt div SizeOf(TColorFPRec) - 1] of TColorFPRec;
PColorFPRecArray = ^TColorFPRecArray; PColorFPRecArray = ^TColorFPRecArray;
{ 16 bit floating-point value. It has 1 sign bit, 5 exponent bits, { 16 bit floating-point value. It has 1 sign bit, 5 exponent bits,
and 10 mantissa bits.} and 10 mantissa bits.}
THalfFloat = type Word; THalfFloat = type Word;
PHalfFloat = ^THalfFloat; PHalfFloat = ^THalfFloat;
{ Color record for 64 bit floating point images, which allows access to { Color record for 64 bit floating point images, which allows access to
individual color channels.} individual color channels.}
TColorHFRec = packed record TColorHFRec = packed record
case LongInt of case LongInt of
0: (B, G, R, A: THalfFloat); 0: (B, G, R, A: THalfFloat);
1: (Channels: array[0..3] of THalfFloat); 1: (Channels: array[0..3] of THalfFloat);
end; end;
PColorHFRec = ^TColorHFRec; PColorHFRec = ^TColorHFRec;
TColorHFRecArray = array[0..MaxInt div SizeOf(TColorHFRec) - 1] of TColorHFRec; TColorHFRecArray = array[0..MaxInt div SizeOf(TColorHFRec) - 1] of TColorHFRec;
PColorHFRecArray = ^TColorHFRecArray; PColorHFRecArray = ^TColorHFRecArray;
{ Palette for indexed mode images with 32 bit colors.} { Palette for indexed mode images with 32 bit colors.}
TPalette32 = TColor32RecArray; TPalette32 = TColor32RecArray;
TPalette32Size256 = array[0..255] of TColor32Rec; TPalette32Size256 = array[0..255] of TColor32Rec;
PPalette32 = ^TPalette32; PPalette32 = ^TPalette32;
{ Palette for indexd mode images with 24 bit colors.} { Palette for indexd mode images with 24 bit colors.}
TPalette24 = TColor24RecArray; TPalette24 = TColor24RecArray;
TPalette24Size256 = array[0..255] of TColor24Rec; TPalette24Size256 = array[0..255] of TColor24Rec;
PPalette24 = ^TPalette24; PPalette24 = ^TPalette24;
{ Record that stores single image data and information describing it.} { Record that stores single image data and information describing it.}
TImageData = packed record TImageData = packed record
Width: LongInt; // Width of image in pixels Width: LongInt; // Width of image in pixels
Height: LongInt; // Height of image in pixels Height: LongInt; // Height of image in pixels
Format: TImageFormat; // Data format of image Format: TImageFormat; // Data format of image
Size: LongInt; // Size of image bits in Bytes Size: LongInt; // Size of image bits in Bytes
Bits: Pointer; // Pointer to memory containing image bits Bits: Pointer; // Pointer to memory containing image bits
Palette: PPalette32; // Image palette for indexed images Palette: PPalette32; // Image palette for indexed images
end; end;
PImageData = ^TImageData; PImageData = ^TImageData;
{ Pixel format information used in conversions to/from 16 and 8 bit ARGB { Pixel format information used in conversions to/from 16 and 8 bit ARGB
image formats.} image formats.}
TPixelFormatInfo = packed record TPixelFormatInfo = packed record
ABitCount, RBitCount, GBitCount, BBitCount: Byte; ABitCount, RBitCount, GBitCount, BBitCount: Byte;
ABitMask, RBitMask, GBitMask, BBitMask: LongWord; ABitMask, RBitMask, GBitMask, BBitMask: LongWord;
AShift, RShift, GShift, BShift: Byte; AShift, RShift, GShift, BShift: Byte;
ARecDiv, RRecDiv, GRecDiv, BRecDiv: Byte; ARecDiv, RRecDiv, GRecDiv, BRecDiv: Byte;
end; end;
PPixelFormatInfo = ^TPixelFormatInfo; PPixelFormatInfo = ^TPixelFormatInfo;
PImageFormatInfo = ^TImageFormatInfo; PImageFormatInfo = ^TImageFormatInfo;
{ Look at TImageFormatInfo.GetPixelsSize for details.} { Look at TImageFormatInfo.GetPixelsSize for details.}
TFormatGetPixelsSizeFunc = function(Format: TImageFormat; Width, TFormatGetPixelsSizeFunc = function(Format: TImageFormat; Width,
Height: LongInt): LongInt; Height: LongInt): LongInt;
{ Look at TImageFormatInfo.CheckDimensions for details.} { Look at TImageFormatInfo.CheckDimensions for details.}
TFormatCheckDimensionsProc = procedure(Format: TImageFormat; var Width, TFormatCheckDimensionsProc = procedure(Format: TImageFormat; var Width,
Height: LongInt); Height: LongInt);
{ Function for getting pixel colors. Native pixel is read from Image and { Function for getting pixel colors. Native pixel is read from Image and
then translated to 32 bit ARGB.} then translated to 32 bit ARGB.}
TGetPixel32Func = function(Bits: Pointer; Info: PImageFormatInfo; TGetPixel32Func = function(Bits: Pointer; Info: PImageFormatInfo;
Palette: PPalette32): TColor32Rec; Palette: PPalette32): TColor32Rec;
{ Function for getting pixel colors. Native pixel is read from Image and { Function for getting pixel colors. Native pixel is read from Image and
then translated to FP ARGB.} then translated to FP ARGB.}
TGetPixelFPFunc = function(Bits: Pointer; Info: PImageFormatInfo; TGetPixelFPFunc = function(Bits: Pointer; Info: PImageFormatInfo;
Palette: PPalette32): TColorFPRec; Palette: PPalette32): TColorFPRec;
{ Procedure for setting pixel colors. Input 32 bit ARGB color is translated to { Procedure for setting pixel colors. Input 32 bit ARGB color is translated to
native format and then written to Image.} native format and then written to Image.}
TSetPixel32Proc = procedure(Bits: Pointer; Info: PImageFormatInfo; TSetPixel32Proc = procedure(Bits: Pointer; Info: PImageFormatInfo;
Palette: PPalette32;const Color: TColor32Rec); Palette: PPalette32;const Color: TColor32Rec);
{ Procedure for setting pixel colors. Input FP ARGB color is translated to { Procedure for setting pixel colors. Input FP ARGB color is translated to
native format and then written to Image.} native format and then written to Image.}
TSetPixelFPProc = procedure(Bits: Pointer; Info: PImageFormatInfo; TSetPixelFPProc = procedure(Bits: Pointer; Info: PImageFormatInfo;
Palette: PPalette32; const Color: TColorFPRec); Palette: PPalette32; const Color: TColorFPRec);
{ Additional information for each TImageFormat value.} { Additional information for each TImageFormat value.}
TImageFormatInfo = packed record TImageFormatInfo = packed record
Format: TImageFormat; // Format described by this record Format: TImageFormat; // Format described by this record
Name: array[0..15] of Char; // Symbolic name of format Name: array[0..15] of Char; // Symbolic name of format
BytesPerPixel: LongInt; // Number of bytes per pixel (note: it is BytesPerPixel: LongInt; // Number of bytes per pixel (note: it is
// 0 for formats where BitsPerPixel < 8 (e.g. DXT). // 0 for formats where BitsPerPixel < 8 (e.g. DXT).
// Use GetPixelsSize function to get size of // Use GetPixelsSize function to get size of
// image data. // image data.
ChannelCount: LongInt; // Number of image channels (R, G, B, A, Gray) ChannelCount: LongInt; // Number of image channels (R, G, B, A, Gray)
PaletteEntries: LongInt; // Number of palette entries PaletteEntries: LongInt; // Number of palette entries
HasGrayChannel: Boolean; // True if image has grayscale channel HasGrayChannel: Boolean; // True if image has grayscale channel
HasAlphaChannel: Boolean; // True if image has alpha channel HasAlphaChannel: Boolean; // True if image has alpha channel
IsFloatingPoint: Boolean; // True if image has floating point pixels IsFloatingPoint: Boolean; // True if image has floating point pixels
UsePixelFormat: Boolean; // True if image uses pixel format UsePixelFormat: Boolean; // True if image uses pixel format
IsRBSwapped: Boolean; // True if Red and Blue channels are swapped IsRBSwapped: Boolean; // True if Red and Blue channels are swapped
// e.g. A16B16G16R16 has IsRBSwapped True // e.g. A16B16G16R16 has IsRBSwapped True
RBSwapFormat: TImageFormat; // Indicates supported format with swapped RBSwapFormat: TImageFormat; // Indicates supported format with swapped
// Red and Blue channels, ifUnknown if such // Red and Blue channels, ifUnknown if such
// format does not exist // format does not exist
IsIndexed: Boolean; // True if image uses palette IsIndexed: Boolean; // True if image uses palette
IsSpecial: Boolean; // True if image is in special format IsSpecial: Boolean; // True if image is in special format
PixelFormat: PPixelFormatInfo; // Pixel format structure PixelFormat: PPixelFormatInfo; // Pixel format structure
GetPixelsSize: TFormatGetPixelsSizeFunc; // Returns size in bytes of GetPixelsSize: TFormatGetPixelsSizeFunc; // Returns size in bytes of
// Width * Height pixels of image // Width * Height pixels of image
CheckDimensions: TFormatCheckDimensionsProc; // some formats have limited CheckDimensions: TFormatCheckDimensionsProc; // some formats have limited
// values of Width and Height. This // values of Width and Height. This
// procedure checks and changes dimensions // procedure checks and changes dimensions
// to be valid for given format. // to be valid for given format.
GetPixel32: TGetPixel32Func; // 32bit ARGB pixel get function GetPixel32: TGetPixel32Func; // 32bit ARGB pixel get function
GetPixelFP: TGetPixelFPFunc; // FP ARGB pixel get function GetPixelFP: TGetPixelFPFunc; // FP ARGB pixel get function
SetPixel32: TSetPixel32Proc; // 32bit ARGB pixel set procedure SetPixel32: TSetPixel32Proc; // 32bit ARGB pixel set procedure
SetPixelFP: TSetPixelFPProc; // FP ARGB pixel set procedure SetPixelFP: TSetPixelFPProc; // FP ARGB pixel set procedure
SpecialNearestFormat: TImageFormat; // Regular image format used when SpecialNearestFormat: TImageFormat; // Regular image format used when
// compressing/decompressing special images // compressing/decompressing special images
// as source/target // as source/target
end; end;
{ Handle to list of image data records.} { Handle to list of image data records.}
TImageDataList = Pointer; TImageDataList = Pointer;
PImageDataList = ^TImageDataList; PImageDataList = ^TImageDataList;
{ Handle to input/output.} { Handle to input/output.}
TImagingHandle = Pointer; TImagingHandle = Pointer;
{ Filters used in functions that resize images or their portions.} { Filters used in functions that resize images or their portions.}
TResizeFilter = ( TResizeFilter = (
rfNearest = 0, rfNearest = 0,
rfBilinear = 1, rfBilinear = 1,
rfBicubic = 2); rfBicubic = 2);
{ Seek origin mode for IO function Seek.} { Seek origin mode for IO function Seek.}
TSeekMode = ( TSeekMode = (
smFromBeginning = 0, smFromBeginning = 0,
smFromCurrent = 1, smFromCurrent = 1,
smFromEnd = 2); smFromEnd = 2);
{ IO functions used for reading and writing images from/to input/output.} { IO functions used for reading and writing images from/to input/output.}
TOpenReadProc = function(Source: PChar): TImagingHandle; cdecl; TOpenReadProc = function(Source: PChar): TImagingHandle; cdecl;
TOpenWriteProc = function(Source: PChar): TImagingHandle; cdecl; TOpenWriteProc = function(Source: PChar): TImagingHandle; cdecl;
TCloseProc = procedure(Handle: TImagingHandle); cdecl; TCloseProc = procedure(Handle: TImagingHandle); cdecl;
TEofProc = function(Handle: TImagingHandle): Boolean; cdecl; TEofProc = function(Handle: TImagingHandle): Boolean; cdecl;
TSeekProc = function(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode): LongInt; cdecl; TSeekProc = function(Handle: TImagingHandle; Offset: LongInt; Mode: TSeekMode): LongInt; cdecl;
TTellProc = function(Handle: TImagingHandle): LongInt; cdecl; TTellProc = function(Handle: TImagingHandle): LongInt; cdecl;
TReadProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl; TReadProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl;
TWriteProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl; TWriteProc = function(Handle: TImagingHandle; Buffer: Pointer; Count: LongInt): LongInt; cdecl;
implementation implementation
{ {
File Notes: File Notes:
-- TODOS ---------------------------------------------------- -- TODOS ----------------------------------------------------
- add lookup tables to pixel formats for fast conversions - add lookup tables to pixel formats for fast conversions
-- 0.24.3 Changes/Bug Fixes --------------------------------- -- 0.24.3 Changes/Bug Fixes ---------------------------------
- Added ifATI1N and ifATI2N image data formats. - Added ifATI1N and ifATI2N image data formats.
-- 0.23 Changes/Bug Fixes ----------------------------------- -- 0.23 Changes/Bug Fixes -----------------------------------
- Added ifBTC image format and SpecialNearestFormat field - Added ifBTC image format and SpecialNearestFormat field
to TImageFormatInfo. to TImageFormatInfo.
-- 0.21 Changes/Bug Fixes ----------------------------------- -- 0.21 Changes/Bug Fixes -----------------------------------
- Added option constants for PGM and PPM file formats. - Added option constants for PGM and PPM file formats.
- Added TPalette32Size256 and TPalette24Size256 types. - Added TPalette32Size256 and TPalette24Size256 types.
-- 0.19 Changes/Bug Fixes ----------------------------------- -- 0.19 Changes/Bug Fixes -----------------------------------
- added ImagingVersionPatch constant so bug fix only releases - added ImagingVersionPatch constant so bug fix only releases
can be distinguished from ordinary major/minor releases can be distinguished from ordinary major/minor releases
- renamed TPixelFormat to TPixelFormatInfo to avoid name collisions - renamed TPixelFormat to TPixelFormatInfo to avoid name collisions
with Graphics.TPixelFormat with Graphics.TPixelFormat
- added new image data formats: ifR16F, ifA16R16G16B16F, - added new image data formats: ifR16F, ifA16R16G16B16F,
ifA16B16G16R16F ifA16B16G16R16F
- added pixel get/set function pointers to TImageFormatInfo - added pixel get/set function pointers to TImageFormatInfo
- added 16bit half float type and color record - added 16bit half float type and color record
- renamed TColorFRec to TColorFPRec (and related types too) - renamed TColorFRec to TColorFPRec (and related types too)
-- 0.17 Changes/Bug Fixes ----------------------------------- -- 0.17 Changes/Bug Fixes -----------------------------------
- added option ImagingMipMapFilter which now controls resampling filter - added option ImagingMipMapFilter which now controls resampling filter
used when generating mipmaps used when generating mipmaps
- added TResizeFilter type - added TResizeFilter type
- added ChannelCount to TImageFormatInfo - added ChannelCount to TImageFormatInfo
- added new option constants for MNG and JNG images - added new option constants for MNG and JNG images
-- 0.15 Changes/Bug Fixes ----------------------------------- -- 0.15 Changes/Bug Fixes -----------------------------------
- added RBSwapFormat to TImageFormatInfo for faster conversions - added RBSwapFormat to TImageFormatInfo for faster conversions
between swapped formats (it just calls SwapChannels now if between swapped formats (it just calls SwapChannels now if
RBSwapFormat is not ifUnknown) RBSwapFormat is not ifUnknown)
- moved TImageFormatInfo and required types from Imaging unit - moved TImageFormatInfo and required types from Imaging unit
here, removed TImageFormatShortInfo here, removed TImageFormatShortInfo
- added new options: ImagingLoadOverrideFormat, ImagingSaveOverrideFormat - added new options: ImagingLoadOverrideFormat, ImagingSaveOverrideFormat
-- 0.13 Changes/Bug Fixes ----------------------------------- -- 0.13 Changes/Bug Fixes -----------------------------------
- new ImagingColorReductionMask option added - new ImagingColorReductionMask option added
- new image format added: ifA16Gray16 - new image format added: ifA16Gray16
} }
end. end.

644
Imaging/ImagingUtility.pas
View File

@ -106,13 +106,13 @@ type
TChar16 = array[0..15] of AnsiChar; TChar16 = array[0..15] of AnsiChar;
{ Options for BuildFileList function: { Options for BuildFileList function:
flFullNames - file names in result will have full path names flFullNames - file names in result will have full path names
(ExtractFileDir(Path) + FileName) (ExtractFileDir(Path) + FileName)
flRelNames - file names in result will have names relative to flRelNames - file names in result will have names relative to
ExtractFileDir(Path) dir ExtractFileDir(Path) dir
flRecursive - adds files in subdirectories found in Path.} flRecursive - adds files in subdirectories found in Path.}
TFileListOption = (flFullNames, flRelNames, flRecursive); TFileListOption = (flFullNames, flRelNames, flRecursive);
TFileListOptions = set of TFileListOption; TFileListOptions = set of TFileListOption;
{ Frees class instance and sets its reference to nil.} { Frees class instance and sets its reference to nil.}
@ -137,35 +137,35 @@ function GetAppExe: string;
path delimiter at the end.} path delimiter at the end.}
function GetAppDir: string; function GetAppDir: string;
{ Returns True if FileName matches given Mask with optional case sensitivity. { Returns True if FileName matches given Mask with optional case sensitivity.
Mask can contain ? and * special characters: ? matches Mask can contain ? and * special characters: ? matches
one character, * matches zero or more characters.} one character, * matches zero or more characters.}
function MatchFileNameMask(const FileName, Mask: string; CaseSensitive: Boolean = False): Boolean; function MatchFileNameMask(const FileName, Mask: string; CaseSensitive: Boolean = False): Boolean;
{ This function fills Files string list with names of files found { This function fills Files string list with names of files found
with FindFirst/FindNext functions (See details on Path/Atrr here). with FindFirst/FindNext functions (See details on Path/Atrr here).
- BuildFileList('c:\*.*', faAnyFile, List, [flRecursive]) returns - BuildFileList('c:\*.*', faAnyFile, List, [flRecursive]) returns
list of all files (only name.ext - no path) on C drive list of all files (only name.ext - no path) on C drive
- BuildFileList('d:\*.*', faDirectory, List, [flFullNames]) returns - BuildFileList('d:\*.*', faDirectory, List, [flFullNames]) returns
list of all directories (d:\dirxxx) in root of D drive.} list of all directories (d:\dirxxx) in root of D drive.}
function BuildFileList(Path: string; Attr: LongInt; Files: TStrings; function BuildFileList(Path: string; Attr: LongInt; Files: TStrings;
Options: TFileListOptions = []): Boolean; Options: TFileListOptions = []): Boolean;
{ Similar to RTL's Pos function but with optional Offset where search will start. { Similar to RTL's Pos function but with optional Offset where search will start.
This function is in the RTL StrUtils unit but } This function is in the RTL StrUtils unit but }
function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt; function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt;
{ Same as PosEx but without case sensitivity.} { Same as PosEx but without case sensitivity.}
function PosNoCase(const SubStr, S: string; Offset: LongInt = 1): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} function PosNoCase(const SubStr, S: string; Offset: LongInt = 1): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
{ Returns a sub-string from S which is followed by { Returns a sub-string from S which is followed by
Sep separator and deletes the sub-string from S including the separator.} Sep separator and deletes the sub-string from S including the separator.}
function StrToken(var S: string; Sep: Char): string; function StrToken(var S: string; Sep: Char): string;
{ Same as StrToken but searches from the end of S string.} { Same as StrToken but searches from the end of S string.}
function StrTokenEnd(var S: string; Sep: Char): string; function StrTokenEnd(var S: string; Sep: Char): string;
{ Fills instance of TStrings with tokens from string S where tokens are separated by { Fills instance of TStrings with tokens from string S where tokens are separated by
one of Seps characters.} one of Seps characters.}
procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings); procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings);
{ Returns string representation of integer number (with digit grouping).} { Returns string representation of integer number (with digit grouping).}
function IntToStrFmt(const I: Int64): string; {$IFDEF USE_INLINE}inline;{$ENDIF} function IntToStrFmt(const I: Int64): string; {$IFDEF USE_INLINE}inline;{$ENDIF}
{ Returns string representation of float number (with digit grouping).} { Returns string representation of float number (with digit grouping).}
function FloatToStrFmt(const F: Double; Precision: Integer = 2): string; {$IFDEF USE_INLINE}inline;{$ENDIF} function FloatToStrFmt(const F: Double; Precision: Integer = 2): string; {$IFDEF USE_INLINE}inline;{$ENDIF}
{ Clamps integer value to range <Min, Max>} { Clamps integer value to range <Min, Max>}
function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF} function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
{ Clamps float value to range <Min, Max>} { Clamps float value to range <Min, Max>}
@ -402,7 +402,7 @@ end;
function GetTimeMilliseconds: Int64; function GetTimeMilliseconds: Int64;
begin begin
Result := GetTimeMicroseconds div 1000; Result := GetTimeMicroseconds div 1000;
end; end;
function GetFileExt(const FileName: string): string; function GetFileExt(const FileName: string): string;
@ -444,269 +444,269 @@ begin
end; end;
function MatchFileNameMask(const FileName, Mask: string; CaseSensitive: Boolean): Boolean; function MatchFileNameMask(const FileName, Mask: string; CaseSensitive: Boolean): Boolean;
var var
MaskLen, KeyLen : LongInt; MaskLen, KeyLen : LongInt;
function CharMatch(A, B: Char): Boolean; function CharMatch(A, B: Char): Boolean;
begin begin
if CaseSensitive then if CaseSensitive then
Result := A = B Result := A = B
else else
Result := AnsiUpperCase (A) = AnsiUpperCase (B); Result := AnsiUpperCase (A) = AnsiUpperCase (B);
end; end;
function MatchAt(MaskPos, KeyPos: LongInt): Boolean; function MatchAt(MaskPos, KeyPos: LongInt): Boolean;
begin begin
while (MaskPos <= MaskLen) and (KeyPos <= KeyLen) do while (MaskPos <= MaskLen) and (KeyPos <= KeyLen) do
begin begin
case Mask[MaskPos] of case Mask[MaskPos] of
'?' : '?' :
begin begin
Inc(MaskPos); Inc(MaskPos);
Inc(KeyPos); Inc(KeyPos);
end; end;
'*' : '*' :
begin begin
while (MaskPos <= MaskLen) and (Mask[MaskPos] = '*') do while (MaskPos <= MaskLen) and (Mask[MaskPos] = '*') do
Inc(MaskPos); Inc(MaskPos);
if MaskPos > MaskLen then if MaskPos > MaskLen then
begin begin
Result := True; Result := True;
Exit; Exit;
end; end;
repeat repeat
if MatchAt(MaskPos, KeyPos) then if MatchAt(MaskPos, KeyPos) then
begin begin
Result := True; Result := True;
Exit; Exit;
end; end;
Inc(KeyPos); Inc(KeyPos);
until KeyPos > KeyLen; until KeyPos > KeyLen;
Result := False; Result := False;
Exit; Exit;
end; end;
else else
if not CharMatch(Mask[MaskPos], FileName[KeyPos]) then if not CharMatch(Mask[MaskPos], FileName[KeyPos]) then
begin begin
Result := False; Result := False;
Exit; Exit;
end end
else else
begin begin
Inc(MaskPos); Inc(MaskPos);
Inc(KeyPos); Inc(KeyPos);
end; end;
end; end;
end; end;
while (MaskPos <= MaskLen) and (Mask[MaskPos] in ['?', '*']) do while (MaskPos <= MaskLen) and (Mask[MaskPos] in ['?', '*']) do
Inc(MaskPos); Inc(MaskPos);
if (MaskPos <= MaskLen) or (KeyPos <= KeyLen) then if (MaskPos <= MaskLen) or (KeyPos <= KeyLen) then
begin begin
Result := False; Result := False;
Exit; Exit;
end; end;
Result := True; Result := True;
end; end;
begin begin
MaskLen := Length(Mask); MaskLen := Length(Mask);
KeyLen := Length(FileName); KeyLen := Length(FileName);
if MaskLen = 0 then if MaskLen = 0 then
begin begin
Result := True; Result := True;
Exit; Exit;
end; end;
Result := MatchAt(1, 1); Result := MatchAt(1, 1);
end; end;
function BuildFileList(Path: string; Attr: LongInt; function BuildFileList(Path: string; Attr: LongInt;
Files: TStrings; Options: TFileListOptions): Boolean; Files: TStrings; Options: TFileListOptions): Boolean;
var var
FileMask: string; FileMask: string;
RootDir: string; RootDir: string;
Folders: TStringList; Folders: TStringList;
CurrentItem: LongInt; CurrentItem: LongInt;
Counter: LongInt; Counter: LongInt;
LocAttr: LongInt; LocAttr: LongInt;
procedure BuildFolderList; procedure BuildFolderList;
var var
FindInfo: TSearchRec; FindInfo: TSearchRec;
Rslt: LongInt; Rslt: LongInt;
begin begin
Counter := Folders.Count - 1; Counter := Folders.Count - 1;
CurrentItem := 0; CurrentItem := 0;
while CurrentItem <= Counter do while CurrentItem <= Counter do
begin begin
// Searching for subfolders // Searching for subfolders
Rslt := SysUtils.FindFirst(Folders[CurrentItem] + '*', faDirectory, FindInfo); Rslt := SysUtils.FindFirst(Folders[CurrentItem] + '*', faDirectory, FindInfo);
try try
while Rslt = 0 do while Rslt = 0 do
begin begin
if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') and if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') and
(FindInfo.Attr and faDirectory = faDirectory) then (FindInfo.Attr and faDirectory = faDirectory) then
Folders.Add(Folders[CurrentItem] + FindInfo.Name + PathDelim); Folders.Add(Folders[CurrentItem] + FindInfo.Name + PathDelim);
Rslt := SysUtils.FindNext(FindInfo); Rslt := SysUtils.FindNext(FindInfo);
end; end;
finally finally
SysUtils.FindClose(FindInfo); SysUtils.FindClose(FindInfo);
end; end;
Counter := Folders.Count - 1; Counter := Folders.Count - 1;
Inc(CurrentItem); Inc(CurrentItem);
end; end;
end; end;
procedure FillFileList(CurrentCounter: LongInt); procedure FillFileList(CurrentCounter: LongInt);
var var
FindInfo: TSearchRec; FindInfo: TSearchRec;
Res: LongInt; Res: LongInt;
CurrentFolder: string; CurrentFolder: string;
begin begin
CurrentFolder := Folders[CurrentCounter]; CurrentFolder := Folders[CurrentCounter];
Res := SysUtils.FindFirst(CurrentFolder + FileMask, LocAttr, FindInfo); Res := SysUtils.FindFirst(CurrentFolder + FileMask, LocAttr, FindInfo);
if flRelNames in Options then if flRelNames in Options then
CurrentFolder := ExtractRelativePath(RootDir, CurrentFolder); CurrentFolder := ExtractRelativePath(RootDir, CurrentFolder);
try try
while Res = 0 do while Res = 0 do
begin begin
if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') then if (FindInfo.Name <> '.') and (FindInfo.Name <> '..') then
begin begin
if (flFullNames in Options) or (flRelNames in Options) then if (flFullNames in Options) or (flRelNames in Options) then
Files.Add(CurrentFolder + FindInfo.Name) Files.Add(CurrentFolder + FindInfo.Name)
else else
Files.Add(FindInfo.Name); Files.Add(FindInfo.Name);
end; end;
Res := SysUtils.FindNext(FindInfo); Res := SysUtils.FindNext(FindInfo);
end; end;
finally finally
SysUtils.FindClose(FindInfo); SysUtils.FindClose(FindInfo);
end; end;
end; end;
begin begin
FileMask := ExtractFileName(Path); FileMask := ExtractFileName(Path);
RootDir := ExtractFilePath(Path); RootDir := ExtractFilePath(Path);
Folders := TStringList.Create; Folders := TStringList.Create;
Folders.Add(RootDir); Folders.Add(RootDir);
Files.Clear; Files.Clear;
{$IFDEF DCC} {$IFDEF DCC}
{$WARN SYMBOL_PLATFORM OFF} {$WARN SYMBOL_PLATFORM OFF}
{$ENDIF} {$ENDIF}
if Attr = faAnyFile then if Attr = faAnyFile then
LocAttr := faSysFile or faHidden or faArchive or faReadOnly LocAttr := faSysFile or faHidden or faArchive or faReadOnly
else else
LocAttr := Attr; LocAttr := Attr;
{$IFDEF DCC} {$IFDEF DCC}
{$WARN SYMBOL_PLATFORM ON} {$WARN SYMBOL_PLATFORM ON}
{$ENDIF} {$ENDIF}
// Here's the recursive search for nested folders // Here's the recursive search for nested folders
if flRecursive in Options then if flRecursive in Options then
BuildFolderList; BuildFolderList;
if Attr <> faDirectory then if Attr <> faDirectory then
for Counter := 0 to Folders.Count - 1 do for Counter := 0 to Folders.Count - 1 do
FillFileList(Counter) FillFileList(Counter)
else else
Files.AddStrings(Folders); Files.AddStrings(Folders);
Folders.Free; Folders.Free;
Result := True; Result := True;
end; end;
function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt; function PosEx(const SubStr, S: string; Offset: LongInt = 1): LongInt;
var var
I, X: LongInt; I, X: LongInt;
Len, LenSubStr: LongInt; Len, LenSubStr: LongInt;
begin begin
I := Offset; I := Offset;
LenSubStr := Length(SubStr); LenSubStr := Length(SubStr);
Len := Length(S) - LenSubStr + 1; Len := Length(S) - LenSubStr + 1;
while I <= Len do while I <= Len do
begin begin
if S[I] = SubStr[1] then if S[I] = SubStr[1] then
begin begin
X := 1; X := 1;
while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
Inc(X); Inc(X);
if (X = LenSubStr) then if (X = LenSubStr) then
begin begin
Result := I; Result := I;
Exit; Exit;
end; end;
end; end;
Inc(I); Inc(I);
end; end;
Result := 0; Result := 0;
end; end;
function PosNoCase(const SubStr, S: string; Offset: LongInt): LongInt; function PosNoCase(const SubStr, S: string; Offset: LongInt): LongInt;
begin begin
Result := PosEx(AnsiLowerCase(SubStr), AnsiLowerCase(S), Offset); Result := PosEx(AnsiLowerCase(SubStr), AnsiLowerCase(S), Offset);
end; end;
function StrToken(var S: string; Sep: Char): string; function StrToken(var S: string; Sep: Char): string;
var var
I: LongInt; I: LongInt;
begin begin
I := Pos(Sep, S); I := Pos(Sep, S);
if I <> 0 then if I <> 0 then
begin begin
Result := Copy(S, 1, I - 1); Result := Copy(S, 1, I - 1);
Delete(S, 1, I); Delete(S, 1, I);
end end
else else
begin begin
Result := S; Result := S;
S := ''; S := '';
end; end;
end; end;
function StrTokenEnd(var S: string; Sep: Char): string; function StrTokenEnd(var S: string; Sep: Char): string;
var var
I, J: LongInt; I, J: LongInt;
begin begin
J := 0; J := 0;
I := Pos(Sep, S); I := Pos(Sep, S);
while I <> 0 do while I <> 0 do
begin begin
J := I; J := I;
I := PosEx(Sep, S, J + 1); I := PosEx(Sep, S, J + 1);
end; end;
if J <> 0 then if J <> 0 then
begin begin
Result := Copy(S, J + 1, MaxInt); Result := Copy(S, J + 1, MaxInt);
Delete(S, J, MaxInt); Delete(S, J, MaxInt);
end end
else else
begin begin
Result := S; Result := S;
S := ''; S := '';
end; end;
end; end;
procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings); procedure StrTokensToList(const S: string; Sep: Char; Tokens: TStrings);
var var
Token, Str: string; Token, Str: string;
begin begin
Tokens.Clear; Tokens.Clear;
Str := S; Str := S;
while Str <> '' do while Str <> '' do
begin begin
Token := StrToken(Str, Sep); Token := StrToken(Str, Sep);
Tokens.Add(Token); Tokens.Add(Token);
end; end;
end; end;
function IntToStrFmt(const I: Int64): string; function IntToStrFmt(const I: Int64): string;
begin begin
Result := Format('%.0n', [I * 1.0]); Result := Format('%.0n', [I * 1.0]);
end; end;
function FloatToStrFmt(const F: Double; Precision: Integer): string; function FloatToStrFmt(const F: Double; Precision: Integer): string;
begin begin
Result := Format('%.' + IntToStr(Precision) + 'n', [F]); Result := Format('%.' + IntToStr(Precision) + 'n', [F]);
end; end;
function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt; function ClampInt(Number: LongInt; Min, Max: LongInt): LongInt;
begin begin
Result := Number; Result := Number;
@ -877,18 +877,18 @@ end;
function Iff(Condition: Boolean; TruePart, FalsePart: Pointer): Pointer; function Iff(Condition: Boolean; TruePart, FalsePart: Pointer): Pointer;
begin begin
if Condition then if Condition then
Result := TruePart Result := TruePart
else else
Result := FalsePart; Result := FalsePart;
end; end;
function Iff(Condition: Boolean; const TruePart, FalsePart: Int64): Int64; function Iff(Condition: Boolean; const TruePart, FalsePart: Int64): Int64;
begin begin
if Condition then if Condition then
Result := TruePart Result := TruePart
else else
Result := FalsePart; Result := FalsePart;
end; end;
function IffFloat(Condition: Boolean; TruePart, FalsePart: Single): Single; function IffFloat(Condition: Boolean; TruePart, FalsePart: Single): Single;
@ -982,8 +982,8 @@ end;
function MulDiv(Number, Numerator, Denominator: Word): Word; function MulDiv(Number, Numerator, Denominator: Word): Word;
{$IF Defined(USE_ASM) and (not Defined(USE_INLINE))} {$IF Defined(USE_ASM) and (not Defined(USE_INLINE))}
asm asm
MUL DX MUL DX
DIV CX DIV CX
end; end;
{$ELSE} {$ELSE}
begin begin
@ -995,8 +995,8 @@ function IsLittleEndian: Boolean;
var var
W: Word; W: Word;
begin begin
W := $00FF; W := $00FF;
Result := PByte(@W)^ = $FF; Result := PByte(@W)^ = $FF;
end; end;
function SwapEndianWord(Value: Word): Word; function SwapEndianWord(Value: Word): Word;
@ -1254,12 +1254,12 @@ begin
end; end;
function GetVolumeLevelCount(Depth, MipMaps: LongInt): LongInt; function GetVolumeLevelCount(Depth, MipMaps: LongInt): LongInt;
var var
I: LongInt; I: LongInt;
begin begin
Result := Depth; Result := Depth;
for I := 1 to MipMaps - 1 do for I := 1 to MipMaps - 1 do
Inc(Result, ClampInt(Depth shr I, 1, Depth)); Inc(Result, ClampInt(Depth shr I, 1, Depth));
end; end;
function BoundsToRect(X, Y, Width, Height: LongInt): TRect; function BoundsToRect(X, Y, Width, Height: LongInt): TRect;
@ -1408,27 +1408,27 @@ begin
end; end;
function RectInRect(const R1, R2: TRect): Boolean; function RectInRect(const R1, R2: TRect): Boolean;
begin begin
Result:= Result:=
(R1.Left >= R2.Left) and (R1.Left >= R2.Left) and
(R1.Top >= R2.Top) and (R1.Top >= R2.Top) and
(R1.Right <= R2.Right) and (R1.Right <= R2.Right) and
(R1.Bottom <= R2.Bottom); (R1.Bottom <= R2.Bottom);
end; end;
function RectIntersects(const R1, R2: TRect): Boolean; function RectIntersects(const R1, R2: TRect): Boolean;
begin begin
Result := Result :=
not (R1.Left > R2.Right) and not (R1.Left > R2.Right) and
not (R1.Top > R2.Bottom) and not (R1.Top > R2.Bottom) and
not (R1.Right < R2.Left) and not (R1.Right < R2.Left) and
not (R1.Bottom < R2.Top); not (R1.Bottom < R2.Top);
end; end;
function FormatExceptMsg(const Msg: string; const Args: array of const): string; function FormatExceptMsg(const Msg: string; const Args: array of const): string;
begin begin
Result := Format(Msg + SLineBreak + 'Message: ' + GetExceptObject.Message, Args); Result := Format(Msg + SLineBreak + 'Message: ' + GetExceptObject.Message, Args);
end; end;
procedure DebugMsg(const Msg: string; const Args: array of const); procedure DebugMsg(const Msg: string; const Args: array of const);
var var

28
heContnrs.pas
View File

@ -1499,7 +1499,7 @@ end;
function TheObjectVector.GetEnumerator: TEnumerator; function TheObjectVector.GetEnumerator: TEnumerator;
begin begin
Result.Init(-1, @MoveNext, @GetCurrent); Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheObjectVector.Has(const Item: TItem): Boolean; function TheObjectVector.Has(const Item: TItem): Boolean;
@ -1733,7 +1733,7 @@ end;
function TheVector.GetEnumerator: TEnumerator; function TheVector.GetEnumerator: TEnumerator;
begin begin
Result.Init(-1, @MoveNext, @GetCurrent); Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheVector.Has(const Item: TItem): Boolean; function TheVector.Has(const Item: TItem): Boolean;
@ -1944,7 +1944,7 @@ end;
function TheCmpVector.GetEnumerator: TEnumerator; function TheCmpVector.GetEnumerator: TEnumerator;
begin begin
Result.Init(-1, @MoveNext, @GetCurrent); Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheCmpVector.Has(const Item: TItem): Boolean; function TheCmpVector.Has(const Item: TItem): Boolean;
@ -2105,7 +2105,7 @@ end;
function TheSortVector.GetEnumerator: TEnumerator; function TheSortVector.GetEnumerator: TEnumerator;
begin begin
Result.Init(-1, @MoveNext, @GetCurrent); Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheSortVector.Has(const Item: TItem): Boolean; function TheSortVector.Has(const Item: TItem): Boolean;
@ -2267,7 +2267,7 @@ end;
function TheCmpSortVector.GetEnumerator: TEnumerator; function TheCmpSortVector.GetEnumerator: TEnumerator;
begin begin
Result.Init(-1, @MoveNext, @GetCurrent); Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheCmpSortVector.Has(const Item: TItem): Boolean; function TheCmpSortVector.Has(const Item: TItem): Boolean;
@ -2439,7 +2439,7 @@ end;
function TheObjectSortVector.GetEnumerator: TEnumerator; function TheObjectSortVector.GetEnumerator: TEnumerator;
begin begin
Result.Init(-1, @MoveNext, @GetCurrent); Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheObjectSortVector.Has(const Item: TItem): Boolean; function TheObjectSortVector.Has(const Item: TItem): Boolean;
@ -2621,7 +2621,7 @@ end;
function TheVectorSet.GetEnumerator: TEnumerator; function TheVectorSet.GetEnumerator: TEnumerator;
begin begin
Result.Init(-1, @MoveNext, @GetCurrent); Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheVectorSet.Include(const Item: TItem): Boolean; function TheVectorSet.Include(const Item: TItem): Boolean;
@ -2778,7 +2778,7 @@ end;
function TheCmpVectorSet.GetEnumerator: TEnumerator; function TheCmpVectorSet.GetEnumerator: TEnumerator;
begin begin
Result.Init(-1, @MoveNext, @GetCurrent); Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheCmpVectorSet.Include(const Item: TItem): Boolean; function TheCmpVectorSet.Include(const Item: TItem): Boolean;
@ -2941,7 +2941,7 @@ end;
function TheObjectVectorSet.GetEnumerator: TEnumerator; function TheObjectVectorSet.GetEnumerator: TEnumerator;
begin begin
Result.Init(-1, @MoveNext, @GetCurrent); Result.Init(-1, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheObjectVectorSet.Include(const Item: TItem): Boolean; function TheObjectVectorSet.Include(const Item: TItem): Boolean;
@ -3732,7 +3732,7 @@ end;
function TheList.GetEnumerator: TEnumerator; function TheList.GetEnumerator: TEnumerator;
begin begin
Result.Init(NewIterator, @MoveNext, @CurrentItem); Result.Init(NewIterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@CurrentItem));
end; end;
function TheList.CurrentItem(var Iterator: TIterator): TItem; function TheList.CurrentItem(var Iterator: TIterator): TItem;
@ -3937,7 +3937,7 @@ end;
function TheObjectList.GetEnumerator: TEnumerator; function TheObjectList.GetEnumerator: TEnumerator;
begin begin
Result.Init(NewIterator, @MoveNext, @CurrentItem); Result.Init(NewIterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@CurrentItem));
end; end;
function TheObjectList.CurrentItem(var Iterator: TIterator): TItem; function TheObjectList.CurrentItem(var Iterator: TIterator): TItem;
@ -4163,7 +4163,7 @@ begin
Iterator.Index := -1; Iterator.Index := -1;
Iterator.UseSentinel := False; Iterator.UseSentinel := False;
Assert(Iterator.Page = Iterator.Page); // hint off Assert(Iterator.Page = Iterator.Page); // hint off
Result.Init(Iterator, @MoveNext, @GetCurrent); Result.Init(Iterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheBTreeSet.Include(const Item: TItem): Boolean; function TheBTreeSet.Include(const Item: TItem): Boolean;
@ -5273,7 +5273,7 @@ begin
Iterator.Index := -1; Iterator.Index := -1;
Iterator.UseSentinel := False; Iterator.UseSentinel := False;
Assert(Iterator.Page = Iterator.Page); // hint off Assert(Iterator.Page = Iterator.Page); // hint off
Result.Init(Iterator, @MoveNext, @GetCurrent); Result.Init(Iterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheCmpBTreeSet.Include(const Item: TItem): Boolean; function TheCmpBTreeSet.Include(const Item: TItem): Boolean;
@ -5781,7 +5781,7 @@ begin
Iterator.Index := -1; Iterator.Index := -1;
Iterator.UseSentinel := False; Iterator.UseSentinel := False;
Assert(Iterator.Page = Iterator.Page); // hint off Assert(Iterator.Page = Iterator.Page); // hint off
Result.Init(Iterator, @MoveNext, @GetCurrent); Result.Init(Iterator, TEnumerator.TMoveNext(@MoveNext), TEnumerator.TGetCurrent(@GetCurrent));
end; end;
function TheObjectBTreeSet.Include(const Item: TItem): Boolean; function TheObjectBTreeSet.Include(const Item: TItem): Boolean;