Compare commits

...

10 Commits

275 changed files with 132464 additions and 43065 deletions

View File

@ -1,8 +1,8 @@
#syntax: regexp
#(?<!\.(pas|lfm|lpr|lpi))$
syntax: glob
obj/* obj/*
bin/* bin/*
dist/*
Client.bin/*
Server.bin/*
doc/* doc/*
pasdoc/* pasdoc/*
Setup/* Setup/*
@ -23,3 +23,4 @@ Setup/*
*.compiled *.compiled
*.sh *.sh
*.exe *.exe
*.res

0
.hgeol Normal file
View File

Binary file not shown.

Before

Width:  |  Height:  |  Size: 5.4 KiB

After

Width:  |  Height:  |  Size: 5.3 KiB

View File

@ -1,33 +1,223 @@
<?xml version="1.0"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="7"/> <Version Value="9"/>
<General> <General>
<Flags> <Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/> <MainUnitHasUsesSectionForAllUnits Value="False"/>
<AlwaysBuild Value="False"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<TargetFileExt Value=".exe"/> <Title Value="CentrED+"/>
<Title Value="CentrED"/> <ResourceType Value="res"/>
<LFMResourceType Value="res"/> <XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/> <Icon Value="0"/>
</General> </General>
<LazDoc Paths="../doc"/> <LazDoc Paths="../doc"/>
<VersionInfo> <VersionInfo>
<UseVersionInfo Value="True"/> <UseVersionInfo Value="True"/>
<CurrentMajorRevNr Value="6"/> <AutoIncrementBuild Value="True"/>
<CurrentMinorRevNr Value="1"/> <MinorVersionNr Value="7"/>
<CurrentBuildNr Value="209"/> <RevisionNr Value="8"/>
<ProjectVersion Value="0.6.1.209"/> <BuildNr Value="1760"/>
<CompanyName Value="AKS DataBasis"/> <Language Value="0419"/>
<FileDescription Value="UO CentrED"/> <StringTable CompanyName="www.uoquint.ru" FileDescription="UO CentrED+" InternalName="CentrED+" LegalCopyright="StaticZ" OriginalFilename="CentrED-plus.exe" ProductName="CentrED+" ProductVersion="0.7.8"/>
<InternalName Value="CentrED"/>
<LegalCopyright Value="Andreas Schneider"/>
<OriginalFilename Value="CentrED.exe"/>
<ProductName Value="CentrED"/>
</VersionInfo> </VersionInfo>
<BuildModes Count="5">
<Item1 Name="default" Default="True"/>
<Item2 Name="Release Win32">
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="../bin/PEBinaries/CentrED-plus (x32).exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..;../obj;../Imaging;$(ProjOutDir)"/>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
<UnitOutputDirectory Value="../obj/win32"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<TargetProcessor Value="pentium4"/>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/PEBinaries/
-dNoLogging"/>
</Other>
</CompilerOptions>
</Item2>
<Item3 Name="Release Win64">
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="../bin/PEBinaries/CentrED-plus (x64).exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..;../obj;../Imaging;$(ProjOutDir)"/>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
<UnitOutputDirectory Value="../obj/win64"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<TargetProcessor Value="pentium4"/>
<TargetCPU Value="x86_64"/>
<TargetOS Value="win64"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/PEBinaries/
-dNoLogging"/>
</Other>
</CompilerOptions>
</Item3>
<Item4 Name="Release Linux GTK2 x86">
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="../bin/PEBinaries/CentrED-plus"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools;GUI"/>
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<TargetCPU Value="i386"/>
<TargetOS Value="linux"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/PEBinaries/
-dNoLogging"/>
</Other>
</CompilerOptions>
</Item4>
<Item5 Name="Release Linux GTK2 x64">
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="../bin/PEBinaries/CentrED-plus"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools;GUI"/>
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<TargetCPU Value="x86_64"/>
<TargetOS Value="linux"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/PEBinaries/
-dNoLogging"/>
</Other>
</CompilerOptions>
</Item5>
</BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@ -39,45 +229,46 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="5"> <RequiredPackages Count="6">
<Item1> <Item1>
<PackageName Value="multiloglaz"/> <PackageName Value="lclextensions_package"/>
<MinVersion Minor="3" Valid="True"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="LazOpenGLContext"/> <PackageName Value="multiloglaz"/>
<MinVersion Valid="True"/>
</Item2> </Item2>
<Item3> <Item3>
<PackageName Value="LCL"/> <PackageName Value="LazOpenGLContext"/>
<MinVersion Valid="True"/>
</Item3> </Item3>
<Item4> <Item4>
<PackageName Value="lnetvisual"/> <PackageName Value="LCL"/>
<MinVersion Minor="5" Release="3" Valid="True"/>
</Item4> </Item4>
<Item5> <Item5>
<PackageName Value="virtualtreeview_package"/> <PackageName Value="lnetvisual"/>
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/> <MinVersion Minor="5" Release="3" Valid="True"/>
</Item5> </Item5>
<Item6>
<PackageName Value="laz.virtualtreeview_package"/>
</Item6>
</RequiredPackages> </RequiredPackages>
<Units Count="46"> <Units Count="60">
<Unit0> <Unit0>
<Filename Value="CentrED.lpr"/> <Filename Value="CentrED.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="CentrED"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="UfrmMain.pas"/> <Filename Value="UfrmMain.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmMain"/> <ComponentName Value="frmMain"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmMain"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="UdmNetwork.pas"/> <Filename Value="UdmNetwork.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="dmNetwork"/> <ComponentName Value="dmNetwork"/>
<ResourceBaseClass Value="DataModule"/> <ResourceBaseClass Value="DataModule"/>
<UnitName Value="UdmNetwork"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="UfrmLogin.pas"/> <Filename Value="UfrmLogin.pas"/>
@ -91,118 +282,101 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmInitialize"/> <ComponentName Value="frmInitialize"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmInitialize"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="UfrmAccountControl.pas"/> <Filename Value="UfrmAccountControl.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmAccountControl"/> <ComponentName Value="frmAccountControl"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmAccountControl"/>
</Unit5> </Unit5>
<Unit6> <Unit6>
<Filename Value="UfrmEditAccount.pas"/> <Filename Value="UfrmEditAccount.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmEditAccount"/> <ComponentName Value="frmEditAccount"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmEditAccount"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="Tools/UfrmDrawSettings.pas"/> <Filename Value="Tools/UfrmDrawSettings.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmDrawSettings"/> <ComponentName Value="frmDrawSettings"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmDrawSettings"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
<Filename Value="Tools/UfrmBoundaries.pas"/> <Filename Value="Tools/UfrmBoundaries.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmBoundaries"/> <ComponentName Value="frmBoundaries"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmBoundaries"/>
</Unit8> </Unit8>
<Unit9> <Unit9>
<Filename Value="Tools/UfrmElevateSettings.pas"/> <Filename Value="Tools/UfrmElevateSettings.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmElevateSettings"/> <ComponentName Value="frmElevateSettings"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmElevateSettings"/>
</Unit9> </Unit9>
<Unit10> <Unit10>
<Filename Value="UOverlayUI.pas"/> <Filename Value="UOverlayUI.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UOverlayUI"/>
</Unit10> </Unit10>
<Unit11> <Unit11>
<Filename Value="UResourceManager.pas"/> <Filename Value="UResourceManager.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UResourceManager"/>
</Unit11> </Unit11>
<Unit12> <Unit12>
<Filename Value="Tools/UfrmConfirmation.pas"/> <Filename Value="Tools/UfrmConfirmation.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmConfirmation"/> <ComponentName Value="frmConfirmation"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmConfirmation"/>
</Unit12> </Unit12>
<Unit13> <Unit13>
<Filename Value="Tools/UfrmMoveSettings.pas"/> <Filename Value="Tools/UfrmMoveSettings.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmMoveSettings"/> <ComponentName Value="frmMoveSettings"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmMoveSettings"/>
</Unit13> </Unit13>
<Unit14> <Unit14>
<Filename Value="UfrmAbout.pas"/> <Filename Value="UfrmAbout.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmAbout"/> <ComponentName Value="frmAbout"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmAbout"/>
</Unit14> </Unit14>
<Unit15> <Unit15>
<Filename Value="Tools/UfrmHueSettings.pas"/> <Filename Value="Tools/UfrmHueSettings.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmHueSettings"/> <ComponentName Value="frmHueSettings"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmHueSettings"/>
</Unit15> </Unit15>
<Unit16> <Unit16>
<Filename Value="UfrmRadar.pas"/> <Filename Value="UfrmRadar.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmRadarMap"/> <ComponentName Value="frmRadarMap"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmRadar"/>
</Unit16> </Unit16>
<Unit17> <Unit17>
<Filename Value="UfrmLargeScaleCommand.pas"/> <Filename Value="UfrmLargeScaleCommand.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmLargeScaleCommand"/> <ComponentName Value="frmLargeScaleCommand"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmLargeScaleCommand"/>
</Unit17> </Unit17>
<Unit18> <Unit18>
<Filename Value="Tools/UfrmVirtualLayer.pas"/> <Filename Value="Tools/UfrmVirtualLayer.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmVirtualLayer"/> <ComponentName Value="frmVirtualLayer"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmVirtualLayer"/>
</Unit18> </Unit18>
<Unit19> <Unit19>
<Filename Value="Tools/UfrmFilter.pas"/> <Filename Value="Tools/UfrmFilter.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmFilter"/> <ComponentName Value="frmFilter"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmFilter"/>
</Unit19> </Unit19>
<Unit20> <Unit20>
<Filename Value="UGUIPlatformUtils.pas"/> <Filename Value="UGUIPlatformUtils.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UGUIPlatformUtils"/>
</Unit20> </Unit20>
<Unit21> <Unit21>
<Filename Value="UPlatformTypes.pas"/> <Filename Value="UPlatformTypes.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UPlatformTypes"/>
</Unit21> </Unit21>
<Unit22> <Unit22>
<Filename Value="UfrmRegionControl.pas"/> <Filename Value="UfrmRegionControl.pas"/>
@ -210,99 +384,80 @@
<ComponentName Value="frmRegionControl"/> <ComponentName Value="frmRegionControl"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmRegionControl"/>
</Unit22> </Unit22>
<Unit23> <Unit23>
<Filename Value="UPacketHandlers.pas"/> <Filename Value="UPacketHandlers.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UPacketHandlers"/>
</Unit23> </Unit23>
<Unit24> <Unit24>
<Filename Value="UPackets.pas"/> <Filename Value="UPackets.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UPackets"/>
</Unit24> </Unit24>
<Unit25> <Unit25>
<Filename Value="ULandscape.pas"/> <Filename Value="ULandscape.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="ULandscape"/>
</Unit25> </Unit25>
<Unit26> <Unit26>
<Filename Value="UGameResources.pas"/> <Filename Value="UGameResources.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UGameResources"/>
</Unit26> </Unit26>
<Unit27> <Unit27>
<Filename Value="UAdminHandling.pas"/> <Filename Value="UAdminHandling.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UAdminHandling"/>
</Unit27> </Unit27>
<Unit28> <Unit28>
<Filename Value="Tools/UfrmToolWindow.pas"/> <Filename Value="Tools/UfrmToolWindow.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmToolWindow"/> <ComponentName Value="frmToolWindow"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmToolWindow"/>
</Unit28> </Unit28>
<Unit29> <Unit29>
<Filename Value="../Logging.pas"/> <Filename Value="../Logging.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="Logging"/>
</Unit29> </Unit29>
<Unit30> <Unit30>
<Filename Value="../UOLib/UStatics.pas"/> <Filename Value="../UOLib/UStatics.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UStatics"/>
</Unit30> </Unit30>
<Unit31> <Unit31>
<Filename Value="../UOLib/UWorldItem.pas"/> <Filename Value="../UOLib/UWorldItem.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UWorldItem"/>
</Unit31> </Unit31>
<Unit32> <Unit32>
<Filename Value="../UOLib/UMap.pas"/> <Filename Value="../UOLib/UMap.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UMap"/>
</Unit32> </Unit32>
<Unit33> <Unit33>
<Filename Value="../UOLib/UTiledata.pas"/> <Filename Value="../UOLib/UTiledata.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UTiledata"/>
</Unit33> </Unit33>
<Unit34> <Unit34>
<Filename Value="UGLFont.pas"/> <Filename Value="UGLFont.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UGLFont"/>
</Unit34> </Unit34>
<Unit35> <Unit35>
<Filename Value="../UOLib/UAnimData.pas"/> <Filename Value="../UOLib/UAnimData.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UAnimData"/>
</Unit35> </Unit35>
<Unit36> <Unit36>
<Filename Value="../MulProvider/UTileDataProvider.pas"/> <Filename Value="../MulProvider/UTileDataProvider.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UTileDataProvider"/>
</Unit36> </Unit36>
<Unit37> <Unit37>
<Filename Value="../MulProvider/UAnimDataProvider.pas"/> <Filename Value="../MulProvider/UAnimDataProvider.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UAnimDataProvider"/>
</Unit37> </Unit37>
<Unit38> <Unit38>
<Filename Value="../MulProvider/UMulManager.pas"/> <Filename Value="../MulProvider/UMulManager.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UMulManager"/>
</Unit38> </Unit38>
<Unit39> <Unit39>
<Filename Value="../MulProvider/UArtProvider.pas"/> <Filename Value="../MulProvider/UArtProvider.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UArtProvider"/>
</Unit39> </Unit39>
<Unit40> <Unit40>
<Filename Value="../MulProvider/UTexmapProvider.pas"/> <Filename Value="../MulProvider/UTexmapProvider.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UTexmapProvider"/>
</Unit40> </Unit40>
<Unit41> <Unit41>
<Filename Value="../version.inc"/> <Filename Value="../version.inc"/>
@ -311,56 +466,123 @@
<Unit42> <Unit42>
<Filename Value="ULightManager.pas"/> <Filename Value="ULightManager.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="ULightManager"/>
</Unit42> </Unit42>
<Unit43> <Unit43>
<Filename Value="../UOLib/ULight.pas"/> <Filename Value="../UOLib/ULight.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="ULight"/>
</Unit43> </Unit43>
<Unit44> <Unit44>
<Filename Value="../MulProvider/ULightProvider.pas"/> <Filename Value="../MulProvider/ULightProvider.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="ULightProvider"/>
</Unit44> </Unit44>
<Unit45> <Unit45>
<Filename Value="Tools/UfrmLightlevel.pas"/> <Filename Value="Tools/UfrmLightlevel.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmLightlevel"/> <ComponentName Value="frmLightlevel"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmLightlevel"/>
</Unit45> </Unit45>
<Unit46>
<Filename Value="../UEnhancedMemoryStream.pas"/>
<IsPartOfProject Value="True"/>
</Unit46>
<Unit47>
<Filename Value="UndoRedoCmd.pas"/>
<IsPartOfProject Value="True"/>
</Unit47>
<Unit48>
<Filename Value="../UOLib/UArt.pas"/>
<IsPartOfProject Value="True"/>
</Unit48>
<Unit49>
<Filename Value="../vinfo.pas"/>
<IsPartOfProject Value="True"/>
</Unit49>
<Unit50>
<Filename Value="language.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Language"/>
</Unit50>
<Unit51>
<Filename Value="Tools/UfrmFillSettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmFillSettings"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit51>
<Unit52>
<Filename Value="Tools/UfrmSelectionSettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSelectionSettings"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit52>
<Unit53>
<Filename Value="Tools/UfrmSurfStretchSettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSurfStretchSettings"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit53>
<Unit54>
<Filename Value="Tools/UfrmSurfElevateSettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSurfElevateSettings"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit54>
<Unit55>
<Filename Value="Tools/UfrmSurfSmoothSettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSurfSmoothSettings"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit55>
<Unit56>
<Filename Value="Crc32Hash.pas"/>
<IsPartOfProject Value="True"/>
</Unit56>
<Unit57>
<Filename Value="../UOLib/UUopFile.pas"/>
<IsPartOfProject Value="True"/>
</Unit57>
<Unit58>
<Filename Value="GUI/AeroGlass.pas"/>
<IsPartOfProject Value="True"/>
</Unit58>
<Unit59>
<Filename Value="GUI/VirtualList.pas"/>
<IsPartOfProject Value="True"/>
</Unit59>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="8"/> <Version Value="11"/>
<Target> <Target>
<Filename Value="../bin/CentrED"/> <Filename Value="../bin/PEBinaries/CentrED-plus"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="$(ProjOutDir)/;../Imaging/;../"/> <IncludeFiles Value="..;../obj;../Imaging;$(ProjOutDir)"/>
<OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/;../Imaging/JpegLib/;../Imaging/ZLib/;Tools/"/> <OtherUnitFiles Value="Tools;..;../UOLib;../Server;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;GUI"/>
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="../obj"/>
<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"/> <UseAnsiStrings Value="False"/>
<UseAnsiStrings Value="True"/>
</SyntaxOptions> </SyntaxOptions>
</Parsing> </Parsing>
<CodeGeneration> <CodeGeneration>
<SmartLinkUnit Value="True"/> <Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
</Checks>
<Optimizations> <Optimizations>
<OptimizationLevel Value="3"/> <OptimizationLevel Value="3"/>
</Optimizations> </Optimizations>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>
<UseLineInfoUnit Value="False"/> <DebugInfoType Value="dsStabs"/>
<StripSymbols Value="True"/>
</Debugging> </Debugging>
<LinkSmart Value="True"/>
<Options> <Options>
<Win32> <Win32>
<GraphicApplication Value="True"/> <GraphicApplication Value="True"/>
@ -369,11 +591,10 @@
</Linking> </Linking>
<Other> <Other>
<CompilerMessages> <CompilerMessages>
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/> <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
</CompilerMessages> </CompilerMessages>
<CustomOptions Value="-FE../bin/ <CustomOptions Value="-FE../bin/PEBinaries/
-dNoLogging"/> +-dNoLogging"/>
<CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
</CONFIG> </CONFIG>

View File

@ -1,52 +1,143 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2009 Andreas Schneider * Portions Copyright 2015 Andreas Schneider
*) * Portions Copyright 2015 StaticZ
program CentrED; *)
program CentrED;
{$mode objfpc}{$H+}
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads} uses
cthreads, {$IFDEF UNIX}{$IFDEF UseCThreads}
{$ENDIF}{$ENDIF} cthreads,
SysUtils, {$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset Classes, SysUtils,
Forms, LResources, UdmNetwork; Interfaces, // this includes the LCL widgetset
LCLType, Forms, Dialogs, UdmNetwork, UResourceManager, Graphics;
{$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF}
{$R CentrED.res}
function GetApplicationName: String; //{$R CentrED.manifest.rc}
begin
Result := 'CentrED'; function GetApplicationName: String;
end; begin
Result := 'CentrED-plus';
begin end;
{$I CentrED.lrs}
OnGetApplicationName := @GetApplicationName; function LoadCursorFromRes(AFileName: string; CurFormat: Boolean = True): HCURSOR;
Application.Initialize; type
Application.CreateForm(TdmNetwork, dmNetwork); TIconHeader = packed record
Application.Run; hReserved: WORD; // = 0
end. hType: WORD; // ICO = 1, CUR = 2
hCount: WORD;
end;
TIconInfo = packed record
iWidth: BYTE;
iHeight: BYTE;
iColors: BYTE;
iReserved: BYTE; // = 0
iHotspotX: WORD; // CUR file (/iPlanes for ICO)
iHotspotY: WORD; // CUR file (/iBpp for ICO)
iSize: Cardinal;
iOffset: Cardinal;
end;
var
stream: TStream;
(*dwSize: Integer;
buffer: array of Byte;
header: TIconHeader;
icoinf: TIconInfo; *) //TODO Cleanup
cursorImage: TCursorImage;
begin
stream := ResourceManager.GetResource(AFileName);
(*dwSize := stream.Size;
SetLength(buffer, dwSize + 8);
stream.Read(buffer[0], dwSize);
if not CurFormat then
Result := HCURSOR(CreateIconFromResource(@buffer[0], dwSize, False, $00030000))
else begin
CopyMemory(@header, @buffer[0], SizeOf(TIconHeader));
// Грузим последнее изображение, которое обычно должно являться первым и единственным в иконках
CopyMemory(@icoinf, @buffer[SizeOf(TIconHeader) + (header.hCount - 1) * SizeOf(TIconInfo)], SizeOf(TIconInfo));
CopyMemory(@buffer[icoinf.iOffset-4], @icoinf.iHotspotX, 2);
CopyMemory(@buffer[icoinf.iOffset-2], @icoinf.iHotspotY, 2);
Result := HCURSOR(CreateIconFromResource(@buffer[icoinf.iOffset-4], icoinf.iSize+4, False, $00030000))
end;*)
try
cursorImage := TCursorImage.Create;
cursorImage.LoadFromStream(stream);
Result := cursorImage.ReleaseHandle;
finally
cursorImage.Free;
end;
end;
begin
Application.Title:='CentrED+';
OnGetApplicationName := @GetApplicationName;
Application.Initialize;
{if LowerCase(ChangeFileExt(ExtractFileName(ParamStr(0)), '')) <> LowerCase(GetApplicationName) then
begin
MessageDlg('Bug', 'The executable file has been renamed. Rename ' +
'file as follows: "' +
GetApplicationName + '.exe"', mtError, [mbOK], 0);
Application.Terminate;
end;} //TODO Why?
if Paramcount = 1 then begin
MessageDlg('Startup options', ParamStr(1), mtError, [mbOK], 0);
end;
// Loading cursors ...
Screen.Cursors[-02] := LoadCursorFromRes('Cursors/BC_NormalSelect.cur'); //crArrow
Screen.Cursors[-19] := LoadCursorFromRes('Cursors/BC_WorkingInBackground.cur'); //crAppStart
Screen.Cursors[-20] := LoadCursorFromRes('Cursors/BC_HelpSelect.cur'); //crHelp
//Screen.Cursors[-12] := LoadCursorFromRes('Cursors/.cur'); //crDrag
//Screen.Cursors[-16] := LoadCursorFromRes('Cursors/.cur'); //crMultiDrag
//Screen.Cursors[-13] := LoadCursorFromRes('Cursors/.cur'); //crNoDrop
Screen.Cursors[-03] := LoadCursorFromRes('Cursors/BC_PrecisionSelect.cur'); //crCross
Screen.Cursors[-04] := LoadCursorFromRes('Cursors/BC_TextSelect.cur'); //crIBeam
//TODO Screen.Cursors[-11] := LoadCursorFromRes('Cursors/BI_Busy.ani', False); //crHourGlass
Screen.Cursors[-18] := LoadCursorFromRes('Cursors/TN_Unavailable.cur'); //crNo
Screen.Cursors[-22] := LoadCursorFromRes('Cursors/BC_Move.cur'); //crSize
Screen.Cursors[-06] := LoadCursorFromRes('Cursors/BC_DiagonalResize2.cur'); //crSizeNESW
Screen.Cursors[-07] := LoadCursorFromRes('Cursors/BC_VerticalResize.cur'); //crSizeNS
Screen.Cursors[-08] := LoadCursorFromRes('Cursors/BC_DiagonalResize1.cur'); //crSizeNWSE
Screen.Cursors[-09] := LoadCursorFromRes('Cursors/BC_HorizontalResize.cur'); //crSizeWE
Screen.Cursors[-10] := LoadCursorFromRes('Cursors/BC_AlternateSelect.cur'); //crUpArrow
//Screen.Cursors[-14] := LoadCursorFromRes('Cursors/.cur'); //crHSplit
//Screen.Cursors[-15] := LoadCursorFromRes('Cursors/.cur'); //crVSplit
Screen.Cursors[-21] := LoadCursorFromRes('Cursors/TN_LinkSelect.cur'); //crHandPoint
Screen.Cursors[+01] := LoadCursorFromRes('Cursors/UO_Precision.cur');
Screen.Cursors[+02] := LoadCursorFromRes('Cursors/UO_AttackMode.cur');
Screen.Cursors[+03] := LoadCursorFromRes('Cursors/UO_Gauntlet.cur');
// Run the program...
Application.CreateForm(TdmNetwork, dmNetwork);
Application.Run;
end.

View File

@ -1,17 +1,22 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <?xml version="1.0" encoding="UTF-8" standalone="no"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/> <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>
<description>Your application description here.</description> <description>Your application description here.</description>
<dependency> <dependency>
<dependentAssembly> <dependentAssembly>
<assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/> <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>
</dependentAssembly> </dependentAssembly>
</dependency> </dependency>
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v3"> <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
<security> <security>
<requestedPrivileges> <requestedPrivileges>
<requestedExecutionLevel level="asInvoker" uiAccess="false"/> <requestedExecutionLevel level="requestedexecutionlevel" uiAccess="false"/>
</requestedPrivileges> </requestedPrivileges>
</security> </security>
</trustInfo> </trustInfo>
</assembly> <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
<asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
<dpiAware>true</dpiAware>
</asmv3:windowsSettings>
</asmv3:application>
</assembly>

194
Client/Crc32Hash.pas Normal file
View File

@ -0,0 +1,194 @@
unit Crc32Hash;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Dialogs;
procedure CalcCRC32(p: Pointer; ByteCount: DWORD; var CRCValue: DWORD);
function CalcStringCRC32(s: string; out CRC32: DWORD): Boolean;
procedure CalcFileCRC32(FromName: string; var CRCvalue: DWORD; var TotalBytes: Int64; var error: Word);
implementation
// The constants here are for the CRC-32 generator
// polynomial, as defined in the Microsoft
// Systems Journal, March 1995, pp. 107 - 108
const
Table: array[0..255] of DWORD =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
type
TInteger8 = Int64;
{
//----------------------------------crc32----------------------------------
{$IFDEF VER130} // This is a bit awkward
// 8-byte integer
TInteger8 = Int64; // Delphi 5
{$ELSE}
{$IFDEF VER120}
TInteger8 = Int64; // Delphi 4
{$ELSE}
TInteger8 = COMP; // Delphi 2 or 3
{$ENDIF}
{$ENDIF}
}
//----------------------------------crc32----------------------------------
// Use CalcCRC32 as a procedure so CRCValue can be passed in but
// also returned. This allows multiple calls to CalcCRC32 for
// the "same" CRC-32 calculation.
procedure CalcCRC32(p: Pointer; ByteCount: DWORD; var CRCValue: DWORD);
// The following is a little cryptic (but executes very quickly).
// The algorithm is as follows:
// 1. exclusive-or the input byte with the low-order byte of
// the CRC register to get an INDEX
// 2. shift the CRC register eight bits to the right
// 3. exclusive-or the CRC register with the contents of Table[INDEX]
// 4. repeat steps 1 through 3 for all bytes
var
i: DWORD;
q: ^BYTE;
begin
q := p;
for i := 0 to ByteCount - 1 do
begin
CRCvalue := (CRCvalue shr 8) xor
Table[q^ xor (CRCvalue and $000000FF)];
Inc(q)
end
end {CalcCRC32};
function CalcStringCRC32(s: string; out CRC32: DWORD): Boolean;
var
CRC32Table: DWORD;
begin
// Verify the table used to compute the CRCs has not been modified.
// Thanks to Gary Williams for this suggestion, Jan. 2003.
CRC32Table := $FFFFFFFF;
CalcCRC32(Addr(Table[0]), SizeOf(Table), CRC32Table);
CRC32Table := not CRC32Table;
if CRC32Table <> $6FCF9E13 then
{$IFDEF ResBuilder}
writeln('!!! CRC32 Table CRC32 is ' + IntToHex(Crc32Table, 8) + ', expecting $6FCF9E13')
{$ELSE}
ShowMessage('CRC32 Table CRC32 is ' + IntToHex(Crc32Table, 8) + ', expecting $6FCF9E13')
{$ENDIF}
else
begin
CRC32 := $FFFFFFFF; // To match PKZIP
if Length(s) > 0 {// Avoid access violation in D4 } then
CalcCRC32(Addr(s[1]), Length(s), CRC32);
CRC32 := not CRC32; // To match PKZIP
Result := True;
end;
//ShowMessage('Get CRC is = ' + IntToStr(CRC32));
end;
procedure CalcFileCRC32(FromName: string; var CRCvalue: DWORD;
var TotalBytes: TInteger8;
var error: Word);
var
Stream: TMemoryStream;
begin
error := 0;
CRCValue := $FFFFFFFF;
Stream := TMemoryStream.Create;
try
try
Stream.LoadFromFile(FromName);
if Stream.Size > 0 then
CalcCRC32(Stream.Memory, Stream.Size, CRCvalue)
except
on E: EReadError do
error := 1
end;
CRCvalue := not CRCvalue
finally
Stream.Free
end;
end;
{
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
CRC32: DWORD;
begin
s := 'Test String';
if CalcStringCRC32(s, CRC32) then
ShowMessage(IntToStr(crc32));
end;
}
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

BIN
Client/Cursors/BC_Busy.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

BIN
Client/Cursors/BC_Move.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

BIN
Client/Cursors/BI_Busy.ani Normal file

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

BIN
Client/Cursors/BI_Help.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

BIN
Client/Cursors/BI_Link.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

BIN
Client/Cursors/BI_Move.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

BIN
Client/Cursors/BI_Text.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

BIN
Client/Cursors/RO_Hand.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

BIN
Client/Cursors/TN_Busy.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

BIN
Client/Cursors/UO_Help.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

BIN
Client/Cursors/UO_Move.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

BIN
Client/Cursors/UO_Pen.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

BIN
Client/Cursors/UO_Text.cur Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.2 KiB

BIN
Client/Cursors/UO_Wait.ani Normal file

Binary file not shown.

Binary file not shown.

222
Client/GUI/AeroGlass.pas Normal file
View File

@ -0,0 +1,222 @@
unit AeroGlass;
{$mode delphi}
//{$mode objfpc}{$H+}
interface
uses
//Windows, Forms, Graphics;
// os
Windows, UxTheme, ShellAPI, Win32Proc, Win32Extra,
// rtl
Classes, SysUtils,
// lcl
Forms, Controls, Graphics, Themes;//, LCLProc, LCLType;
type
_MARGINS = packed record
cxLeftWidth : Integer;
cxRightWidth : Integer;
cyTopHeight : Integer;
cyBottomHeight : Integer;
end;
PMargins = ^_MARGINS;
TMargins = _MARGINS;
DwmIsCompositionEnabledFunc = function(pfEnabled: PBoolean): HRESULT; stdcall;
DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall;
SetLayeredWindowAttributesFunc = function(destWnd: HWND; cKey: TColor; bAlpha: Byte; dwFlags: DWord): BOOL; stdcall;
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
procedure GlassFormEx(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia);
procedure GlassForm(frm: TForm; cBlurColorKey: TColor = clFuchsia);
function WindowsAeroGlassCompatible: Boolean;
function CreateBitmap32(DC: HDC; W, H: Integer; var BitmapBits: Pointer): HBITMAP;
procedure DrawAlphaText(wnd: hwnd; DC: HDC; x,y: integer; txt: WideString);
implementation
// =============================================================================
// == Преобразование формы в AeroGlass
// =============================================================================
function WindowsAeroGlassCompatible: Boolean;
var
osVinfo: TOSVERSIONINFO;
begin
ZeroMemory(@osVinfo, SizeOf(osVinfo));
OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
if (
(GetVersionEx(osVInfo) = True) and
(osVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and
(osVinfo.dwMajorVersion >= 6)
)
then Result:=True
else Result:=False;
end;
procedure GlassFormEx(frm: TForm; tmpMargins: TMargins; cBlurColorKey: TColor = clFuchsia);
var
hDwmDLL: Cardinal;
fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
fSetLayeredWindowAttributesFunc: SetLayeredWindowAttributesFunc;
bCmpEnable: Boolean;
mgn: TMargins;
begin
{ Continue if Windows version is compatible }
if WindowsAeroGlassCompatible then begin
{ Continue if 'dwmapi' library is loaded }
hDwmDLL := LoadLibrary('dwmapi.dll');
if hDwmDLL <> 0 then begin
{ Get values }
@fDwmIsCompositionEnabled := GetProcAddress(hDwmDLL, 'DwmIsCompositionEnabled');
@fDwmExtendFrameIntoClientArea := GetProcAddress(hDwmDLL, 'DwmExtendFrameIntoClientArea');
@fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
{ Continue if values are <> nil }
if (
(@fDwmIsCompositionEnabled <> nil) and
(@fDwmExtendFrameIntoClientArea <> nil) and
(@fSetLayeredWindowAttributesFunc <> nil)
)
then begin
{ Continue if composition is enabled }
fDwmIsCompositionEnabled(@bCmpEnable);
if bCmpEnable = True then begin
{ Set Form Color same as cBlurColorKey }
frm.Color := cBlurColorKey;
{ ... }
SetWindowLong(frm.Handle, GWL_EXSTYLE, GetWindowLong(frm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
{ ... }
fSetLayeredWindowAttributesFunc(frm.Handle, cBlurColorKey, 0, LWA_COLORKEY);
{ Set margins }
ZeroMemory(@mgn, SizeOf(mgn));
mgn.cxLeftWidth := tmpMargins.cxLeftWidth;
mgn.cxRightWidth := tmpMargins.cxRightWidth;
mgn.cyTopHeight := tmpMargins.cyTopHeight;
mgn.cyBottomHeight := tmpMargins.cyBottomHeight;
{ Extend Form }
fDwmExtendFrameIntoClientArea(frm.Handle,@mgn);
end;
end;
{ Free loaded 'dwmapi' library }
FreeLibrary(hDWMDLL);
end;
end;
end;
procedure GlassForm(frm: TForm; cBlurColorKey: TColor = clFuchsia);
var
tmpMargins: TMargins;
begin
{ If all margins are -1 the whole form will be aero glass}
tmpMargins.cxLeftWidth := 8;
tmpMargins.cxRightWidth := 8;
tmpMargins.cyBottomHeight := 25;
tmpMargins.cyTopHeight := 4;
{ FormName ; Margins ; TransparentColor }
GlassFormEx(frm, tmpMargins, cBlurColorKey);
end;
// =============================================================================
// == Вывод текста и изображений на форме AeroGlass
// =============================================================================
function CreateBitmap32(DC: HDC; W, H: Integer; var BitmapBits: Pointer): HBITMAP;
var
bi: BITMAPINFO;
begin
ZeroMemory(@bi, sizeof(BITMAPINFO));
with bi.bmiHeader do
begin
biSize := sizeof(BITMAPINFOHEADER);
biWidth := W;
biHeight := -H;
biCompression := BI_RGB;
biBitCount := 32;
biPlanes := 1;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
biClrUsed := 0;
biClrImportant := 0;
end;
Result := CreateDIBSection(DC, bi, DIB_RGB_COLORS, BitmapBits, 0, 0);
end;
type
TDTTOpts = record
dwSize: Longword;
dwFlags: Longword;
crText: Longword;
crBorder: Longword;
crShadow: Longword;
eTextShadowType: Integer;
ptShadowOffset: TPoint;
iBorderSize: Integer;
iFontPropId: Integer;
iColorPropId: Integer;
iStateId: Integer;
fApplyOverlay: Integer;
iGlowSize: Integer;
pfnDrawTextCallback: Pointer;
lParam: Integer;
end;
var
hTheme: THandle;
procedure DrawAlphaText(wnd: hwnd; DC: HDC; x,y: integer; txt: WideString);
var
tr: trect;
txtOptions: TDTTOPTS;
hBmp: HBITMAP;
hBmpDC: HDC;
hFnt: HFont;
p: pointer;
ts: SIZE;
begin
hTheme := OpenThemeData(wnd, 'window');
hBmpDC := CreateCompatibleDC(0);
hFnt := CreateFont(-MulDiv(10, GetDeviceCaps(hBmpDC, LOGPIXELSY), 72), 0, 0, 0, FW_BOLD {FW_NORMAL}, 0, 0, 0,
DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH, 'arial');
SelectObject(hBmpDC, hFnt);
GetTextExtentPointW(hBmpDC, PWideChar(txt), length(txt), ts);
SetRect(tr, 0, 0, ts.cx + 5, ts.cy + 5);
hBmp := CreateBitmap32(hBmpDC, tr.Right, tr.Bottom, p);
SelectObject(hBmpDC, hBmp);
ZeroMemory(@txtOptions, sizeof(TDTTOPTS));
txtOptions.dwSize := sizeof(TDTTOPTS);
txtOptions.dwFlags := DTT_COMPOSITED or DTT_GLOWSIZE or DTT_TEXTCOLOR;
txtOptions.iGlowSize := 5;
txtOptions.crText := $00FF0000;
DrawThemeTextEx(hTheme, hBmpDC, 0, 0, PWideChar(txt), length(txt), DT_SINGLELINE or DT_vCENTER, @tr, @txtOptions);
BitBlt(dc, x, y, tr.Right, tr.Bottom, hBmpDC, 0, 0, SRCCOPY);
DeleteObject(hBmpDC);
DeleteObject(hBmp);
DeleteObject(hFnt);
CloseThemeData(hTheme);
end;
end.

368
Client/GUI/GlowLabel.pas Normal file
View File

@ -0,0 +1,368 @@
unit GlowLabel;
{******************************************************************}
{ GlowLabel }
{ }
{ home page : http://www.winningcubed.de }
{ email : martin.walter@winningcubed.de }
{ }
{ date : 15-04-2007 }
{ }
{ version : 1.0 }
{ }
{ Use of this file is permitted for commercial and non-commercial }
{ use, as long as the author is credited. }
{ This file (c) 2007 Martin Walter }
{ }
{ This Software is distributed on an "AS IS" basis, WITHOUT }
{ WARRANTY OF ANY KIND, either express or implied. }
{ }
{ *****************************************************************}
interface
uses
Windows, Classes, StdCtrls {$IFDEF USETNT}, TntStdCtrls{$ENDIF};
type
TCustomGlowLabel = class({$IFDEF USETNT}TTntCustomLabel{$ELSE}TCustomLabel{$ENDIF})
private
FGlow: Boolean;
FGlowSize: Integer;
FOldGlowSize: Integer;
FBoundsWithGlow: Boolean;
procedure SetGlow(const Value: Boolean);
procedure SetGlowSize(const Value: Integer);
function IsGlow: Boolean;
function GetExpansion(GlowSize: Integer): Integer;
protected
procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
procedure AdjustBounds; override;
property Glow: Boolean read FGlow write SetGlow;
property GlowSize: Integer read FGlowSize write SetGlowSize;
public
constructor Create(AOwner: TComponent); override;
end;
TGlowLabel = class(TCustomGlowLabel)
published
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property Caption;
property Color nodefault;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property EllipsisPosition;
property Enabled;
property FocusControl;
property Font;
property Glow;
property GlowSize;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Transparent;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseActivate;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseEnter;
property OnMouseLeave;
property OnStartDock;
property OnStartDrag;
end;
procedure Register;
implementation
uses
Controls, Forms, Graphics, SysUtils, Math, DwmApi, Themes, UxTheme;
function StrScanW(const Str: PWideChar; Chr: WideChar): PWideChar;
begin
Result := Str;
while Result^ <> Chr do
begin
if Result^ = #0 then
begin
Result := nil;
Exit;
end;
Inc(Result);
end;
end;
function LastDelimiterW(const Delimiters, S: WideString): Integer;
var
P: PWideChar;
begin
Result := Length(S);
P := PWideChar(Delimiters);
while Result > 0 do
begin
if (S[Result] <> #0) and (StrScanW(P, S[Result]) <> nil) then
Exit;
Dec(Result);
end;
end;
{ TGlowCustomLabel }
procedure TCustomGlowLabel.AdjustBounds;
const
WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
DC: HDC;
Rect, Bounds, CalcRect: TRect;
AAlignment: TAlignment;
Expand: Integer;
DoSetBounds: Boolean;
begin
DoSetBounds := False;
Bounds := BoundsRect;
Rect := Bounds;
if (IsGlow and (csReading in ComponentState)) then
begin
FBoundsWithGlow := True;
FOldGlowSize := FGlowSize;
end;
if FBoundsWithGlow then
begin
Expand := GetExpansion(FOldGlowSize);
Inc(Rect.Left, Expand);
Inc(Rect.Top, Expand);
Dec(Rect.Right, Expand);
Dec(Rect.Bottom, Expand);
FBoundsWithGlow := False;
DoSetBounds := True;
end;
if not ((csReading in ComponentState) or
(csLoading in ComponentState)) and
AutoSize then
begin
DC := GetDC(0);
Canvas.Handle := DC;
CalcRect.Left := 0;
CalcRect.Top := 0;
DoDrawText(CalcRect, (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[WordWrap]);
Canvas.Handle := 0;
ReleaseDC(0, DC);
AAlignment := Alignment;
if UseRightToLeftAlignment then
ChangeBiDiModeAlignment(AAlignment);
if AAlignment = taRightJustify then
Rect.Left := Rect.Right - CalcRect.Right;
Rect.Right := Rect.Left + CalcRect.Right;
Rect.Bottom := Rect.Top + CalcRect.Bottom;
DoSetBounds := True;
end;
if IsGlow then
begin
FBoundsWithGlow := True;
Expand := GetExpansion(FGlowSize);
Dec(Rect.Left, Expand);
Dec(Rect.Top, Expand);
Inc(Rect.Right, Expand);
Inc(Rect.Bottom, Expand);
FOldGlowSize := FGlowSize;
DoSetBounds := True;
end;
if DoSetBounds then
SetBounds(Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
end;
constructor TCustomGlowLabel.Create(AOwner: TComponent);
begin
inherited;
FGlow := False;
FGlowSize := 10;
FOldGlowSize := 0;
FBoundsWithGlow := False;
end;
procedure TCustomGlowLabel.DoDrawText(var Rect: TRect; Flags: Integer);
procedure DoDrawThemeTextEx(DC: HDC; const Text: WideString; TextLen: Integer;
var TextRect: TRect; TextFlags: Cardinal);
var
Options: TDTTOpts;
begin
FillChar(Options, SizeOf(Options), 0);
Options.dwSize := SizeOf(Options);
Options.dwFlags := DTT_TEXTCOLOR or DTT_COMPOSITED;
if IsGlow then
begin
Options.dwFlags := Options.dwFlags or DTT_GLOWSIZE;
Options.iGlowSize := FGlowSize;
end;
Options.crText := ColorToRGB(Canvas.Font.Color);
with ThemeServices.GetElementDetails(teEditTextNormal) do
DrawThemeTextEx(ThemeServices.Theme[teEdit], DC, Part, State,
PWideChar(Text), TextLen, TextFlags, @TextRect, Options);
end;
procedure DrawText(DC: HDC; const Text: WideString; TextLen: Integer;
var TextRect: TRect; TextFlags: Cardinal);
var
LForm: TCustomForm;
PaintOnGlass: Boolean;
Expand: Integer;
begin
PaintOnGlass := ThemeServices.ThemesEnabled and DwmCompositionEnabled and
not (csDesigning in ComponentState);
if PaintOnGlass then
begin
LForm := GetParentForm(Self);
PaintOnGlass := (LForm <> nil) and LForm.GlassFrame.FrameExtended and
LForm.GlassFrame.IntersectsControl(Self);
end;
if IsGlow and (Flags and DT_CALCRECT = 0) then
begin
Expand := GetExpansion(FGlowSize);
case Alignment of
taLeftJustify: OffsetRect(TextRect, Expand, 0);
taRightJustify: OffsetRect(TextRect, -Expand, 0);
end;
case Layout of
tlTop: OffsetRect(TextRect, 0, Expand);
tlBottom: OffsetRect(TextRect, 0, -Expand);
end;
end;
if PaintOnGlass and (Flags and DT_CALCRECT = 0) then
DoDrawThemeTextEx(DC, Text, TextLen, TextRect, TextFlags)
else
Windows.DrawTextW(DC, PWideChar(Text), TextLen, TextRect, TextFlags);
end;
const
EllipsisStr = '...';
Ellipsis: array[TEllipsisPosition] of Longint = (0, DT_PATH_ELLIPSIS,
DT_END_ELLIPSIS, DT_WORD_ELLIPSIS);
var
Text, DText: WideString;
NewRect: TRect;
Height, Delim: Integer;
begin
Text := Caption;
if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
(Text[1] = '&') and (Text[2] = #0)) then
Text := Text + ' ';
if not ShowAccelChar then
Flags := Flags or DT_NOPREFIX;
Flags := DrawTextBiDiModeFlags(Flags);
Canvas.Font := Font;
if (EllipsisPosition <> epNone) and not AutoSize then
begin
DText := Text;
Flags := Flags and not DT_EXPANDTABS;
Flags := Flags or Ellipsis[EllipsisPosition];
if WordWrap and (EllipsisPosition in [epEndEllipsis, epWordEllipsis]) then
begin
repeat
NewRect := Rect;
Dec(NewRect.Right, Canvas.TextWidth(EllipsisStr));
Windows.DrawTextW(Canvas.Handle, PWideChar(DText), Length(DText), NewRect, Flags or DT_CALCRECT);
Height := NewRect.Bottom - NewRect.Top;
if (Height > ClientHeight) and (Height > Canvas.Font.Height) then
begin
Delim := LastDelimiterW(' '#9, Text);
if Delim = 0 then
Delim := Length(Text);
Dec(Delim);
Text := Copy(Text, 1, Delim);
DText := Text + EllipsisStr;
if Text = '' then
Break;
end else
Break;
until False;
end;
if Text <> '' then
Text := DText;
end;
if not Enabled then
begin
OffsetRect(Rect, 1, 1);
Canvas.Font.Color := clBtnHighlight;
DrawText(Canvas.Handle, Text, Length(Text), Rect, Flags);
OffsetRect(Rect, -1, -1);
Canvas.Font.Color := clBtnShadow;
DrawText(Canvas.Handle, Text, Length(Text), Rect, Flags);
end
else
DrawText(Canvas.Handle, Text, Length(Text), Rect, Flags);
end;
function TCustomGlowLabel.GetExpansion(GlowSize: Integer): Integer;
begin
Result := Ceil(GlowSize / 2) + 1;
end;
function TCustomGlowLabel.IsGlow: Boolean;
begin
Result := FGlow and (FGlowSize > 0);
end;
procedure TCustomGlowLabel.SetGlow(const Value: Boolean);
begin
if FGlow <> Value then
begin
FGlow := Value;
AdjustBounds;
Invalidate;
end;
end;
procedure TCustomGlowLabel.SetGlowSize(const Value: Integer);
begin
if FGlowSize <> Value then
begin
FGlowSize := Value;
AdjustBounds;
Invalidate;
end;
end;
procedure Register;
begin
RegisterComponents('MWK', [TGlowLabel]);
end;
end.

705
Client/GUI/VirtualList.pas Normal file
View File

@ -0,0 +1,705 @@
unit VirtualList;
{$mode delphi}{$H+}
interface
uses
Forms, Controls, StdCtrls, Graphics, Classes, SysUtils, laz.VirtualTrees,
Logging, LMessages, LCLIntf, Math;
type
{$Z4} INPUTTYPE = (INPUT_MOUSE = $00, INPUT_KEYBOARD = $01, INPUT_HARDWARE = $02);
{$Z4} KEYEVENTF = (KEYEVENTF_EXTENDEDKEY = $01, KEYEVENTF_KEYUP = $02, KEYEVENTF_SCANCODE = $04, KEYEVENTF_UNICODE = $08);
{TKEYINPUT = record
itype: INPUTTYPE;
// tagKEYBDINPUT
wVk: WORD;
wScan: WORD;
dwFlags: KEYEVENTF;
time: DWORD;
dwExtraInfo: ULONG_PTR;
end;} //TODO
PVirtualItem = ^TVirtualItem;
TVirtualItem = record
NextItem: PVirtualItem;
Node: PVirtualNode;
Column: Word;
Selected: Boolean;
end;
{ TVirtualList }
TVirtualList = class(TLazVirtualDrawTree)
private
HintCanvas: TCanvas;
TileColumn: Word;
FirstItem: PVirtualItem;
LastItem: PVirtualItem;
LastSelected: PVirtualItem;
ClearAll: Boolean;
FSelectionCount: DWord;
FTilesCount: DWord;
function GetSelected(Item: PVirtualItem): Boolean;
procedure SetSelected(Item: PVirtualItem; Value: Boolean);
function GetFocusedNode(): PVirtualItem;
procedure SetFocusedNode(Item: PVirtualItem);
public
constructor Create(AOwner: TComponent); override;
procedure UpdateHintCanvas(newCanvas: TCanvas);
procedure DoGetHintSize(Node: PVirtualNode; Column: TColumnIndex; var R: TRect); override;
procedure UpdateTileColumn(count: Word; Forse: Boolean = False);
//function AddChild(Parent: PVirtualNode; UserData: Pointer = nil): PVirtualNode; override;
function AddChild(ParentItem: PVirtualNode; UserData: Pointer = nil): PVirtualNode; override;
function AddItem(ParentItem: PVirtualItem; UserData: Pointer = nil): PVirtualItem;
function GetFirst(ConsiderChildrenAbove: Boolean = False): PVirtualItem;
function GetNext(Item: PVirtualItem; ConsiderChildrenAbove: Boolean = False): PVirtualItem;
function GetLast(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualItem;
function GetItemAt(Node: PVirtualNode; Column: TColumnIndex): PVirtualItem;
function GetNodeData(Item: PVirtualItem): Pointer;
procedure Clear; override;
function GetFirstSelected(ConsiderChildrenAbove: Boolean = False): PVirtualItem;
function GetNextSelected(Item: PVirtualItem; ConsiderChildrenAbove: Boolean = False): PVirtualItem;
property Selected[Item: PVirtualItem]: Boolean read GetSelected write SetSelected;
procedure ClearSelection;
procedure DeleteSelectedNodes; override;
property FocusedNode: PVirtualItem read GetFocusedNode write SetFocusedNode;
procedure DoPaintNode(var PaintInfo: TVTPaintInfo); override;
procedure PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: Integer); override;
procedure DoPaintDropMark(Canvas: TCanvas; Node: PVirtualNode; const R: TRect); override;
procedure HandleMouseDblClick(var Message: TLMMouse; const HitInfo: THitInfo); override;
procedure HandleMouseDown(var Message: TLMMouse; var HitInfo: THitInfo); override;
procedure HandleMouseUp(Keys: PtrUInt; const HitInfo: THitInfo); override;
property SelectedCount: Dword read FSelectionCount;
property TilesCount: Dword read FTilesCount;
end;
//function SendInput(nInputs:UINT; pInputs:POINTER; cbSize:INTEGER):UINT; stdcall; external 'User32.dll' name 'SendInput';
Implementation
//----------------------------------------------------------------------------------------------------------------------
constructor TVirtualList.Create(AOwner: TComponent);
var
Pvdt: TLazVirtualDrawTree;
column: TVirtualTreeColumn;
c: Integer;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.Create START');
if not (AOwner is TLazVirtualDrawTree) then begin
Logger.Send([lcClient, lcDebug], 'TVirtualTree.Create(AOwner: TLazVirtualDrawTree) must get argument TLazVirtualDrawTree');
Assert(not (AOwner is TLazVirtualDrawTree), 'TVirtualTree.Create(AOwner: TLazVirtualDrawTree) must get argument TLazVirtualDrawTree');
Abort;
Halt;
end;
inherited Create(AOwner.Owner);
Pvdt := TLazVirtualDrawTree(AOwner);
Self.Parent := Pvdt.Parent;
FSelectionCount := 0;
FTilesCount:= 0;
TileColumn := 1;
ClearAll := True;
// Копирование свойств
Self.AnchorSideTop.Control := Pvdt.AnchorSideTop.Control;
Self.AnchorSideTop.Side := Pvdt.AnchorSideTop.Side;
Self.AnchorSideLeft.Control := Pvdt.AnchorSideLeft.Control;
Self.AnchorSideLeft.Side := Pvdt.AnchorSideLeft.Side;
Self.AnchorSideRight.Control := Pvdt.AnchorSideRight.Control;
Self.AnchorSideRight.Side := Pvdt.AnchorSideRight.Side;
Self.AnchorSideBottom.Control := Pvdt.AnchorSideBottom.Control;
Self.AnchorSideBottom.Side := Pvdt.AnchorSideBottom.Side;
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.Create 0');
Self.Left := Pvdt.Left;
Self.Height := Pvdt.Height;
Self.Hint := Pvdt.Hint;
Self.Top := Pvdt.Top;
Self.Width := Pvdt.Width;
Self.Anchors := Pvdt.Anchors;
Self.BorderSpacing.Top := Pvdt.BorderSpacing.Top;
Self.BorderSpacing.Left := Pvdt.BorderSpacing.Left;
Self.BorderSpacing.Right := Pvdt.BorderSpacing.Right;
Self.BorderSpacing.Bottom := Pvdt.BorderSpacing.Bottom;
Self.BiDiMode := Pvdt.BiDiMode;
Self.Tag := Pvdt.Tag;
Self.Color := Pvdt.Color;
Self.Colors.DropMarkColor := Pvdt.Colors.DropMarkColor;
Self.Colors.DropTargetColor := Pvdt.Colors.DropTargetColor;
Self.Colors.DropTargetBorderColor := Pvdt.Colors.DropTargetBorderColor;
Self.Colors.BorderColor := Pvdt.Colors.BorderColor;
Self.Colors.GridLineColor := Pvdt.Colors.GridLineColor;
Self.Colors.TreeLineColor := Pvdt.Colors.TreeLineColor;
Self.Colors.FocusedSelectionColor := Pvdt.Colors.FocusedSelectionColor;
Self.Colors.FocusedSelectionBorderColor := Pvdt.Colors.FocusedSelectionBorderColor;
Self.Colors.SelectionRectangleBlendColor := Pvdt.Colors.SelectionRectangleBlendColor;
Self.Colors.UnfocusedSelectionColor := Pvdt.Colors.UnfocusedSelectionColor;
Self.Colors.UnfocusedSelectionBorderColor := Pvdt.Colors.UnfocusedSelectionBorderColor;
Self.Constraints.MinHeight := Pvdt.Constraints.MinHeight;
Self.Constraints.MinWidth := Pvdt.Constraints.MinWidth;
Self.Constraints.MaxHeight := Pvdt.Constraints.MaxHeight;
Self.Constraints.MaxWidth := Pvdt.Constraints.MaxWidth;
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.Create 0___');
// Self.DefaultNodeHeight := Pvdt.DefaultNodeHeight;
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.Create 0&&&');
Self.DragKind := PVdt.DragKind;
Self.DragMode := Pvdt.DragMode;
Self.DragOperations := Pvdt.DragOperations;
Self.DragType := Pvdt.DragType;
Self.DrawSelectionMode := Pvdt.DrawSelectionMode;
Self.Font.Height := Pvdt.Font.Height;
Self.Font.Name := Pvdt.Font.Name;
Self.Font.Color := Pvdt.Font.Color;
Self.Font.Style := Pvdt.Font.Style;
Self.Font.Underline := Pvdt.Font.Underline;
Self.Font.Orientation := Pvdt.Font.Orientation;
Self.Font.Size := Pvdt.Font.Size;
Self.Font.Pitch := Pvdt.Font.Pitch;
Self.Font.Quality := Pvdt.Font.Quality;
Self.Header.AutoSizeIndex := Pvdt.Header.AutoSizeIndex;
Self.Header.DefaultHeight := Pvdt.Header.DefaultHeight;
Self.Header.MainColumn := Pvdt.Header.MainColumn;
Self.Header.Options := Pvdt.Header.Options;
Self.Header.ParentFont := Pvdt.Header.ParentFont;
Self.Header.Style := Pvdt.Header.Style;
Self.HintMode := Pvdt.HintMode;
Self.ParentFont := Pvdt.ParentFont;
Self.ParentShowHint := Pvdt.ParentShowHint;
Self.PopupMenu := Pvdt.PopupMenu;
Self.ScrollBarOptions.AlwaysVisible := Pvdt.ScrollBarOptions.AlwaysVisible;
Self.ScrollBarOptions.ScrollBars := Pvdt.ScrollBarOptions.ScrollBars;
Self.ShowHint := Pvdt.ShowHint;
Self.TabOrder := Pvdt.TabOrder;
Self.TreeOptions.AutoOptions := Pvdt.TreeOptions.AutoOptions;
Self.TreeOptions.MiscOptions := Pvdt.TreeOptions.MiscOptions;
Self.TreeOptions.PaintOptions := Pvdt.TreeOptions.PaintOptions;
Self.TreeOptions.SelectionOptions := Pvdt.TreeOptions.SelectionOptions;
// Копирование событий
Self.OnChange := Pvdt.OnChange;
Self.OnClick := Pvdt.OnClick;
Self.OnDrawHint := Pvdt.OnDrawHint;
Self.OnDrawNode := Pvdt.OnDrawNode;
Self.OnEnter := Pvdt.OnEnter;
Self.OnGetHintSize := Pvdt.OnGetHintSize;
Self.OnKeyDown := Pvdt.OnKeyDown;
Self.OnKeyPress := Pvdt.OnKeyPress;
Self.OnMouseDown := Pvdt.OnMouseDown;
Self.OnMouseMove := Pvdt.OnMouseMove;
Self.OnScroll := Pvdt.OnScroll;
Self.OnDragAllowed := Pvdt.OnDragAllowed;
Self.OnDragDrop := Pvdt.OnDragDrop;
Self.OnDragOver := Pvdt.OnDragOver;
// Копирование колонок
for c := 0 to Pvdt.Header.Columns.Count-1 do begin
column := Self.Header.Columns.Add;
column.Options := Pvdt.Header.Columns[c].Options;
column.Position := Pvdt.Header.Columns[c].Position;
column.MaxWidth := Pvdt.Header.Columns[c].MaxWidth;
column.MinWidth := Pvdt.Header.Columns[c].MinWidth;
column.Width := Pvdt.Header.Columns[c].Width;
column.Spacing := Pvdt.Header.Columns[c].Spacing;
column.Margin := Pvdt.Header.Columns[c].Margin;
column.Style := Pvdt.Header.Columns[c].Style;
column.Text := Pvdt.Header.Columns[c].Text;
end;
Pvdt.Destroy;
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.Create DONE');
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVirtualList.UpdateHintCanvas(newCanvas: TCanvas);
begin
// Для перерисовки тултипа нужна его канва, достать ее можно только при получении
// сообщения CM_HINTSHOW (см CMHintShow), но так как все нужные свойства закрыты
// единственным способом ее получения является обработчик события OnDrawHint
Self.HintCanvas := newCanvas;
end;
procedure TVirtualList.DoGetHintSize(Node: PVirtualNode; Column: TColumnIndex; var R: TRect);
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.DoGetHintSize %d', [Column]);
inherited DoGetHintSize(Node, Column, R);
if (Self.HintCanvas <> nil) then begin
//Self.HintCanvas.Brush.Color := clRed;
Self.HintCanvas.Brush.Style := bsSolid;
Self.HintCanvas.FillRect(0,0,Self.HintCanvas.Width, Self.HintCanvas.Height);
inherited DoDrawHint(Self.HintCanvas, Node, R, Column);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVirtualList.UpdateTileColumn(count: Word; Forse: Boolean = False);
var
data, RawData, NodeDat: PByte;
n, c: DWord;
node: PVirtualNode;
item: PVirtualItem;
begin
if (not Forse and ((Self.TileColumn = count) or (Self.Header.Columns.Count <= count)))
then Exit;
getmem(RawData, NodeDataSize * RootNodeCount + NodeDataSize div Self.TileColumn * count);
data := RawData;
node := inherited GetFirst(False);
while node <> nil do begin
Move(inherited GetNodeData(node)^, data^, NodeDataSize);
inc(data, NodeDataSize);
node := inherited GetNext(node, False);
end;
SetRoundMode(rmUp);
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.UpdateTileColumn %d %d %d', [Self.RootNodeCount, Self.TileColumn, count]);
//nodes := Round(Self.RootNodeCount * Self.TileColumn / count);
SetRoundMode(rmNearest);
Self.ClearAll := False;
inherited Clear;
Self.NodeDataSize := Self.NodeDataSize div Self.TileColumn * count;
Self.ClearAll := True;
Self.TileColumn := count;
item := Self.FirstItem;
data := RawData;
//if (item <> nil) then
n:=0;
while item <> nil do begin
if (item^.NextItem = nil)
then Break;
node := inherited AddChild(nil);
NodeDat := inherited GetNodeData(node);
Move(data^, NodeDat^, Self.NodeDataSize);
inc(data, Self.NodeDataSize);
for c:=0 to Self.TileColumn - 1 do begin
if (item^.NextItem = nil)
then Break;
item^.Node := node;
item^.Column := c;
item := item^.NextItem;
end;
inc(n, +1);
end;
freemem(RawData);
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.UpdateTileColumn %s', ['Done']);
end;
function TVirtualList.AddChild(ParentItem: PVirtualNode; UserData: Pointer = nil): PVirtualNode;
begin
Result := PVirtualNode(Self.AddItem(PVirtualItem(Parent), UserData));
end;
function TVirtualList.AddItem(ParentItem: PVirtualItem; UserData: Pointer = nil): PVirtualItem;
var
item: PVirtualItem;
begin
// Logger.Send([lcClient, lcDebug], 'TVirtualTree.AddChild %s', ['Start']);
getmem(item, SizeOf(TVirtualItem));
item^.NextItem:=nil;
item^.Selected:=False;
if ((Self.LastItem = nil) or (Self.LastItem^.Column = Self.TileColumn - 1))
then begin
item^.Node := inherited AddChild(nil);
item^.Column := 0;
if (Self.FirstItem = nil)
then Self.FirstItem := item;
end else begin
item^.Node := Self.LastItem^.Node;
item^.Column := Self.LastItem^.Column + 1;
end;
if (Self.LastItem <> nil)
then Self.LastItem^.NextItem := item;
Self.LastItem := item;
Result := item;
inc(FTilesCount, +1);
// Logger.Send([lcClient, lcDebug], 'TVirtualTree.AddChild %s', ['Done']);
end;
function TVirtualList.GetFirst(ConsiderChildrenAbove: Boolean = False): PVirtualItem;
begin
Result := Self.FirstItem;
end;
function TVirtualList.GetNext(Item: PVirtualItem; ConsiderChildrenAbove: Boolean = False): PVirtualItem;
begin
Result := Item^.NextItem;
end;
function TVirtualList.GetLast(Node: PVirtualNode = nil; ConsiderChildrenAbove: Boolean = False): PVirtualItem;
begin
Result := Self.LastItem;
end;
function TVirtualList.GetItemAt(Node: PVirtualNode; Column: TColumnIndex): PVirtualItem;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.GetItemAt %s', ['Start']);
if (Column < 0) or (Column >= Self.Header.Columns.Count) then begin
Result := nil;
Exit;
end;
Result := Self.FirstItem;
while (Result <> nil) and ((Result^.Node <> Node) or (Result^.Column <> Word(Self.Header.Columns[Column].Tag)))
do Result := Result^.NextItem;
end;
function TVirtualList.GetNodeData(Item: PVirtualItem): Pointer;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.GetNodeData %s', ['Start']);
Result := inherited GetNodeData(Item^.Node) + (Item^.Column * NodeDataSize div Self.TileColumn);
end;
procedure TVirtualList.Clear;
var
item: PVirtualItem;
next: PVirtualItem;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.Clear %s', ['Called']);
// Злоябучий паскаль автоматически вызывает чистку при изменении NodeDataSize, что не всегда нужно...
if (Self.ClearAll) and (Self.FirstItem <> nil) then begin
next := Self.FirstItem;
while (next <> nil) do begin
item := next;
next := next^.NextItem;
freemem(item);
end;
Self.FirstItem:=nil;
Self.LastItem:=nil;
end;
inherited;
FTilesCount := 0;
FSelectionCount := 0;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualList.GetFirstSelected(ConsiderChildrenAbove: Boolean = False): PVirtualItem;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.GetFirstSelected %s', ['']);
Result := Self.FirstItem;
while ((Result <> nil) and (not Result^.Selected)) do begin
Result := Result^.NextItem;
end;
end;
function TVirtualList.GetNextSelected(Item: PVirtualItem; ConsiderChildrenAbove: Boolean = False): PVirtualItem;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.GetNextSelected %s', ['']);
Result := Item^.NextItem;
while ((Result <> nil) and (not Result^.Selected)) do begin
Result := Result^.NextItem;
end;
end;
function TVirtualList.GetSelected(Item: PVirtualItem): Boolean;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.GetSelected %s', ['']);
Result := Item^.Selected;
end;
procedure TVirtualList.SetSelected(Item: PVirtualItem; Value: Boolean);
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.SetSelected %s', ['']);
if (Item^.Selected = Value)
then Exit;
Item^.Selected := Value;
if not Value
then Dec(FSelectionCount)
else begin
Inc(FSelectionCount);
Self.LastSelected := Item;
end;
// TODO: Обновить отображение выделения
end;
procedure TVirtualList.ClearSelection;
var
item: PVirtualItem;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.ClearSelection %s', ['']);
item := Self.FirstItem;
while (item <> nil) do begin
Self.SetSelected(item, False);
item := item^.NextItem;
end;
FSelectionCount := 0;
inherited ClearSelection;
end;
procedure TVirtualList.DeleteSelectedNodes;
var
item, next, prev: PVirtualItem;
node: PVirtualNode;
data, RawData: PByte;
size: Word;
c: Word;
begin
if (Self.GetFirstSelected() = nil)
then Exit;
size := NodeDataSize div Self.TileColumn;
getmem(RawData, NodeDataSize * RootNodeCount);
data := RawData;
prev := nil;
item := Self.FirstItem;
while (item <> nil) do begin
if (item^.Selected) then begin
next := item^.NextItem;
Dec(FTilesCount);
freemem(item);
if (prev <> nil) then begin
prev^.NextItem := next;
end else begin
Self.FirstItem := next;
end;
if (next = nil) then begin
Self.LastItem := prev;
end;
item := next;
end else begin
Move((inherited GetNodeData(item^.Node) + (size * item^.Column))^, data^, size);
inc(data, size);
prev := item;
item := item^.NextItem;
end;
end;
data := RawData;
item := Self.FirstItem;
node := inherited GetFirst();
while (node <> nil) do begin
Move(data^, inherited GetNodeData(node)^, NodeDataSize);
Inc(data, NodeDataSize);
for c := 0 to Self.TileColumn - 1 do
if item <> nil then begin
item^.Node := node;
item^.Column := c;
item := item^.NextItem;
end else Break;
if (item = nil)
then Break;
node := inherited GetNext(node);
end;
if (Self.LastItem = nil)
then inherited Clear
else begin
item := Self.LastItem^.NextItem;
while (item <> nil) do begin
if (item^.Node <> Self.LastItem^.Node) then begin
node := item^.Node;
while (node <> nil) do begin
inherited DeleteNode(node, False);
node := inherited GetNext(node);
end;
Break;
end;
item := item^.NextItem;
end;
end;
freemem(RawData);
Self.LastSelected := nil;
FSelectionCount := 0;
end;
//----------------------------------------------------------------------------------------------------------------------
function TVirtualList.GetFocusedNode(): PVirtualItem;
var
node: PVirtualNode;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.GetFocusedNode %s', ['']);
node := inherited FocusedNode;
Result := Self.FirstItem;
while ((Result <> nil) and (Result^.Node <> node))
do Result := Result^.NextItem;
end;
procedure TVirtualList.SetFocusedNode(Item: PVirtualItem);
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.SetFocusedNode %s', ['']);
inherited FocusedNode := Item^.Node;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVirtualList.DoPaintNode(var PaintInfo: TVTPaintInfo);
var
item: PVirtualItem;
node: PVirtualNode;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.DoPaintNode %s', ['Start']);
item := Self.FirstItem;//^.NextItem;
while ((item <> nil) and ((item^.Node^.Index <> PaintInfo.Node^.Index) or (item^.Column <> Word(Self.Header.Columns[PaintInfo.Column].Tag))))
do item := item^.NextItem;
if (item <> nil) then begin
node := PaintInfo.Node;
PaintInfo.Node := PVirtualNode(item);
inherited DoPaintNode(PaintInfo);
PaintInfo.Node := node;
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.DoPaintNode %s', ['Done']);
if (item^.Selected and (item = Self.LastSelected))
then PaintInfo.Canvas.Pen.Color := Colors.FocusedSelectionBorderColor
else if item^.Selected
then PaintInfo.Canvas.Pen.Color := Colors.UnfocusedSelectionBorderColor
else PaintInfo.Canvas.Pen.Color := Colors.BorderColor;
//PaintInfo.Canvas.Pen.Color := clRed;
PaintInfo.Canvas.Pen.Style := psDot;//psSolid;
PaintInfo.Canvas.Pen.Width := 1;
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.DoPaintNode [%d,%d,%d,%d] [%d,%d]', [PaintInfo.CellRect.Left, PaintInfo.CellRect.Top,
//PaintInfo.CellRect.Right - PaintInfo.CellRect.Left, PaintInfo.CellRect.Bottom - PaintInfo.CellRect.Top, PaintInfo.Canvas.Width, PaintInfo.Canvas.Height]);
PaintInfo.Canvas.Line(PaintInfo.CellRect.Left+1,PaintInfo.CellRect.Bottom-1,PaintInfo.CellRect.Right-1,PaintInfo.CellRect.Bottom-1);
PaintInfo.Canvas.Line(PaintInfo.CellRect.Right-1,PaintInfo.CellRect.Top+1,PaintInfo.CellRect.Left+1,PaintInfo.CellRect.Top+1);
if Self.TileColumn > 1 then begin
PaintInfo.Canvas.Line(PaintInfo.CellRect.Left+1,PaintInfo.CellRect.Top+1,PaintInfo.CellRect.Left+1,PaintInfo.CellRect.Bottom-1);
PaintInfo.Canvas.Line(PaintInfo.CellRect.Right-1,PaintInfo.CellRect.Bottom-1,PaintInfo.CellRect.Right-1,PaintInfo.CellRect.Top+1);
end;
PaintInfo.Canvas.Pen.Color := Color;
PaintInfo.Canvas.Pen.Style := psSolid;
PaintInfo.Canvas.Line(PaintInfo.CellRect.Left,PaintInfo.CellRect.Bottom,PaintInfo.CellRect.Right,PaintInfo.CellRect.Bottom);
PaintInfo.Canvas.Line(PaintInfo.CellRect.Right,PaintInfo.CellRect.Top,PaintInfo.CellRect.Left,PaintInfo.CellRect.Top);
if Self.TileColumn > 1 then begin
PaintInfo.Canvas.Line(PaintInfo.CellRect.Left,PaintInfo.CellRect.Top,PaintInfo.CellRect.Left,PaintInfo.CellRect.Bottom);
PaintInfo.Canvas.Line(PaintInfo.CellRect.Right,PaintInfo.CellRect.Bottom,PaintInfo.CellRect.Right,PaintInfo.CellRect.Top);
PaintInfo.Canvas.Pixels[PaintInfo.CellRect.Left+1,PaintInfo.CellRect.Top+1] := Color;
PaintInfo.Canvas.Pixels[PaintInfo.CellRect.Left+1,PaintInfo.CellRect.Bottom-1] := Color;
PaintInfo.Canvas.Pixels[PaintInfo.CellRect.Right-1,PaintInfo.CellRect.Bottom-1] := Color;
PaintInfo.Canvas.Pixels[PaintInfo.CellRect.Right-1,PaintInfo.CellRect.Top+1] := Color;
end;
//PaintInfo.Canvas.Rectangle(PaintInfo.CellRect);
//PaintInfo.Canvas.Line(Rect(1,1,PaintInfo.Canvas.Width-2, PaintInfo.Canvas.Height-2));
//PaintInfo.Canvas.Rectangle(Rect(1,1,PaintInfo.Canvas.Width-2, PaintInfo.Canvas.Height-2));
//PaintInfo.Canvas.Line(1,1,PaintInfo.Canvas.Width-2,PaintInfo.Canvas.Height-2);
//PaintInfo.Canvas.Line(1,1,1,PaintInfo.Canvas.Height-2);
//PaintInfo.Canvas.Line(1,PaintInfo.Canvas.Height-2,PaintInfo.Canvas.Width-2,PaintInfo.Canvas.Height-2);
//PaintInfo.Canvas.Line(PaintInfo.Canvas.Width-4,PaintInfo.Canvas.Height-2,PaintInfo.Canvas.Width-4,1);
//PaintInfo.Canvas.Line(0,PaintInfo.Canvas.Width,0,0);
end;
end;
procedure TVirtualList.PrepareCell(var PaintInfo: TVTPaintInfo; WindowOrgX, MaxWidth: Integer);
var
item: PVirtualItem;
begin
inherited PrepareCell(PaintInfo, WindowOrgX, MaxWidth);
item := Self.GetItemAt(PaintInfo.Node, PaintInfo.Column);
if (item = nil)
then Exit;
if (item^.Selected and (item = Self.LastSelected))
then PaintInfo.Canvas.Brush.Color := Colors.FocusedSelectionColor
else if item^.Selected
then PaintInfo.Canvas.Brush.Color := Colors.UnfocusedSelectionColor
else PaintInfo.Canvas.Brush.Color := Colors.GridLineColor;
PaintInfo.Canvas.Brush.Style := bsSolid;
PaintInfo.Canvas.FillRect(0,0,PaintInfo.Canvas.Width, PaintInfo.Canvas.Height);
end;
procedure TVirtualList.DoPaintDropMark(Canvas: TCanvas; Node: PVirtualNode; const R: TRect);
begin
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TVirtualList.HandleMouseDblClick(var Message: TLMMouse; const HitInfo: THitInfo);
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.HandleMouseDblClick %s', ['Start']);
inherited HandleMouseDblClick(Message, HitInfo);
end;
procedure TVirtualList.HandleMouseDown(var Message: TLMMouse; var HitInfo: THitInfo);
var
ShiftState: TShiftState;
HitItem: PVirtualItem;
item: PVirtualItem;
//kinput: TKEYINPUT;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.HandleMouseDown %s', ['Start']);
HitItem := Self.GetItemAt(HitInfo.HitNode, HitInfo.HitColumn);
if (HitItem = nil) then begin
inherited HandleMouseDown(Message, HitInfo);
Exit;
end;
ShiftState := KeysToShiftState(Message.Keys) * [ssShift, ssCtrl, ssAlt];
if not (ssAlt in ShiftState) then begin
if (not (ssCtrl in ShiftState)) and (not (ssShift in ShiftState)) then begin
if (not HitItem^.Selected)
then Self.ClearSelection;
Self.SetSelected(HitItem, True);
end else if not (ssShift in ShiftState) then begin
Self.SetSelected(HitItem, not HitItem^.Selected);
end else begin
if not (ssCtrl in ShiftState)
then Self.ClearSelection;
if Self.LastSelected = nil
then Self.LastSelected := Self.FirstItem;
if Self.LastSelected^.Node^.Index < HitItem^.Node^.Index then begin
item := Self.LastSelected;
HitItem := HitItem;
end else begin
item := HitItem;
HitItem := Self.LastSelected;
end;
while item <> HitItem^.NextItem do begin
Self.SetSelected(item, True);
item := item^.NextItem;
end;
end;
end;
// Вызываем перерисовку контрола (тутбы потом понормальному сделать...)
if (Self.Focused) then begin
Self.Parent.SetFocus;
Self.SetFocus;
end;
inherited HandleMouseDown(Message, HitInfo);
// Чтоже я творю-то...
{if (ShiftState = []) then begin
kinput.itype := INPUT_KEYBOARD;
kinput.wVk := $11; // VK_CONTROL
SendInput(1, @kinput, sizeof(TKEYINPUT));
BeginDrag(TRUE);
kinput.dwFlags := KEYEVENTF_KEYUP;
SendInput(1, @kinput, sizeof(TKEYINPUT));
end;} //TODO
end;
procedure TVirtualList.HandleMouseUp(Keys: PtrUInt; const HitInfo: THitInfo);
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.HandleMouseUp %s', ['Start']);
inherited HandleMouseUp(Keys, HitInfo);
end;
//----------------------------------------------------------------------------------------------------------------------
end.

BIN
Client/Overlay/About.bmp Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 110 KiB

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
Client/Overlay/Splash.bmp Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 165 KiB

BIN
Client/Overlay/Splash.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 148 KiB

BIN
Client/Overlay/baner-f0.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.6 KiB

BIN
Client/Overlay/baner-f1.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.8 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 6.6 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.0 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.3 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.0 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.0 KiB

View File

@ -1,5 +1,40 @@
Sounds/MusicInf.wav
GLFont/DejaVu.png
GLFont/DejaVu.fnt
Overlay/LeftTopArrow.tga Overlay/LeftTopArrow.tga
Overlay/TopArrow.tga Overlay/TopArrow.tga
Overlay/VirtualLayer.tga Overlay/VirtualLayer.tga
GLFont/DejaVu.png Overlay/LightBulb_24nn.tga
GLFont/DejaVu.fnt Overlay/LightBulb_24bw.tga
Overlay/LightBulb_24tw.tga
Overlay/LightBulb_24bo.tga
Overlay/LightBulb_24to.tga
Overlay/LightBulb_24by.tga
Overlay/LightBulb_24ty.tga
Overlay/LightBulb_24ny.tga
Overlay/LightBulb_24bl.tga
Overlay/LightBulb_24bb.tga
Overlay/LightBulb_24tb.tga
Overlay/LightBulb_24bg.tga
Overlay/LightBulb_24tg.tga
Overlay/LightBulb_24br.tga
Overlay/LightBulb_24bp.tga
Overlay/Splash.bmp
Overlay/About.bmp
Cursors/BC_NormalSelect.cur
Cursors/BC_WorkingInBackground.cur
Cursors/BC_HelpSelect.cur
Cursors/BC_PrecisionSelect.cur
Cursors/BC_TextSelect.cur
Cursors/BI_Busy.ani
Cursors/TN_Unavailable.cur
Cursors/BC_Move.cur
Cursors/BC_DiagonalResize2.cur
Cursors/BC_VerticalResize.cur
Cursors/BC_DiagonalResize1.cur
Cursors/BC_HorizontalResize.cur
Cursors/BC_AlternateSelect.cur
Cursors/TN_LinkSelect.cur
Cursors/UO_Precision.cur
Cursors/UO_AttackMode.cur
Cursors/UO_Gauntlet.cur

BIN
Client/Sounds/MusicInf.wav Normal file

Binary file not shown.

View File

@ -1,47 +1,313 @@
inherited frmBoundaries: TfrmBoundaries inherited frmBoundaries: TfrmBoundaries
Left = 290 Left = 1259
Height = 164 Height = 141
Top = 171 Top = 502
Width = 205 Width = 403
Caption = 'Boundaries' Anchors = [akTop, akLeft, akBottom]
ClientHeight = 164 Caption = 'Границы видимости'
ClientWidth = 205 ClientHeight = 141
object lblMaxZ: TLabel[0] ClientWidth = 403
OnCreate = FormCreate
object tbMaxZ: TTrackBar[0]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = seMaxZ AnchorSideTop.Control = tbMinZ
AnchorSideTop.Side = asrCenter
Left = 8
Height = 16
Top = 89
Width = 68
BorderSpacing.Left = 8
Caption = 'Maximum Z:'
Layout = tlCenter
ParentColor = False
end
object lblMinZ: TLabel[1]
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = seMinZ
AnchorSideTop.Side = asrCenter
Left = 8
Height = 16
Top = 12
Width = 67
BorderSpacing.Left = 8
Caption = 'Minimum Z:'
Layout = tlCenter
ParentColor = False
end
object tbMinZ: TTrackBar[2]
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = seMinZ
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 8 Left = 8
Height = 36 Height = 30
Top = 41 Top = 28
Width = 189 Width = 387
Frequency = 10
Max = 127
Min = -128
OnChange = tbMaxZChange
PageSize = 1
Position = 127
TickMarks = tmTopLeft
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 20
BorderSpacing.Right = 8
TabOrder = 1
end
object GroupBox1: TGroupBox[1]
AnchorSideLeft.Control = tbMaxZ
AnchorSideTop.Control = tbMaxZ
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = tbMaxZ
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 216
Height = 72
Top = 60
Width = 179
Anchors = [akTop, akRight]
BorderSpacing.Top = 2
BorderSpacing.Bottom = 4
Caption = 'Границы высоты'
ClientHeight = 54
ClientWidth = 175
TabOrder = 2
object seMinZ: TSpinEdit
AnchorSideTop.Control = GroupBox1
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 119
Height = 23
Top = 0
Width = 48
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
MaxValue = 127
MinValue = -128
OnChange = seMinZChange
TabOrder = 0
Value = -128
end
object seMaxZ: TSpinEdit
AnchorSideTop.Control = seMinZ
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom
Left = 119
Height = 23
Top = 28
Width = 48
Anchors = [akTop, akRight]
BorderSpacing.Top = 5
BorderSpacing.Right = 8
MaxValue = 127
MinValue = -128
OnChange = seMaxZChange
TabOrder = 1
Value = 127
end
object lblMinZ: TLabel
AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = seMinZ
AnchorSideTop.Side = asrCenter
Left = 8
Height = 16
Top = 3
Width = 93
BorderSpacing.Left = 8
BorderSpacing.Top = 6
Caption = 'Z Минимальная:'
Layout = tlCenter
ParentColor = False
end
object lblMaxZ: TLabel
AnchorSideLeft.Control = lblMinZ
AnchorSideTop.Control = seMaxZ
AnchorSideTop.Side = asrCenter
Left = 8
Height = 16
Top = 31
Width = 97
Caption = 'Z Максимальная:'
Layout = tlCenter
ParentColor = False
end
end
object GroupBox2: TGroupBox[2]
AnchorSideLeft.Control = tbMaxZ
AnchorSideTop.Control = GroupBox1
AnchorSideRight.Control = GroupBox1
AnchorSideBottom.Control = GroupBox1
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 72
Top = 60
Width = 201
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Right = 7
Caption = 'Границы дальности обзора'
ClientHeight = 54
ClientWidth = 197
TabOrder = 3
object seMaxX: TSpinEdit
AnchorSideTop.Control = GroupBox2
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 137
Height = 23
Top = 0
Width = 54
Anchors = [akTop, akRight]
BorderSpacing.Right = 6
MaxValue = 12288
OnChange = seMaxXChange
TabOrder = 0
Value = 12288
end
object seMaxY: TSpinEdit
AnchorSideTop.Control = seMaxX
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox2
AnchorSideRight.Side = asrBottom
Left = 137
Height = 23
Top = 28
Width = 54
Anchors = [akTop, akRight]
BorderSpacing.Top = 5
BorderSpacing.Right = 6
MaxValue = 8192
OnChange = seMaxYChange
TabOrder = 1
Value = 8192
end
object seMinY: TSpinEdit
AnchorSideTop.Control = seMaxY
AnchorSideRight.Control = seMaxY
Left = 64
Height = 23
Top = 28
Width = 54
Anchors = [akTop, akRight]
BorderSpacing.Right = 19
MaxValue = 8192
OnChange = seMinYChange
TabOrder = 2
end
object seMinX: TSpinEdit
AnchorSideTop.Control = seMaxX
AnchorSideRight.Control = seMaxX
Left = 64
Height = 23
Top = 0
Width = 54
Anchors = [akTop, akRight]
BorderSpacing.Right = 19
MaxValue = 12288
OnChange = seMinXChange
TabOrder = 3
end
object lblAxeX: TLabel
AnchorSideLeft.Control = sbClearXbnd
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seMinZ
AnchorSideTop.Side = asrCenter
Left = 23
Height = 16
Top = 3
Width = 35
BorderSpacing.Left = 3
BorderSpacing.Top = 6
Caption = 'Ось X:'
Layout = tlCenter
ParentColor = False
end
object lblAxeY: TLabel
AnchorSideLeft.Control = sbClearYbnd
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seMinZ
AnchorSideTop.Side = asrCenter
Left = 23
Height = 16
Top = 31
Width = 35
BorderSpacing.Left = 3
BorderSpacing.Top = 6
Caption = 'Ось Y:'
Layout = tlCenter
ParentColor = False
end
object lblAxeX1: TLabel
AnchorSideLeft.Control = seMinX
AnchorSideTop.Control = seMaxX
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = seMaxX
AnchorSideRight.Side = asrBottom
Left = 112
Height = 16
Top = 3
Width = 31
Alignment = taCenter
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 48
BorderSpacing.Top = 6
BorderSpacing.Right = 48
Caption = '—'
Layout = tlCenter
ParentColor = False
end
object lblAxeY1: TLabel
AnchorSideLeft.Control = seMinY
AnchorSideTop.Control = seMaxY
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = seMaxY
AnchorSideRight.Side = asrBottom
Left = 112
Height = 16
Top = 31
Width = 31
Alignment = taCenter
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 48
BorderSpacing.Top = 6
BorderSpacing.Right = 48
Caption = '—'
Layout = tlCenter
ParentColor = False
end
object sbClearXbnd: TSpeedButton
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = seMaxX
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = lblAxeX
Left = 4
Height = 16
Top = 3
Width = 16
BorderSpacing.Left = 4
BorderSpacing.Right = 2
Caption = '✇'
Font.CharSet = RUSSIAN_CHARSET
Font.Height = -8
Font.Name = 'Tahoma'
Font.Pitch = fpVariable
Font.Quality = fqDraft
NumGlyphs = 0
OnClick = sbClearXbndClick
ShowHint = True
ParentFont = False
ParentShowHint = False
end
object sbClearYbnd: TSpeedButton
AnchorSideLeft.Control = GroupBox2
AnchorSideTop.Control = seMaxY
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = lblAxeX
Left = 4
Height = 16
Top = 31
Width = 16
BorderSpacing.Left = 4
BorderSpacing.Right = 2
Caption = '✇'
Font.CharSet = RUSSIAN_CHARSET
Font.Height = -8
Font.Name = 'Tahoma'
Font.Pitch = fpVariable
Font.Quality = fqDraft
NumGlyphs = 0
OnClick = sbClearYbndClick
ShowHint = True
ParentFont = False
ParentShowHint = False
end
end
object tbMinZ: TTrackBar[3]
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 8
Height = 30
Top = 8
Width = 387
Frequency = 10 Frequency = 10
Max = 127 Max = 127
Min = -128 Min = -128
@ -52,58 +318,7 @@ inherited frmBoundaries: TfrmBoundaries
BorderSpacing.Around = 8 BorderSpacing.Around = 8
TabOrder = 0 TabOrder = 0
end end
object tbMaxZ: TTrackBar[3] inherited tmClose: TTimer[4]
AnchorSideLeft.Control = Owner left = 312
AnchorSideTop.Control = seMaxZ
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 8
Height = 36
Top = 118
Width = 189
Frequency = 10
Max = 127
Min = -128
OnChange = tbMaxZChange
PageSize = 1
Position = 127
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 8
TabOrder = 1
end
object seMaxZ: TSpinEdit[4]
AnchorSideTop.Control = tbMinZ
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 149
Height = 25
Top = 85
Width = 48
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
MaxValue = 127
MinValue = -128
OnChange = seMaxZChange
TabOrder = 2
Value = 127
end
object seMinZ: TSpinEdit[5]
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 149
Height = 25
Top = 8
Width = 48
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
BorderSpacing.Right = 8
MaxValue = 127
MinValue = -128
OnChange = seMinZChange
TabOrder = 3
Value = -128
end end
end end

View File

@ -31,20 +31,39 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ComCtrls, Spin, ExtCtrls, UfrmToolWindow; ComCtrls, Spin, ExtCtrls, Buttons, UfrmToolWindow;
type type
{ TfrmBoundaries } { TfrmBoundaries }
TfrmBoundaries = class(TfrmToolWindow) TfrmBoundaries = class(TfrmToolWindow)
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
lblAxeX1: TLabel;
lblAxeY1: TLabel;
lblMaxZ: TLabel; lblMaxZ: TLabel;
lblMinZ: TLabel; lblMinZ: TLabel;
lblAxeX: TLabel;
lblAxeY: TLabel;
seMaxZ: TSpinEdit; seMaxZ: TSpinEdit;
seMinZ: TSpinEdit; seMinZ: TSpinEdit;
seMaxX: TSpinEdit;
seMaxY: TSpinEdit;
seMinY: TSpinEdit;
seMinX: TSpinEdit;
sbClearXbnd: TSpeedButton;
sbClearYbnd: TSpeedButton;
tbMinZ: TTrackBar; tbMinZ: TTrackBar;
tbMaxZ: TTrackBar; tbMaxZ: TTrackBar;
procedure FormCreate(Sender: TObject);
procedure sbClearXbndClick(Sender: TObject);
procedure sbClearYbndClick(Sender: TObject);
procedure seMaxXChange(Sender: TObject);
procedure seMaxYChange(Sender: TObject);
procedure seMaxZChange(Sender: TObject); procedure seMaxZChange(Sender: TObject);
procedure seMinXChange(Sender: TObject);
procedure seMinYChange(Sender: TObject);
procedure seMinZChange(Sender: TObject); procedure seMinZChange(Sender: TObject);
procedure tbMaxZChange(Sender: TObject); procedure tbMaxZChange(Sender: TObject);
procedure tbMinZChange(Sender: TObject); procedure tbMinZChange(Sender: TObject);
@ -58,30 +77,101 @@ var
implementation implementation
uses uses
UfrmMain; UfrmMain, Language;
{ TfrmBoundaries } { TfrmBoundaries }
procedure TfrmBoundaries.seMaxZChange(Sender: TObject); procedure TfrmBoundaries.FormCreate(Sender: TObject);
begin begin
tbMaxZ.Position := seMaxZ.Value; LanguageTranslate(Self);
seMaxX.MaxValue := 8*frmMain.Landscape.Width-1;
seMinX.MaxValue := seMaxX.MaxValue; seMaxX.Value := seMaxX.MaxValue;
seMaxY.MaxValue := 8*frmMain.Landscape.Height-1;
seMinY.MaxValue := seMaxY.MaxValue; seMaxY.Value := seMaxY.MaxValue;
end;
procedure TfrmBoundaries.sbClearXbndClick(Sender: TObject);
begin
seMinX.Value := seMinX.MinValue;
seMaxX.Value := seMaxX.MaxValue;
frmMain.InvalidateFilter;
end;
procedure TfrmBoundaries.sbClearYbndClick(Sender: TObject);
begin
seMinY.Value := seMinY.MinValue;
seMaxY.Value := seMaxY.MaxValue;
frmMain.InvalidateFilter;
end;
procedure TfrmBoundaries.seMinXChange(Sender: TObject);
begin
if (seMaxX.Value <= seMinX.Value) then if (seMinX.Value < seMaxX.MaxValue)
then seMaxX.Value := seMinX.Value+1
else seMaxX.Value := seMaxX.MaxValue;
frmMain.InvalidateFilter;
end;
procedure TfrmBoundaries.seMaxXChange(Sender: TObject);
begin
if (seMinX.Value >= seMaxX.Value) then if (seMaxX.Value > seMinX.MinValue)
then seMinX.Value := seMaxX.Value-1
else seMinX.Value := seMinX.MinValue;
frmMain.InvalidateFilter;
end;
procedure TfrmBoundaries.seMinYChange(Sender: TObject);
begin
if (seMaxY.Value <= seMinY.Value) then if (seMinY.Value < seMaxY.MaxValue)
then seMaxY.Value := seMinY.Value+1
else seMaxY.Value := seMaxY.MaxValue;
frmMain.InvalidateFilter;
end;
procedure TfrmBoundaries.seMaxYChange(Sender: TObject);
begin
if (seMinY.Value >= seMaxY.Value) then if (seMaxY.Value > seMinY.MinValue)
then seMinY.Value := seMaxY.Value-1
else seMinY.Value := seMinY.MinValue;
frmMain.InvalidateFilter; frmMain.InvalidateFilter;
end; end;
procedure TfrmBoundaries.seMinZChange(Sender: TObject); procedure TfrmBoundaries.seMinZChange(Sender: TObject);
begin begin
if (seMaxZ.Value <= seMinZ.Value) then if (seMinZ.Value < seMaxZ.MaxValue)
then seMaxZ.Value := seMinZ.Value+1
else seMaxZ.Value := seMaxZ.MaxValue;
tbMinZ.Position := seMinZ.Value; tbMinZ.Position := seMinZ.Value;
tbMaxZ.Position := seMaxZ.Value;
frmMain.InvalidateFilter; frmMain.InvalidateFilter;
end; end;
procedure TfrmBoundaries.tbMaxZChange(Sender: TObject); procedure TfrmBoundaries.seMaxZChange(Sender: TObject);
begin begin
seMaxZ.Value := tbMaxZ.Position; if (seMinZ.Value >= seMaxZ.Value) then if (seMaxZ.Value > seMinZ.MinValue)
then seMinZ.Value := seMaxZ.Value-1
else seMinZ.Value := seMinZ.MinValue;
tbMaxZ.Position := seMaxZ.Value;
tbMinZ.Position := seMinZ.Value;
frmMain.InvalidateFilter; frmMain.InvalidateFilter;
end; end;
procedure TfrmBoundaries.tbMinZChange(Sender: TObject); procedure TfrmBoundaries.tbMinZChange(Sender: TObject);
begin begin
if (tbMaxZ.Position <= tbMinZ.Position) then if (tbMinZ.Position < tbMaxZ.Max)
then tbMaxZ.Position := tbMinZ.Position+1
else tbMaxZ.Position := tbMaxZ.Max;
seMinZ.Value := tbMinZ.Position;
seMaxZ.Value := tbMaxZ.Position;
frmMain.InvalidateFilter;
end;
procedure TfrmBoundaries.tbMaxZChange(Sender: TObject);
begin
if (tbMinZ.Position >= tbMaxZ.Position) then if (tbMaxZ.Position > tbMinZ.Min)
then tbMinZ.Position := tbMaxZ.Position-1
else tbMinZ.Position := tbMinZ.Min;
seMaxZ.Value := tbMaxZ.Position;
seMinZ.Value := tbMinZ.Position; seMinZ.Value := tbMinZ.Position;
frmMain.InvalidateFilter; frmMain.InvalidateFilter;
end; end;

View File

@ -1,37 +1,36 @@
object frmConfirmation: TfrmConfirmation object frmConfirmation: TfrmConfirmation
Left = 290 Left = 1559
Height = 43 Height = 43
Top = 171 Top = 261
Width = 108 Width = 116
BorderIcons = [] BorderIcons = []
BorderStyle = bsToolWindow BorderStyle = bsToolWindow
Caption = 'Apply?' Caption = 'Подтвердить?'
ClientHeight = 43 ClientHeight = 43
ClientWidth = 108 ClientWidth = 116
Font.Height = -11 Font.Height = -11
LCLVersion = '0.9.25' OnCreate = FormCreate
object btnYes: TButton LCLVersion = '0.9.30.2'
Left = 8 object btnYes: TButton
Height = 25 Left = 8
Top = 8 Height = 25
Width = 40 Top = 8
BorderSpacing.InnerBorder = 4 Width = 40
Caption = 'Yes' BorderSpacing.InnerBorder = 4
Default = True Caption = 'Да'
ModalResult = 6 Default = True
ParentFont = True ModalResult = 6
TabOrder = 0 TabOrder = 0
end end
object btnNo: TButton object btnNo: TButton
Left = 56 Left = 56
Height = 25 Height = 25
Top = 8 Top = 8
Width = 40 Width = 40
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 4
Cancel = True Cancel = True
Caption = 'No' Caption = 'Нет'
ModalResult = 7 ModalResult = 7
ParentFont = True TabOrder = 1
TabOrder = 1 end
end end
end

View File

@ -1,57 +1,67 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2007 Andreas Schneider
*) *)
unit UfrmConfirmation; unit UfrmConfirmation;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls; Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
type type
{ TfrmConfirmation } { TfrmConfirmation }
TfrmConfirmation = class(TForm) TfrmConfirmation = class(TForm)
btnYes: TButton; btnYes: TButton;
btnNo: TButton; btnNo: TButton;
private procedure FormCreate(Sender: TObject);
{ private declarations } private
public { private declarations }
{ public declarations } public
end; { public declarations }
end;
var
frmConfirmation: TfrmConfirmation; var
frmConfirmation: TfrmConfirmation;
implementation
implementation
initialization
{$I UfrmConfirmation.lrs} uses Language;
end. { TfrmConfirmation }
procedure TfrmConfirmation.FormCreate(Sender: TObject);
begin
LanguageTranslate(Self);
end;
initialization
{$I UfrmConfirmation.lrs}
end.

View File

@ -1,123 +1,181 @@
inherited frmDrawSettings: TfrmDrawSettings inherited frmDrawSettings: TfrmDrawSettings
Left = 268 Left = 1224
Height = 180 Height = 240
Top = 165 Top = 636
Width = 242 Width = 242
ActiveControl = rbTileList Caption = 'Опции рисования'
Caption = 'Draw settings' ClientHeight = 240
ClientHeight = 180 ClientWidth = 242
ClientWidth = 242 OnCreate = FormCreate
OnCreate = FormCreate OnShow = FormShow
object rbTileList: TRadioButton[0] object cbProbability: TCheckBox[0]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = rbRandom
AnchorSideTop.Control = Owner AnchorSideTop.Control = rbRandom
Left = 8 AnchorSideTop.Side = asrBottom
Height = 22 Left = 8
Top = 8 Height = 19
Width = 146 Top = 56
BorderSpacing.Left = 8 Width = 170
BorderSpacing.Top = 8 BorderSpacing.Top = 6
BorderSpacing.Bottom = 4 Caption = 'Размещать тайл с шансом:'
Caption = 'Use tile from the list' TabOrder = 9
Checked = True end
State = cbChecked object rbTileList: TRadioButton[1]
TabOrder = 0 AnchorSideLeft.Control = Owner
end AnchorSideTop.Control = Owner
object rbRandom: TRadioButton[1] Left = 8
AnchorSideLeft.Control = rbTileList Height = 19
AnchorSideTop.Control = rbTileList Top = 8
AnchorSideTop.Side = asrBottom Width = 170
Left = 8 BorderSpacing.Left = 8
Height = 22 BorderSpacing.Top = 8
Top = 34 BorderSpacing.Bottom = 4
Width = 213 Caption = 'Выбранный тайл из списка'
BorderSpacing.Top = 4 Checked = True
Caption = 'Use tiles from the random pool' TabOrder = 0
TabOrder = 1 TabStop = True
TabStop = False end
end object rbRandom: TRadioButton[2]
object gbHue: TGroupBox[2] AnchorSideLeft.Control = rbTileList
AnchorSideLeft.Control = Owner AnchorSideTop.Control = rbTileList
AnchorSideTop.Control = seRandomHeight AnchorSideTop.Side = asrBottom
AnchorSideTop.Side = asrBottom Left = 8
AnchorSideRight.Control = Owner Height = 19
AnchorSideRight.Side = asrBottom Top = 31
Left = 8 Width = 170
Height = 49 BorderSpacing.Top = 4
Top = 132 Caption = 'Случайный тайл из набора'
Width = 226 OnChange = rbRandomChange
Anchors = [akTop, akLeft, akRight] TabOrder = 1
BorderSpacing.Around = 8 end
Caption = 'Hue (Statics only)' object gbHue: TGroupBox[3]
ClientHeight = 45 AnchorSideLeft.Control = Owner
ClientWidth = 222 AnchorSideTop.Control = seRandomHeight
TabOrder = 2 AnchorSideTop.Side = asrBottom
object pbHue: TPaintBox AnchorSideRight.Control = Owner
Cursor = crHandPoint AnchorSideRight.Side = asrBottom
Left = 4 Left = 8
Height = 41 Height = 49
Top = 0 Top = 185
Width = 214 Width = 226
Align = alClient Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 4 BorderSpacing.Around = 8
BorderSpacing.Right = 4 Caption = 'Цвет (Только для Статики)'
BorderSpacing.Bottom = 4 ClientHeight = 31
OnClick = pbHueClick ClientWidth = 222
OnPaint = pbHuePaint TabOrder = 2
end object pbHue: TPaintBox
end Cursor = crHandPoint
object cbRandomHeight: TCheckBox[3] Left = 4
AnchorSideLeft.Control = cbForceAltitude Height = 27
AnchorSideTop.Control = cbForceAltitude Top = 0
AnchorSideTop.Side = asrBottom Width = 214
Left = 8 Align = alClient
Height = 22 BorderSpacing.Left = 4
Top = 102 BorderSpacing.Right = 4
Width = 149 BorderSpacing.Bottom = 4
BorderSpacing.Top = 12 OnClick = pbHueClick
Caption = 'Add Random Altitude' OnPaint = pbHuePaint
TabOrder = 3 end
end end
object seRandomHeight: TSpinEdit[4] object cbRandomHeight: TCheckBox[4]
AnchorSideTop.Control = cbRandomHeight AnchorSideLeft.Control = cbForceAltitude
AnchorSideTop.Side = asrCenter AnchorSideTop.Control = cbForceAltitude
AnchorSideRight.Control = Owner AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom Left = 8
Left = 184 Height = 19
Height = 21 Top = 156
Top = 103 Width = 163
Width = 50 BorderSpacing.Top = 8
Anchors = [akTop, akRight] Caption = 'Добавить к высоте (случ):'
BorderSpacing.Right = 8 TabOrder = 3
TabOrder = 4 end
end object seRandomHeight: TSpinEdit[5]
object cbForceAltitude: TCheckBox[5] AnchorSideTop.Control = cbRandomHeight
AnchorSideLeft.Control = rbRandom AnchorSideTop.Side = asrCenter
AnchorSideTop.Control = rbRandom AnchorSideRight.Control = Owner
AnchorSideTop.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 8 Left = 184
Height = 22 Height = 23
Top = 68 Top = 154
Width = 111 Width = 50
BorderSpacing.Top = 12 Anchors = [akTop, akRight]
Caption = 'Force altitude:' BorderSpacing.Right = 8
TabOrder = 5 OnChange = seRandomHeightChange
end TabOrder = 4
object seForceAltitude: TSpinEdit[6] end
AnchorSideTop.Control = cbForceAltitude object cbForceAltitude: TCheckBox[6]
AnchorSideTop.Side = asrCenter AnchorSideLeft.Control = rbRandom
AnchorSideRight.Control = Owner AnchorSideTop.Control = cbUseSurfaceAltitude
AnchorSideRight.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 184 Left = 8
Height = 21 Height = 19
Top = 69 Top = 129
Width = 50 Width = 135
Anchors = [akTop, akRight] BorderSpacing.Top = 2
BorderSpacing.Right = 8 Caption = 'Задать фикс. высоту:'
MaxValue = 127 TabOrder = 5
MinValue = -128 end
TabOrder = 6 object seForceAltitude: TSpinEdit[7]
end AnchorSideTop.Control = cbForceAltitude
inherited tmClose: TTimer[7] AnchorSideTop.Side = asrCenter
end AnchorSideRight.Control = Owner
end AnchorSideRight.Side = asrBottom
Left = 184
Height = 23
Top = 127
Width = 50
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
MaxValue = 127
MinValue = -128
OnChange = seForceAltitudeChange
TabOrder = 6
end
object cbUseSurfaceAltitude: TCheckBox[8]
AnchorSideLeft.Control = rbRandom
AnchorSideTop.Control = cbUseFreeTilesOnly
AnchorSideTop.Side = asrBottom
Left = 8
Height = 19
Top = 108
Width = 213
BorderSpacing.Top = 12
Caption = 'Брать высоту верхней поверхности'
OnChange = cbUseSurfaceAltitudeChange
TabOrder = 7
end
object seProbability: TFloatSpinEdit[9]
AnchorSideTop.Control = cbProbability
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 176
Height = 23
Top = 54
Width = 58
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 8
Increment = 0.01
MaxValue = 100
MinValue = 0.01
OnChange = seProbabilityChange
TabOrder = 8
Value = 100
end
object cbUseFreeTilesOnly: TCheckBox[10]
AnchorSideLeft.Control = rbRandom
AnchorSideTop.Control = cbProbability
AnchorSideTop.Side = asrBottom
Left = 8
Height = 19
Top = 77
Width = 218
BorderSpacing.Top = 2
Caption = 'Размещать только на пустых тайлах'
TabOrder = 10
end
inherited tmClose: TTimer[11]
left = 200
end
end

View File

@ -1,129 +1,189 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2009 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UfrmDrawSettings; unit UfrmDrawSettings;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Spin, ExtCtrls, LMessages, UfrmToolWindow; Spin, ExtCtrls, LMessages, laz.VirtualTrees, VirtualList, UfrmToolWindow, UfrmMain;
type type
{ TfrmDrawSettings } { TfrmDrawSettings }
TfrmDrawSettings = class(TfrmToolWindow) TfrmDrawSettings = class(TfrmToolWindow)
cbForceAltitude: TCheckBox; cbForceAltitude: TCheckBox;
cbRandomHeight: TCheckBox; cbProbability: TCheckBox;
gbHue: TGroupBox; cbUseSurfaceAltitude: TCheckBox;
pbHue: TPaintBox; cbRandomHeight: TCheckBox;
rbRandom: TRadioButton; cbUseFreeTilesOnly: TCheckBox;
rbTileList: TRadioButton; seProbability: TFloatSpinEdit;
seForceAltitude: TSpinEdit; gbHue: TGroupBox;
seRandomHeight: TSpinEdit; pbHue: TPaintBox;
procedure FormCreate(Sender: TObject); rbRandom: TRadioButton;
procedure pbHueClick(Sender: TObject); rbTileList: TRadioButton;
procedure pbHuePaint(Sender: TObject); seForceAltitude: TSpinEdit;
procedure seForceAltitudeChange(Sender: TObject); seRandomHeight: TSpinEdit;
procedure seRandomHeightChange(Sender: TObject); procedure cbUseSurfaceAltitudeChange(Sender: TObject);
private procedure FormCreate(Sender: TObject);
FCanClose: Boolean; procedure FormShow(Sender: TObject);
function CanClose: Boolean; override; procedure pbHueClick(Sender: TObject);
procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction); procedure pbHuePaint(Sender: TObject);
end; procedure rbRandomChange(Sender: TObject);
procedure seForceAltitudeChange(Sender: TObject);
var procedure seProbabilityChange(Sender: TObject);
frmDrawSettings: TfrmDrawSettings; procedure seRandomHeightChange(Sender: TObject);
private
implementation FCanClose: Boolean;
function CanClose: Boolean; override;
uses procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction);
UGameResources, UHue, UfrmHueSettings; end;
{ TfrmDrawSettings } var
frmDrawSettings: TfrmDrawSettings;
procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
begin implementation
frmHueSettings.Left := Mouse.CursorPos.x - 8;
frmHueSettings.Top := Mouse.CursorPos.y - 8; uses
frmHueSettings.OnClose := @OnHueClose; UGameResources, UHue, UfrmHueSettings, Language;
frmHueSettings.Show;
FCanClose := False; type
end; PTileInfo = ^TTileInfo;
TTileInfo = record
procedure TfrmDrawSettings.FormCreate(Sender: TObject); ID: LongWord;
begin ptr: Pointer;
FCanClose := True; end;
end;
{ TfrmDrawSettings }
procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
var procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
hue: THue; begin
begin frmHueSettings.Left := Mouse.CursorPos.x - 8;
if frmHueSettings <> nil then frmHueSettings.Top := Mouse.CursorPos.y - 8;
begin frmHueSettings.OnClose := @OnHueClose;
if frmHueSettings.lbHue.ItemIndex > 0 then frmHueSettings.Show;
hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1] FCanClose := False;
else end;
hue := nil;
TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect, procedure TfrmDrawSettings.FormCreate(Sender: TObject);
frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]); begin
end; FCanClose := True;
end; cbUseSurfaceAltitudeChange(Sender);
end;
procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject);
begin procedure TfrmDrawSettings.FormShow(Sender: TObject);
cbForceAltitude.Checked := True; var
end; item: PVirtualItem;
tileInfo: PTileInfo;
procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject); selectedID: LongWord;
begin begin
cbRandomHeight.Checked := True; LanguageTranslate(Self);
end; item := frmMain.vdtTiles.GetFirstSelected;
if item <> nil then
function TfrmDrawSettings.CanClose: Boolean; begin
begin tileInfo := frmMain.vdtTiles.GetNodeData(item);
Result := FCanClose and inherited CanClose; selectedID := tileInfo^.ID;
end; end;
if (selectedID < $4000) or (selectedID >= $2F000000)
procedure TfrmDrawSettings.OnHueClose(Sender: TObject; then begin
var ACloseAction: TCloseAction); cbUseFreeTilesOnly.Checked:= False;
var cbUseFreeTilesOnly.Enabled:= False;
msg: TLMessage; if (selectedID >= $2F000000) then
begin cbProbability.Enabled:= False;
FCanClose := True; end else begin
frmHueSettings.OnClose := nil; cbUseFreeTilesOnly.Enabled:= True;
pbHue.Repaint; cbProbability.Enabled:= True;
MouseLeave(msg); end;
end;
(frmDrawSettings as TfrmToolWindow).FormShow(Sender);
initialization end;
{$I UfrmDrawSettings.lrs}
procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
end. var
hue: THue;
begin
if frmHueSettings <> nil then
begin
if frmHueSettings.lbHue.ItemIndex > 0 then
hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1]
else
hue := nil;
TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect,
frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]);
end;
end;
procedure TfrmDrawSettings.rbRandomChange(Sender: TObject);
begin
if frmMain.mnuAutoHideRandomList.Checked then
frmMain.mnuAutoHideRandomListClick(Sender);
end;
procedure TfrmDrawSettings.seProbabilityChange(Sender: TObject);
begin
cbProbability.Checked := (seProbability.Value < seProbability.MaxValue);
end;
procedure TfrmDrawSettings.cbUseSurfaceAltitudeChange(Sender: TObject);
begin
cbForceAltitude.Enabled := not cbUseSurfaceAltitude.Checked;
seForceAltitude.Enabled := not cbUseSurfaceAltitude.Checked;
end;
procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject);
begin
cbForceAltitude.Checked := True;
end;
procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject);
begin
cbRandomHeight.Checked := (seRandomHeight.Value <> 0);
end;
function TfrmDrawSettings.CanClose: Boolean;
begin
Result := FCanClose and inherited CanClose;
end;
procedure TfrmDrawSettings.OnHueClose(Sender: TObject;
var ACloseAction: TCloseAction);
var
msg: TLMessage;
begin
FCanClose := True;
frmHueSettings.OnClose := nil;
pbHue.Repaint;
MouseLeave(msg);
end;
initialization
{$I UfrmDrawSettings.lrs}
end.

View File

@ -1,24 +1,25 @@
inherited frmElevateSettings: TfrmElevateSettings inherited frmElevateSettings: TfrmElevateSettings
Left = 290 Left = 1502
Height = 114 Height = 114
Top = 171 Top = 189
Width = 250 Width = 250
Caption = 'Elevate' Caption = 'Изменение высоты'
ClientHeight = 114 ClientHeight = 114
ClientWidth = 250 ClientWidth = 250
OnCreate = FormCreate
object rbRaise: TRadioButton[0] object rbRaise: TRadioButton[0]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
Left = 8 Left = 8
Height = 19 Height = 19
Top = 8 Top = 8
Width = 47 Width = 66
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = 'Raise' Caption = 'Поднять'
Checked = True Checked = True
State = cbChecked
TabOrder = 2 TabOrder = 2
TabStop = True
end end
object rbLower: TRadioButton[1] object rbLower: TRadioButton[1]
AnchorSideLeft.Control = rbRaise AnchorSideLeft.Control = rbRaise
@ -27,10 +28,9 @@ inherited frmElevateSettings: TfrmElevateSettings
Left = 8 Left = 8
Height = 19 Height = 19
Top = 27 Top = 27
Width = 52 Width = 71
Caption = 'Lower' Caption = 'Опустить'
TabOrder = 0 TabOrder = 0
TabStop = False
end end
object rbSet: TRadioButton[2] object rbSet: TRadioButton[2]
AnchorSideLeft.Control = rbLower AnchorSideLeft.Control = rbLower
@ -39,10 +39,9 @@ inherited frmElevateSettings: TfrmElevateSettings
Left = 8 Left = 8
Height = 19 Height = 19
Top = 46 Top = 46
Width = 36 Width = 56
Caption = 'Set' Caption = 'Задать'
TabOrder = 1 TabOrder = 1
TabStop = False
end end
object cbRandomHeight: TCheckBox[3] object cbRandomHeight: TCheckBox[3]
AnchorSideLeft.Control = rbSet AnchorSideLeft.Control = rbSet
@ -51,9 +50,9 @@ inherited frmElevateSettings: TfrmElevateSettings
Left = 8 Left = 8
Height = 19 Height = 19
Top = 81 Top = 81
Width = 135 Width = 163
BorderSpacing.Top = 16 BorderSpacing.Top = 16
Caption = 'Add Random Altitude' Caption = 'Добавить к высоте (случ.)'
TabOrder = 3 TabOrder = 3
end end
object seRandomHeight: TSpinEdit[4] object seRandomHeight: TSpinEdit[4]
@ -63,8 +62,8 @@ inherited frmElevateSettings: TfrmElevateSettings
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 197 Left = 197
Height = 25 Height = 23
Top = 78 Top = 79
Width = 45 Width = 45
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 8 BorderSpacing.Right = 8
@ -79,8 +78,8 @@ inherited frmElevateSettings: TfrmElevateSettings
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 197 Left = 197
Height = 25 Height = 23
Top = 24 Top = 25
Width = 45 Width = 45
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 8 BorderSpacing.Right = 8
@ -89,4 +88,6 @@ inherited frmElevateSettings: TfrmElevateSettings
TabOrder = 5 TabOrder = 5
Value = 1 Value = 1
end end
inherited tmClose: TTimer[6]
end
end end

Some files were not shown because too many files have changed in this diff Show More