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 |
68
.drone.yml
|
@ -1,68 +0,0 @@
|
|||
---
|
||||
kind: pipeline
|
||||
type: docker
|
||||
name: default
|
||||
|
||||
steps:
|
||||
- name: Build
|
||||
image: git.aksdb.de/aksdb/centred:builder-221016
|
||||
commands:
|
||||
- ~/lazarus/lazbuild --lazarusdir=~/lazarus --build-mode="Release.win32" -B Client/CentrED.lpr
|
||||
- ~/lazarus/lazbuild --lazarusdir=~/lazarus --build-mode="Release.Linux.x64" -B Client/CentrED.lpr
|
||||
- ~/lazarus/lazbuild --lazarusdir=~/lazarus --build-mode="Release.win32" -B Server/cedserver.lpi
|
||||
- ~/lazarus/lazbuild --lazarusdir=~/lazarus --build-mode="Release.Linux.x64" -B Server/cedserver.lpi
|
||||
|
||||
- name: Package
|
||||
image: git.aksdb.de/aksdb/centred:builder-221016
|
||||
commands:
|
||||
- mkdir -p dist/client.win32 dist/client.linux.x64 dist/server.win32 dist/server.linux.x64
|
||||
- cp Client.bin/nodraw.txt Client.bin/ColorLight.xml dist/client.linux.x64/
|
||||
- cp Client.bin/nodraw.txt Client.bin/ColorLight.xml dist/client.win32/
|
||||
- cp Client.bin/CentrED.x64 dist/client.linux.x64/CentrED
|
||||
- cp Client.bin/CentrED.exe dist/client.win32/CentrED.exe
|
||||
- cp Server.bin/cedserver.x64 dist/server.linux.x64/cedserver
|
||||
- cp Server.bin/cedserver.exe dist/server.win32/cedserver.exe
|
||||
- cd dist/client.win32 && zip ../CentrED.win32.zip *
|
||||
- cd ../client.linux.x64 && tar czf ../CentrED.linux.x64.tgz *
|
||||
- cd ../server.win32 && zip ../Server.win32.zip *
|
||||
- cd ../server.linux.x64 && tar czf ../Server.linux.x64.tgz *
|
||||
|
||||
- name: Upload Client (win32)
|
||||
image: vividboarder/drone-webdav
|
||||
settings:
|
||||
file: dist/CentrED.win32.zip
|
||||
destination: https://aksdb.de/snapshots/CentrED/
|
||||
username: centred
|
||||
password:
|
||||
from_secret: snapshots_password
|
||||
|
||||
- name: Upload Client (linux x64)
|
||||
image: vividboarder/drone-webdav
|
||||
settings:
|
||||
file: dist/CentrED.linux.x64.tgz
|
||||
destination: https://aksdb.de/snapshots/CentrED/
|
||||
username: centred
|
||||
password:
|
||||
from_secret: snapshots_password
|
||||
|
||||
- name: Upload Server (win32)
|
||||
image: vividboarder/drone-webdav
|
||||
settings:
|
||||
file: dist/Server.win32.zip
|
||||
destination: https://aksdb.de/snapshots/CentrED/
|
||||
username: centred
|
||||
password:
|
||||
from_secret: snapshots_password
|
||||
|
||||
- name: Upload Server (linux x64)
|
||||
image: vividboarder/drone-webdav
|
||||
settings:
|
||||
file: dist/Server.linux.x64.tgz
|
||||
destination: https://aksdb.de/snapshots/CentrED/
|
||||
username: centred
|
||||
password:
|
||||
from_secret: snapshots_password
|
||||
|
||||
trigger:
|
||||
branch:
|
||||
- master
|
|
@ -1,5 +1,6 @@
|
|||
obj/*
|
||||
bin/*
|
||||
dist/*
|
||||
Client.bin/*
|
||||
Server.bin/*
|
||||
doc/*
|
||||
|
|
|
@ -1,13 +0,0 @@
|
|||
# This file contains a list of all tiles to be ignored when the "NoDraw"
|
||||
# option is not active.
|
||||
# Lines starting with T are terrain tiles, S indicated static tiles.
|
||||
# A - between numbers indicates a range of tiles.
|
||||
|
||||
#Terrain
|
||||
T$2
|
||||
|
||||
#Statics
|
||||
S$1
|
||||
S$2198-$21A4
|
||||
S$21BC
|
||||
S$5690
|
|
@ -1,5 +0,0 @@
|
|||
LEFTTOPARROW RCDATA "Overlay/LeftTopArrow.tga"
|
||||
TOPARROW RCDATA "Overlay/TopArrow.tga"
|
||||
VIRTUALLAYER RCDATA "Overlay/VirtualLayer.tga"
|
||||
DEJAVU RCDATA "GLFont/DejaVu.png"
|
||||
DEJAVUDAT RCDATA "GLFont/DejaVu.fnt"
|
Before Width: | Height: | Size: 5.4 KiB After Width: | Height: | Size: 5.3 KiB |
|
@ -1,17 +1,18 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasUsesSectionForAllUnits Value="False"/>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="CentrED"/>
|
||||
<Scaled Value="True"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="CentrED+"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<LazDoc Paths="../doc"/>
|
||||
|
@ -19,24 +20,23 @@
|
|||
<UseVersionInfo Value="True"/>
|
||||
<AutoIncrementBuild Value="True"/>
|
||||
<MinorVersionNr Value="7"/>
|
||||
<BuildNr Value="263"/>
|
||||
<StringTable CompanyName="AKS DataBasis" FileDescription="UO CentrED" InternalName="CentrED" LegalCopyright="(c) 2022 Andreas Schneider and StaticZ" OriginalFilename="CentrED.exe" ProductName="CentrED" ProductVersion="0.7.0"/>
|
||||
<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="8">
|
||||
<BuildModes Count="5">
|
||||
<Item1 Name="default" Default="True"/>
|
||||
<Item2 Name="Release.Win32">
|
||||
<MacroValues Count="1">
|
||||
<Macro1 Name="LCLWidgetType" Value="win32"/>
|
||||
</MacroValues>
|
||||
<Item2 Name="Release Win32">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../Client.bin/CentrED"/>
|
||||
<Filename Value="../bin/PEBinaries/CentrED-plus (x32).exe"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
|
||||
<IncludeFiles Value="..;../obj;../Imaging;$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
|
||||
<UnitOutputDirectory Value="../obj/win32"/>
|
||||
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
|
@ -46,6 +46,7 @@
|
|||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
<TargetProcessor Value="pentium4"/>
|
||||
<TargetCPU Value="i386"/>
|
||||
<TargetOS Value="win32"/>
|
||||
<Optimizations>
|
||||
|
@ -69,20 +70,21 @@
|
|||
<CompilerMessages>
|
||||
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-dNoLogging"/>
|
||||
<CustomOptions Value="-FE../bin/PEBinaries/
|
||||
-dNoLogging"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item2>
|
||||
<Item3 Name="Release.Win64">
|
||||
<Item3 Name="Release Win64">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../Client.bin/CentrED"/>
|
||||
<Filename Value="../bin/PEBinaries/CentrED-plus (x64).exe"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
|
||||
<IncludeFiles Value="..;../obj;../Imaging;$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
|
||||
<UnitOutputDirectory Value="../obj/win64"/>
|
||||
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
|
@ -92,6 +94,7 @@
|
|||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
<TargetProcessor Value="pentium4"/>
|
||||
<TargetCPU Value="x86_64"/>
|
||||
<TargetOS Value="win64"/>
|
||||
<Optimizations>
|
||||
|
@ -115,24 +118,22 @@
|
|||
<CompilerMessages>
|
||||
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-dNoLogging"/>
|
||||
<CustomOptions Value="-FE../bin/PEBinaries/
|
||||
-dNoLogging"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item3>
|
||||
<Item4 Name="Release.Linux.x86">
|
||||
<MacroValues Count="1">
|
||||
<Macro2 Name="LCLWidgetType" Value="gtk2"/>
|
||||
</MacroValues>
|
||||
<Item4 Name="Release Linux GTK2 x86">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../Client.bin/CentrED.x86"/>
|
||||
<Filename Value="../bin/PEBinaries/CentrED-plus"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
|
||||
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools;GUI"/>
|
||||
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
|
||||
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
|
@ -164,24 +165,22 @@
|
|||
<CompilerMessages>
|
||||
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-dNoLogging"/>
|
||||
<CustomOptions Value="-FE../bin/PEBinaries/
|
||||
-dNoLogging"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item4>
|
||||
<Item5 Name="Release.Linux.x64">
|
||||
<MacroValues Count="1">
|
||||
<Macro2 Name="LCLWidgetType" Value="gtk2"/>
|
||||
</MacroValues>
|
||||
<Item5 Name="Release Linux GTK2 x64">
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../Client.bin/CentrED.x64"/>
|
||||
<Filename Value="../bin/PEBinaries/CentrED-plus"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
|
||||
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools;GUI"/>
|
||||
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
|
||||
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
|
@ -213,165 +212,47 @@
|
|||
<CompilerMessages>
|
||||
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-dNoLogging"/>
|
||||
<CustomOptions Value="-FE../bin/PEBinaries/
|
||||
-dNoLogging"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item5>
|
||||
<Item6 Name="Debug.Win32">
|
||||
<MacroValues Count="1">
|
||||
<Macro1 Name="LCLWidgetType" Value="win32"/>
|
||||
</MacroValues>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../Client.bin/CentrED"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
|
||||
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<CStyleOperator Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<OverflowChecks Value="True"/>
|
||||
</Checks>
|
||||
<TargetCPU Value="i386"/>
|
||||
<TargetOS Value="win32"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
|
||||
</CompilerMessages>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item6>
|
||||
<Item7 Name="Debug.Linux.x86">
|
||||
<MacroValues Count="1">
|
||||
<Macro2 Name="LCLWidgetType" Value="gtk2"/>
|
||||
</MacroValues>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../Client.bin/CentrED"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
|
||||
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<CStyleOperator Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<OverflowChecks Value="True"/>
|
||||
</Checks>
|
||||
<TargetCPU Value="i386"/>
|
||||
<TargetOS Value="linux"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-dNoLogging"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item7>
|
||||
<Item8 Name="Debug.Linux.x64">
|
||||
<MacroValues Count="1">
|
||||
<Macro2 Name="LCLWidgetType" Value="gtk2"/>
|
||||
</MacroValues>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="../Client.bin/CentrED"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
|
||||
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
|
||||
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<CStyleOperator Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<OverflowChecks Value="True"/>
|
||||
</Checks>
|
||||
<TargetCPU Value="x86_64"/>
|
||||
<TargetOS Value="linux"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-dNoLogging"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</Item8>
|
||||
<SharedMatrixOptions Count="2">
|
||||
<Item1 ID="851019893220" Modes="Release.Win32,Debug.Win32" Type="IDEMacro" MacroName="LCLWidgetType" Value="win32"/>
|
||||
<Item2 ID="521965364444" Modes="Release.Linux.x86,Release.Linux.x64,Debug.Linux.x86,Debug.Linux.x64" Type="IDEMacro" MacroName="LCLWidgetType" Value="gtk2"/>
|
||||
</SharedMatrixOptions>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
<environment>
|
||||
<UserOverrides Count="1">
|
||||
<Variable0 Name="HEAPTRC" Value="log=CentrED.trc"/>
|
||||
</UserOverrides>
|
||||
</environment>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="1">
|
||||
<Mode0 Name="default">
|
||||
<local>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
<environment>
|
||||
<UserOverrides Count="1">
|
||||
<Variable0 Name="HEAPTRC" Value="log=CentrED.trc"/>
|
||||
</UserOverrides>
|
||||
</environment>
|
||||
</Mode0>
|
||||
</Modes>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="6">
|
||||
<Item1>
|
||||
<PackageName Value="laz.virtualtreeview_package"/>
|
||||
<PackageName Value="lclextensions_package"/>
|
||||
<MinVersion Minor="3" Valid="True"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCLBase"/>
|
||||
<MinVersion Major="1" Release="1" Valid="True"/>
|
||||
<PackageName Value="multiloglaz"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="multiloglaz"/>
|
||||
<PackageName Value="LazOpenGLContext"/>
|
||||
<MinVersion Valid="True"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="LazOpenGLContext"/>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<PackageName Value="lnetvisual"/>
|
||||
<MinVersion Minor="5" Release="3" Valid="True"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<PackageName Value="laz.virtualtreeview_package"/>
|
||||
</Item6>
|
||||
</RequiredPackages>
|
||||
<Units Count="49">
|
||||
<Units Count="60">
|
||||
<Unit0>
|
||||
<Filename Value="CentrED.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
|
@ -387,21 +268,19 @@
|
|||
<Filename Value="UdmNetwork.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="dmNetwork"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="DataModule"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="UfrmLogin.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmLogin"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="UfrmLogin"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="UfrmInitialize.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmInitialize"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
|
@ -415,28 +294,24 @@
|
|||
<Filename Value="UfrmEditAccount.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmEditAccount"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit6>
|
||||
<Unit7>
|
||||
<Filename Value="Tools/UfrmDrawSettings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmDrawSettings"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit7>
|
||||
<Unit8>
|
||||
<Filename Value="Tools/UfrmBoundaries.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmBoundaries"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit8>
|
||||
<Unit9>
|
||||
<Filename Value="Tools/UfrmElevateSettings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmElevateSettings"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit9>
|
||||
<Unit10>
|
||||
|
@ -444,228 +319,282 @@
|
|||
<IsPartOfProject Value="True"/>
|
||||
</Unit10>
|
||||
<Unit11>
|
||||
<Filename Value="UResourceManager.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="Tools/UfrmConfirmation.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmConfirmation"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit11>
|
||||
<Unit12>
|
||||
<Filename Value="Tools/UfrmMoveSettings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmMoveSettings"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit12>
|
||||
<Unit13>
|
||||
<Filename Value="UfrmAbout.pas"/>
|
||||
<Filename Value="Tools/UfrmMoveSettings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmAbout"/>
|
||||
<HasResources Value="True"/>
|
||||
<ComponentName Value="frmMoveSettings"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit13>
|
||||
<Unit14>
|
||||
<Filename Value="Tools/UfrmHueSettings.pas"/>
|
||||
<Filename Value="UfrmAbout.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmHueSettings"/>
|
||||
<HasResources Value="True"/>
|
||||
<ComponentName Value="frmAbout"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit14>
|
||||
<Unit15>
|
||||
<Filename Value="UfrmRadar.pas"/>
|
||||
<Filename Value="Tools/UfrmHueSettings.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmRadarMap"/>
|
||||
<HasResources Value="True"/>
|
||||
<ComponentName Value="frmHueSettings"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit15>
|
||||
<Unit16>
|
||||
<Filename Value="UfrmLargeScaleCommand.pas"/>
|
||||
<Filename Value="UfrmRadar.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmLargeScaleCommand"/>
|
||||
<HasResources Value="True"/>
|
||||
<ComponentName Value="frmRadarMap"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit16>
|
||||
<Unit17>
|
||||
<Filename Value="Tools/UfrmVirtualLayer.pas"/>
|
||||
<Filename Value="UfrmLargeScaleCommand.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmVirtualLayer"/>
|
||||
<HasResources Value="True"/>
|
||||
<ComponentName Value="frmLargeScaleCommand"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit17>
|
||||
<Unit18>
|
||||
<Filename Value="Tools/UfrmFilter.pas"/>
|
||||
<Filename Value="Tools/UfrmVirtualLayer.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmFilter"/>
|
||||
<HasResources Value="True"/>
|
||||
<ComponentName Value="frmVirtualLayer"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit18>
|
||||
<Unit19>
|
||||
<Filename Value="UGUIPlatformUtils.pas"/>
|
||||
<Filename Value="Tools/UfrmFilter.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmFilter"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit19>
|
||||
<Unit20>
|
||||
<Filename Value="UPlatformTypes.pas"/>
|
||||
<Filename Value="UGUIPlatformUtils.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit20>
|
||||
<Unit21>
|
||||
<Filename Value="UPlatformTypes.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit21>
|
||||
<Unit22>
|
||||
<Filename Value="UfrmRegionControl.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmRegionControl"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit21>
|
||||
<Unit22>
|
||||
<Filename Value="UPacketHandlers.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit22>
|
||||
<Unit23>
|
||||
<Filename Value="UPackets.pas"/>
|
||||
<Filename Value="UPacketHandlers.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit23>
|
||||
<Unit24>
|
||||
<Filename Value="ULandscape.pas"/>
|
||||
<Filename Value="UPackets.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit24>
|
||||
<Unit25>
|
||||
<Filename Value="UGameResources.pas"/>
|
||||
<Filename Value="ULandscape.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit25>
|
||||
<Unit26>
|
||||
<Filename Value="UAdminHandling.pas"/>
|
||||
<Filename Value="UGameResources.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit26>
|
||||
<Unit27>
|
||||
<Filename Value="UAdminHandling.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit27>
|
||||
<Unit28>
|
||||
<Filename Value="Tools/UfrmToolWindow.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmToolWindow"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit27>
|
||||
<Unit28>
|
||||
<Filename Value="../Logging.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit28>
|
||||
<Unit29>
|
||||
<Filename Value="../UOLib/UStatics.pas"/>
|
||||
<Filename Value="../Logging.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit29>
|
||||
<Unit30>
|
||||
<Filename Value="../UOLib/UWorldItem.pas"/>
|
||||
<Filename Value="../UOLib/UStatics.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit30>
|
||||
<Unit31>
|
||||
<Filename Value="../UOLib/UMap.pas"/>
|
||||
<Filename Value="../UOLib/UWorldItem.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit31>
|
||||
<Unit32>
|
||||
<Filename Value="../UOLib/UTiledata.pas"/>
|
||||
<Filename Value="../UOLib/UMap.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit32>
|
||||
<Unit33>
|
||||
<Filename Value="UGLFont.pas"/>
|
||||
<Filename Value="../UOLib/UTiledata.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit33>
|
||||
<Unit34>
|
||||
<Filename Value="../UOLib/UAnimData.pas"/>
|
||||
<Filename Value="UGLFont.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit34>
|
||||
<Unit35>
|
||||
<Filename Value="../MulProvider/UTileDataProvider.pas"/>
|
||||
<Filename Value="../UOLib/UAnimData.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit35>
|
||||
<Unit36>
|
||||
<Filename Value="../MulProvider/UAnimDataProvider.pas"/>
|
||||
<Filename Value="../MulProvider/UTileDataProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit36>
|
||||
<Unit37>
|
||||
<Filename Value="../MulProvider/UMulManager.pas"/>
|
||||
<Filename Value="../MulProvider/UAnimDataProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit37>
|
||||
<Unit38>
|
||||
<Filename Value="../MulProvider/UArtProvider.pas"/>
|
||||
<Filename Value="../MulProvider/UMulManager.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit38>
|
||||
<Unit39>
|
||||
<Filename Value="../MulProvider/UTexmapProvider.pas"/>
|
||||
<Filename Value="../MulProvider/UArtProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit39>
|
||||
<Unit40>
|
||||
<Filename Value="../version.inc"/>
|
||||
<Filename Value="../MulProvider/UTexmapProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit40>
|
||||
<Unit41>
|
||||
<Filename Value="ULightManager.pas"/>
|
||||
<Filename Value="../version.inc"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit41>
|
||||
<Unit42>
|
||||
<Filename Value="../UOLib/ULight.pas"/>
|
||||
<Filename Value="ULightManager.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit42>
|
||||
<Unit43>
|
||||
<Filename Value="../MulProvider/ULightProvider.pas"/>
|
||||
<Filename Value="../UOLib/ULight.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit43>
|
||||
<Unit44>
|
||||
<Filename Value="../MulProvider/ULightProvider.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit44>
|
||||
<Unit45>
|
||||
<Filename Value="Tools/UfrmLightlevel.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmLightlevel"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit44>
|
||||
<Unit45>
|
||||
<Filename Value="UfrmChangePassword.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="frmChangePassword"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit45>
|
||||
<Unit46>
|
||||
<Filename Value="USelectionHelper.pas"/>
|
||||
<Filename Value="../UEnhancedMemoryStream.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit46>
|
||||
<Unit47>
|
||||
<Filename Value="UActions.pas"/>
|
||||
<Filename Value="UndoRedoCmd.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit47>
|
||||
<Unit48>
|
||||
<Filename Value="UUoaDesigns.pas"/>
|
||||
<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="11"/>
|
||||
<Target>
|
||||
<Filename Value="../Client.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)"/>
|
||||
<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="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
</Checks>
|
||||
<Optimizations>
|
||||
<OptimizationLevel Value="0"/>
|
||||
<OptimizationLevel Value="3"/>
|
||||
</Optimizations>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsStabs"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-B"/>
|
||||
<CustomOptions Value="-FE../bin/PEBinaries/
|
||||
+-dNoLogging"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
|
|
|
@ -21,39 +21,122 @@
|
|||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2012 Andreas Schneider
|
||||
* Portions Copyright 2015 Andreas Schneider
|
||||
* Portions Copyright 2015 StaticZ
|
||||
*)
|
||||
program CentrED;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFNDEF NoLogging}heaptrc, Logging, filechannel,{$ENDIF}
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
SysUtils,
|
||||
Classes, SysUtils,
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, UdmNetwork;
|
||||
LCLType, Forms, Dialogs, UdmNetwork, UResourceManager, Graphics;
|
||||
|
||||
{$R CentrED.res}
|
||||
{$R Assets.rc} // Beware: you need 'windres', which is part of mingw-binutils on *nix!
|
||||
//{$R CentrED.manifest.rc}
|
||||
|
||||
function GetApplicationName: String;
|
||||
begin
|
||||
Result := 'CentrED';
|
||||
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
|
||||
{$IFNDEF NoLogging}
|
||||
SetHeapTraceOutput('CentrED.trc');
|
||||
Logger.Channels.Add(TFileChannel.Create('CentrED.log'));
|
||||
{$ENDIF}
|
||||
|
||||
Application.Title:='CentrED+';
|
||||
OnGetApplicationName := @GetApplicationName;
|
||||
|
||||
Application.Scaled := True;
|
||||
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.
|
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 4.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
After Width: | Height: | Size: 2.2 KiB |
|
@ -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.
|
After Width: | Height: | Size: 110 KiB |
After Width: | Height: | Size: 165 KiB |
After Width: | Height: | Size: 148 KiB |
After Width: | Height: | Size: 6.6 KiB |
After Width: | Height: | Size: 6.8 KiB |
After Width: | Height: | Size: 3.1 KiB |
After Width: | Height: | Size: 6.6 KiB |
After Width: | Height: | Size: 1.0 KiB |
After Width: | Height: | Size: 2.3 KiB |
After Width: | Height: | Size: 4.0 KiB |
After Width: | Height: | Size: 9.0 KiB |
|
@ -0,0 +1,40 @@
|
|||
Sounds/MusicInf.wav
|
||||
GLFont/DejaVu.png
|
||||
GLFont/DejaVu.fnt
|
||||
Overlay/LeftTopArrow.tga
|
||||
Overlay/TopArrow.tga
|
||||
Overlay/VirtualLayer.tga
|
||||
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
|
|
@ -1,278 +1,324 @@
|
|||
inherited frmBoundaries: TfrmBoundaries
|
||||
Left = 445
|
||||
Height = 208
|
||||
Top = 332
|
||||
Width = 406
|
||||
AutoSize = True
|
||||
Caption = 'Boundaries'
|
||||
ClientHeight = 208
|
||||
ClientWidth = 406
|
||||
Left = 1259
|
||||
Height = 141
|
||||
Top = 502
|
||||
Width = 403
|
||||
Anchors = [akTop, akLeft, akBottom]
|
||||
Caption = 'Границы видимости'
|
||||
ClientHeight = 141
|
||||
ClientWidth = 403
|
||||
OnCreate = FormCreate
|
||||
object gbZRestriction: TGroupBox[0]
|
||||
object tbMaxZ: TTrackBar[0]
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
Left = 4
|
||||
Height = 204
|
||||
Top = 4
|
||||
Width = 200
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 4
|
||||
BorderSpacing.Top = 4
|
||||
Caption = 'Restrict Height'
|
||||
ClientHeight = 180
|
||||
ClientWidth = 198
|
||||
Constraints.MinWidth = 200
|
||||
TabOrder = 0
|
||||
object lblMinZ: TLabel
|
||||
AnchorSideLeft.Control = tbMinZ
|
||||
AnchorSideTop.Control = seMinZ
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 4
|
||||
Height = 23
|
||||
Top = 9
|
||||
Width = 93
|
||||
Caption = 'Minimum Z:'
|
||||
Color = clDefault
|
||||
Layout = tlCenter
|
||||
ParentColor = False
|
||||
Transparent = False
|
||||
end
|
||||
AnchorSideTop.Control = tbMinZ
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 8
|
||||
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 = gbZRestriction
|
||||
AnchorSideRight.Control = gbZRestriction
|
||||
AnchorSideTop.Control = GroupBox1
|
||||
AnchorSideRight.Control = GroupBox1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 132
|
||||
Height = 33
|
||||
Top = 4
|
||||
Width = 62
|
||||
Left = 119
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 48
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Top = 4
|
||||
BorderSpacing.Right = 4
|
||||
BorderSpacing.Right = 8
|
||||
MaxValue = 127
|
||||
MinValue = -128
|
||||
OnChange = seMinZChange
|
||||
TabOrder = 0
|
||||
Value = -128
|
||||
end
|
||||
object tbMinZ: TTrackBar
|
||||
AnchorSideLeft.Control = gbZRestriction
|
||||
object seMaxZ: TSpinEdit
|
||||
AnchorSideTop.Control = seMinZ
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = gbZRestriction
|
||||
AnchorSideRight.Control = GroupBox1
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 4
|
||||
Height = 47
|
||||
Top = 41
|
||||
Width = 190
|
||||
Frequency = 10
|
||||
Max = 127
|
||||
Min = -128
|
||||
OnChange = tbMinZChange
|
||||
PageSize = 1
|
||||
Position = -128
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 4
|
||||
TabOrder = 1
|
||||
end
|
||||
object lblMaxZ: TLabel
|
||||
AnchorSideLeft.Control = tbMaxZ
|
||||
AnchorSideTop.Control = seMaxZ
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 4
|
||||
Left = 119
|
||||
Height = 23
|
||||
Top = 97
|
||||
Width = 97
|
||||
Caption = 'Maximum Z:'
|
||||
Color = clDefault
|
||||
Layout = tlCenter
|
||||
ParentColor = False
|
||||
Transparent = False
|
||||
end
|
||||
object seMaxZ: TSpinEdit
|
||||
AnchorSideTop.Control = tbMinZ
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = seMinZ
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 132
|
||||
Height = 33
|
||||
Top = 92
|
||||
Width = 62
|
||||
Top = 28
|
||||
Width = 48
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Top = 5
|
||||
BorderSpacing.Right = 8
|
||||
MaxValue = 127
|
||||
MinValue = -128
|
||||
OnChange = seMaxZChange
|
||||
TabOrder = 2
|
||||
TabOrder = 1
|
||||
Value = 127
|
||||
end
|
||||
object tbMaxZ: TTrackBar
|
||||
AnchorSideLeft.Control = gbZRestriction
|
||||
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 = asrBottom
|
||||
AnchorSideRight.Control = gbZRestriction
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 4
|
||||
Height = 47
|
||||
Top = 129
|
||||
Width = 190
|
||||
Frequency = 10
|
||||
Max = 127
|
||||
Min = -128
|
||||
OnChange = tbMaxZChange
|
||||
PageSize = 1
|
||||
Position = 127
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 4
|
||||
TabOrder = 3
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 8
|
||||
Height = 16
|
||||
Top = 31
|
||||
Width = 97
|
||||
Caption = 'Z Максимальная:'
|
||||
Layout = tlCenter
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
object gbViewRestriction: TGroupBox[1]
|
||||
AnchorSideLeft.Control = gbZRestriction
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = gbZRestriction
|
||||
object GroupBox2: TGroupBox[2]
|
||||
AnchorSideLeft.Control = tbMaxZ
|
||||
AnchorSideTop.Control = GroupBox1
|
||||
AnchorSideRight.Control = GroupBox1
|
||||
AnchorSideBottom.Control = GroupBox1
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 208
|
||||
Height = 200
|
||||
Top = 4
|
||||
Width = 194
|
||||
Left = 8
|
||||
Height = 72
|
||||
Top = 60
|
||||
Width = 201
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Around = 4
|
||||
Caption = 'Restrict View Range'
|
||||
ClientHeight = 176
|
||||
ClientWidth = 192
|
||||
TabOrder = 1
|
||||
object seMinX: TSpinEdit
|
||||
AnchorSideLeft.Control = lblX
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = seMaxX
|
||||
Left = 22
|
||||
Height = 33
|
||||
Top = 4
|
||||
Width = 74
|
||||
BorderSpacing.Left = 4
|
||||
OnChange = seMinXChange
|
||||
TabOrder = 0
|
||||
end
|
||||
BorderSpacing.Right = 7
|
||||
Caption = 'Границы дальности обзора'
|
||||
ClientHeight = 54
|
||||
ClientWidth = 197
|
||||
TabOrder = 3
|
||||
object seMaxX: TSpinEdit
|
||||
AnchorSideTop.Control = gbViewRestriction
|
||||
AnchorSideRight.Control = gbViewRestriction
|
||||
AnchorSideTop.Control = GroupBox2
|
||||
AnchorSideRight.Control = GroupBox2
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 114
|
||||
Height = 33
|
||||
Top = 4
|
||||
Width = 74
|
||||
Left = 137
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 54
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Top = 4
|
||||
BorderSpacing.Right = 4
|
||||
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
|
||||
AnchorSideLeft.Control = seMinX
|
||||
AnchorSideTop.Control = seMinX
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = seMinX
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 22
|
||||
Height = 33
|
||||
Top = 45
|
||||
Width = 74
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 8
|
||||
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 seMaxY: TSpinEdit
|
||||
AnchorSideLeft.Control = seMaxX
|
||||
AnchorSideTop.Control = seMinY
|
||||
object seMinX: TSpinEdit
|
||||
AnchorSideTop.Control = seMaxX
|
||||
AnchorSideRight.Control = seMaxX
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 114
|
||||
Height = 33
|
||||
Top = 45
|
||||
Width = 74
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
OnChange = seMaxYChange
|
||||
Left = 64
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 54
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 19
|
||||
MaxValue = 12288
|
||||
OnChange = seMinXChange
|
||||
TabOrder = 3
|
||||
end
|
||||
object lblX: TLabel
|
||||
AnchorSideLeft.Control = gbViewRestriction
|
||||
AnchorSideTop.Control = seMinX
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 4
|
||||
Height = 23
|
||||
Top = 9
|
||||
Width = 14
|
||||
BorderSpacing.Left = 4
|
||||
Caption = 'X:'
|
||||
Color = clDefault
|
||||
ParentColor = False
|
||||
Transparent = False
|
||||
end
|
||||
object lblY: TLabel
|
||||
AnchorSideLeft.Control = lblX
|
||||
AnchorSideTop.Control = seMinY
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 4
|
||||
Height = 23
|
||||
Top = 50
|
||||
Width = 13
|
||||
Caption = 'Y:'
|
||||
Color = clDefault
|
||||
ParentColor = False
|
||||
Transparent = False
|
||||
end
|
||||
object lblXSep: TLabel
|
||||
AnchorSideLeft.Control = seMinX
|
||||
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
|
||||
Left = 100
|
||||
Height = 23
|
||||
Top = 9
|
||||
Width = 17
|
||||
BorderSpacing.Left = 4
|
||||
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 = '—'
|
||||
Color = clDefault
|
||||
Layout = tlCenter
|
||||
ParentColor = False
|
||||
Transparent = False
|
||||
end
|
||||
object lblYSep: TLabel
|
||||
AnchorSideLeft.Control = lblXSep
|
||||
AnchorSideTop.Control = seMinY
|
||||
object lblAxeY1: TLabel
|
||||
AnchorSideLeft.Control = seMinY
|
||||
AnchorSideTop.Control = seMaxY
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 100
|
||||
Height = 23
|
||||
Top = 50
|
||||
Width = 17
|
||||
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 = '—'
|
||||
Color = clDefault
|
||||
Layout = tlCenter
|
||||
ParentColor = False
|
||||
Transparent = False
|
||||
end
|
||||
object btnSelectArea: TButton
|
||||
Left = 0
|
||||
Height = 25
|
||||
Top = 95
|
||||
Width = 112
|
||||
Caption = 'Select Area'
|
||||
OnClick = btnSelectAreaClick
|
||||
TabOrder = 4
|
||||
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 btnClear: TButton
|
||||
Left = 117
|
||||
Height = 25
|
||||
Top = 95
|
||||
Width = 75
|
||||
Caption = 'Clear'
|
||||
OnClick = btnClearClick
|
||||
TabOrder = 5
|
||||
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
|
||||
inherited tmClose: TTimer[2]
|
||||
Left = 200
|
||||
Top = 176
|
||||
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
|
||||
OnChange = tbMinZChange
|
||||
PageSize = 1
|
||||
Position = -128
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Around = 8
|
||||
TabOrder = 0
|
||||
end
|
||||
inherited tmClose: TTimer[4]
|
||||
left = 312
|
||||
end
|
||||
end
|
||||
|
|
|
@ -21,8 +21,7 @@
|
|||
* CDDL HEADER END
|
||||
*
|
||||
*
|
||||
* Portions Copyright 2015 Andreas Schneider
|
||||
* Portions Copyright 2015 StaticZ
|
||||
* Portions Copyright 2009 Andreas Schneider
|
||||
*)
|
||||
unit UfrmBoundaries;
|
||||
|
||||
|
@ -32,34 +31,34 @@ interface
|
|||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
ComCtrls, Spin, ExtCtrls, UfrmToolWindow, USelectionHelper;
|
||||
ComCtrls, Spin, ExtCtrls, Buttons, UfrmToolWindow;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmBoundaries }
|
||||
|
||||
TfrmBoundaries = class(TfrmToolWindow)
|
||||
btnSelectArea: TButton;
|
||||
btnClear: TButton;
|
||||
gbZRestriction: TGroupBox;
|
||||
gbViewRestriction: TGroupBox;
|
||||
lblYSep: TLabel;
|
||||
lblXSep: TLabel;
|
||||
lblY: TLabel;
|
||||
lblX: TLabel;
|
||||
GroupBox1: TGroupBox;
|
||||
GroupBox2: TGroupBox;
|
||||
lblAxeX1: TLabel;
|
||||
lblAxeY1: TLabel;
|
||||
lblMaxZ: TLabel;
|
||||
lblMinZ: TLabel;
|
||||
lblAxeX: TLabel;
|
||||
lblAxeY: TLabel;
|
||||
seMaxZ: TSpinEdit;
|
||||
seMinZ: TSpinEdit;
|
||||
seMinX: TSpinEdit;
|
||||
seMaxX: TSpinEdit;
|
||||
seMinY: TSpinEdit;
|
||||
seMaxY: TSpinEdit;
|
||||
tbMaxZ: TTrackBar;
|
||||
seMinY: TSpinEdit;
|
||||
seMinX: TSpinEdit;
|
||||
sbClearXbnd: TSpeedButton;
|
||||
sbClearYbnd: TSpeedButton;
|
||||
tbMinZ: TTrackBar;
|
||||
procedure btnSelectAreaClick(Sender: TObject);
|
||||
procedure btnClearClick(Sender: TObject);
|
||||
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);
|
||||
|
@ -68,8 +67,6 @@ type
|
|||
procedure seMinZChange(Sender: TObject);
|
||||
procedure tbMaxZChange(Sender: TObject);
|
||||
procedure tbMinZChange(Sender: TObject);
|
||||
protected
|
||||
procedure RangeSelected(AX1, AY1, AX2, AY2: Word);
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
@ -80,86 +77,103 @@ var
|
|||
implementation
|
||||
|
||||
uses
|
||||
UfrmMain;
|
||||
UfrmMain, Language;
|
||||
|
||||
{ TfrmBoundaries }
|
||||
|
||||
procedure TfrmBoundaries.FormCreate(Sender: TObject);
|
||||
begin
|
||||
seMinX.MaxValue := frmMain.Landscape.CellWidth - 1;
|
||||
seMaxX.MaxValue := seMinX.MaxValue;
|
||||
seMaxX.Value := seMaxX.MaxValue;
|
||||
|
||||
seMinY.MaxValue := frmMain.Landscape.CellHeight - 1;
|
||||
seMaxY.MaxValue := seMinY.MaxValue;
|
||||
seMaxY.Value := seMaxX.MaxValue;
|
||||
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.btnSelectAreaClick(Sender: TObject);
|
||||
procedure TfrmBoundaries.sbClearXbndClick(Sender: TObject);
|
||||
begin
|
||||
SelectRange(@RangeSelected);
|
||||
seMinX.Value := seMinX.MinValue;
|
||||
seMaxX.Value := seMaxX.MaxValue;
|
||||
frmMain.InvalidateFilter;
|
||||
end;
|
||||
|
||||
procedure TfrmBoundaries.btnClearClick(Sender: TObject);
|
||||
procedure TfrmBoundaries.sbClearYbndClick(Sender: TObject);
|
||||
begin
|
||||
seMinX.Value := 0;
|
||||
seMinY.Value := 0;
|
||||
seMaxX.Value := seMaxX.MaxValue;
|
||||
seMinY.Value := seMinY.MinValue;
|
||||
seMaxY.Value := seMaxY.MaxValue;
|
||||
frmMain.InvalidateFilter;
|
||||
end;
|
||||
|
||||
procedure TfrmBoundaries.seMaxXChange(Sender: TObject);
|
||||
begin
|
||||
frmMain.InvalidateFilter;
|
||||
end;
|
||||
|
||||
procedure TfrmBoundaries.seMaxYChange(Sender: TObject);
|
||||
begin
|
||||
frmMain.InvalidateFilter;
|
||||
end;
|
||||
|
||||
procedure TfrmBoundaries.seMaxZChange(Sender: TObject);
|
||||
begin
|
||||
tbMaxZ.Position := seMaxZ.Value;
|
||||
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.RangeSelected(AX1, AY1, AX2, AY2: Word);
|
||||
procedure TfrmBoundaries.tbMaxZChange(Sender: TObject);
|
||||
begin
|
||||
seMinX.Value := AX1;
|
||||
seMinY.Value := AY1;
|
||||
seMaxX.Value := AX2;
|
||||
seMaxY.Value := AY2;
|
||||
frmBoundaries.Show;
|
||||
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;
|
||||
|
||||
initialization
|
||||
|
|
|
@ -1,33 +1,35 @@
|
|||
object frmConfirmation: TfrmConfirmation
|
||||
Left = 290
|
||||
Height = 54
|
||||
Top = 171
|
||||
Width = 135
|
||||
Left = 1559
|
||||
Height = 43
|
||||
Top = 261
|
||||
Width = 116
|
||||
BorderIcons = []
|
||||
BorderStyle = bsToolWindow
|
||||
Caption = 'Apply?'
|
||||
ClientHeight = 54
|
||||
ClientWidth = 135
|
||||
Font.Height = -14
|
||||
Caption = 'Подтвердить?'
|
||||
ClientHeight = 43
|
||||
ClientWidth = 116
|
||||
Font.Height = -11
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '0.9.30.2'
|
||||
object btnYes: TButton
|
||||
Left = 10
|
||||
Height = 31
|
||||
Top = 10
|
||||
Width = 50
|
||||
BorderSpacing.InnerBorder = 5
|
||||
Caption = 'Yes'
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Да'
|
||||
Default = True
|
||||
ModalResult = 6
|
||||
TabOrder = 0
|
||||
end
|
||||
object btnNo: TButton
|
||||
Left = 70
|
||||
Height = 31
|
||||
Top = 10
|
||||
Width = 50
|
||||
BorderSpacing.InnerBorder = 5
|
||||
Left = 56
|
||||
Height = 25
|
||||
Top = 8
|
||||
Width = 40
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Cancel = True
|
||||
Caption = 'No'
|
||||
Caption = 'Нет'
|
||||
ModalResult = 7
|
||||
TabOrder = 1
|
||||
end
|
||||
|
|
|
@ -39,6 +39,7 @@ type
|
|||
TfrmConfirmation = class(TForm)
|
||||
btnYes: TButton;
|
||||
btnNo: TButton;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
|
@ -50,6 +51,15 @@ var
|
|||
|
||||
implementation
|
||||
|
||||
uses Language;
|
||||
|
||||
{ TfrmConfirmation }
|
||||
|
||||
procedure TfrmConfirmation.FormCreate(Sender: TObject);
|
||||
begin
|
||||
LanguageTranslate(Self);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I UfrmConfirmation.lrs}
|
||||
|
||||
|
|