Compare commits
10 Commits
| Author | SHA1 | Date |
|---|---|---|
 Andreas Schneider
|
c393dfc799 | |
|
Andreas Schneider
|
bcb05e94df | |
|
Andreas Schneider
|
38e0d404db | |
|
Andreas Schneider
|
2b8eb45ccf | |
|
Andreas Schneider
|
98b69e9d03 | |
|
Andreas Schneider
|
6155d91a89 | |
|
Andreas Schneider
|
58b24b35ec | |
|
Andreas Schneider
|
fe6b65844f | |
|
Andreas Schneider
|
34637d40ce | |
|
Andreas Schneider
|
2e62fd570a |
|
|
@ -1,8 +1,8 @@
|
|||
#syntax: regexp
|
||||
#(?<!\.(pas|lfm|lpr|lpi))$
|
||||
syntax: glob
|
||||
obj/*
|
||||
bin/*
|
||||
dist/*
|
||||
Client.bin/*
|
||||
Server.bin/*
|
||||
doc/*
|
||||
pasdoc/*
|
||||
Setup/*
|
||||
|
|
@ -23,3 +23,4 @@ Setup/*
|
|||
*.compiled
|
||||
*.sh
|
||||
*.exe
|
||||
*.res
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 5.4 KiB After Width: | Height: | Size: 5.3 KiB |
|
|
@ -1,33 +1,223 @@
|
|||
<?xml version="1.0"?>
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="7"/>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasUsesSectionForAllUnits Value="False"/>
|
||||
<AlwaysBuild Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<TargetFileExt Value=".exe"/>
|
||||
<Title Value="CentrED"/>
|
||||
<LFMResourceType Value="res"/>
|
||||
<Title Value="CentrED+"/>
|
||||
<ResourceType Value="res"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<LazDoc Paths="../doc"/>
|
||||
<VersionInfo>
|
||||
<UseVersionInfo Value="True"/>
|
||||
<CurrentMajorRevNr Value="6"/>
|
||||
<CurrentMinorRevNr Value="1"/>
|
||||
<CurrentBuildNr Value="209"/>
|
||||
<ProjectVersion Value="0.6.1.209"/>
|
||||
<CompanyName Value="AKS DataBasis"/>
|
||||
<FileDescription Value="UO CentrED"/>
|
||||
<InternalName Value="CentrED"/>
|
||||
<LegalCopyright Value="Andreas Schneider"/>
|
||||
<OriginalFilename Value="CentrED.exe"/>
|
||||
<ProductName Value="CentrED"/>
|
||||
<AutoIncrementBuild Value="True"/>
|
||||
<MinorVersionNr Value="7"/>
|
||||
<RevisionNr Value="8"/>
|
||||
<BuildNr Value="1760"/>
|
||||
<Language Value="0419"/>
|
||||
<StringTable CompanyName="www.uoquint.ru" FileDescription="UO CentrED+" InternalName="CentrED+" LegalCopyright="StaticZ" OriginalFilename="CentrED-plus.exe" ProductName="CentrED+" ProductVersion="0.7.8"/>
|
||||
</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>
|
||||
<Version Value="2"/>
|
||||
<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)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="5">
|
||||
<RequiredPackages Count="6">
|
||||
<Item1>
|
||||
<PackageName Value="multiloglaz"/>
|
||||
<PackageName Value="lclextensions_package"/>
|
||||
<MinVersion Minor="3" Valid="True"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LazOpenGLContext"/>
|
||||
<MinVersion Valid="True"/>
|
||||
<PackageName Value="multiloglaz"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="LCL"/>
|
||||
<PackageName Value="LazOpenGLContext"/>
|
||||
<MinVersion Valid="True"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="lnetvisual"/>
|
||||
<MinVersion Minor="5" Release="3" Valid="True"/>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<PackageName Value="virtualtreeview_package"/>
|
||||
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
|
||||
<PackageName Value="lnetvisual"/>
|
||||
<MinVersion Minor="5" Release="3" Valid="True"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<PackageName Value="laz.virtualtreeview_package"/>
|
||||
</Item6>
|
||||
</RequiredPackages>
|
||||
<Units Count="46">
|
||||
<Units Count="60">
|
||||
<Unit0>
|
||||
<Filename Value="CentrED.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="CentrED"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="UfrmMain.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmMain"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmMain"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="UdmNetwork.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="dmNetwork"/>
|
||||
<ResourceBaseClass Value="DataModule"/>
|
||||
<UnitName Value="UdmNetwork"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="UfrmLogin.pas"/>
|
||||
|
|
@ -91,118 +282,101 @@
|
|||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmInitialize"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmInitialize"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="UfrmAccountControl.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmAccountControl"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmAccountControl"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="UfrmEditAccount.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmEditAccount"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmEditAccount"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="Tools/UfrmDrawSettings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmDrawSettings"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmDrawSettings"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="Tools/UfrmBoundaries.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmBoundaries"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmBoundaries"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="Tools/UfrmElevateSettings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmElevateSettings"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmElevateSettings"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
<Filename Value="UOverlayUI.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UOverlayUI"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="UResourceManager.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UResourceManager"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="Tools/UfrmConfirmation.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmConfirmation"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmConfirmation"/>
|
||||
</Unit12>
|
||||
<Unit13>
|
||||
<Filename Value="Tools/UfrmMoveSettings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmMoveSettings"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmMoveSettings"/>
|
||||
</Unit13>
|
||||
<Unit14>
|
||||
<Filename Value="UfrmAbout.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmAbout"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmAbout"/>
|
||||
</Unit14>
|
||||
<Unit15>
|
||||
<Filename Value="Tools/UfrmHueSettings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmHueSettings"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmHueSettings"/>
|
||||
</Unit15>
|
||||
<Unit16>
|
||||
<Filename Value="UfrmRadar.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmRadarMap"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmRadar"/>
|
||||
</Unit16>
|
||||
<Unit17>
|
||||
<Filename Value="UfrmLargeScaleCommand.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmLargeScaleCommand"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmLargeScaleCommand"/>
|
||||
</Unit17>
|
||||
<Unit18>
|
||||
<Filename Value="Tools/UfrmVirtualLayer.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmVirtualLayer"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmVirtualLayer"/>
|
||||
</Unit18>
|
||||
<Unit19>
|
||||
<Filename Value="Tools/UfrmFilter.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmFilter"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmFilter"/>
|
||||
</Unit19>
|
||||
<Unit20>
|
||||
<Filename Value="UGUIPlatformUtils.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UGUIPlatformUtils"/>
|
||||
</Unit20>
|
||||
<Unit21>
|
||||
<Filename Value="UPlatformTypes.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UPlatformTypes"/>
|
||||
</Unit21>
|
||||
<Unit22>
|
||||
<Filename Value="UfrmRegionControl.pas"/>
|
||||
|
|
@ -210,99 +384,80 @@
|
|||
<ComponentName Value="frmRegionControl"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmRegionControl"/>
|
||||
</Unit22>
|
||||
<Unit23>
|
||||
<Filename Value="UPacketHandlers.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UPacketHandlers"/>
|
||||
</Unit23>
|
||||
<Unit24>
|
||||
<Filename Value="UPackets.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UPackets"/>
|
||||
</Unit24>
|
||||
<Unit25>
|
||||
<Filename Value="ULandscape.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ULandscape"/>
|
||||
</Unit25>
|
||||
<Unit26>
|
||||
<Filename Value="UGameResources.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UGameResources"/>
|
||||
</Unit26>
|
||||
<Unit27>
|
||||
<Filename Value="UAdminHandling.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UAdminHandling"/>
|
||||
</Unit27>
|
||||
<Unit28>
|
||||
<Filename Value="Tools/UfrmToolWindow.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmToolWindow"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmToolWindow"/>
|
||||
</Unit28>
|
||||
<Unit29>
|
||||
<Filename Value="../Logging.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Logging"/>
|
||||
</Unit29>
|
||||
<Unit30>
|
||||
<Filename Value="../UOLib/UStatics.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UStatics"/>
|
||||
</Unit30>
|
||||
<Unit31>
|
||||
<Filename Value="../UOLib/UWorldItem.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UWorldItem"/>
|
||||
</Unit31>
|
||||
<Unit32>
|
||||
<Filename Value="../UOLib/UMap.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UMap"/>
|
||||
</Unit32>
|
||||
<Unit33>
|
||||
<Filename Value="../UOLib/UTiledata.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UTiledata"/>
|
||||
</Unit33>
|
||||
<Unit34>
|
||||
<Filename Value="UGLFont.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UGLFont"/>
|
||||
</Unit34>
|
||||
<Unit35>
|
||||
<Filename Value="../UOLib/UAnimData.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UAnimData"/>
|
||||
</Unit35>
|
||||
<Unit36>
|
||||
<Filename Value="../MulProvider/UTileDataProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UTileDataProvider"/>
|
||||
</Unit36>
|
||||
<Unit37>
|
||||
<Filename Value="../MulProvider/UAnimDataProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UAnimDataProvider"/>
|
||||
</Unit37>
|
||||
<Unit38>
|
||||
<Filename Value="../MulProvider/UMulManager.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UMulManager"/>
|
||||
</Unit38>
|
||||
<Unit39>
|
||||
<Filename Value="../MulProvider/UArtProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UArtProvider"/>
|
||||
</Unit39>
|
||||
<Unit40>
|
||||
<Filename Value="../MulProvider/UTexmapProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="UTexmapProvider"/>
|
||||
</Unit40>
|
||||
<Unit41>
|
||||
<Filename Value="../version.inc"/>
|
||||
|
|
@ -311,56 +466,123 @@
|
|||
<Unit42>
|
||||
<Filename Value="ULightManager.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ULightManager"/>
|
||||
</Unit42>
|
||||
<Unit43>
|
||||
<Filename Value="../UOLib/ULight.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ULight"/>
|
||||
</Unit43>
|
||||
<Unit44>
|
||||
<Filename Value="../MulProvider/ULightProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ULightProvider"/>
|
||||
</Unit44>
|
||||
<Unit45>
|
||||
<Filename Value="Tools/UfrmLightlevel.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmLightlevel"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmLightlevel"/>
|
||||
</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>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="8"/>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../bin/CentrED"/>
|
||||
<Filename Value="../bin/PEBinaries/CentrED-plus"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)/;../Imaging/;../"/>
|
||||
<OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/;../Imaging/JpegLib/;../Imaging/ZLib/;Tools/"/>
|
||||
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
|
||||
<SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/;../;../UOLib/;../MulProvider/;../Imaging/;../Imaging/JpegLib/;../Imaging/ZLib/;Tools/"/>
|
||||
<IncludeFiles Value="..;../obj;../Imaging;$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="Tools;..;../UOLib;../Server;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;GUI"/>
|
||||
<UnitOutputDirectory Value="../obj"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<CStyleOperator Value="False"/>
|
||||
<UseAnsiStrings Value="True"/>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
<Checks>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
</Checks>
|
||||
<Optimizations>
|
||||
<OptimizationLevel Value="3"/>
|
||||
</Optimizations>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseLineInfoUnit Value="False"/>
|
||||
<StripSymbols Value="True"/>
|
||||
<DebugInfoType Value="dsStabs"/>
|
||||
</Debugging>
|
||||
<LinkSmart Value="True"/>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
|
|
@ -369,11 +591,10 @@
|
|||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
|
||||
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-FE../bin/
|
||||
-dNoLogging"/>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
<CustomOptions Value="-FE../bin/PEBinaries/
|
||||
+-dNoLogging"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
|
|
|
|||
|
|
@ -1,52 +1,143 @@
|
|||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
program CentrED;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
SysUtils,
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, LResources, UdmNetwork;
|
||||
|
||||
{$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF}
|
||||
|
||||
function GetApplicationName: String;
|
||||
begin
|
||||
Result := 'CentrED';
|
||||
end;
|
||||
|
||||
begin
|
||||
{$I CentrED.lrs}
|
||||
OnGetApplicationName := @GetApplicationName;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TdmNetwork, dmNetwork);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2015 Andreas Schneider
|
||||
* Portions Copyright 2015 StaticZ
|
||||
*)
|
||||
program CentrED;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Classes, SysUtils,
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
LCLType, Forms, Dialogs, UdmNetwork, UResourceManager, Graphics;
|
||||
|
||||
{$R CentrED.res}
|
||||
//{$R CentrED.manifest.rc}
|
||||
|
||||
function GetApplicationName: String;
|
||||
begin
|
||||
Result := 'CentrED-plus';
|
||||
end;
|
||||
|
||||
function LoadCursorFromRes(AFileName: string; CurFormat: Boolean = True): HCURSOR;
|
||||
type
|
||||
TIconHeader = packed record
|
||||
hReserved: WORD; // = 0
|
||||
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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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">
|
||||
<assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>
|
||||
<description>Your application description here.</description>
|
||||
<dependency>
|
||||
<dependentAssembly>
|
||||
<assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>
|
||||
</dependentAssembly>
|
||||
</dependency>
|
||||
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
|
||||
<security>
|
||||
<requestedPrivileges>
|
||||
<requestedExecutionLevel level="asInvoker" uiAccess="false"/>
|
||||
</requestedPrivileges>
|
||||
</security>
|
||||
</trustInfo>
|
||||
</assembly>
|
||||
<assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="CompanyName.ProductName.YourApp" type="win32"/>
|
||||
<description>Your application description here.</description>
|
||||
<dependency>
|
||||
<dependentAssembly>
|
||||
<assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="*" publicKeyToken="6595b64144ccf1df" language="*"/>
|
||||
</dependentAssembly>
|
||||
</dependency>
|
||||
<trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
|
||||
<security>
|
||||
<requestedPrivileges>
|
||||
<requestedExecutionLevel level="requestedexecutionlevel" uiAccess="false"/>
|
||||
</requestedPrivileges>
|
||||
</security>
|
||||
</trustInfo>
|
||||
<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>
|
||||
|
|
|
|||
|
|
@ -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 |
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 |
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.
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 |
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.
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 |
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 |
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 |
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 |
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.
Binary file not shown.
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
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.
Binary file not shown.
|
After Width: | Height: | Size: 165 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 148 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 6.6 KiB |
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 |
|
|
@ -1,5 +1,40 @@
|
|||
Sounds/MusicInf.wav
|
||||
GLFont/DejaVu.png
|
||||
GLFont/DejaVu.fnt
|
||||
Overlay/LeftTopArrow.tga
|
||||
Overlay/TopArrow.tga
|
||||
Overlay/VirtualLayer.tga
|
||||
GLFont/DejaVu.png
|
||||
GLFont/DejaVu.fnt
|
||||
Overlay/LightBulb_24nn.tga
|
||||
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
|
||||
Binary file not shown.
|
|
@ -1,47 +1,313 @@
|
|||
inherited frmBoundaries: TfrmBoundaries
|
||||
Left = 290
|
||||
Height = 164
|
||||
Top = 171
|
||||
Width = 205
|
||||
Caption = 'Boundaries'
|
||||
ClientHeight = 164
|
||||
ClientWidth = 205
|
||||
object lblMaxZ: TLabel[0]
|
||||
Left = 1259
|
||||
Height = 141
|
||||
Top = 502
|
||||
Width = 403
|
||||
Anchors = [akTop, akLeft, akBottom]
|
||||
Caption = 'Границы видимости'
|
||||
ClientHeight = 141
|
||||
ClientWidth = 403
|
||||
OnCreate = FormCreate
|
||||
object tbMaxZ: TTrackBar[0]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = seMaxZ
|
||||
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
|
||||
AnchorSideTop.Control = tbMinZ
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 36
|
||||
Top = 41
|
||||
Width = 189
|
||||
Height = 30
|
||||
Top = 28
|
||||
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
|
||||
Max = 127
|
||||
Min = -128
|
||||
|
|
@ -52,58 +318,7 @@ inherited frmBoundaries: TfrmBoundaries
|
|||
BorderSpacing.Around = 8
|
||||
TabOrder = 0
|
||||
end
|
||||
object tbMaxZ: TTrackBar[3]
|
||||
AnchorSideLeft.Control = Owner
|
||||
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
|
||||
inherited tmClose: TTimer[4]
|
||||
left = 312
|
||||
end
|
||||
end
|
||||
|
|
|
|||
|
|
@ -31,20 +31,39 @@ interface
|
|||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
ComCtrls, Spin, ExtCtrls, UfrmToolWindow;
|
||||
ComCtrls, Spin, ExtCtrls, Buttons, UfrmToolWindow;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmBoundaries }
|
||||
|
||||
TfrmBoundaries = class(TfrmToolWindow)
|
||||
GroupBox1: TGroupBox;
|
||||
GroupBox2: TGroupBox;
|
||||
lblAxeX1: TLabel;
|
||||
lblAxeY1: TLabel;
|
||||
lblMaxZ: TLabel;
|
||||
lblMinZ: TLabel;
|
||||
lblAxeX: TLabel;
|
||||
lblAxeY: TLabel;
|
||||
seMaxZ: TSpinEdit;
|
||||
seMinZ: TSpinEdit;
|
||||
seMaxX: TSpinEdit;
|
||||
seMaxY: TSpinEdit;
|
||||
seMinY: TSpinEdit;
|
||||
seMinX: TSpinEdit;
|
||||
sbClearXbnd: TSpeedButton;
|
||||
sbClearYbnd: TSpeedButton;
|
||||
tbMinZ: 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 seMinXChange(Sender: TObject);
|
||||
procedure seMinYChange(Sender: TObject);
|
||||
procedure seMinZChange(Sender: TObject);
|
||||
procedure tbMaxZChange(Sender: TObject);
|
||||
procedure tbMinZChange(Sender: TObject);
|
||||
|
|
@ -58,30 +77,101 @@ var
|
|||
implementation
|
||||
|
||||
uses
|
||||
UfrmMain;
|
||||
UfrmMain, Language;
|
||||
|
||||
{ TfrmBoundaries }
|
||||
|
||||
procedure TfrmBoundaries.seMaxZChange(Sender: TObject);
|
||||
procedure TfrmBoundaries.FormCreate(Sender: TObject);
|
||||
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;
|
||||
end;
|
||||
|
||||
procedure TfrmBoundaries.seMinZChange(Sender: TObject);
|
||||
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;
|
||||
tbMaxZ.Position := seMaxZ.Value;
|
||||
frmMain.InvalidateFilter;
|
||||
end;
|
||||
|
||||
procedure TfrmBoundaries.tbMaxZChange(Sender: TObject);
|
||||
procedure TfrmBoundaries.seMaxZChange(Sender: TObject);
|
||||
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;
|
||||
end;
|
||||
|
||||
procedure TfrmBoundaries.tbMinZChange(Sender: TObject);
|
||||
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;
|
||||
frmMain.InvalidateFilter;
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -1,37 +1,36 @@
|
|||
object frmConfirmation: TfrmConfirmation
|
||||
Left = 290
|
||||
Height = 43
|
||||
Top = 171
|
||||
Width = 108
|
||||
BorderIcons = []
|
||||
BorderStyle = bsToolWindow
|
||||
Caption = 'Apply?'
|
||||
ClientHeight = 43
|
||||
ClientWidth = 108
|
||||
Font.Height = -11
|
||||
LCLVersion = '0.9.25'
|
||||
object btnYes: TButton
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Yes'
|
||||
Default = True
|
||||
ModalResult = 6
|
||||
ParentFont = True
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnNo: TButton
|
||||
Left = 56
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Cancel = True
|
||||
Caption = 'No'
|
||||
ModalResult = 7
|
||||
ParentFont = True
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
object frmConfirmation: TfrmConfirmation
|
||||
Left = 1559
|
||||
Height = 43
|
||||
Top = 261
|
||||
Width = 116
|
||||
BorderIcons = []
|
||||
BorderStyle = bsToolWindow
|
||||
Caption = 'Подтвердить?'
|
||||
ClientHeight = 43
|
||||
ClientWidth = 116
|
||||
Font.Height = -11
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '0.9.30.2'
|
||||
object btnYes: TButton
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Да'
|
||||
Default = True
|
||||
ModalResult = 6
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnNo: TButton
|
||||
Left = 56
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Cancel = True
|
||||
Caption = 'Нет'
|
||||
ModalResult = 7
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,57 +1,67 @@
|
|||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
*)
|
||||
unit UfrmConfirmation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmConfirmation }
|
||||
|
||||
TfrmConfirmation = class(TForm)
|
||||
btnYes: TButton;
|
||||
btnNo: TButton;
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmConfirmation: TfrmConfirmation;
|
||||
|
||||
implementation
|
||||
|
||||
initialization
|
||||
{$I UfrmConfirmation.lrs}
|
||||
|
||||
end.
|
||||
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2007 Andreas Schneider
|
||||
*)
|
||||
unit UfrmConfirmation;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmConfirmation }
|
||||
|
||||
TfrmConfirmation = class(TForm)
|
||||
btnYes: TButton;
|
||||
btnNo: TButton;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmConfirmation: TfrmConfirmation;
|
||||
|
||||
implementation
|
||||
|
||||
uses Language;
|
||||
|
||||
{ TfrmConfirmation }
|
||||
|
||||
procedure TfrmConfirmation.FormCreate(Sender: TObject);
|
||||
begin
|
||||
LanguageTranslate(Self);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmConfirmation.lrs}
|
||||
|
||||
end.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,123 +1,181 @@
|
|||
inherited frmDrawSettings: TfrmDrawSettings
|
||||
Left = 268
|
||||
Height = 180
|
||||
Top = 165
|
||||
Width = 242
|
||||
ActiveControl = rbTileList
|
||||
Caption = 'Draw settings'
|
||||
ClientHeight = 180
|
||||
ClientWidth = 242
|
||||
OnCreate = FormCreate
|
||||
object rbTileList: TRadioButton[0]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 8
|
||||
Width = 146
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Bottom = 4
|
||||
Caption = 'Use tile from the list'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 0
|
||||
end
|
||||
object rbRandom: TRadioButton[1]
|
||||
AnchorSideLeft.Control = rbTileList
|
||||
AnchorSideTop.Control = rbTileList
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 34
|
||||
Width = 213
|
||||
BorderSpacing.Top = 4
|
||||
Caption = 'Use tiles from the random pool'
|
||||
TabOrder = 1
|
||||
TabStop = False
|
||||
end
|
||||
object gbHue: TGroupBox[2]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = seRandomHeight
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 49
|
||||
Top = 132
|
||||
Width = 226
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 8
|
||||
Caption = 'Hue (Statics only)'
|
||||
ClientHeight = 45
|
||||
ClientWidth = 222
|
||||
TabOrder = 2
|
||||
object pbHue: TPaintBox
|
||||
Cursor = crHandPoint
|
||||
Left = 4
|
||||
Height = 41
|
||||
Top = 0
|
||||
Width = 214
|
||||
Align = alClient
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.Bottom = 4
|
||||
OnClick = pbHueClick
|
||||
OnPaint = pbHuePaint
|
||||
end
|
||||
end
|
||||
object cbRandomHeight: TCheckBox[3]
|
||||
AnchorSideLeft.Control = cbForceAltitude
|
||||
AnchorSideTop.Control = cbForceAltitude
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 102
|
||||
Width = 149
|
||||
BorderSpacing.Top = 12
|
||||
Caption = 'Add Random Altitude'
|
||||
TabOrder = 3
|
||||
end
|
||||
object seRandomHeight: TSpinEdit[4]
|
||||
AnchorSideTop.Control = cbRandomHeight
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 184
|
||||
Height = 21
|
||||
Top = 103
|
||||
Width = 50
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
TabOrder = 4
|
||||
end
|
||||
object cbForceAltitude: TCheckBox[5]
|
||||
AnchorSideLeft.Control = rbRandom
|
||||
AnchorSideTop.Control = rbRandom
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 22
|
||||
Top = 68
|
||||
Width = 111
|
||||
BorderSpacing.Top = 12
|
||||
Caption = 'Force altitude:'
|
||||
TabOrder = 5
|
||||
end
|
||||
object seForceAltitude: TSpinEdit[6]
|
||||
AnchorSideTop.Control = cbForceAltitude
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 184
|
||||
Height = 21
|
||||
Top = 69
|
||||
Width = 50
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
MaxValue = 127
|
||||
MinValue = -128
|
||||
TabOrder = 6
|
||||
end
|
||||
inherited tmClose: TTimer[7]
|
||||
end
|
||||
end
|
||||
inherited frmDrawSettings: TfrmDrawSettings
|
||||
Left = 1224
|
||||
Height = 240
|
||||
Top = 636
|
||||
Width = 242
|
||||
Caption = 'Опции рисования'
|
||||
ClientHeight = 240
|
||||
ClientWidth = 242
|
||||
OnCreate = FormCreate
|
||||
OnShow = FormShow
|
||||
object cbProbability: TCheckBox[0]
|
||||
AnchorSideLeft.Control = rbRandom
|
||||
AnchorSideTop.Control = rbRandom
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 19
|
||||
Top = 56
|
||||
Width = 170
|
||||
BorderSpacing.Top = 6
|
||||
Caption = 'Размещать тайл с шансом:'
|
||||
TabOrder = 9
|
||||
end
|
||||
object rbTileList: TRadioButton[1]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 8
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 170
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Bottom = 4
|
||||
Caption = 'Выбранный тайл из списка'
|
||||
Checked = True
|
||||
TabOrder = 0
|
||||
TabStop = True
|
||||
end
|
||||
object rbRandom: TRadioButton[2]
|
||||
AnchorSideLeft.Control = rbTileList
|
||||
AnchorSideTop.Control = rbTileList
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 19
|
||||
Top = 31
|
||||
Width = 170
|
||||
BorderSpacing.Top = 4
|
||||
Caption = 'Случайный тайл из набора'
|
||||
OnChange = rbRandomChange
|
||||
TabOrder = 1
|
||||
end
|
||||
object gbHue: TGroupBox[3]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = seRandomHeight
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 49
|
||||
Top = 185
|
||||
Width = 226
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 8
|
||||
Caption = 'Цвет (Только для Статики)'
|
||||
ClientHeight = 31
|
||||
ClientWidth = 222
|
||||
TabOrder = 2
|
||||
object pbHue: TPaintBox
|
||||
Cursor = crHandPoint
|
||||
Left = 4
|
||||
Height = 27
|
||||
Top = 0
|
||||
Width = 214
|
||||
Align = alClient
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.Bottom = 4
|
||||
OnClick = pbHueClick
|
||||
OnPaint = pbHuePaint
|
||||
end
|
||||
end
|
||||
object cbRandomHeight: TCheckBox[4]
|
||||
AnchorSideLeft.Control = cbForceAltitude
|
||||
AnchorSideTop.Control = cbForceAltitude
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 19
|
||||
Top = 156
|
||||
Width = 163
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Добавить к высоте (случ):'
|
||||
TabOrder = 3
|
||||
end
|
||||
object seRandomHeight: TSpinEdit[5]
|
||||
AnchorSideTop.Control = cbRandomHeight
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 184
|
||||
Height = 23
|
||||
Top = 154
|
||||
Width = 50
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
OnChange = seRandomHeightChange
|
||||
TabOrder = 4
|
||||
end
|
||||
object cbForceAltitude: TCheckBox[6]
|
||||
AnchorSideLeft.Control = rbRandom
|
||||
AnchorSideTop.Control = cbUseSurfaceAltitude
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 19
|
||||
Top = 129
|
||||
Width = 135
|
||||
BorderSpacing.Top = 2
|
||||
Caption = 'Задать фикс. высоту:'
|
||||
TabOrder = 5
|
||||
end
|
||||
object seForceAltitude: TSpinEdit[7]
|
||||
AnchorSideTop.Control = cbForceAltitude
|
||||
AnchorSideTop.Side = asrCenter
|
||||
AnchorSideRight.Control = Owner
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,129 +1,189 @@
|
|||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UfrmDrawSettings;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
Spin, ExtCtrls, LMessages, UfrmToolWindow;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmDrawSettings }
|
||||
|
||||
TfrmDrawSettings = class(TfrmToolWindow)
|
||||
cbForceAltitude: TCheckBox;
|
||||
cbRandomHeight: TCheckBox;
|
||||
gbHue: TGroupBox;
|
||||
pbHue: TPaintBox;
|
||||
rbRandom: TRadioButton;
|
||||
rbTileList: TRadioButton;
|
||||
seForceAltitude: TSpinEdit;
|
||||
seRandomHeight: TSpinEdit;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure pbHueClick(Sender: TObject);
|
||||
procedure pbHuePaint(Sender: TObject);
|
||||
procedure seForceAltitudeChange(Sender: TObject);
|
||||
procedure seRandomHeightChange(Sender: TObject);
|
||||
private
|
||||
FCanClose: Boolean;
|
||||
function CanClose: Boolean; override;
|
||||
procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction);
|
||||
end;
|
||||
|
||||
var
|
||||
frmDrawSettings: TfrmDrawSettings;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UGameResources, UHue, UfrmHueSettings;
|
||||
|
||||
{ TfrmDrawSettings }
|
||||
|
||||
procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
|
||||
begin
|
||||
frmHueSettings.Left := Mouse.CursorPos.x - 8;
|
||||
frmHueSettings.Top := Mouse.CursorPos.y - 8;
|
||||
frmHueSettings.OnClose := @OnHueClose;
|
||||
frmHueSettings.Show;
|
||||
FCanClose := False;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FCanClose := True;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
|
||||
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.seForceAltitudeChange(Sender: TObject);
|
||||
begin
|
||||
cbForceAltitude.Checked := True;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject);
|
||||
begin
|
||||
cbRandomHeight.Checked := True;
|
||||
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.
|
||||
|
||||
(*
|
||||
* CDDL HEADER START
|
||||
*
|
||||
* The contents of this file are subject to the terms of the
|
||||
* Common Development and Distribution License, Version 1.0 only
|
||||
* (the "License"). You may not use this file except in compliance
|
||||
* with the License.
|
||||
*
|
||||
* You can obtain a copy of the license at
|
||||
* http://www.opensource.org/licenses/cddl1.php.
|
||||
* See the License for the specific language governing permissions
|
||||
* and limitations under the License.
|
||||
*
|
||||
* When distributing Covered Code, include this CDDL HEADER in each
|
||||
* file and include the License file at
|
||||
* http://www.opensource.org/licenses/cddl1.php. If applicable,
|
||||
* add the following below this CDDL HEADER, with the fields enclosed
|
||||
* by brackets "[]" replaced with your own identifying * information:
|
||||
* Portions Copyright [yyyy] [name of copyright owner]
|
||||
*
|
||||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UfrmDrawSettings;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
Spin, ExtCtrls, LMessages, laz.VirtualTrees, VirtualList, UfrmToolWindow, UfrmMain;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmDrawSettings }
|
||||
|
||||
TfrmDrawSettings = class(TfrmToolWindow)
|
||||
cbForceAltitude: TCheckBox;
|
||||
cbProbability: TCheckBox;
|
||||
cbUseSurfaceAltitude: TCheckBox;
|
||||
cbRandomHeight: TCheckBox;
|
||||
cbUseFreeTilesOnly: TCheckBox;
|
||||
seProbability: TFloatSpinEdit;
|
||||
gbHue: TGroupBox;
|
||||
pbHue: TPaintBox;
|
||||
rbRandom: TRadioButton;
|
||||
rbTileList: TRadioButton;
|
||||
seForceAltitude: TSpinEdit;
|
||||
seRandomHeight: TSpinEdit;
|
||||
procedure cbUseSurfaceAltitudeChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure pbHueClick(Sender: TObject);
|
||||
procedure pbHuePaint(Sender: TObject);
|
||||
procedure rbRandomChange(Sender: TObject);
|
||||
procedure seForceAltitudeChange(Sender: TObject);
|
||||
procedure seProbabilityChange(Sender: TObject);
|
||||
procedure seRandomHeightChange(Sender: TObject);
|
||||
private
|
||||
FCanClose: Boolean;
|
||||
function CanClose: Boolean; override;
|
||||
procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction);
|
||||
end;
|
||||
|
||||
var
|
||||
frmDrawSettings: TfrmDrawSettings;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
UGameResources, UHue, UfrmHueSettings, Language;
|
||||
|
||||
type
|
||||
PTileInfo = ^TTileInfo;
|
||||
TTileInfo = record
|
||||
ID: LongWord;
|
||||
ptr: Pointer;
|
||||
end;
|
||||
|
||||
{ TfrmDrawSettings }
|
||||
|
||||
procedure TfrmDrawSettings.pbHueClick(Sender: TObject);
|
||||
begin
|
||||
frmHueSettings.Left := Mouse.CursorPos.x - 8;
|
||||
frmHueSettings.Top := Mouse.CursorPos.y - 8;
|
||||
frmHueSettings.OnClose := @OnHueClose;
|
||||
frmHueSettings.Show;
|
||||
FCanClose := False;
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FCanClose := True;
|
||||
cbUseSurfaceAltitudeChange(Sender);
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.FormShow(Sender: TObject);
|
||||
var
|
||||
item: PVirtualItem;
|
||||
tileInfo: PTileInfo;
|
||||
selectedID: LongWord;
|
||||
begin
|
||||
LanguageTranslate(Self);
|
||||
item := frmMain.vdtTiles.GetFirstSelected;
|
||||
if item <> nil then
|
||||
begin
|
||||
tileInfo := frmMain.vdtTiles.GetNodeData(item);
|
||||
selectedID := tileInfo^.ID;
|
||||
end;
|
||||
if (selectedID < $4000) or (selectedID >= $2F000000)
|
||||
then begin
|
||||
cbUseFreeTilesOnly.Checked:= False;
|
||||
cbUseFreeTilesOnly.Enabled:= False;
|
||||
if (selectedID >= $2F000000) then
|
||||
cbProbability.Enabled:= False;
|
||||
end else begin
|
||||
cbUseFreeTilesOnly.Enabled:= True;
|
||||
cbProbability.Enabled:= True;
|
||||
end;
|
||||
|
||||
(frmDrawSettings as TfrmToolWindow).FormShow(Sender);
|
||||
end;
|
||||
|
||||
procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
|
||||
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.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,24 +1,25 @@
|
|||
inherited frmElevateSettings: TfrmElevateSettings
|
||||
Left = 290
|
||||
Left = 1502
|
||||
Height = 114
|
||||
Top = 171
|
||||
Top = 189
|
||||
Width = 250
|
||||
Caption = 'Elevate'
|
||||
Caption = 'Изменение высоты'
|
||||
ClientHeight = 114
|
||||
ClientWidth = 250
|
||||
OnCreate = FormCreate
|
||||
object rbRaise: TRadioButton[0]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 8
|
||||
Height = 19
|
||||
Top = 8
|
||||
Width = 47
|
||||
Width = 66
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
Caption = 'Raise'
|
||||
Caption = 'Поднять'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 2
|
||||
TabStop = True
|
||||
end
|
||||
object rbLower: TRadioButton[1]
|
||||
AnchorSideLeft.Control = rbRaise
|
||||
|
|
@ -27,10 +28,9 @@ inherited frmElevateSettings: TfrmElevateSettings
|
|||
Left = 8
|
||||
Height = 19
|
||||
Top = 27
|
||||
Width = 52
|
||||
Caption = 'Lower'
|
||||
Width = 71
|
||||
Caption = 'Опустить'
|
||||
TabOrder = 0
|
||||
TabStop = False
|
||||
end
|
||||
object rbSet: TRadioButton[2]
|
||||
AnchorSideLeft.Control = rbLower
|
||||
|
|
@ -39,10 +39,9 @@ inherited frmElevateSettings: TfrmElevateSettings
|
|||
Left = 8
|
||||
Height = 19
|
||||
Top = 46
|
||||
Width = 36
|
||||
Caption = 'Set'
|
||||
Width = 56
|
||||
Caption = 'Задать'
|
||||
TabOrder = 1
|
||||
TabStop = False
|
||||
end
|
||||
object cbRandomHeight: TCheckBox[3]
|
||||
AnchorSideLeft.Control = rbSet
|
||||
|
|
@ -51,9 +50,9 @@ inherited frmElevateSettings: TfrmElevateSettings
|
|||
Left = 8
|
||||
Height = 19
|
||||
Top = 81
|
||||
Width = 135
|
||||
Width = 163
|
||||
BorderSpacing.Top = 16
|
||||
Caption = 'Add Random Altitude'
|
||||
Caption = 'Добавить к высоте (случ.)'
|
||||
TabOrder = 3
|
||||
end
|
||||
object seRandomHeight: TSpinEdit[4]
|
||||
|
|
@ -63,8 +62,8 @@ inherited frmElevateSettings: TfrmElevateSettings
|
|||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 197
|
||||
Height = 25
|
||||
Top = 78
|
||||
Height = 23
|
||||
Top = 79
|
||||
Width = 45
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
|
|
@ -79,8 +78,8 @@ inherited frmElevateSettings: TfrmElevateSettings
|
|||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 197
|
||||
Height = 25
|
||||
Top = 24
|
||||
Height = 23
|
||||
Top = 25
|
||||
Width = 45
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
|
|
@ -89,4 +88,6 @@ inherited frmElevateSettings: TfrmElevateSettings
|
|||
TabOrder = 5
|
||||
Value = 1
|
||||
end
|
||||
inherited tmClose: TTimer[6]
|
||||
end
|
||||
end
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue