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

* Added CentrED+ code (thanks to StaticZ for his awesome work!)

This commit is contained in:
Andreas Schneider 2015-05-01 12:23:03 +02:00
parent 2e62fd570a
commit 34637d40ce
97 changed files with 22628 additions and 4243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Client/CentrED.ico
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 5.4 KiB

After

Width:  |  Height:  |  Size: 5.3 KiB

317
Client/CentrED.lpi
View File

@ -1,33 +1,181 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="7"/> <Version Value="9"/>
<General> <General>
<Flags> <Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/> <MainUnitHasUsesSectionForAllUnits Value="False"/>
<AlwaysBuild Value="False"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<TargetFileExt Value=".exe"/> <Title Value="CentrED+"/>
<Title Value="CentrED"/> <ResourceType Value="res"/>
<LFMResourceType Value="res"/> <XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/> <Icon Value="0"/>
</General> </General>
<LazDoc Paths="../doc"/> <LazDoc Paths="../doc"/>
<VersionInfo> <VersionInfo>
<UseVersionInfo Value="True"/> <UseVersionInfo Value="True"/>
<CurrentMajorRevNr Value="6"/> <AutoIncrementBuild Value="True"/>
<CurrentMinorRevNr Value="1"/> <MinorVersionNr Value="7"/>
<CurrentBuildNr Value="209"/> <RevisionNr Value="8"/>
<ProjectVersion Value="0.6.1.209"/> <BuildNr Value="1759"/>
<CompanyName Value="AKS DataBasis"/> <Language Value="0419"/>
<FileDescription Value="UO CentrED"/> <StringTable CompanyName="www.uoquint.ru" FileDescription="UO CentrED+" InternalName="CentrED+" LegalCopyright="StaticZ" OriginalFilename="CentrED-plus.exe" ProductName="CentrED+" ProductVersion="0.7.8"/>
<InternalName Value="CentrED"/>
<LegalCopyright Value="Andreas Schneider"/>
<OriginalFilename Value="CentrED.exe"/>
<ProductName Value="CentrED"/>
</VersionInfo> </VersionInfo>
<BuildModes Count="4">
<Item1 Name="default" Default="True"/>
<Item2 Name="Release Win32">
<CompilerOptions>
<Version Value="9"/>
<Target>
<Filename Value="../bin/PEBinaries/CentrED-plus (x32).exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..;../obj;../Imaging;$(ProjOutDir)"/>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
<UnitOutputDirectory Value="../obj/win32"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
<LCLWidgetType Value="win32"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<TargetProcessor Value="pentium4"/>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/PEBinaries/
-dNoLogging"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item2>
<Item3 Name="Release Win64">
<CompilerOptions>
<Version Value="9"/>
<Target>
<Filename Value="../bin/PEBinaries/CentrED-plus (x64).exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="..;../obj;../Imaging;$(ProjOutDir)"/>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
<UnitOutputDirectory Value="../obj/win64"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
<LCLWidgetType Value="win32"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<TargetProcessor Value="pentium4"/>
<TargetCPU Value="x86_64"/>
<TargetOS Value="win64"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/PEBinaries/
-dNoLogging"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item3>
<Item4 Name="Release Linux GTK2 x86">
<CompilerOptions>
<Version Value="9"/>
<Target>
<Filename Value="../bin/PEBinaries/CentrED-plus"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir);../Imaging;.."/>
<OtherUnitFiles Value="..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/>
<SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType);..;../UOLib;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;Tools"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<TargetCPU Value="i386"/>
<TargetOS Value="linux"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CustomOptions Value="-FE../bin/PEBinaries/
-dNoLogging"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item4>
</BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@ -39,27 +187,31 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="5"> <RequiredPackages Count="6">
<Item1> <Item1>
<PackageName Value="multiloglaz"/> <PackageName Value="lclextensions_package"/>
<MinVersion Minor="3" Valid="True"/>
</Item1> </Item1>
<Item2> <Item2>
<PackageName Value="LazOpenGLContext"/> <PackageName Value="multiloglaz"/>
<MinVersion Valid="True"/>
</Item2> </Item2>
<Item3> <Item3>
<PackageName Value="LCL"/> <PackageName Value="LazOpenGLContext"/>
<MinVersion Valid="True"/>
</Item3> </Item3>
<Item4> <Item4>
<PackageName Value="lnetvisual"/> <PackageName Value="LCL"/>
<MinVersion Minor="5" Release="3" Valid="True"/>
</Item4> </Item4>
<Item5> <Item5>
<PackageName Value="lnetvisual"/>
<MinVersion Minor="5" Release="3" Valid="True"/>
</Item5>
<Item6>
<PackageName Value="virtualtreeview_package"/> <PackageName Value="virtualtreeview_package"/>
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/> <MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
</Item5> </Item6>
</RequiredPackages> </RequiredPackages>
<Units Count="46"> <Units Count="60">
<Unit0> <Unit0>
<Filename Value="CentrED.lpr"/> <Filename Value="CentrED.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -330,37 +482,125 @@
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmLightlevel"/> <UnitName Value="UfrmLightlevel"/>
</Unit45> </Unit45>
<Unit46>
<Filename Value="../UEnhancedMemoryStream.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UEnhancedMemoryStream"/>
</Unit46>
<Unit47>
<Filename Value="UndoRedoCmd.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UndoRedoCmd"/>
</Unit47>
<Unit48>
<Filename Value="../UOLib/UArt.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UArt"/>
</Unit48>
<Unit49>
<Filename Value="../vinfo.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="vinfo"/>
</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"/>
<UnitName Value="UfrmFillSettings"/>
</Unit51>
<Unit52>
<Filename Value="Tools/UfrmSelectionSettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSelectionSettings"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmSelectionSettings"/>
</Unit52>
<Unit53>
<Filename Value="Tools/UfrmSurfStretchSettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSurfStretchSettings"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmSurfStretchSettings"/>
</Unit53>
<Unit54>
<Filename Value="Tools/UfrmSurfElevateSettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSurfElevateSettings"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmSurfElevateSettings"/>
</Unit54>
<Unit55>
<Filename Value="Tools/UfrmSurfSmoothSettings.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSurfSmoothSettings"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="UfrmSurfSmoothSettings"/>
</Unit55>
<Unit56>
<Filename Value="Crc32Hash.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Crc32Hash"/>
</Unit56>
<Unit57>
<Filename Value="../UOLib/UUopFile.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UUopFile"/>
</Unit57>
<Unit58>
<Filename Value="GUI/AeroGlass.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="AeroGlass"/>
</Unit58>
<Unit59>
<Filename Value="GUI/VirtualList.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="VirtualList"/>
</Unit59>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="8"/> <Version Value="9"/>
<Target> <Target>
<Filename Value="../bin/CentrED"/> <Filename Value="../bin/PEBinaries/CentrED-plus.exe"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="$(ProjOutDir)/;../Imaging/;../"/> <IncludeFiles Value="..;../obj;../Imaging;$(ProjOutDir)"/>
<OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/;../Imaging/JpegLib/;../Imaging/ZLib/;Tools/"/> <OtherUnitFiles Value="Tools;..;../UOLib;../Server;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;GUI"/>
<UnitOutputDirectory Value="../obj/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="../obj"/>
<SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/;../;../UOLib/;../MulProvider/;../Imaging/;../Imaging/JpegLib/;../Imaging/ZLib/;Tools/"/> <LCLWidgetType Value="win32"/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>
<SyntaxOptions> <SyntaxOptions>
<CStyleOperator Value="False"/> <UseAnsiStrings Value="False"/>
<UseAnsiStrings Value="True"/>
</SyntaxOptions> </SyntaxOptions>
</Parsing> </Parsing>
<CodeGeneration> <CodeGeneration>
<SmartLinkUnit Value="True"/> <Checks>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
</Checks>
<TargetProcessor Value="pentium4"/>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
<Optimizations> <Optimizations>
<OptimizationLevel Value="3"/> <OptimizationLevel Value="3"/>
</Optimizations> </Optimizations>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>
<UseLineInfoUnit Value="False"/> <GenerateDebugInfo Value="True"/>
<StripSymbols Value="True"/>
</Debugging> </Debugging>
<LinkSmart Value="True"/>
<Options> <Options>
<Win32> <Win32>
<GraphicApplication Value="True"/> <GraphicApplication Value="True"/>
@ -370,9 +610,10 @@
<Other> <Other>
<CompilerMessages> <CompilerMessages>
<IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/> <IgnoredMessages idx4079="True" idx4080="True" idx4081="True" idx5024="True" idx5028="True"/>
<UseMsgFile Value="True"/>
</CompilerMessages> </CompilerMessages>
<CustomOptions Value="-FE../bin/ <CustomOptions Value="-FE../bin/PEBinaries/
-dNoLogging"/> +-dNoLogging"/>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>

95
Client/CentrED.lpr
View File

@ -21,7 +21,7 @@
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2009 Andreas Schneider * Portions Copyright 2010 Andreas Schneider
*) *)
program CentrED; program CentrED;
@ -31,21 +31,104 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads} {$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
SysUtils, Classes, SysUtils,
Interfaces, // this includes the LCL widgetset Interfaces, // this includes the LCL widgetset
Forms, LResources, UdmNetwork; Forms, Dialogs, Windows, UdmNetwork, UResourceManager;
{$IFDEF WINDOWS}{$R CentrED.rc}{$ENDIF} {$R CentrED.res}
{$R CentrED.manifest.rc}
function GetApplicationName: String; function GetApplicationName: String;
begin begin
Result := 'CentrED'; Result := 'CentrED-plus';
end; 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;
begin begin
{$I CentrED.lrs} 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;
end;
begin
Application.Title:='CentrED+';
OnGetApplicationName := @GetApplicationName; OnGetApplicationName := @GetApplicationName;
Application.Initialize; Application.Initialize;
if LowerCase(ChangeFileExt(ExtractFileName(ParamStr(0)), '')) <> LowerCase(GetApplicationName) then
begin
MessageDlg('Ошибка', 'Исполняемый файл был переименован. Переименуйте ' +
'файл следующим образом: "' +
GetApplicationName + '.exe"', mtError, [mbOK], 0);
Application.Terminate;
end;
if Paramcount = 1 then begin
MessageDlg('Параметры запуска', ParamStr(1), mtError, [mbOK], 0);
end;
// Загрузка курсоров ...
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
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');
// Запуск программы...
Application.CreateForm(TdmNetwork, dmNetwork); Application.CreateForm(TdmNetwork, dmNetwork);
Application.Run; Application.Run;
end. end.

35
Client/CentrED.manifest
View File

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

194
Client/Crc32Hash.pas Normal file
View File

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

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

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

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

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

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

@ -0,0 +1,703 @@
unit VirtualList;
{$mode delphi}{$H+}
interface
uses
Windows, Forms, Controls, StdCtrls, Graphics, Classes, SysUtils, VirtualTrees,
Logging, LMessages, ShellAPI, 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;
PVirtualItem = ^TVirtualItem;
TVirtualItem = record
NextItem: PVirtualItem;
Node: PVirtualNode;
Column: Word;
Selected: Boolean;
end;
TVirtualList = class(TVirtualDrawTree)
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(var Message: TLMMouse; 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: TVirtualDrawTree;
column: TVirtualTreeColumn;
c: Integer;
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.Create START');
if not (AOwner is TVirtualDrawTree) then begin
Logger.Send([lcClient, lcDebug], 'TVirtualTree.Create(AOwner: TVirtualDrawTree) must get argument TVirtualDrawTree');
Assert(not (AOwner is TVirtualDrawTree), 'TVirtualTree.Create(AOwner: TVirtualDrawTree) must get argument TVirtualDrawTree');
Abort;
Halt;
end;
inherited Create(AOwner.Owner);
Pvdt := TVirtualDrawTree(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;
end;
procedure TVirtualList.HandleMouseUp(var Message: TLMMouse; const HitInfo: THitInfo);
begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.HandleMouseUp %s', ['Start']);
inherited HandleMouseUp(Message, HitInfo);
end;
//----------------------------------------------------------------------------------------------------------------------
end.

39
Client/ResourceList.txt
View File

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

BIN
Client/Sounds/MusicInf.wav Normal file
View File

Binary file not shown.

399
Client/Tools/UfrmBoundaries.lfm
View File

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

102
Client/Tools/UfrmBoundaries.pas
View File

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

19
Client/Tools/UfrmConfirmation.lfm
View File

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

10
Client/Tools/UfrmConfirmation.pas
View File

@ -39,6 +39,7 @@ type
TfrmConfirmation = class(TForm) TfrmConfirmation = class(TForm)
btnYes: TButton; btnYes: TButton;
btnNo: TButton; btnNo: TButton;
procedure FormCreate(Sender: TObject);
private private
{ private declarations } { private declarations }
public public
@ -50,6 +51,15 @@ var
implementation implementation
uses Language;
{ TfrmConfirmation }
procedure TfrmConfirmation.FormCreate(Sender: TObject);
begin
LanguageTranslate(Self);
end;
initialization initialization
{$I UfrmConfirmation.lrs} {$I UfrmConfirmation.lrs}

142
Client/Tools/UfrmDrawSettings.lfm
View File

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

66
Client/Tools/UfrmDrawSettings.pas
View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Spin, ExtCtrls, LMessages, UfrmToolWindow; Spin, ExtCtrls, LMessages, VirtualTrees, VirtualList, UfrmToolWindow, UfrmMain;
type type
@ -39,17 +39,25 @@ type
TfrmDrawSettings = class(TfrmToolWindow) TfrmDrawSettings = class(TfrmToolWindow)
cbForceAltitude: TCheckBox; cbForceAltitude: TCheckBox;
cbProbability: TCheckBox;
cbUseSurfaceAltitude: TCheckBox;
cbRandomHeight: TCheckBox; cbRandomHeight: TCheckBox;
cbUseFreeTilesOnly: TCheckBox;
seProbability: TFloatSpinEdit;
gbHue: TGroupBox; gbHue: TGroupBox;
pbHue: TPaintBox; pbHue: TPaintBox;
rbRandom: TRadioButton; rbRandom: TRadioButton;
rbTileList: TRadioButton; rbTileList: TRadioButton;
seForceAltitude: TSpinEdit; seForceAltitude: TSpinEdit;
seRandomHeight: TSpinEdit; seRandomHeight: TSpinEdit;
procedure cbUseSurfaceAltitudeChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure pbHueClick(Sender: TObject); procedure pbHueClick(Sender: TObject);
procedure pbHuePaint(Sender: TObject); procedure pbHuePaint(Sender: TObject);
procedure rbRandomChange(Sender: TObject);
procedure seForceAltitudeChange(Sender: TObject); procedure seForceAltitudeChange(Sender: TObject);
procedure seProbabilityChange(Sender: TObject);
procedure seRandomHeightChange(Sender: TObject); procedure seRandomHeightChange(Sender: TObject);
private private
FCanClose: Boolean; FCanClose: Boolean;
@ -63,7 +71,14 @@ var
implementation implementation
uses uses
UGameResources, UHue, UfrmHueSettings; UGameResources, UHue, UfrmHueSettings, Language;
type
PTileInfo = ^TTileInfo;
TTileInfo = record
ID: LongWord;
ptr: Pointer;
end;
{ TfrmDrawSettings } { TfrmDrawSettings }
@ -79,6 +94,34 @@ end;
procedure TfrmDrawSettings.FormCreate(Sender: TObject); procedure TfrmDrawSettings.FormCreate(Sender: TObject);
begin begin
FCanClose := True; FCanClose := True;
cbUseSurfaceAltitudeChange(Sender);
end;
procedure TfrmDrawSettings.FormShow(Sender: TObject);
var
item: PVirtualItem;
tileInfo: PTileInfo;
selectedID: LongWord;
begin
LanguageTranslate(Self);
item := frmMain.vdtTiles.GetFirstSelected;
if item <> nil then
begin
tileInfo := frmMain.vdtTiles.GetNodeData(item);
selectedID := tileInfo^.ID;
end;
if (selectedID < $4000) or (selectedID >= $2F000000)
then begin
cbUseFreeTilesOnly.Checked:= False;
cbUseFreeTilesOnly.Enabled:= False;
if (selectedID >= $2F000000) then
cbProbability.Enabled:= False;
end else begin
cbUseFreeTilesOnly.Enabled:= True;
cbProbability.Enabled:= True;
end;
(frmDrawSettings as TfrmToolWindow).FormShow(Sender);
end; end;
procedure TfrmDrawSettings.pbHuePaint(Sender: TObject); procedure TfrmDrawSettings.pbHuePaint(Sender: TObject);
@ -96,6 +139,23 @@ begin
end; end;
end; end;
procedure TfrmDrawSettings.rbRandomChange(Sender: TObject);
begin
if frmMain.mnuAutoHideRandomList.Checked then
frmMain.mnuAutoHideRandomListClick(Sender);
end;
procedure TfrmDrawSettings.seProbabilityChange(Sender: TObject);
begin
cbProbability.Checked := (seProbability.Value < seProbability.MaxValue);
end;
procedure TfrmDrawSettings.cbUseSurfaceAltitudeChange(Sender: TObject);
begin
cbForceAltitude.Enabled := not cbUseSurfaceAltitude.Checked;
seForceAltitude.Enabled := not cbUseSurfaceAltitude.Checked;
end;
procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject); procedure TfrmDrawSettings.seForceAltitudeChange(Sender: TObject);
begin begin
cbForceAltitude.Checked := True; cbForceAltitude.Checked := True;
@ -103,7 +163,7 @@ end;
procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject); procedure TfrmDrawSettings.seRandomHeightChange(Sender: TObject);
begin begin
cbRandomHeight.Checked := True; cbRandomHeight.Checked := (seRandomHeight.Value <> 0);
end; end;
function TfrmDrawSettings.CanClose: Boolean; function TfrmDrawSettings.CanClose: Boolean;

37
Client/Tools/UfrmElevateSettings.lfm
View File

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

8
Client/Tools/UfrmElevateSettings.pas
View File

@ -44,6 +44,7 @@ type
rbSet: TRadioButton; rbSet: TRadioButton;
seRandomHeight: TSpinEdit; seRandomHeight: TSpinEdit;
seZ: TSpinEdit; seZ: TSpinEdit;
procedure FormCreate(Sender: TObject);
procedure seRandomHeightChange(Sender: TObject); procedure seRandomHeightChange(Sender: TObject);
public public
{ public declarations } { public declarations }
@ -54,6 +55,8 @@ var
implementation implementation
uses Language;
{ TfrmElevateSettings } { TfrmElevateSettings }
procedure TfrmElevateSettings.seRandomHeightChange(Sender: TObject); procedure TfrmElevateSettings.seRandomHeightChange(Sender: TObject);
@ -61,6 +64,11 @@ begin
cbRandomHeight.Checked := True; cbRandomHeight.Checked := True;
end; end;
procedure TfrmElevateSettings.FormCreate(Sender: TObject);
begin
LanguageTranslate(Self);
end;
initialization initialization
{$I UfrmElevateSettings.lrs} {$I UfrmElevateSettings.lrs}

206
Client/Tools/UfrmFillSettings.lfm Normal file
View File

@ -0,0 +1,206 @@
inherited frmFillSettings: TfrmFillSettings
Left = 1248
Height = 377
Top = 177
Width = 469
Caption = 'Опции заливки'
ClientHeight = 377
ClientWidth = 469
OnCreate = FormCreate
OnShow = FormShow
object vdtLastPreview: TVirtualDrawTree[0]
Tag = -1
AnchorSideLeft.Control = cbCategory
AnchorSideTop.Control = gbHue
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbHue
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Cursor = crHandPoint
Left = 4
Height = 320
Hint = '-'
Top = 53
Width = 64
Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Top = 2
BorderSpacing.Bottom = 4
BorderStyle = bsNone
Color = clBlack
Colors.DropMarkColor = 16762250
Colors.DropTargetColor = 16762250
Colors.DropTargetBorderColor = 16762250
Colors.FocusedSelectionColor = 16762250
Colors.FocusedSelectionBorderColor = 16762250
Colors.HotColor = clYellow
Colors.SelectionRectangleBlendColor = 16762250
Colors.SelectionRectangleBorderColor = 16762250
Colors.UnfocusedSelectionColor = 16769734
Colors.UnfocusedSelectionBorderColor = 16769734
Constraints.MinHeight = 64
DefaultNodeHeight = 44
DragMode = dmAutomatic
DragOperations = []
DragType = dtVCL
Header.AutoSizeIndex = -1
Header.Columns = <>
Header.DefaultHeight = 17
Header.MainColumn = -1
Header.Options = [hoShowHint]
Header.ParentFont = True
Header.Style = hsFlatButtons
HintMode = hmHint
ParentShowHint = False
ScrollBarOptions.ScrollBars = ssNone
ShowHint = True
TabOrder = 1
TreeOptions.AutoOptions = [toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag]
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toStaticBackground]
TreeOptions.SelectionOptions = [toMultiSelect]
Visible = False
OnDrawNode = vdtPreviewDrawNode
end
object vdtEntryPreview: TVirtualDrawTree[1]
Tag = -1
AnchorSideLeft.Control = vdtLastPreview
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = vdtLastPreview
AnchorSideRight.Control = gbHue
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = vdtLastPreview
AnchorSideBottom.Side = asrBottom
Cursor = crHandPoint
Left = 72
Height = 320
Hint = '-'
Top = 53
Width = 393
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderStyle = bsNone
Color = clBlack
Colors.DropMarkColor = 16762250
Colors.DropTargetColor = 16762250
Colors.DropTargetBorderColor = 16762250
Colors.FocusedSelectionColor = 16762250
Colors.FocusedSelectionBorderColor = 16762250
Colors.HotColor = clYellow
Colors.SelectionRectangleBlendColor = 16762250
Colors.SelectionRectangleBorderColor = 16762250
Colors.UnfocusedSelectionColor = 16769734
Colors.UnfocusedSelectionBorderColor = 16769734
Constraints.MinHeight = 64
DefaultNodeHeight = 44
DragMode = dmAutomatic
DragOperations = []
DragType = dtVCL
Header.AutoSizeIndex = -1
Header.Columns = <>
Header.DefaultHeight = 17
Header.MainColumn = -1
Header.Options = [hoShowHint]
Header.ParentFont = True
Header.Style = hsFlatButtons
HintMode = hmHint
ParentShowHint = False
ScrollBarOptions.AlwaysVisible = True
ScrollBarOptions.ScrollBars = ssVertical
ShowHint = True
TabOrder = 5
TreeOptions.AutoOptions = [toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag]
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toStaticBackground]
TreeOptions.SelectionOptions = [toMultiSelect]
Visible = False
OnDrawNode = vdtPreviewDrawNode
end
object gbHue: TGroupBox[2]
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 239
Height = 49
Top = 2
Width = 226
Anchors = [akTop, akRight]
BorderSpacing.Top = 2
BorderSpacing.Right = 4
Caption = 'Цвет (Только для Статики)'
ClientHeight = 31
ClientWidth = 222
TabOrder = 0
object pbHue: TPaintBox
Cursor = crHandPoint
Left = 4
Height = 27
Top = 0
Width = 214
Align = alClient
BorderSpacing.Left = 4
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
OnClick = pbHueClick
OnPaint = pbHuePaint
end
end
object cbCategory: TComboBox[3]
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = lblFillType
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 23
Top = 20
Width = 120
BorderSpacing.Left = 4
BorderSpacing.Top = 1
ItemHeight = 15
Sorted = True
Style = csDropDownList
TabOrder = 2
end
object cbFillReview: TCheckBox[4]
AnchorSideLeft.Control = cbFillConfirm
AnchorSideBottom.Control = cbFillConfirm
Left = 132
Height = 19
Top = 7
Width = 103
Anchors = [akLeft, akBottom]
Caption = 'Предпросмотр'
TabOrder = 3
end
object cbFillConfirm: TCheckBox[5]
AnchorSideLeft.Control = cbCategory
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Control = gbHue
AnchorSideBottom.Side = asrBottom
Left = 132
Height = 19
Top = 26
Width = 107
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Bottom = 6
Caption = 'Подтверждение'
TabOrder = 4
end
object lblFillType: TLabel[6]
AnchorSideLeft.Control = cbCategory
AnchorSideTop.Control = Owner
AnchorSideRight.Side = asrBottom
Left = 4
Height = 16
Top = 3
Width = 72
BorderSpacing.Top = 3
Caption = 'Тип заливки:'
ParentColor = False
end
inherited tmClose: TTimer[7]
left = 80
end
end

187
Client/Tools/UfrmFillSettings.pas Normal file
View File

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

348
Client/Tools/UfrmFilter.lfm
View File

@ -1,19 +1,23 @@
object frmFilter: TfrmFilter object frmFilter: TfrmFilter
Left = 290 Left = 1498
Height = 492 Height = 492
Top = 171 Top = 0
Width = 232 Width = 232
ActiveControl = rgFilterType.RadioButton0
BorderIcons = [biSystemMenu, biMinimize] BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsToolWindow BorderStyle = bsToolWindow
Caption = 'Filter' Caption = 'Фильтр'
ClientHeight = 492 ClientHeight = 492
ClientWidth = 232 ClientWidth = 232
Font.Height = -11 Font.Height = -11
KeyPreview = True
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnKeyDown = FormKeyDown
OnMouseDown = FormMouseDown
OnMouseUp = FormMouseUp
OnShow = FormShow OnShow = FormShow
LCLVersion = '0.9.29' ShowInTaskBar = stNever
LCLVersion = '0.9.30.2'
object rgFilterType: TRadioGroup object rgFilterType: TRadioGroup
Left = 4 Left = 4
Height = 40 Height = 40
@ -22,7 +26,7 @@ object frmFilter: TfrmFilter
Align = alTop Align = alTop
AutoFill = True AutoFill = True
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Filter rule' Caption = 'Правило фильтра'
ChildSizing.LeftRightSpacing = 6 ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6 ChildSizing.TopBottomSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
@ -31,15 +35,18 @@ object frmFilter: TfrmFilter
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 2 ChildSizing.ControlsPerLine = 2
ClientHeight = 26 ClientHeight = 22
ClientWidth = 222 ClientWidth = 220
Columns = 2 Columns = 2
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
'Exclusive' 'Исключающий'
'Inclusive' 'Включающий'
) )
OnClick = rgFilterTypeClick OnClick = rgFilterTypeClick
OnKeyDown = FormKeyDown
OnMouseDown = FormMouseDown
OnMouseUp = FormMouseUp
TabOrder = 0 TabOrder = 0
end end
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
@ -49,25 +56,31 @@ object frmFilter: TfrmFilter
Width = 224 Width = 224
Align = alClient Align = alClient
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Tile filter' Caption = 'Фильтрация тайлов'
ClientHeight = 245 ClientHeight = 241
ClientWidth = 222 ClientWidth = 220
TabOrder = 1 TabOrder = 1
OnMouseDown = FormMouseDown
OnMouseUp = FormMouseUp
object Label1: TLabel object Label1: TLabel
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = btnClear
AnchorSideTop.Control = cbTileFilter AnchorSideLeft.Side = asrBottom
AnchorSideTop.Side = asrBottom AnchorSideTop.Control = btnClear
AnchorSideRight.Control = GroupBox1 AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 4 Left = 56
Height = 30 Height = 25
Top = 30 Top = 215
Width = 214 Width = 164
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 4 BorderSpacing.Left = 4
Caption = 'Drag and Drop static tiles from the tile list on this list to add them to the filter.' Caption = 'Чтобы добавить тайлы - перетащите предметы в список из списка тайлов.'
Font.Height = -9
ParentColor = False ParentColor = False
ParentFont = False
WordWrap = True WordWrap = True
OnMouseDown = FormMouseDown
OnMouseUp = FormMouseUp
end end
object btnClear: TSpeedButton object btnClear: TSpeedButton
AnchorSideLeft.Control = btnDelete AnchorSideLeft.Control = btnDelete
@ -78,46 +91,45 @@ object frmFilter: TfrmFilter
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 30 Left = 30
Height = 22 Height = 22
Hint = 'Clear' Hint = 'Очистить список'
Top = 219 Top = 215
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000003ADCFE004800 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
3A00FEFF4800FCFF1C00FCFF1C0080FF9C00003BD700AF9AFF00002CC600FDEB FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
9B000000000000000000000000000000000000000000000000000EECFF00B2FC FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
FF000046C00078D0FF000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 640C00005D7300005DBA00005DCC00005DCC00005DCC00005DCC00005DCC0000
EFFF0000EDFF0000EDFFCBF3FC008905000024AEEF00E4A81C000000DB00B29E 5DCC00005DCC00005DCC00005DBA00005D730000640CFFFFFF00FFFFFF000000
FF0088000D000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111
F7FF3242F7FF141BF1FF0000EDFFFCFF1C00FCFF1C0080FF9C0004000000FFBC D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D73FFFFFF00FFFFFF000000
00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111
F5FF161BF5FF3343F7FF141BF1FF0000EDFFE4FF5C000050FF004C0000000000 D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBAFFFFFF00FFFFFF000000
F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111
F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF000008000052FF000000 B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CCFFFFFF00FFFFFF000000
FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA
FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF0000CC0088005B000000 EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CCFFFFFF00FFFFFF000000
FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6
FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00B8FF00E3FFA8000000 E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCCFFFFFF00FFFFFF000000
FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2
FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF08009000FCFF72000000 E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CCFFFFFF00FFFFFF000000
FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC
FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF02000000E4FF5C000000 DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CCFFFFFF00FFFFFF000000
FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB
FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FFFCFF1C00000000000000 DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACCFFFFFF00FFFFFF000000
FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF
FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000CCFF4C000000 FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECCFFFFFF00FFFFFF000000
FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F
FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CCFFFFFF00FFFFFF000000
00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B
FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BAFFFFFF00FFFFFF000000
0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D
FEFF5461FEFF2227FCFF0000FBFFFCFF1C00000000000000000008000000EFEF F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A873FFFFFF00FFFFFF000000
EF00EFEFEF00EFEFEF000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000
FDFF0000FDFF0000FDFF000000000000000000000000000000009034DE009034 AACC0000AACC0000AACC0000AABA0000AA730000A90CFFFFFF00FFFFFF00FFFF
DE00D86FDF00D86FDF00E0A223004AC6080000000000580000005870DF000C70 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
DF000000000000000000000000002070DF000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0 NumGlyphs = 0
OnClick = btnClearClick OnClick = btnClearClick
@ -130,47 +142,46 @@ object frmFilter: TfrmFilter
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 4 Left = 4
Height = 22 Height = 22
Hint = 'Delete' Hint = 'Удалить выделенные'
Top = 219 Top = 215
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
20000000000000040000640000006400000000000000000000004F91AB005588 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
9C0043718A004E6974003E4B4C00457796003E6A950037556C005C7E8800548B FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
A00031464100FFFFFF002B3238002D3B430074B9C8007FC4D5004788A7004A92 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
B500435E6F002E3040002E3538003D5E7B003853BEFF3551BDFF304BBCFF2E4E 640C00005D7300005DBA00005DCC00005DCC00005DCC00005DCC00005DCC0000
B8FF303B3600FFFFFF00313637002C2D2B00588997007BC3D400365F8400396E 5DCC00005DCC00005DCC00005DBA00005D730000640CFFFFFF00FFFFFF000000
9A003B6282003A5564004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111
E4FF334DC1FF2B4AB7FFFFFFFF0036423900486B710061B4CE00396F9600375C D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D73FFFFFF00FFFFFF000000
83004085B1004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 7DBA1616CBF91111D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111
EEFF9EA0F4FF515DD7FF2B4AB7FFFFFFFF00354C4C004D94AF00375D7F003348 D1FF1111D1FF1111D1FF1111D1FF0F0FC8F900007DBAFFFFFF00FFFFFF000000
5C005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 84CC1C1CCEFF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FFFFFFFF004A90A6003B5864003D5B C8FF1111C8FF1111C8FF1111C8FF1111C8FF000084CCFFFFFF00FFFFFF000000
6A004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 89CC2222C8FF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF57929C00498BA40047676D005C62 BEFF1111BEFF1111BEFF1111BEFF1212BEFF000089CCFFFFFF00FFFFFF000000
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 8DCC3434C7FF1212B4FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF54839500FFFFFF005F63 A8FF1111A8FF1111A8FF1111B4FF1414B6FF00008DCCFFFFFF00FFFFFF000000
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 92CC4646CEFF2626B5FFD0D0D0FFCCCCCCFFD1D1D1FFDCDCDCFFE8E8E8FFEEEE
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF6FA2AF00000000006469 EEFFEEEEEEFFEEEEEEFF1111AAFF1818B0FF000092CCFFFFFF00FFFFFF000000
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 96CC4A4AD2FF3333BBFFF8F8F8FFDEDEDEFFCECECEFFD1D1D1FFDCDCDCFFE8E8
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF58B2E00000000000676A E8FFEEEEEEFFEEEEEEFF1111A1FF1D1DACFF000096CCFFFFFF00FFFFFF000000
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F 9ACC5050D8FF3737BFFF3737BFFF3737BFFF3232BAFF2727B0FF1C1CA6FF1616
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF000000000800000000E8 A0FF12129CFF12129CFF1616A0FF2B2BB5FF00009ACCFFFFFF00FFFFFF000000
1D007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 9ECC5A5AE2FF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF000000000000000001000100DB12 CAFF4242CAFF4242CAFF4242CAFF4E4ED6FF00009ECCFFFFFF00FFFFFF000000
C0006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 A2CC6262EAFF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4F
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF00000000000000002401AD00BA02 D7FF4F4FD7FF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CCFFFFFF00FFFFFF000000
AE002301AE006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B
FBFFBAC7FCFF707BE9FF4C5BCCFFBB02F00000010000D8000000000000000000 E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BAFFFFFF00FFFFFF000000
000008000000010008006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D
F4FF6670E2FF535ED1FF5031DE005031DE002501AC00B902AD000D040400F804 F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A873FFFFFF00FFFFFF000000
0500F20005000A0106000C040500F8040600686ADDFF6364DCFF6164DAFF5D63 A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000
D9FFF2000700F804610000000000710900005031DE005031DE004034DE004034 AACC0000AACC0000AACC0000AABA0000AA730000A90CFFFFFF00FFFFFF00FFFF
DE0068B0E00068B0E0000E049300F8049500F2009500070102000F049500F804 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0200F2000200080104000E040200F8040400F200040009010500 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0 NumGlyphs = 0
OnClick = btnDeleteClick OnClick = btnDeleteClick
@ -178,20 +189,21 @@ object frmFilter: TfrmFilter
ParentShowHint = False ParentShowHint = False
end end
object vdtFilter: TVirtualDrawTree object vdtFilter: TVirtualDrawTree
Tag = 1 Tag = -1
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = Label1 AnchorSideTop.Control = cbTileFilter
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = GroupBox1 AnchorSideRight.Control = GroupBox1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDelete AnchorSideBottom.Control = btnDelete
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 151 Height = 184
Top = 64 Top = 27
Width = 214 Width = 212
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Color = 16052980
DefaultNodeHeight = 44 DefaultNodeHeight = 44
DragType = dtVCL DragType = dtVCL
Header.AutoSizeIndex = 0 Header.AutoSizeIndex = 0
@ -199,38 +211,115 @@ object frmFilter: TfrmFilter
item item
Position = 0 Position = 0
Text = 'ID' Text = 'ID'
Width = 40
end end
item item
Position = 1 Position = 1
Text = 'Tile' Text = 'Тайл'
Width = 44 Width = 44
end end
item item
Position = 2 Position = 2
Text = 'Name' Text = 'Название'
Width = 100 Width = 108
end
item
MaxWidth = 10
MinWidth = 0
Position = 3
Text = 'tile_separator'
Width = 8
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus]
Position = 4
Text = 'tile_S1'
Width = 46
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus]
Position = 5
Text = 'tile_S2'
Width = 46
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus]
Position = 6
Text = 'tile_S3'
Width = 46
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus]
Position = 7
Text = 'tile_S4'
Width = 46
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus]
Position = 8
Text = 'tile_M1'
Width = 62
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus]
Position = 9
Text = 'tile_M2'
Width = 62
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus]
Position = 10
Text = 'tile_M3'
Width = 62
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus]
Position = 11
Text = 'tile_L1'
Width = 93
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus]
Position = 12
Text = 'tile_L2'
Width = 93
end
item
MaxWidth = 10
MinWidth = 0
Position = 13
Text = 'tile_separator'
Width = 2
end> end>
Header.DefaultHeight = 17 Header.DefaultHeight = 17
Header.Options = [hoColumnResize, hoDrag, hoVisible] Header.Options = [hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
ScrollBarOptions.AlwaysVisible = True
ScrollBarOptions.ScrollBars = ssVertical
TabOrder = 0 TabOrder = 0
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toStaticBackground]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnDragOver = vdtFilterDragOver OnDragOver = vdtFilterDragOver
OnDragDrop = vdtFilterDragDrop OnDragDrop = vdtFilterDragDrop
OnDrawNode = vdtFilterDrawNode OnDrawNode = vdtFilterDrawNode
OnKeyDown = FormKeyDown
end end
object cbTileFilter: TCheckBox object cbTileFilter: TCheckBox
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = GroupBox1
AnchorSideTop.Control = GroupBox1 AnchorSideTop.Control = GroupBox1
Left = 4 Left = 4
Height = 22 Height = 19
Top = 4 Top = 4
Width = 85 Width = 166
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Filter active' Caption = 'Использовать фильтрацию'
OnChange = cbTileFilterChange OnChange = cbTileFilterChange
OnKeyDown = FormKeyDown
OnMouseDown = FormMouseDown
OnMouseUp = FormMouseUp
TabOrder = 1 TabOrder = 1
end end
end end
@ -241,29 +330,35 @@ object frmFilter: TfrmFilter
Width = 224 Width = 224
Align = alBottom Align = alBottom
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Hue filter' Caption = 'Фильтрация цветов'
ClientHeight = 154 ClientHeight = 150
ClientWidth = 222 ClientWidth = 220
TabOrder = 2 TabOrder = 2
OnMouseDown = FormMouseDown
OnMouseUp = FormMouseUp
object cbHueFilter: TCheckBox object cbHueFilter: TCheckBox
Left = 4 Left = 4
Height = 22 Height = 19
Top = 4 Top = 4
Width = 214 Width = 212
Align = alTop Align = alTop
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Filter active' Caption = 'Использовать фильтрацию'
OnChange = cbHueFilterChange OnChange = cbHueFilterChange
OnKeyDown = FormKeyDown
OnMouseDown = FormMouseDown
OnMouseUp = FormMouseUp
TabOrder = 0 TabOrder = 0
end end
object vdtHues: TVirtualDrawTree object vdtHues: TVirtualDrawTree
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 120 Height = 119
Top = 30 Top = 27
Width = 214 Width = 212
Align = alClient Align = alClient
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Color = 16052980
Header.AutoSizeIndex = 2 Header.AutoSizeIndex = 2
Header.Columns = < Header.Columns = <
item item
@ -272,25 +367,28 @@ object frmFilter: TfrmFilter
end end
item item
Position = 1 Position = 1
Text = 'Hue' Text = 'Цвет'
Width = 38 Width = 38
end end
item item
Position = 2 Position = 2
Text = 'Name' Text = 'Название'
Width = 154 Width = 133
end> end>
Header.DefaultHeight = 17 Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
PopupMenu = pmHues PopupMenu = pmHues
ScrollBarOptions.AlwaysVisible = True
ScrollBarOptions.ScrollBars = ssVertical
TabOrder = 1 TabOrder = 1
TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] TreeOptions.MiscOptions = [toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect] TreeOptions.SelectionOptions = [toFullRowSelect]
OnChecked = vdtHuesChecked OnChecked = vdtHuesChecked
OnDrawNode = vdtHuesDrawNode OnDrawNode = vdtHuesDrawNode
OnKeyDown = FormKeyDown
end end
end end
object Splitter1: TSplitter object Splitter1: TSplitter
@ -306,12 +404,18 @@ object frmFilter: TfrmFilter
left = 148 left = 148
top = 404 top = 404
object mnuCheckHues: TMenuItem object mnuCheckHues: TMenuItem
Caption = 'Check all hues' Caption = 'Отметить все цвета'
OnClick = mnuCheckHuesClick OnClick = mnuCheckHuesClick
end end
object mnuUncheckHues: TMenuItem object mnuUncheckHues: TMenuItem
Caption = 'Uncheck all hues' Caption = 'Удалить все цвета'
OnClick = mnuUncheckHuesClick OnClick = mnuUncheckHuesClick
end end
end end
object tFormClose: TTimer
Interval = 10
OnTimer = tFormCloseTimer
left = 192
top = 56
end
end end

181
Client/Tools/UfrmFilter.pas
View File

@ -31,8 +31,8 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, VirtualTrees, LCLIntf, LMessages, Buttons, UPlatformTypes, UStatics, ExtCtrls, VirtualTrees, VirtualList, LCLIntf, LMessages, Buttons, UPlatformTypes,
Menus; UStatics, Menus, Windows, Logging;
type type
@ -55,7 +55,8 @@ type
pmHues: TPopupMenu; pmHues: TPopupMenu;
rgFilterType: TRadioGroup; rgFilterType: TRadioGroup;
Splitter1: TSplitter; Splitter1: TSplitter;
vdtFilter: TVirtualDrawTree; tFormClose: TTimer;
vdtFilter: TVirtualList;
vdtHues: TVirtualDrawTree; vdtHues: TVirtualDrawTree;
procedure btnClearClick(Sender: TObject); procedure btnClearClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject); procedure btnDeleteClick(Sender: TObject);
@ -63,10 +64,18 @@ type
procedure cbTileFilterChange(Sender: TObject); procedure cbTileFilterChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure mnuUncheckHuesClick(Sender: TObject); procedure mnuUncheckHuesClick(Sender: TObject);
procedure mnuCheckHuesClick(Sender: TObject); procedure mnuCheckHuesClick(Sender: TObject);
procedure rgFilterTypeClick(Sender: TObject); procedure rgFilterTypeClick(Sender: TObject);
procedure tFormCloseTimer(Sender: TObject);
procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject; procedure vdtFilterDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode); Pt: TPoint; var Effect: Integer; Mode: TDropMode);
@ -78,6 +87,8 @@ type
procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vdtHuesChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vdtHuesDrawNode(Sender: TBaseVirtualTree; procedure vdtHuesDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo); const PaintInfo: TVTPaintInfo);
private
FLastRMouseDown: DWORD;
protected protected
FLocked: Boolean; FLocked: Boolean;
FCheckedHues: TBits; FCheckedHues: TBits;
@ -86,6 +97,8 @@ type
property Locked: Boolean read FLocked write FLocked; property Locked: Boolean read FLocked write FLocked;
function Filter(AStatic: TStaticItem): Boolean; function Filter(AStatic: TStaticItem): Boolean;
procedure JumpToHue(AHueID: Word); procedure JumpToHue(AHueID: Word);
procedure AddTile(ATileID: LongWord);
procedure AddHue(AHueID: Word);
end; end;
var var
@ -94,16 +107,17 @@ var
implementation implementation
uses uses
UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils; UfrmMain, UGameResources, UHue, UGraphicHelper, UGUIPlatformUtils, Language;
type type
PTileInfo = ^TTileInfo; PTileInfo = ^TTileInfo;
TTileInfo = record TTileInfo = record
ID: Word; ID: LongWord;
ptr: Pointer;
end; end;
PHueInfo = ^THueInfo; PHueInfo = ^THueInfo;
THueInfo = record THueInfo = record
ID: Word; ID: LongWord;
Hue: THue; Hue: THue;
end; end;
@ -111,16 +125,21 @@ type
procedure TfrmFilter.FormShow(Sender: TObject); procedure TfrmFilter.FormShow(Sender: TObject);
var var
upperLeft, lowerLeft: TPoint; wspos : TPoint;
wrect : TRect;
begin begin
upperLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width, 0));
lowerLeft := frmMain.pcLeft.ClientToScreen(Point(frmMain.pcLeft.Width,
frmMain.pcLeft.Height));
Left := upperLeft.x - 8;
Top := upperLeft.y - 8;
Height := lowerLeft.y - upperLeft.y;
SetWindowParent(Handle, frmMain.Handle); SetWindowParent(Handle, frmMain.Handle);
GetWindowRect(frmFilter.Handle, wrect);
wspos := frmMain.oglGameWindow.ClientToScreen(Classes.Point(0, 0));
Left := wspos.X - 1;
Top := wspos.Y - 1;
Height:= frmMain.oglGameWindow.ClientHeight - (wrect.Bottom - wrect.Top - ClientHeight);
end;
procedure TfrmFilter.GroupBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
end; end;
procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject); procedure TfrmFilter.mnuUncheckHuesClick(Sender: TObject);
@ -149,24 +168,27 @@ procedure TfrmFilter.vdtFilterDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var var
sourceTree: TVirtualDrawTree; sourceTree: TVirtualList;
selected, node: PVirtualNode; selected: PVirtualItem;
node: PVirtualNode;
sourceTileInfo, targetTileInfo: PTileInfo; sourceTileInfo, targetTileInfo: PTileInfo;
begin begin
sourceTree := Source as TVirtualDrawTree; sourceTree := Source as TVirtualList;
if (sourceTree <> Sender) and (sourceTree <> nil) and if (sourceTree <> Sender) and (sourceTree <> nil) then
(sourceTree.Tag = 1) then
begin begin
Sender.BeginUpdate; Sender.BeginUpdate;
selected := sourceTree.GetFirstSelected; selected := sourceTree.GetFirstSelected;
while selected <> nil do while selected <> nil do
begin begin
sourceTileInfo := sourceTree.GetNodeData(selected); sourceTileInfo := sourceTree.GetNodeData(selected);
if sourceTileInfo^.ID > $3FFF then if (sourceTileInfo^.ID > $3FFF) and (sourceTileInfo^.ID < $0F000000) then
begin begin
node := Sender.AddChild(nil); //node := Sender.AddChild(nil);
targetTileInfo := Sender.GetNodeData(node); //targetTileInfo := Sender.GetNodeData(node);
targetTileInfo^.ID := sourceTileInfo^.ID; //targetTileInfo^.ID := sourceTileInfo^.ID;
Logger.Send([lcClient, lcDebug], 'TfrmFilter.vdtFilterDragDrop TileID', Format('0x%.8x', [sourceTileInfo^.ID]));
AddTile(sourceTileInfo^.ID);
cbTileFilter.Checked := True; cbTileFilter.Checked := True;
frmMain.InvalidateFilter; frmMain.InvalidateFilter;
end; end;
@ -180,8 +202,7 @@ procedure TfrmFilter.vdtFilterDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean); Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin begin
if (Source <> Sender) and (Source is TVirtualDrawTree) and if (Source <> Sender) and (Source is TVirtualDrawTree) then
(TVirtualDrawTree(Source).Tag = 1) then
begin begin
Accept := True; Accept := True;
end; end;
@ -244,8 +265,8 @@ function TfrmFilter.Filter(AStatic: TStaticItem): Boolean;
var var
found: Boolean; found: Boolean;
tileInfo: PTileInfo; tileInfo: PTileInfo;
node: PVirtualNode; node: PVirtualItem;
id: Word; id: LongWord;
begin begin
if cbTileFilter.Checked then if cbTileFilter.Checked then
begin begin
@ -296,12 +317,70 @@ begin
end; end;
end; end;
procedure TfrmFilter.AddTile(ATileID: LongWord);
var
selected, node: PVirtualItem;
sourceTileInfo, targetTileInfo: PTileInfo;
exists: Boolean;
begin
if (ATileID > $3FFF) and (ATileID < $0F000000) then
begin
exists := False;
vdtFilter.BeginUpdate;
selected := vdtFilter.GetFirst();
while selected <> nil do
begin
sourceTileInfo := vdtFilter.GetNodeData(selected);
if sourceTileInfo^.ID = ATileID then
begin
exists := True;
break;
end;
selected := vdtFilter.GetNext(selected);
end;
if not exists then
begin
node := vdtFilter.AddItem(nil);
targetTileInfo := vdtFilter.GetNodeData(node);
targetTileInfo^.ID := ATileID;
end;
vdtFilter.EndUpdate;
end;
end;
procedure TfrmFilter.AddHue(AHueID: Word);
var
hueInfo: PHueInfo;
node: PVirtualNode;
begin
node := vdtHues.GetFirst;
while node <> nil do
begin
hueInfo := vdtHues.GetNodeData(node);
if hueInfo^.ID = AHueID then
begin
//FCheckedHues.Bits[AHueID] := True;
vdtHues.CheckState[node] := csCheckedNormal;
vdtHues.ClearSelection;
vdtHues.Selected[node] := True;
vdtHues.FocusedNode := node;
node := nil;
end else
node := vdtHues.GetNext(node);
end;
end;
procedure TfrmFilter.FormCreate(Sender: TObject); procedure TfrmFilter.FormCreate(Sender: TObject);
var var
i: Integer; i: Integer;
hueInfo: PHueInfo; hueInfo: PHueInfo;
node: PVirtualNode; node: PVirtualNode;
begin begin
vdtFilter := TVirtualList.Create(vdtFilter);
LanguageTranslate(Self);
FLocked := False; FLocked := False;
vdtFilter.NodeDataSize := SizeOf(TTileInfo); vdtFilter.NodeDataSize := SizeOf(TTileInfo);
vdtHues.NodeDataSize := SizeOf(THueInfo); vdtHues.NodeDataSize := SizeOf(THueInfo);
@ -326,9 +405,56 @@ begin
if FCheckedHues <> nil then FreeAndNil(FCheckedHues); if FCheckedHues <> nil then FreeAndNil(FCheckedHues);
end; end;
procedure TfrmFilter.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_SPACE) and Visible then begin
frmFilter.Locked := True;
frmFilter.Hide;
frmFilter.Locked := False;
// Говно код для задержки чтобы дать время обработать события что возвращают фокус
tFormClose.Interval := 10;
tFormClose.Tag := PtrInt(False);
tFormClose.Enabled := True;
end;
end;
procedure TfrmFilter.tFormCloseTimer(Sender: TObject);
begin
if (Boolean(tFormClose.Tag)) then begin
frmFilter.Locked := True;
frmFilter.Hide;
frmFilter.Locked := False;
end;
frmMain.SetFocus;
tFormClose.Enabled := False;
end;
procedure TfrmFilter.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If Button = mbRight then
FLastRMouseDown := GetTickCount;
end;
procedure TfrmFilter.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (Visible and not frmMain.mnuAutoShowFilterWindow.Checked and (GetTickCount - FLastRMouseDown < 1000)) then
begin
frmFilter.Locked := True;
frmFilter.Hide;
frmFilter.Locked := False;
frmMain.SetFocus;
end;
end;
procedure TfrmFilter.btnDeleteClick(Sender: TObject); procedure TfrmFilter.btnDeleteClick(Sender: TObject);
begin begin
vdtFilter.BeginUpdate;
vdtFilter.DeleteSelectedNodes; vdtFilter.DeleteSelectedNodes;
vdtFilter.EndUpdate;
frmMain.InvalidateFilter;
end; end;
procedure TfrmFilter.cbHueFilterChange(Sender: TObject); procedure TfrmFilter.cbHueFilterChange(Sender: TObject);
@ -344,6 +470,7 @@ end;
procedure TfrmFilter.btnClearClick(Sender: TObject); procedure TfrmFilter.btnClearClick(Sender: TObject);
begin begin
vdtFilter.Clear; vdtFilter.Clear;
frmMain.InvalidateFilter;
end; end;
initialization initialization

603
Client/Tools/UfrmHueSettings.lfm
View File

@ -1,59 +1,588 @@
inherited frmHueSettings: TfrmHueSettings inherited frmHueSettings: TfrmHueSettings
Left = 290 Left = 1300
Height = 209 Height = 496
Top = 171 Top = 33
Width = 217 Width = 516
Caption = 'Hue Settings' Caption = 'Выбор цвета'
ClientHeight = 209 ClientHeight = 496
ClientWidth = 217 ClientWidth = 516
OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnHide = FormHide
OnShow = FormShow
object lblHue: TLabel[0] object lblHue: TLabel[0]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = cbRandom
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = edHue AnchorSideTop.Control = edHue
AnchorSideTop.Side = asrCenter AnchorSideRight.Control = edHue
Left = 8 AnchorSideRight.Side = asrBottom
Left = 410
Height = 16 Height = 16
Top = 12 Top = 9
Width = 26 Width = 30
BorderSpacing.Left = 8 Anchors = [akTop, akRight]
Caption = 'Hue:' BorderSpacing.Left = 2
BorderSpacing.Top = 3
BorderSpacing.Right = 65
Caption = 'Цвет:'
ParentColor = False ParentColor = False
end end
object edHue: TEdit[1] object edHue: TEdit[1]
AnchorSideLeft.Control = lblHue AnchorSideLeft.Control = lblHue
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Owner AnchorSideTop.Control = lbHue
Left = 42 AnchorSideRight.Control = gbPreview
Height = 25 AnchorSideRight.Side = asrBottom
Top = 8 Left = 444
Width = 80 Height = 23
Top = 6
Width = 61
Anchors = [akTop, akRight]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Right = 7
OnEditingDone = edHueEditingDone OnEditingDone = edHueEditingDone
TabOrder = 0 TabOrder = 1
end end
object lbHue: TListBox[2] object lbHue: TListBox[2]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = gbPreview
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 6
Height = 484
Top = 6
Width = 315
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Top = 6
BorderSpacing.Right = 4
BorderSpacing.Bottom = 6
DragMode = dmAutomatic
ItemHeight = 16
OnClick = lbHueDblClick
OnDblClick = lbHueDblClick
OnDrawItem = lbHueDrawItem
OnSelectionChange = lbHueSelectionChange
Style = lbOwnerDrawFixed
TabOrder = 2
end
object gbRandom: TGroupBox[3]
AnchorSideLeft.Control = gbPreview
AnchorSideTop.Control = lbHue
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbPreview
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 325
Height = 250
Top = 240
Width = 187
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Top = 4
BorderSpacing.Bottom = 6
Caption = 'Набор случайных цветов'
ClientHeight = 232
ClientWidth = 183
TabOrder = 3
Visible = False
object btnAddRandom: TSpeedButton
AnchorSideLeft.Control = gbRandom
AnchorSideTop.Control = gbRandom
Left = 4
Height = 22
Hint = 'Add'
Top = 0
Width = 23
BorderSpacing.Left = 4
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000464
000C025D0073025D00BA025D00CC025D00CC025D00CC025D00CC025D00CC025D
00CC025D00CC025D00CC025D00BA025D00730464000CFFFFFF00FFFFFF00066D
0073129208DD20CC10F922D911FF22D911FF22D911FF22D911FF22D911FF22D9
11FF22D911FF22D911FF1FCC0FF9109207DD066D0073FFFFFF00FFFFFF000A7D
00BA25CA15F922D111FF22D111FF22D111FF22D111FF22B611FF22B611FF22D1
11FF22D111FF22D111FF22D111FF20C80FF90A7D00BAFFFFFF00FFFFFF000C84
00CC2BCC1AFF22C811FF22C811FF22C811FF22BC11FFE8E8E8FFECECECFF22BC
11FF22C811FF22C811FF22C811FF22C811FF0C8400CCFFFFFF00FFFFFF000D89
00CC31C620FF22BE11FF22BE11FF22BE11FF22B511FFE4E4E4FFE8E8E8FF22B5
11FF22BE11FF22BE11FF22BE11FF23BE12FF0D8900CCFFFFFF00FFFFFF000E8D
00CC41C330FF23B412FF22A811FF22A811FF22A411FFE0E0E0FFE4E4E4FF22A4
11FF22A811FF22A811FF22B411FF25B514FF0E8D00CCFFFFFF00FFFFFF000F92
00CC52C941FF33AF22FFD4D4D4FFD3D3D3FFD7D7D7FFDCDCDCFFE0E0E0FFE4E4
E4FFE8E8E8FFECECECFF22A611FF28AF17FF0F9200CCFFFFFF00FFFFFF001096
00CC55CC44FF3CB32BFFF8F8F8FFE1E1E1FFD5D5D5FFD7D7D7FFDCDCDCFFE0E0
E0FFE4E4E4FFE8E8E8FF22A011FF2CAA1BFF109600CCFFFFFF00FFFFFF00119A
00CC5AD149FF47BE36FF3EB52DFF3EB52DFF37AE26FFEBEBEBFFE2E2E2FF259D
14FF239B12FF239B12FF279F16FF39B128FF119A00CCFFFFFF00FFFFFF00129E
00CC60D74FFF4EC53DFF4EC53DFF4EC53DFF44BB33FFFFFFFFFFFFFFFFFF44BB
33FF4EC53DFF4EC53DFF4EC53DFF58CF47FF129E00CCFFFFFF00FFFFFF0013A2
00CC67DE56FF57CE46FF57CE46FF57CE46FF4AC139FFFFFFFFFFFFFFFFFF4AC1
39FF57CE46FF57CE46FF57CE46FF60D74FFF13A200CCFFFFFF00FFFFFF0014A5
00BA64DE53F95FD64EFF5FD64EFF5FD64EFF5FD64EFF50C73FFF50C73FFF5FD6
4EFF5FD64EFF5FD64EFF5FD64EFF60DA4FF914A500BAFFFFFF00FFFFFF0014A8
007337C124DD66E054F96EE55DFF6EE55DFF6EE55DFF6EE55DFF6DE45CFF6DE4
5CFF6DE45CFF6DE45CFF64DF53F936BF23DD14A80073FFFFFF00FFFFFF0015A9
000C15AA007315AA00BA15AA00CC15AA00CC15AA00CC15AA00CC15AA00CC15AA
00CC15AA00CC15AA00CC15AA00BA15AA007315A9000CFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
NumGlyphs = 0
OnClick = btnAddRandomClick
ShowHint = True
ParentShowHint = False
end
object btnDeleteRandom: TSpeedButton
AnchorSideLeft.Control = btnAddRandom
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = btnAddRandom
Left = 31
Height = 22
Hint = 'Delete'
Top = 0
Width = 23
BorderSpacing.Left = 4
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
640C00005D7300005DBA00005DCC00005DCC00005DCC00005DCC00005DCC0000
5DCC00005DCC00005DCC00005DBA00005D730000640CFFFFFF00FFFFFF000000
6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111
D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D73FFFFFF00FFFFFF000000
7DBA1616CBF91111D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111
D1FF1111D1FF1111D1FF1111D1FF0F0FC8F900007DBAFFFFFF00FFFFFF000000
84CC1C1CCEFF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111
C8FF1111C8FF1111C8FF1111C8FF1111C8FF000084CCFFFFFF00FFFFFF000000
89CC2222C8FF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111
BEFF1111BEFF1111BEFF1111BEFF1212BEFF000089CCFFFFFF00FFFFFF000000
8DCC3434C7FF1212B4FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111
A8FF1111A8FF1111A8FF1111B4FF1414B6FF00008DCCFFFFFF00FFFFFF000000
92CC4646CEFF2626B5FFD0D0D0FFCCCCCCFFD1D1D1FFDCDCDCFFE8E8E8FFEEEE
EEFFEEEEEEFFEEEEEEFF1111AAFF1818B0FF000092CCFFFFFF00FFFFFF000000
96CC4A4AD2FF3333BBFFF8F8F8FFDEDEDEFFCECECEFFD1D1D1FFDCDCDCFFE8E8
E8FFEEEEEEFFEEEEEEFF1111A1FF1D1DACFF000096CCFFFFFF00FFFFFF000000
9ACC5050D8FF3737BFFF3737BFFF3737BFFF3232BAFF2727B0FF1C1CA6FF1616
A0FF12129CFF12129CFF1616A0FF2B2BB5FF00009ACCFFFFFF00FFFFFF000000
9ECC5A5AE2FF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242
CAFF4242CAFF4242CAFF4242CAFF4E4ED6FF00009ECCFFFFFF00FFFFFF000000
A2CC6262EAFF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4F
D7FF4F4FD7FF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CCFFFFFF00FFFFFF000000
A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B
E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BAFFFFFF00FFFFFF000000
A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D
F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A873FFFFFF00FFFFFF000000
A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000
AACC0000AACC0000AACC0000AABA0000AA730000A90CFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
NumGlyphs = 0
OnClick = btnDeleteRandomClick
ShowHint = True
ParentShowHint = False
end
object btnClearRandom: TSpeedButton
AnchorSideLeft.Control = btnDeleteRandom
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = btnDeleteRandom
Left = 58
Height = 22
Hint = 'Clear'
Top = 0
Width = 23
BorderSpacing.Left = 4
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
640C00005D7300005DBA00005DCC00005DCC00005DCC00005DCC00005DCC0000
5DCC00005DCC00005DCC00005DBA00005D730000640CFFFFFF00FFFFFF000000
6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111
D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D73FFFFFF00FFFFFF000000
7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111
D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBAFFFFFF00FFFFFF000000
84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111
B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CCFFFFFF00FFFFFF000000
89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA
EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CCFFFFFF00FFFFFF000000
8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6
E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCCFFFFFF00FFFFFF000000
92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2
E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CCFFFFFF00FFFFFF000000
96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC
DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CCFFFFFF00FFFFFF000000
9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB
DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACCFFFFFF00FFFFFF000000
9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF
FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECCFFFFFF00FFFFFF000000
A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F
D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CCFFFFFF00FFFFFF000000
A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B
E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BAFFFFFF00FFFFFF000000
A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D
F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A873FFFFFF00FFFFFF000000
A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000
AACC0000AACC0000AACC0000AABA0000AA730000A90CFFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
NumGlyphs = 0
OnClick = btnClearRandomClick
ShowHint = True
ParentShowHint = False
end
object btnRandomPresetSave: TSpeedButton
AnchorSideTop.Control = cbRandomPreset
AnchorSideRight.Control = btnRandomPresetDelete
Left = 131
Height = 22
Hint = 'Save Preset'
Top = 205
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000
000000000000000000000000000000000000BA6833FFC38458FFD38B68FFE18F
70FFDC8D6CFFDA8B6DFFD78A6EFFCD8B6CFFAB6D44FFA65F2EFF00000000BA65
30FFBB6631FFBA6630FFBA6630FFBA6530FFC68355FFEFCEBAFFDDFFFFFF87EE
C7FFA2F4D7FFA2F6D7FF8CEEC7FFE0FFFFFFDDA285FFAB6A3EFFBC6933FFF8F1
EAFFF7ECDFFFF6EADEFFF6EADCFFF6EADCFFC37F51FFEFB69AFFEAF3E8FF51BF
84FF6FC998FF71C999FF54BF84FFE4F4E9FFDD9C7BFFAA693AFFBF7138FFF5EB
DFFFFDBF68FFFBBE65FFFCBE64FFFCBE64FFC48154FFEAB697FFF3F3EAFFEDF1
E6FFEFF1E6FFEFF0E6FFEDF1E5FFF3F5EDFFD59C79FFB07044FFC1783CFFF7ED
E3FFFDC26EFFFFD79EFFFFD69BFFFFD798FFC98B61FFE6B592FFE2A781FFE1A7
81FFDEA37DFFDCA17BFFDB9F79FFD99E77FFD49A73FFBB7E57FFC47C40FFF7F0
E6FFF8B455FFF7B554FFF8B453FFF8B253FFCA8D65FFEAB899FFDDA57EFFDDA6
80FFDBA37CFFD9A07AFFD9A079FFD89F78FFD89E78FFBF845DFFC58245FFF8F2
EBFFFEE7D6FFFDE7D6FFFDE7D6FFFDE6D5FFC8885DFFEFBFA1FFFDFCFAFFFEFC
FBFFFEFDFDFFFEFDFCFFFDFBFAFFFDFCFBFFDDA885FFC17F53FFC68447FFF9F3
ECFFFEE8D6FFFDE7D6FFFDE7D6FFFDE7D5FFC7865BFFEFC09EFFFFFFFFFFCC93
6EFFFFFFFFFFFFFFFFFFFFFBF7FFFFF8F1FFE4AF8CFFC78A61FFC68849FFF9F4
EDFFFEE8D8FFFEE8D7FFFEE7D6FFFDE5D3FFCC8D65FFF3CDB0FFFFFFFFFFE3C7
B3FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEABFA1FFC98960FFC6884AFFF9F4
EFFFFEE7D7FFFDE7D5FFFDE6D4FFFCE6D2FFD4976EFFD49E7BFFD09871FFD6A4
82FFCD8E68FFCD9069FFD09A75FFD19973FFC88B62FF00000000C6894BFFF9F4
F0FFFCE6D3FFFDE7D3FFFCE4D1FFFBE3CDFFFAE0C8FFF8DCC2FFF5D6BBFFF3D4
B5FFF1D2B3FFF8F4F0FFC48246FF000000000000000000000000C6894BFFF9F5
F1FFFCE3CFFFFCE4CFFFFCE3CDFFFAE1CAFFF9DDC4FFF6D9BCFFF4E9DFFFF7F2
ECFFFBF7F3FFF5EFE9FFC27E45FF000000000000000000000000C6894CFFF9F5
F1FFFCE3CDFFFBE3CDFFFBE2CBFFF9E0C8FFF8DCC2FFF5D6BAFFFDFBF8FFFCE6
CDFFFAE5C9FFE2B684FFBF7942FF000000000000000000000000C5884BFFFAF6
F2FFFAE0C7FFFBE2C9FFFBE0C8FFF9DFC5FFF8DBC1FFF4D6B8FFFFFBF8FFF6D8
B4FFE1B07DFFDB9264FF00000000000000000000000000000000C48549FFF7F2
ECFFF8F4EEFFF8F3EDFFF8F3EDFFF8F3EDFFF8F2ECFFF7F2ECFFF2E6D7FFE2B2
7DFFDB9465FF000000000000000000000000000000000000000000000000C88B
4DFFC88C4FFFC88C4FFFC88C4FFFC88D4FFFC98C4FFFC78B4FFFC5894BFFC476
3BFF000000000000000000000000000000000000000000000000
}
NumGlyphs = 0
OnClick = btnRandomPresetSaveClick
ShowCaption = False
ShowHint = True
ParentShowHint = False
end
object btnRandomPresetDelete: TSpeedButton
AnchorSideTop.Control = btnRandomPresetSave
AnchorSideRight.Control = gbRandom
AnchorSideRight.Side = asrBottom
Left = 157
Height = 22
Hint = 'Delete Preset'
Top = 205
Width = 22
Anchors = [akTop, akRight]
BorderSpacing.Right = 4
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000
0000BA6530FFBB6631FFBA6630FFBA6630FFBA6630FFBA6530FFBA652FFFB965
2EFF6E5E76FF1949A8FF0542BBFF1348ADFF394E8FFF0000000000000000BC69
33FFF8F1EAFFF7ECDFFFF6EBDEFFF6EADEFFF6EADCFFF6EADCFFFAF3EBFF8AA5
D7FF2866CAFF2177E6FF0579EAFF0164DDFF064DBBFF0000000000000000BF71
38FFF5EBDFFFFDBF68FFFCBD67FFFBBE65FFFCBE64FFFCBE64FFFCBD62FF1E52
B0FF639DF4FF187FFFFF0076F8FF0076EEFF0368E1FF0345B9FF00000000C178
3CFFF7EDE3FFFDC26EFFFFD8A0FFFFD79EFFFFD69BFFFFD798FFFFD696FF0543
BCFFAECDFEFFFFFFFFFFFFFFFFFFFFFFFFFF187FEFFF0442BCFF00000000C47C
40FFF7F0E6FFF8B455FFF7B456FFF7B554FFF8B453FFF8B253FFF7B352FF2453
ABFF8DB5F6FF4D92FFFF1177FFFF2186FFFF408AEBFF0344B9FF00000000C580
42FFF8F1E8FFFEE5D5FFFDE5D3FFFDE5D3FFFCE5D3FFFCE5D3FFFCE4D1FF94A1
C9FF3D76D1FF8DB5F7FFB8D6FEFF72A8F5FF2F6BC9FF0000000000000000C582
45FFF8F2EBFFFEE7D6FFFDE7D6FFFDE7D6FFFDE7D6FFFDE6D5FFFDE5D3FFFCE4
D1FF94A1C9FF2A5EC1FF0543BCFF1F59BFFF686279FF0000000000000000C684
47FFF9F3ECFFFEE8D6FFFEE8D7FFFDE7D6FFFDE7D6FFFDE7D5FFFDE5D3FFFBE4
D0FFFBE3CCFFFADFC7FFFADFC6FFFAF2EAFFC68042FF0000000000000000C688
49FFF9F4EDFFFEE8D8FFFEE8D8FFFEE8D7FFFEE7D6FFFDE5D3FFFCE4D1FFFBE1
CCFFFAE0C7FFF9DDC3FFF8DCC2FFFAF4EDFFC68245FF0000000000000000C688
4AFFF9F4EFFFFEE7D7FFFDE7D6FFFDE7D5FFFDE6D4FFFCE6D2FFFBE1CCFFFADF
C7FFF8DCC2FFF6DABDFFF6D8BBFFFAF4EFFFC68346FF0000000000000000C689
4BFFF9F4F0FFFCE6D3FFFCE6D4FFFDE7D3FFFCE4D1FFFBE3CDFFFAE0C8FFF8DC
C2FFF5D6BBFFF3D4B5FFF1D2B3FFF8F4F0FFC48246FF0000000000000000C689
4BFFF9F5F1FFFCE3CFFFFBE4D0FFFCE4CFFFFCE3CDFFFAE1CAFFF9DDC4FFF6D9
BCFFF4E9DFFFF7F2ECFFFBF7F3FFF5EFE9FFC27E45FF0000000000000000C689
4CFFF9F5F1FFFCE3CDFFFBE3CEFFFBE3CDFFFBE2CBFFF9E0C8FFF8DCC2FFF5D6
BAFFFDFBF8FFFCE6CDFFFAE5C9FFE2B684FFBF7942FF0000000000000000C588
4BFFFAF6F2FFFAE0C7FFFBE1C9FFFBE2C9FFFBE0C8FFF9DFC5FFF8DBC1FFF4D6
B8FFFFFBF8FFF6D8B4FFE1B07DFFDB9264FF000000000000000000000000C485
49FFF7F2ECFFF8F4EEFFF8F4EDFFF8F3EDFFF8F3EDFFF8F3EDFFF8F2ECFFF7F2
ECFFF2E6D7FFE2B27DFFDB9465FF000000000000000000000000000000000000
0000C88B4DFFC88C4FFFC88C4FFFC88C4FFFC88C4FFFC88D4FFFC98C4FFFC78B
4FFFC5894BFFC4763BFF00000000000000000000000000000000
}
NumGlyphs = 0
OnClick = btnRandomPresetDeleteClick
ShowCaption = False
ShowHint = True
ParentShowHint = False
end
object cbRandomPreset: TComboBox
AnchorSideLeft.Control = gbRandom
AnchorSideRight.Control = btnRandomPresetSave
AnchorSideBottom.Control = gbRandom
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 23
Top = 205
Width = 123
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
ItemHeight = 15
OnChange = cbRandomPresetChange
Sorted = True
Style = csDropDownList
TabOrder = 0
end
object lbRandom: TListBox
AnchorSideLeft.Control = gbRandom
AnchorSideTop.Control = btnAddRandom
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbRandom
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = cbRandomPreset
Left = 4
Height = 177
Top = 24
Width = 175
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Top = 2
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
ItemHeight = 0
MultiSelect = True
OnDragDrop = lbRandomDragDrop
OnDragOver = lbRandomDragOver
OnDrawItem = lbHueDrawItem
Style = lbOwnerDrawVariable
TabOrder = 1
end
end
object gbPreview: TGroupBox[4]
AnchorSideLeft.Control = lbHue
AnchorSideTop.Control = edHue AnchorSideTop.Control = edHue
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = gbLastUsed
AnchorSideBottom.Side = asrBottom Left = 325
Left = 8 Height = 93
Height = 160 Top = 37
Top = 41 Width = 187
Width = 201 Anchors = [akTop, akRight, akBottom]
Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Top = 8
BorderSpacing.Around = 8 BorderSpacing.Right = 4
ItemHeight = 16 BorderSpacing.Bottom = 4
OnDrawItem = lbHueDrawItem Caption = 'Предпросмотр цвета на тайле'
OnSelectionChange = lbHueSelectionChange ClientHeight = 75
Style = lbOwnerDrawFixed ClientWidth = 183
TabOrder = 1 TabOrder = 4
object ImagePreviewItem: TImage
AnchorSideLeft.Control = gbPreview
AnchorSideTop.Control = edTileId
AnchorSideRight.Control = gbPreview
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = gbPreview
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 209
Top = 6
Width = 175
Align = alCustom
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 2
BorderSpacing.Around = 4
end
object edTileId: TEdit
AnchorSideLeft.Control = lblTileId
AnchorSideTop.Control = gbPreview
AnchorSideRight.Control = ImagePreviewItem
AnchorSideRight.Side = asrBottom
Left = 118
Height = 23
Top = 0
Width = 61
Anchors = [akTop, akRight]
BorderSpacing.Left = 36
OnEditingDone = edTileIdEditingDone
TabOrder = 0
end
object lblTileId: TLabel
AnchorSideLeft.Control = gbPreview
AnchorSideTop.Control = edTileId
AnchorSideRight.Control = edTileId
AnchorSideRight.Side = asrBottom
Left = 84
Height = 16
Top = 4
Width = 31
Anchors = [akTop, akRight]
BorderSpacing.Left = 8
BorderSpacing.Top = 4
BorderSpacing.Right = 64
Caption = 'Тайл:'
ParentColor = False
end
object ShowAll: TButton
AnchorSideLeft.Control = ImagePreviewItem
AnchorSideTop.Control = edTileId
AnchorSideRight.Control = edTileId
AnchorSideBottom.Control = edTileId
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 20
Top = 2
Width = 78
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2
BorderSpacing.Right = 4
BorderSpacing.Bottom = 1
Caption = 'Показать все'
OnClick = ShowAllClick
TabOrder = 1
end
end end
inherited tmClose: TTimer[3] object cbRandom: TCheckBox[5]
left = 152 AnchorSideLeft.Control = gbPreview
top = 112 AnchorSideTop.Control = edHue
AnchorSideRight.Control = gbRandom
Left = 325
Height = 19
Top = 7
Width = 84
Align = alCustom
BorderSpacing.Top = 1
Caption = 'Случайный'
OnChange = cbRandomChange
TabOrder = 5
end
object vdtHuePreview: TVirtualDrawTree[6]
Tag = -1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom
Cursor = crHandPoint
Left = 6
Height = 240
Hint = '-'
Top = 259
Width = 314
Anchors = []
BorderSpacing.Top = 1
BorderSpacing.Right = 3
BorderStyle = bsNone
Color = clBlack
Colors.DropMarkColor = 16762250
Colors.DropTargetColor = 16762250
Colors.DropTargetBorderColor = 16762250
Colors.FocusedSelectionColor = 16762250
Colors.FocusedSelectionBorderColor = 16762250
Colors.HotColor = clYellow
Colors.SelectionRectangleBlendColor = 16762250
Colors.SelectionRectangleBorderColor = 16762250
Colors.UnfocusedSelectionColor = 16769734
Colors.UnfocusedSelectionBorderColor = 16769734
Constraints.MinHeight = 64
DefaultNodeHeight = 44
DragMode = dmAutomatic
DragOperations = []
DragType = dtVCL
Header.AutoSizeIndex = -1
Header.Columns = <>
Header.DefaultHeight = 17
Header.MainColumn = -1
Header.Options = [hoShowHint]
Header.ParentFont = True
Header.Style = hsFlatButtons
HintMode = hmHint
ParentShowHint = False
ScrollBarOptions.AlwaysVisible = True
ScrollBarOptions.ScrollBars = ssVertical
ShowHint = True
TabOrder = 0
TreeOptions.AutoOptions = [toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toFullRowDrag]
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toStaticBackground]
TreeOptions.SelectionOptions = [toMultiSelect]
Visible = False
OnClick = vdtHuePreviewClick
OnDblClick = vdtHuePreviewClick
OnDrawNode = vdtHuePreviewDrawNode
OnMouseMove = vdtHuePreviewMouseMove
end
object gbLastUsed: TGroupBox[7]
AnchorSideLeft.Control = gbPreview
AnchorSideTop.Control = lbHue
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = gbPreview
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = gbRandom
Left = 325
Height = 100
Top = 134
Width = 187
Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Top = 4
BorderSpacing.Bottom = 6
Caption = 'Последние выбранные цвета'
ClientHeight = 82
ClientWidth = 183
TabOrder = 6
Visible = False
object lbLastUsed: TListBox
AnchorSideLeft.Control = gbLastUsed
AnchorSideTop.Control = gbLastUsed
AnchorSideRight.Control = gbLastUsed
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = gbLastUsed
AnchorSideBottom.Side = asrBottom
Left = 4
Height = 78
Top = 0
Width = 175
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4
BorderSpacing.Right = 4
BorderSpacing.Bottom = 4
ItemHeight = 0
OnClick = lbLastUsedDblClick
OnDblClick = lbLastUsedDblClick
OnDrawItem = lbHueDrawItem
Style = lbOwnerDrawVariable
TabOrder = 0
end
end
inherited tmClose: TTimer[8]
left = 24
top = 16
end end
end end

647
Client/Tools/UfrmHueSettings.pas
View File

@ -31,33 +31,118 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
UfrmToolWindow, UHue; ExtCtrls, Buttons, UfrmToolWindow, XMLRead, XMLWrite, DOM, VirtualTrees, VirtualList,
Math, UHue, UArt, UTiledata, UfrmMain, ImagingComponents, LConvEncoding, ComCtrls,
Windows, ShellAPI, Logging,
ULandscape;//ImagingClasses, UPlatformTypes;
type type
{ TfrmHueSettings } { TfrmHueSettings }
TfrmHueSettings = class(TfrmToolWindow) TfrmHueSettings = class(TfrmToolWindow)
btnAddRandom: TSpeedButton;
btnClearRandom: TSpeedButton;
btnDeleteRandom: TSpeedButton;
btnRandomPresetDelete: TSpeedButton;
btnRandomPresetSave: TSpeedButton;
gbLastUsed: TGroupBox;
lbLastUsed: TListBox;
ShowAll: TButton;
cbRandom: TCheckBox;
cbRandomPreset: TComboBox;
edHue: TEdit; edHue: TEdit;
edTileId: TEdit;
gbRandom: TGroupBox;
gbPreview: TGroupBox;
ImagePreviewItem: TImage;
lblHue: TLabel; lblHue: TLabel;
lbHue: TListBox; lbHue: TListBox;
lblTileId: TLabel;
lbRandom: TListBox;
vdtHuePreview: TVirtualDrawTree;
procedure btnAddRandomClick(Sender: TObject);
procedure btnClearRandomClick(Sender: TObject);
procedure btnDeleteRandomClick(Sender: TObject);
procedure btnRandomPresetDeleteClick(Sender: TObject);
procedure btnRandomPresetSaveClick(Sender: TObject);
procedure cbRandomChange(Sender: TObject);
procedure cbRandomPresetChange(Sender: TObject);
procedure edHueEditingDone(Sender: TObject); procedure edHueEditingDone(Sender: TObject);
procedure edTileIdEditingDone(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormClose(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure lbHueDblClick(Sender: TObject);
procedure lbHueDrawItem(Control: TWinControl; Index: Integer; ARect: TRect; procedure lbHueDrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
State: TOwnerDrawState); State: TOwnerDrawState);
procedure lbHueSelectionChange(Sender: TObject; User: boolean); procedure lbHueSelectionChange(Sender: TObject; User: boolean);
procedure lbLastUsedDblClick(Sender: TObject);
procedure lbRandomDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure lbRandomDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure lvHueCustomDrawItem(Sender: TCustomListView; Item: TListItem;
State: TCustomDrawState; var DefaultDraw: Boolean);
procedure ShowAllClick(Sender: TObject);
procedure UpdateItemPreview(ID : Integer; Hue: Integer);
procedure vdtHuePreviewClick(Sender: TObject);
procedure vdtHuePreviewDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
procedure vdtHuePreviewMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
FConfigDir: String;
FRandomHuePresetsFile: String;
FRandomHuePresetsDoc: TXMLDocument;
LastSelectedNode: PVirtualNode;
LastSelectedColm: Integer;
LastFormPosition: TPoint;
function FindRandomPreset(AName: String): TDOMElement;
procedure LoadRandomPresets;
procedure SaveRandomPresets;
procedure HuePreviewRebuild(ItemID, ItemWidth, ItemHeight: Integer);
procedure HuePreviewFree();
public
function GetHue: Word;
procedure AddLastUsed(hue: Word);
public public
class procedure DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect; class procedure DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
ACaption: string); ACaption: string; lineWidth: Integer = 2);
public
lbDlgBadColrCaption: string;
lbDlgBadColr: string;
lbDlgBadTileCaption: string;
lbDlgBadTile: string;
lbDlgSavePrsCaption: string;
lbDlgSavePrs: string;
lbNoHuesName: string;
end; end;
const
vdtHuesPreviewColumnsMax = 1920 div 44;
vdtHuesLastUsedLength = 14;
var var
frmHueSettings: TfrmHueSettings; frmHueSettings: TfrmHueSettings;
implementation implementation
uses uses
UGameResources, UGraphicHelper; UGameResources, UGraphicHelper, UfrmLogin, Language;
type
PHuesInfo = ^THuesInfo;
THuesInfo = record
ID : array[0..vdtHuesPreviewColumnsMax] of Integer;
Art: array[0..vdtHuesPreviewColumnsMax] of TArt;
end;
PTileInfo = ^TTileInfo;
TTileInfo = record
ID: LongWord;
ptr: Pointer;
end;
{ TfrmHueSettings } { TfrmHueSettings }
@ -68,48 +153,385 @@ begin
if (not TryStrToInt(edHue.Text, hueID)) or (hueID >= lbHue.Items.Count) then if (not TryStrToInt(edHue.Text, hueID)) or (hueID >= lbHue.Items.Count) then
begin begin
edHue.Text := Format('$%x', [lbHue.ItemIndex]); edHue.Text := Format('$%x', [lbHue.ItemIndex]);
MessageDlg('Invalid Hue', 'The hue you''ve entered is invalid.', mtWarning, [mbOK], 0); MessageDlg(lbDlgBadColrCaption, lbDlgBadColr, mtWarning, [mbOK], 0);
end else end else
lbHue.ItemIndex := hueID; lbHue.ItemIndex := hueID;
end; end;
procedure TfrmHueSettings.edTileIdEditingDone(Sender: TObject);
var
tileID: Integer;
begin
tileID := 0;
if (not TryStrToInt(edTileId.Text, tileID)) or (tileID >= ResMan.Landscape.MaxStaticID) or (tileID <= 0) then
begin
edTileId.Text := Format('$%x', [edTileId.Tag - $4000]);
MessageDlg(lbDlgBadTileCaption, lbDlgBadTile, mtWarning, [mbOK], 0);
end else
begin
edTileId.Tag := $4000 + tileID;
UpdateItemPreview(edTileId.Tag, lbHue.ItemIndex);
end;
end;
procedure TfrmHueSettings.AddLastUsed(hue: Word);
var
index: Integer;
begin
lbLastUsed.Items.BeginUpdate;
for index := 0 to lbLastUsed.Items.Count - 1 do
if PtrInt(lbLastUsed.Items.Objects[index]) = hue then begin
lbLastUsed.Items.Delete(index);
break;
end;
lbLastUsed.Items.InsertObject(0, lbHue.Items.Strings[hue], TObject(PtrInt(hue)));
while lbLastUsed.Items.Count > vdtHuesLastUsedLength do begin
lbLastUsed.Items.Delete(lbLastUsed.Items.Count - 1);
end;
lbLastUsed.Items.EndUpdate;
end;
procedure TfrmHueSettings.lbLastUsedDblClick(Sender: TObject);
var
hue: Integer;
begin
if (lbLastUsed.ItemIndex < 0) or (lbLastUsed.ItemIndex >= lbLastUsed.Items.Count)
then exit;
hue := PtrInt(lbLastUsed.Items.Objects[lbLastUsed.ItemIndex]);
edHue.Text := Format('$%x', [hue]);
edHueEditingDone(Sender);
end;
procedure TfrmHueSettings.btnDeleteRandomClick(Sender: TObject);
var
i: Integer;
begin
lbRandom.Items.BeginUpdate;
for i := lbRandom.Items.Count - 1 downto 0 do
if lbRandom.Selected[i] then
lbRandom.Items.Delete(i);
lbRandom.Items.EndUpdate;
end;
procedure TfrmHueSettings.btnRandomPresetDeleteClick(Sender: TObject);
var
preset: TDOMElement;
begin
if cbRandomPreset.ItemIndex > -1 then
begin
preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]);
FRandomHuePresetsDoc.DocumentElement.RemoveChild(preset);
cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex);
cbRandomPreset.ItemIndex := -1;
end;
end;
procedure TfrmHueSettings.btnRandomPresetSaveClick(Sender: TObject);
var
presetName: string;
i: Integer;
preset, hue: TDOMElement;
children: TDOMNodeList;
begin
presetName := cbRandomPreset.Text;
if InputQuery(lbDlgSavePrsCaption, lbDlgSavePrs, presetName) then
begin
preset := FindRandomPreset(presetName);
if preset = nil then
begin
preset := FRandomHuePresetsDoc.CreateElement('Preset');
preset.AttribStrings['Name'] := UTF8ToCP1251(presetName);
FRandomHuePresetsDoc.DocumentElement.AppendChild(preset);
cbRandomPreset.Items.AddObject(presetName, preset);
end else
begin
children := preset.GetChildNodes;
for i := children.Count - 1 downto 0 do
preset.RemoveChild(children[i]);
end;
for i := 0 to lbRandom.Items.Count - 1 do
begin
hue := FRandomHuePresetsDoc.CreateElement('Hue');
hue.AttribStrings['ID'] := IntToStr(PtrInt(lbRandom.Items.Objects[i]));
preset.AppendChild(hue);
end;
cbRandomPreset.ItemIndex := cbRandomPreset.Items.IndexOfObject(preset);
SaveRandomPresets;
end;
end;
procedure TfrmHueSettings.cbRandomChange(Sender: TObject);
begin
lbHue.MultiSelect := cbRandom.Checked;
gbRandom.Visible := cbRandom.Checked;
gbLastUsed.Visible := not cbRandom.Checked;
end;
procedure TfrmHueSettings.cbRandomPresetChange(Sender: TObject);
var
preset, hue: TDOMElement;
id: PtrInt;
begin
lbRandom.Clear;
if cbRandomPreset.ItemIndex > -1 then
begin
preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]);
hue := TDOMElement(preset.FirstChild);
while hue <> nil do
begin
if hue.NodeName = 'Hue' then
begin
id := StrToInt(hue.AttribStrings['ID']);
lbRandom.Items.AddObject(lbHue.Items.Strings[id], TObject(id));
end;
hue := TDOMElement(hue.NextSibling);
end;
end;
end;
procedure TfrmHueSettings.btnClearRandomClick(Sender: TObject);
begin
lbRandom.Items.Clear;
end;
procedure TfrmHueSettings.btnAddRandomClick(Sender: TObject);
var
i: PtrInt;
begin
lbRandom.Items.BeginUpdate;
for i := 0 to lbHue.Count - 1 do
if lbHue.Selected[i] then
lbRandom.Items.AddObject(lbHue.Items.Strings[i], TObject(i));
lbRandom.Items.EndUpdate;
end;
procedure TfrmHueSettings.FormCreate(Sender: TObject); procedure TfrmHueSettings.FormCreate(Sender: TObject);
var var
i: Integer; i: Integer;
hue: THue; hue: THue;
begin begin
LanguageTranslate(Self);
lbHue.Clear; lbHue.Clear;
lbHue.Items.Add('$0 (no hue)'); lbHue.Items.Add(lbNoHuesName);
for i := 1 to ResMan.Hue.Count do for i := 1 to ResMan.Hue.Count do
begin begin
hue := ResMan.Hue.Hues[i-1]; hue := ResMan.Hue.Hues[i-1];
lbHue.Items.AddObject(Format('$%x (%s)', [i, hue.Name]), hue); lbHue.Items.AddObject(Format('$%x (%s)', [i, hue.Name]), hue);
end; end;
lbHue.ItemIndex := 0; lbHue.ItemIndex := 0;
if (sprofile <> '') then
if (frmMain.ProfileDir <> '')
then FConfigDir := frmMain.ProfileDir
else FConfigDir := frmMain.ConfigDir;
FRandomHuePresetsFile := FConfigDir + 'RandomHuePresets.xml';
ForceDirectories(FConfigDir);
Logger.Send([lcClient, lcInfo], ' FConfigDir', FRandomHuePresetsFile);
LoadRandomPresets;
vdtHuePreview.Align := alClient;
vdtHuePreview.NodeDataSize := SizeOf(THuesInfo);
gbLastUsed.Height := gbRandom.Height;
cbRandomChange(Sender);
//ImagePreviewItem.Height := gbPreview.Height - ImagePreviewItem.Top - 4;
end; end;
procedure TfrmHueSettings.FormShow(Sender: TObject);
var
item: PVirtualItem;
tileInfo: PTileInfo;
selectedID: LongWord;
begin
item := frmMain.vdtTiles.GetFirstSelected;
if item <> nil then
begin
tileInfo := frmMain.vdtTiles.GetNodeData(item);
selectedID := tileInfo^.ID;
end;
if (selectedID < $4000) or (selectedID >= ResMan.Tiledata.StaticCount + $4000)
then selectedID := $4001;
edTileId.Tag := selectedID;
edTileId.Text := Format('$%x', [selectedID - $4000]);
UpdateItemPreview(edTileId.Tag, lbHue.ItemIndex);
vdtHuePreview.Visible := False;
(frmHueSettings as TfrmToolWindow).FormShow(Sender);
gbPreview.Visible := True;
frmHueSettings.Width := 516;
frmHueSettings.Height:= 534;
//lbHue.Visible:= false;
end;
procedure TfrmHueSettings.FormHide(Sender: TObject);
begin
HuePreviewFree();
end;
procedure TfrmHueSettings.FormClose(Sender: TObject);
begin
HuePreviewFree();
end;
procedure TfrmHueSettings.UpdateItemPreview(ID : Integer; Hue: Integer);
var
tileData: TTileData;
artHue: THue;
artEntry: TArt;
artPartial: Boolean;
destRect: TRect;
destColor: Word;
begin
if ResMan.Art.Exists(ID) then
begin
if Hue > 0 then
artHue := ResMan.Hue.Hues[Hue - 1]
else
artHue := nil;
tileData := TTileData(ResMan.Tiledata.Block[ID]);
artPartial := tdfPartialHue in tileData.Flags;
//destColor := ARGB2RGB(ImagePreviewItem.Canvas.Pixels[destRect.Left, destRect.Top]);
destColor := EncodeUOColor($00F0F0F0);
artEntry := ResMan.Art.GetArt(ID, destColor, artHue, artPartial);
destRect.Bottom := Min(artEntry.Graphic.Height, ImagePreviewItem.Canvas.Height);
destRect.Right := Min(artEntry.Graphic.Width, ImagePreviewItem.Canvas.Width);
destRect.Top := ((ImagePreviewItem.Canvas.Height - destRect.Bottom) div 2);
destRect.Left := ((ImagePreviewItem.Canvas.Width - destRect.Right) div 2);
destRect.Bottom := ((ImagePreviewItem.Canvas.Height + destRect.Bottom) div 2);
destRect.Right := ((ImagePreviewItem.Canvas.Width + destRect.Right) div 2);
ImagePreviewItem.Canvas.Brush.Color := $00F5F5F5;//DecodeUOColor(destColor);
ImagePreviewItem.Canvas.Clear;
DisplayImage(ImagePreviewItem.Canvas, destRect, artEntry.Graphic);
ImagePreviewItem.Update;
artEntry.Free;
end;
end;
procedure TfrmHueSettings.lbHueDrawItem(Control: TWinControl; Index: Integer; procedure TfrmHueSettings.lbHueDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState); ARect: TRect; State: TOwnerDrawState);
var var
hue: THue; hue: THue;
begin begin
if Index > 0 then if ((Control = lbRandom) or (Control = lbLastUsed)) then begin
hue := ResMan.Hue.Hues[Index-1] Index := PtrInt((Control as TListBox).Items.Objects[Index]);
else if Index > 0
hue := nil; then hue := ResMan.Hue.Hues[Index-1]
DrawHue(hue, lbHue.Canvas, ARect, lbHue.Items.Strings[Index]); else hue := nil;
DrawHue(hue, (Control as TListBox).Canvas, ARect, Format('$%x', [Index]), 3);
end else if Control = lbLastUsed then begin
Index := PtrInt(lbLastUsed.Items.Objects[Index]);
if Index > 0
then hue := ResMan.Hue.Hues[Index-1]
else hue := nil;
DrawHue(hue, lbLastUsed.Canvas, ARect, Format('$%x', [Index]), 3);
end else begin // Control = lbHue
if Index > 0
then hue := ResMan.Hue.Hues[Index-1]
else hue := nil;
DrawHue(hue, lbHue.Canvas, ARect, lbHue.Items.Strings[Index], 4);
end
end;
procedure TfrmHueSettings.lbHueDblClick(Sender: TObject);
begin
lbHueSelectionChange(Sender, True);
end; end;
procedure TfrmHueSettings.lbHueSelectionChange(Sender: TObject; User: boolean); procedure TfrmHueSettings.lbHueSelectionChange(Sender: TObject; User: boolean);
begin begin
edHue.Text := Format('$%x', [lbHue.ItemIndex]); edHue.Text := Format('$%x', [lbHue.ItemIndex]);
//if (ImagePreviewItem <> nil) and (ImagePreviewItem.Canvas <> nil) then
UpdateItemPreview(edTileId.Tag, lbHue.ItemIndex);
AddLastUsed(lbHue.ItemIndex);
end;
procedure TfrmHueSettings.lbRandomDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
if Source = lbHue then
btnAddRandomClick(Sender);
end;
procedure TfrmHueSettings.lbRandomDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if Source = lbHue then Accept := True;
end;
procedure TfrmHueSettings.lvHueCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
end;
function TfrmHueSettings.FindRandomPreset(AName: String): TDOMElement;
begin
Result := TDOMElement(FRandomHuePresetsDoc.DocumentElement.FirstChild);
while Result <> nil do
begin
if SameText(Result.AttribStrings['Name'], AName) then
Break;
Result := TDOMElement(Result.NextSibling);
end;
end;
procedure TfrmHueSettings.LoadRandomPresets;
var
presetElement, hueElement: TDOMElement;
begin
FreeAndNil(FRandomHuePresetsDoc);
cbRandomPreset.Items.Clear;
if FileExists(FRandomHuePresetsFile) then
begin
ReadXMLFile(FRandomHuePresetsDoc, FRandomHuePresetsFile);
presetElement := TDOMElement(FRandomHuePresetsDoc.DocumentElement.FirstChild);
while presetElement <> nil do
begin
if presetElement.NodeName = 'Preset' then
cbRandomPreset.Items.AddObject(
CP1251ToUTF8(presetElement.AttribStrings['Name']), presetElement);
presetElement := TDOMElement(presetElement.NextSibling);
end;
end else
begin
FRandomHuePresetsDoc := TXMLDocument.Create;
FRandomHuePresetsDoc.AppendChild(FRandomHuePresetsDoc.CreateElement('RandomHuePresets'));
end;
end;
procedure TfrmHueSettings.SaveRandomPresets;
begin
WriteXMLFile(FRandomHuePresetsDoc, FRandomHuePresetsFile);
end;
function TfrmHueSettings.GetHue: Word;
begin
if cbRandom.Checked and (lbRandom.Items.Count > 0) then
Result := PtrInt(lbRandom.Items.Objects[Random(lbRandom.Items.Count)])
else
Result := lbHue.ItemIndex;
end; end;
class procedure TfrmHueSettings.DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect; class procedure TfrmHueSettings.DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
ACaption: string); ACaption: string; lineWidth: Integer = 2);
var var
hueColor: TColor; hueColor: TColor;
i: Integer; i, w, leftCPos: Integer;
begin begin
ACanvas.Pen.Color := clWhite; ACanvas.Pen.Color := clWhite;
ACanvas.Rectangle(ARect); ACanvas.Rectangle(ARect);
@ -118,12 +540,207 @@ begin
begin begin
hueColor := ARGB2RGB(AHue.ColorTable[i]); hueColor := ARGB2RGB(AHue.ColorTable[i]);
ACanvas.Pen.Color := hueColor; ACanvas.Pen.Color := hueColor;
ACanvas.MoveTo(ARect.Left + 2 + i, ARect.Top + 1); leftCPos := ARect.Left + 2 + lineWidth*i;
ACanvas.LineTo(ARect.Left + 2 + i, ARect.Bottom - 1); for w := 0 to lineWidth do begin
ACanvas.MoveTo(leftCPos + w, ARect.Top + 1);
ACanvas.LineTo(leftCPos + w, ARect.Bottom - 1);
end;
end; end;
ACanvas.TextOut(ARect.Left + 36, ARect.Top, ACaption); ACanvas.TextOut(ARect.Left + lineWidth*36, ARect.Top+1, ACaption);
end; end;
// vdtHuePreview
procedure TfrmHueSettings.ShowAllClick(Sender: TObject);
var
artEntry: TArt;
point: TPoint;
begin
if ResMan.Art.Exists(edTileId.Tag) then begin
LastFormPosition.y := Top;
LastFormPosition.x := Left;
artEntry := ResMan.Art.GetArt(edTileId.Tag, 0, nil, false);
HuePreviewRebuild(edTileId.Tag, artEntry.Graphic.Width, artEntry.Graphic.Height);
cbRandom.Checked := False;
vdtHuePreview.Visible := True;
vdtHuePreview.SetFocus;
end;
end;
procedure TfrmHueSettings.HuePreviewRebuild(ItemID, ItemWidth, ItemHeight: Integer);
var
item: PVirtualNode;
info: PHuesInfo;
cols: Integer;
h,cn: Integer;
ScrollBarWidth: Integer;
wspos: TPoint;
wrect: TRect;
begin
HuePreviewFree;
GetWindowRect(frmHueSettings.Handle, wrect);
wspos.X := 0; wspos.Y := 0;
wspos := frmMain.oglGameWindow.ClientToScreen(wspos);
Left := wspos.X - 20;
Top := wspos.Y - 1;
Width := frmMain.oglGameWindow.ClientWidth - (wrect.Right - wrect.Left - ClientWidth);
Height:= frmMain.oglGameWindow.ClientHeight - (wrect.Bottom - wrect.Top - ClientHeight);
if vdtHuePreview.Tag = edTileId.Tag then exit;
//определяем число колонок
cols:= ((ClientWidth - GetSystemMetrics(SM_CXVSCROLL))// - 16)
div (ItemWidth + 2)) - 1;
if (cols > vdtHuesPreviewColumnsMax)
then cols:=vdtHuesPreviewColumnsMax;
Logger.Send([lcClient, lcInfo], 'TfrmHueSettings.HuePreviewRebuild(): Число колонок cols', cols+1);
// Создаем колонки
vdtHuePreview.BeginUpdate;
vdtHuePreview.Header.Columns.Clear;
vdtHuePreview.Header.Columns.DefaultWidth := ItemWidth + 2;
for cn := 0 to cols do
vdtHuePreview.Header.Columns.Add;
// Создаем ячейки
vdtHuePreview.Clear;
vdtHuePreview.Tag := ItemID;
vdtHuePreview.DefaultNodeHeight := ItemHeight + 2;
h := 0;
while h < ResMan.Hue.Count do begin
item := vdtHuePreview.AddChild(nil);
info := vdtHuePreview.GetNodeData(item);
for cn := cols to vdtHuesPreviewColumnsMax do
info^.Art[cn] := nil;
for cn := 0 to cols do begin
info^.Art[cn] := nil;
info^.ID[cn] := h;
h := h + 1;
if h >= ResMan.Hue.Count
then break;
end;
end;
vdtHuePreview.EndUpdate;
end;
procedure TfrmHueSettings.HuePreviewFree();
var
colm: Integer;
node: PVirtualNode;
info: PHuesInfo;
begin
vdtHuePreview.Tag := -1;
node := vdtHuePreview.GetFirst();
while node <> nil do begin
info := vdtHuePreview.GetNodeData(node);
for colm := 0 to vdtHuesPreviewColumnsMax do begin
if info^.Art[colm] <> nil
then info^.Art[colm].Free;
info^.Art[colm] := nil;
end;
node := vdtHuePreview.GetNext(node);
end;
end;
procedure TfrmHueSettings.vdtHuePreviewDrawNode(Sender: TBaseVirtualTree;
const PaintInfo: TVTPaintInfo);
var
//tileInfo : PTileInfo;
destColor : Word;
tileData : TTileData;
artPartial: Boolean;
artEntry : TArt;
info: PHuesInfo;
id : Integer;
hue : THue;
mpos: TPoint;
rect: TRect;
begin
id := TVirtualDrawTree(Sender).Tag;
info:= Sender.GetNodeData(PaintInfo.Node);
if info^.ID[PaintInfo.Column] <= 0 then begin
hue := nil;
if (PaintInfo.Node <> Sender.GetFirst()) then begin
PaintInfo.Canvas.Brush.Color := vdtHuePreview.Color;
exit; // Не рисуем ячейки без цвета если они не в первом ряду
end;
end else hue := ResMan.Hue.Hues[info^.ID[PaintInfo.Column] - 1];
if ResMan.Art.Exists(id) then begin
// Определяем цвет подсветки (т.е. выделен ли тайл)
{mpos := vdtHuePreview.ScreenToClient(Mouse.CursorPos);
if (vdtHuePreview.GetNodeAt(mpos.x, mpos.y) = PaintInfo.Node)
and ((mpos.x div vdtHuePreview.Header.Columns.DefaultWidth) = PaintInfo.Column)
then destColor := EncodeUOColor(vdtHuePreview.Colors.FocusedSelectionColor)
else }destColor := EncodeUOColor(vdtHuePreview.Color);
if info^.Art[PaintInfo.Column] = nil then begin
tileData := TTileData(ResMan.Tiledata.Block[ID]);
artPartial := tdfPartialHue in tileData.Flags;
artEntry := ResMan.Art.GetArt(ID, destColor, hue, artPartial);
info^.Art[PaintInfo.Column] := artEntry;
end else artEntry := info^.Art[PaintInfo.Column];
rect.Left := PaintInfo.CellRect.Left + 1;
rect.Top := PaintInfo.CellRect.Top + 1;
rect.Right := PaintInfo.CellRect.Right - 1;
rect.Bottom:= PaintInfo.CellRect.Bottom - 1;
DisplayImage(PaintInfo.Canvas, rect, artEntry.Graphic);
//artEntry.Free;
end;
end;
procedure TfrmHueSettings.vdtHuePreviewMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var
mpos: TPoint;
colm: Integer;
node: PVirtualNode;
begin
{mpos := vdtHuePreview.ScreenToClient(Mouse.CursorPos);
colm := mpos.x div vdtHuePreview.Header.Columns.DefaultWidth;
node := vdtHuePreview.GetNodeAt(mpos.x, mpos.y);
if (colm <> LastSelectedColm) and (node <> LastSelectedNode) then begin
vdtHuePreview.RepaintNode(node);
LastSelectedColm := colm;
LastSelectedNode := node;
vdtHuePreview.RepaintNode(node);
end;}
end;
procedure TfrmHueSettings.vdtHuePreviewClick(Sender: TObject);
var
mpos: TPoint;
info: PHuesInfo;
hues: Integer;
begin
mpos := vdtHuePreview.ScreenToClient(Mouse.CursorPos);
info := vdtHuePreview.GetNodeData( vdtHuePreview.GetNodeAt(mpos.x, mpos.y) );
hues := info^.ID[ mpos.x div vdtHuePreview.Header.Columns.DefaultWidth ];
if hues < ResMan.Hue.Count then begin
Logger.Send([lcClient, lcInfo], 'mpos.x="%d"; mpos.y="%d"; hues="%d"', [mpos.x, mpos.y, hues]);
edHue.Text := Format('$%x', [hues]);
edHueEditingDone(Sender);
FormShow(Sender); // Закрываем окно и возвращаемся обратно
Top := LastFormPosition.y;
Left := LastFormPosition.x;
mpos.x := ImagePreviewItem.Width div 2;
mpos.y := ImagePreviewItem.Height div 2;
Mouse.CursorPos := ImagePreviewItem.ClientToScreen(mpos);
end;
end;
initialization initialization
{$I UfrmHueSettings.lrs} {$I UfrmHueSettings.lrs}

15
Client/Tools/UfrmLightlevel.lfm
View File

@ -1,15 +1,19 @@
inherited frmLightlevel: TfrmLightlevel inherited frmLightlevel: TfrmLightlevel
Left = 598
Height = 171 Height = 171
Width = 40 Top = 733
ActiveControl = tbLightlevel Width = 53
Caption = 'Lightlevel' Caption = 'Свет'
ClientHeight = 171 ClientHeight = 171
ClientWidth = 40 ClientWidth = 53
Constraints.MaxWidth = 40
Constraints.MinWidth = 36
OnCreate = FormCreate
object tbLightlevel: TTrackBar[0] object tbLightlevel: TTrackBar[0]
Left = 0 Left = 0
Height = 171 Height = 171
Top = 0 Top = 0
Width = 40 Width = 53
Max = 32 Max = 32
OnChange = tbLightlevelChange OnChange = tbLightlevelChange
Orientation = trVertical Orientation = trVertical
@ -18,5 +22,6 @@ inherited frmLightlevel: TfrmLightlevel
TabOrder = 0 TabOrder = 0
end end
inherited tmClose: TTimer[1] inherited tmClose: TTimer[1]
top = 88
end end
end end

9
Client/Tools/UfrmLightlevel.pas
View File

@ -14,6 +14,7 @@ type
TfrmLightlevel = class(TfrmToolWindow) TfrmLightlevel = class(TfrmToolWindow)
tbLightlevel: TTrackBar; tbLightlevel: TTrackBar;
procedure FormCreate(Sender: TObject);
procedure tbLightlevelChange(Sender: TObject); procedure tbLightlevelChange(Sender: TObject);
private private
{ private declarations } { private declarations }
@ -27,7 +28,7 @@ var
implementation implementation
uses uses
UfrmMain; UfrmMain, Language;
{ TfrmLightlevel } { TfrmLightlevel }
@ -40,9 +41,15 @@ begin
end else end else
frmMain.LightManager.LightLevel := tbLightlevel.Position; frmMain.LightManager.LightLevel := tbLightlevel.Position;
frmMain.acLightlevel.Tag:=frmMain.LightManager.LightLevel;
frmMain.oglGameWindow.Repaint; frmMain.oglGameWindow.Repaint;
end; end;
procedure TfrmLightlevel.FormCreate(Sender: TObject);
begin
LanguageTranslate(Self);
end;
initialization initialization
{$I UfrmLightlevel.lrs} {$I UfrmLightlevel.lrs}

118
Client/Tools/UfrmMoveSettings.lfm
View File

@ -1,25 +1,26 @@
inherited frmMoveSettings: TfrmMoveSettings inherited frmMoveSettings: TfrmMoveSettings
Left = 290 Left = 1327
Height = 120 Height = 112
Top = 171 Top = 452
Width = 232 Width = 212
ActiveControl = cbAsk Caption = 'Опции перемещения'
AutoSize = True ClientHeight = 112
Caption = 'Move settings' ClientWidth = 212
ClientHeight = 120 OnCreate = FormCreate
ClientWidth = 232
object cbAsk: TCheckBox[0] object cbAsk: TCheckBox[0]
AnchorSideLeft.Control = gbDirection AnchorSideLeft.Control = gbMovment
AnchorSideLeft.Side = asrBottom AnchorSideRight.Control = gbMovment
AnchorSideTop.Control = gbDirection AnchorSideRight.Side = asrBottom
Left = 121 AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 119
Height = 19 Height = 19
Top = 20 Top = 63
Width = 94 Width = 87
BorderSpacing.Left = 8 Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Top = 16 BorderSpacing.Left = 4
BorderSpacing.Right = 8 BorderSpacing.Bottom = 30
Caption = 'Ask each time' Caption = 'Спрашивать'
Checked = True Checked = True
State = cbChecked State = cbChecked
TabOrder = 0 TabOrder = 0
@ -27,14 +28,13 @@ inherited frmMoveSettings: TfrmMoveSettings
object gbDirection: TGroupBox[1] object gbDirection: TGroupBox[1]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
Left = 8 Left = 4
Height = 108 Height = 108
Top = 4 Top = 0
Width = 105 Width = 105
AutoSize = True AutoSize = True
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
BorderSpacing.Around = 4
ClientHeight = 90 ClientHeight = 90
ClientWidth = 101 ClientWidth = 101
TabOrder = 1 TabOrder = 1
@ -46,7 +46,6 @@ inherited frmMoveSettings: TfrmMoveSettings
Top = 0 Top = 0
Width = 23 Width = 23
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Color = clBtnFace
Down = True Down = True
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -97,7 +96,6 @@ inherited frmMoveSettings: TfrmMoveSettings
Top = 0 Top = 0
Width = 23 Width = 23
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -147,7 +145,6 @@ inherited frmMoveSettings: TfrmMoveSettings
Top = 0 Top = 0
Width = 23 Width = 23
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -198,7 +195,6 @@ inherited frmMoveSettings: TfrmMoveSettings
Width = 23 Width = 23
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -248,7 +244,6 @@ inherited frmMoveSettings: TfrmMoveSettings
Top = 60 Top = 60
Width = 23 Width = 23
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -299,7 +294,6 @@ inherited frmMoveSettings: TfrmMoveSettings
Width = 23 Width = 23
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -349,7 +343,6 @@ inherited frmMoveSettings: TfrmMoveSettings
Top = 60 Top = 60
Width = 23 Width = 23
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -399,7 +392,6 @@ inherited frmMoveSettings: TfrmMoveSettings
Top = 30 Top = 30
Width = 23 Width = 23
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000000000000000
@ -446,7 +438,7 @@ inherited frmMoveSettings: TfrmMoveSettings
AnchorSideTop.Control = btnTop AnchorSideTop.Control = btnTop
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 33 Left = 33
Height = 25 Height = 23
Hint = 'Offset' Hint = 'Offset'
Top = 30 Top = 30
Width = 34 Width = 34
@ -462,20 +454,70 @@ inherited frmMoveSettings: TfrmMoveSettings
object btnCancel: TButton[2] object btnCancel: TButton[2]
AnchorSideLeft.Control = gbDirection AnchorSideLeft.Control = gbDirection
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = gbMovment
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = gbDirection AnchorSideBottom.Control = gbDirection
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 121 Left = 117
Height = 25 Height = 25
Top = 83 Top = 82
Width = 103 Width = 89
Anchors = [akLeft, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8 BorderSpacing.Bottom = 1
BorderSpacing.Bottom = 4
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 4
Cancel = True Cancel = True
Caption = 'Cancel' Caption = 'Отмена'
ModalResult = 2 ModalResult = 2
TabOrder = 2 TabOrder = 2
end end
object gbMovment: TGroupBox[3]
AnchorSideLeft.Control = gbDirection
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = cbAsk
Left = 115
Height = 59
Top = 0
Width = 91
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Right = 6
BorderSpacing.Bottom = 4
Caption = 'Перемещать'
ClientHeight = 41
ClientWidth = 87
TabOrder = 3
object cbLand: TCheckBox
AnchorSideLeft.Control = gbMovment
AnchorSideTop.Control = gbMovment
Left = 8
Height = 19
Top = 0
Width = 61
BorderSpacing.Left = 8
Caption = 'Рельеф'
OnChange = cbLandChange
TabOrder = 0
end
object cbItem: TCheckBox
AnchorSideLeft.Control = cbLand
AnchorSideTop.Control = cbLand
AnchorSideTop.Side = asrBottom
Left = 8
Height = 19
Top = 19
Width = 63
Caption = 'Статику'
Checked = True
OnChange = cbItemChange
State = cbChecked
TabOrder = 1
end
end
inherited tmClose: TTimer[4]
left = 184
end
end end

28
Client/Tools/UfrmMoveSettings.pas
View File

@ -40,6 +40,8 @@ type
TfrmMoveSettings = class(TfrmToolWindow) TfrmMoveSettings = class(TfrmToolWindow)
btnCancel: TButton; btnCancel: TButton;
cbAsk: TCheckBox; cbAsk: TCheckBox;
cbLand: TCheckBox;
cbItem: TCheckBox;
gbDirection: TGroupBox; gbDirection: TGroupBox;
btnTopLeft: TSpeedButton; btnTopLeft: TSpeedButton;
btnTop: TSpeedButton; btnTop: TSpeedButton;
@ -49,8 +51,12 @@ type
btnBottom: TSpeedButton; btnBottom: TSpeedButton;
btnBottomLeft: TSpeedButton; btnBottomLeft: TSpeedButton;
btnLeft: TSpeedButton; btnLeft: TSpeedButton;
gbMovment: TGroupBox;
seOffset: TSpinEdit; seOffset: TSpinEdit;
procedure btnTopLeftClick(Sender: TObject); procedure btnTopLeftClick(Sender: TObject);
procedure cbItemChange(Sender: TObject);
procedure cbLandChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDeactivate(Sender: TObject); override; procedure FormDeactivate(Sender: TObject); override;
procedure FormShow(Sender: TObject); override; procedure FormShow(Sender: TObject); override;
protected protected
@ -66,7 +72,7 @@ var
implementation implementation
uses uses
UdmNetwork, UfrmMain, UEnums; UdmNetwork, UfrmMain, UEnums, Language;
{ TfrmMoveSettings } { TfrmMoveSettings }
@ -79,7 +85,7 @@ end;
procedure TfrmMoveSettings.FormShow(Sender: TObject); procedure TfrmMoveSettings.FormShow(Sender: TObject);
begin begin
btnCancel.Visible := (fsModal in FormState); btnCancel.Visible := (fsModal in FormState);
if dmNetwork.AccessLevel = alAdministrator then if dmNetwork.AccessLevel = alDeveloper then
seOffset.MaxValue := Max(frmMain.Landscape.CellWidth, frmMain.Landscape.CellHeight); seOffset.MaxValue := Max(frmMain.Landscape.CellWidth, frmMain.Landscape.CellHeight);
inherited FormShow(Sender); inherited FormShow(Sender);
@ -140,6 +146,24 @@ begin
ModalResult := mrYes; ModalResult := mrYes;
end; end;
procedure TfrmMoveSettings.cbItemChange(Sender: TObject);
begin
if not cbItem.Checked
then cbLand.Checked := True;
end;
procedure TfrmMoveSettings.cbLandChange(Sender: TObject);
begin
if not cbLand.Checked
then cbItem.Checked := True;
end;
procedure TfrmMoveSettings.FormCreate(Sender: TObject);
begin
LanguageTranslate(Self);
end;
initialization initialization
{$I UfrmMoveSettings.lrs} {$I UfrmMoveSettings.lrs}

12
Client/Tools/UfrmSelectionSettings.lfm Normal file
View File

@ -0,0 +1,12 @@
inherited frmSelectionSettings: TfrmSelectionSettings
Left = 1122
Height = 116
Top = 613
Width = 188
Caption = 'Опции выделения'
OnCreate = FormCreate
OnShow = FormShow
inherited tmClose: TTimer
left = 80
end
end

82
Client/Tools/UfrmSelectionSettings.pas Normal file
View File

@ -0,0 +1,82 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmSelectionSettings;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Spin, ExtCtrls, LMessages, VirtualTrees, UfrmToolWindow, UfrmMain;
type
{ TfrmSelectionSettings }
TfrmSelectionSettings = class(TfrmToolWindow)
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
FCanClose: Boolean;
function CanClose: Boolean; override;
end;
var
frmSelectionSettings: TfrmSelectionSettings;
implementation
uses
UGameResources, UHue, UfrmHueSettings, Language;
//type
{ TfrmSelectionSettings }
procedure TfrmSelectionSettings.FormCreate(Sender: TObject);
begin
FCanClose := True;
end;
procedure TfrmSelectionSettings.FormShow(Sender: TObject);
begin
LanguageTranslate(Self);
//do work
(frmSelectionSettings as TfrmToolWindow).FormShow(Sender);
end;
function TfrmSelectionSettings.CanClose: Boolean;
begin
Result := FCanClose and inherited CanClose;
end;
initialization
{$I UfrmSelectionSettings.lrs}
end.

12
Client/Tools/UfrmSurfElevateSettings.lfm Normal file
View File

@ -0,0 +1,12 @@
inherited frmSurfElevateSettings: TfrmSurfElevateSettings
Left = 1122
Height = 80
Top = 613
Width = 244
Caption = 'Опции редактирования меша'
OnCreate = FormCreate
OnShow = FormShow
inherited tmClose: TTimer
left = 80
end
end

82
Client/Tools/UfrmSurfElevateSettings.pas Normal file
View File

@ -0,0 +1,82 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmSurfElevateSettings;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Spin, ExtCtrls, LMessages, VirtualTrees, UfrmToolWindow, UfrmMain;
type
{ TfrmSurfElevateSettings }
TfrmSurfElevateSettings = class(TfrmToolWindow)
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
FCanClose: Boolean;
function CanClose: Boolean; override;
end;
var
frmSurfElevateSettings: TfrmSurfElevateSettings;
implementation
uses
UGameResources, UHue, UfrmHueSettings, Language;
//type
{ TfrmSurfElevateSettings }
procedure TfrmSurfElevateSettings.FormCreate(Sender: TObject);
begin
FCanClose := True;
end;
procedure TfrmSurfElevateSettings.FormShow(Sender: TObject);
begin
LanguageTranslate(Self);
//do work
(frmSurfElevateSettings as TfrmToolWindow).FormShow(Sender);
end;
function TfrmSurfElevateSettings.CanClose: Boolean;
begin
Result := FCanClose and inherited CanClose;
end;
initialization
{$I UfrmSurfElevateSettings.lrs}
end.

12
Client/Tools/UfrmSurfSmoothSettings.lfm Normal file
View File

@ -0,0 +1,12 @@
inherited frmSurfSmoothSettings: TfrmSurfSmoothSettings
Left = 1122
Height = 87
Top = 613
Width = 231
Caption = 'Опции растягивания меша'
OnCreate = FormCreate
OnShow = FormShow
inherited tmClose: TTimer
left = 80
end
end

82
Client/Tools/UfrmSurfSmoothSettings.pas Normal file
View File

@ -0,0 +1,82 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmSurfSmoothSettings;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Spin, ExtCtrls, LMessages, VirtualTrees, UfrmToolWindow, UfrmMain;
type
{ TfrmSurfSmoothSettings }
TfrmSurfSmoothSettings = class(TfrmToolWindow)
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
FCanClose: Boolean;
function CanClose: Boolean; override;
end;
var
frmSurfSmoothSettings: TfrmSurfSmoothSettings;
implementation
uses
UGameResources, UHue, UfrmHueSettings, Language;
//type
{ TfrmSurfSmoothSettings }
procedure TfrmSurfSmoothSettings.FormCreate(Sender: TObject);
begin
FCanClose := True;
end;
procedure TfrmSurfSmoothSettings.FormShow(Sender: TObject);
begin
LanguageTranslate(Self);
//do work
(frmSurfSmoothSettings as TfrmToolWindow).FormShow(Sender);
end;
function TfrmSurfSmoothSettings.CanClose: Boolean;
begin
Result := FCanClose and inherited CanClose;
end;
initialization
{$I UfrmSurfSmoothSettings.lrs}
end.

12
Client/Tools/UfrmSurfStretchSettings.lfm Normal file
View File

@ -0,0 +1,12 @@
inherited frmSurfStretchSettings: TfrmSurfStretchSettings
Left = 1122
Height = 71
Top = 613
Width = 249
Caption = 'Опции сглаживания меша'
OnCreate = FormCreate
OnShow = FormShow
inherited tmClose: TTimer
left = 80
end
end

82
Client/Tools/UfrmSurfStretchSettings.pas Normal file
View File

@ -0,0 +1,82 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UfrmSurfStretchSettings;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
Spin, ExtCtrls, LMessages, VirtualTrees, UfrmToolWindow, UfrmMain;
type
{ TfrmSurfStretchSettings }
TfrmSurfStretchSettings = class(TfrmToolWindow)
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
FCanClose: Boolean;
function CanClose: Boolean; override;
end;
var
frmSurfStretchSettings: TfrmSurfStretchSettings;
implementation
uses
UGameResources, UHue, UfrmHueSettings, Language;
//type
{ TfrmSurfStretchSettings }
procedure TfrmSurfStretchSettings.FormCreate(Sender: TObject);
begin
FCanClose := True;
end;
procedure TfrmSurfStretchSettings.FormShow(Sender: TObject);
begin
LanguageTranslate(Self);
//do work
(frmSurfStretchSettings as TfrmToolWindow).FormShow(Sender);
end;
function TfrmSurfStretchSettings.CanClose: Boolean;
begin
Result := FCanClose and inherited CanClose;
end;
initialization
{$I UfrmSurfStretchSettings.lrs}
end.

2
Client/Tools/UfrmToolWindow.lfm
View File

@ -11,7 +11,7 @@ object frmToolWindow: TfrmToolWindow
OnDeactivate = FormDeactivate OnDeactivate = FormDeactivate
OnShow = FormShow OnShow = FormShow
ShowInTaskBar = stNever ShowInTaskBar = stNever
LCLVersion = '0.9.29' LCLVersion = '0.9.30'
object tmClose: TTimer object tmClose: TTimer
Enabled = False Enabled = False
OnTimer = tmCloseTimer OnTimer = tmCloseTimer

170
Client/Tools/UfrmVirtualLayer.lfm
View File

@ -1,21 +1,20 @@
inherited frmVirtualLayer: TfrmVirtualLayer inherited frmVirtualLayer: TfrmVirtualLayer
Left = 290 Left = 1164
Height = 82 Height = 88
Top = 171 Top = 443
Width = 210 Width = 210
ActiveControl = cbShowLayer Caption = 'Виртуальный слой'
Caption = 'Virtual Layer' ClientHeight = 88
ClientHeight = 82
ClientWidth = 210 ClientWidth = 210
OnCreate = FormCreate
object tbZ: TTrackBar[0] object tbZ: TTrackBar[0]
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = seZ AnchorSideTop.Control = cbShowBlocks
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 8 Left = 8
Height = 36 Height = 36
Top = 37 Top = 44
Width = 194 Width = 194
Frequency = 10 Frequency = 10
Max = 127 Max = 127
@ -24,6 +23,7 @@ inherited frmVirtualLayer: TfrmVirtualLayer
PageSize = 1 PageSize = 1
Position = 0 Position = 0
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 9
BorderSpacing.Around = 8 BorderSpacing.Around = 8
TabOrder = 0 TabOrder = 0
end end
@ -32,28 +32,164 @@ inherited frmVirtualLayer: TfrmVirtualLayer
AnchorSideTop.Control = seZ AnchorSideTop.Control = seZ
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 8 Left = 8
Height = 22 Height = 19
Top = 7 Top = 8
Width = 126 Width = 131
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Caption = 'Show Layer at Z:' Caption = 'Показать на высоте:'
OnChange = cbShowLayerChange OnChange = cbShowLayerChange
TabOrder = 1 TabOrder = 1
end end
object seZ: TSpinEdit[2] object cbShowBlocks: TCheckBox[2]
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = cbShowLayer
AnchorSideTop.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 19
Top = 27
Width = 166
BorderSpacing.Left = 8
Caption = 'Выделять границы блоков'
OnChange = cbShowLayerChange
TabOrder = 3
end
object btnZi20: TButton[3]
AnchorSideTop.Control = tbZ
AnchorSideRight.Control = tbZ
AnchorSideRight.Side = asrBottom
Left = 172
Height = 14
Top = 72
Width = 28
Anchors = [akTop, akRight]
BorderSpacing.Top = 28
BorderSpacing.Right = 2
Caption = '+20'
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Consolas'
Font.Pitch = fpFixed
Font.Quality = fqDraft
OnClick = btnZ_Click
ParentFont = False
TabOrder = 4
end
object btnZi05: TButton[4]
AnchorSideTop.Control = btnZi20
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = btnZi20
Left = 142
Height = 14
Top = 72
Width = 28
Anchors = [akTop, akRight]
BorderSpacing.Right = 2
Caption = '+5'
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Consolas'
Font.Pitch = fpFixed
Font.Quality = fqDraft
OnClick = btnZ_Click
ParentFont = False
TabOrder = 5
end
object btnZd20: TButton[5]
AnchorSideLeft.Control = tbZ
AnchorSideTop.Control = btnZi20
AnchorSideTop.Side = asrCenter
Left = 10
Height = 14
Top = 72
Width = 28
BorderSpacing.Left = 2
Caption = '-20'
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Consolas'
Font.Pitch = fpFixed
Font.Quality = fqDraft
OnClick = btnZ_Click
ParentFont = False
TabOrder = 6
end
object btnZd05: TButton[6]
AnchorSideLeft.Control = btnZd20
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = btnZi20
AnchorSideTop.Side = asrCenter
Left = 40
Height = 14
Top = 72
Width = 28
BorderSpacing.Left = 2
Caption = '-5'
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Consolas'
Font.Pitch = fpFixed
Font.Quality = fqDraft
OnClick = btnZ_Click
ParentFont = False
TabOrder = 7
end
object btnZd03: TButton[7]
AnchorSideLeft.Control = btnZd05
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = btnZi20
AnchorSideTop.Side = asrCenter
Left = 70
Height = 14
Top = 72
Width = 28
BorderSpacing.Left = 2
Caption = '-3'
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Consolas'
Font.Pitch = fpFixed
Font.Quality = fqDraft
OnClick = btnZ_Click
ParentFont = False
TabOrder = 8
end
object btnZi03: TButton[8]
AnchorSideTop.Control = btnZi20
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = btnZi05
Left = 112
Height = 14
Top = 72
Width = 28
Anchors = [akTop, akRight]
BorderSpacing.Right = 2
Caption = '+3'
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Consolas'
Font.Pitch = fpFixed
Font.Quality = fqDraft
OnClick = btnZ_Click
ParentFont = False
TabOrder = 9
end
object seZ: TSpinEdit[9]
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 152 Left = 152
Height = 21 Height = 23
Top = 8 Top = 6
Width = 50 Width = 50
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Top = 8 BorderSpacing.Top = 6
BorderSpacing.Right = 8 BorderSpacing.Right = 8
MaxValue = 127 MaxValue = 127
MinValue = -128 MinValue = -128
OnChange = seZChange OnChange = seZChange
TabOrder = 2 TabOrder = 2
end end
inherited tmClose: TTimer[10]
end
end end

34
Client/Tools/UfrmVirtualLayer.pas
View File

@ -38,10 +38,19 @@ type
{ TfrmVirtualLayer } { TfrmVirtualLayer }
TfrmVirtualLayer = class(TfrmToolWindow) TfrmVirtualLayer = class(TfrmToolWindow)
btnZi20: TButton;
btnZi05: TButton;
btnZd20: TButton;
btnZd05: TButton;
btnZd03: TButton;
btnZi03: TButton;
cbShowLayer: TCheckBox; cbShowLayer: TCheckBox;
cbShowBlocks: TCheckBox;
seZ: TSpinEdit; seZ: TSpinEdit;
tbZ: TTrackBar; tbZ: TTrackBar;
procedure btnZ_Click(Sender: TObject);
procedure cbShowLayerChange(Sender: TObject); procedure cbShowLayerChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure seZChange(Sender: TObject); procedure seZChange(Sender: TObject);
procedure tbZChange(Sender: TObject); procedure tbZChange(Sender: TObject);
public public
@ -54,7 +63,7 @@ var
implementation implementation
uses uses
UfrmMain; UfrmMain, Language;
{ TfrmVirtualLayer } { TfrmVirtualLayer }
@ -69,6 +78,29 @@ begin
frmMain.InvalidateScreenBuffer; frmMain.InvalidateScreenBuffer;
end; end;
procedure TfrmVirtualLayer.btnZ_Click(Sender: TObject);
var
value: integer;
begin
value := seZ.Value;
if (Sender = btnZd20) then dec(value, 20) else
if (Sender = btnZd05) then dec(value, 05) else
if (Sender = btnZd03) then dec(value, 03) else
if (Sender = btnZi03) then inc(value, 03) else
if (Sender = btnZi05) then inc(value, 05) else
if (Sender = btnZi20) then inc(value, 20) else
exit;
if (value < -128) or (value > 127) then
exit;
seZ.Value := value;
seZChange(Sender);
end;
procedure TfrmVirtualLayer.FormCreate(Sender: TObject);
begin
LanguageTranslate(Self);
end;
procedure TfrmVirtualLayer.tbZChange(Sender: TObject); procedure TfrmVirtualLayer.tbZChange(Sender: TObject);
begin begin
seZ.Value := tbZ.Position; seZ.Value := tbZ.Position;

72
Client/UGameResources.pas
View File

@ -30,7 +30,7 @@ unit UGameResources;
interface interface
uses uses
Classes, SysUtils, UArtProvider, UTileDataProvider, UTexmapProvider, Classes, SysUtils, Dialogs, UArtProvider, UTileDataProvider, UTexmapProvider,
ULandscape, UHueProvider, UAnimDataProvider, ULightProvider; ULandscape, UHueProvider, UAnimDataProvider, ULightProvider;
type type
@ -38,7 +38,7 @@ type
{ TGameResourceManager } { TGameResourceManager }
TGameResourceManager = class TGameResourceManager = class
constructor Create(ADataDir: String); constructor Create(ADataDir: String; Flags: Cardinal; out Success: Boolean);
destructor Destroy; override; destructor Destroy; override;
protected protected
{ Members } { Members }
@ -63,37 +63,83 @@ type
{ Methods } { Methods }
function GetFile(AFileName: String): String; function GetFile(AFileName: String): String;
procedure InitLandscape(AWidth, AHeight: Word); procedure InitLandscape(AWidth, AHeight: Word);
public
lbDlgErrorFilePathCaption: string;
lbDlgErrorFilePathMsg: string;
end; end;
var var
GameResourceManager: TGameResourceManager; GameResourceManager: TGameResourceManager;
ResMan: TGameResourceManager absolute GameResourceManager; ResMan: TGameResourceManager absolute GameResourceManager;
procedure InitGameResourceManager(ADataDir: String); function InitGameResourceManager(ADataDir: String; Flags: Cardinal): Boolean;
implementation implementation
procedure InitGameResourceManager(ADataDir: String); uses
UStatics, UfrmInitialize, Language;
//var
// GameResourceInited : Boolean;//:= False;
function InitGameResourceManager(ADataDir: String; Flags: Cardinal): Boolean;
begin begin
FreeAndNil(GameResourceManager); FreeAndNil(GameResourceManager);
GameResourceManager := TGameResourceManager.Create(ADataDir); GameResourceManager := TGameResourceManager.Create(ADataDir, Flags, Result);
end; end;
{ TGameResourceManager } { TGameResourceManager }
constructor TGameResourceManager.Create(ADataDir: String); constructor TGameResourceManager.Create(ADataDir: String; Flags: Cardinal; out Success: Boolean);
begin begin
inherited Create; inherited Create;
LanguageTranslate(nil, nil, self);
FDataDir := IncludeTrailingPathDelimiter(ADataDir); FDataDir := IncludeTrailingPathDelimiter(ADataDir);
FArtProvider := TArtProvider.Create(GetFile('art.mul'), GetFile('artidx.mul'), True); // 0xF0 - FlagsData Version Type
FTiledataProvider := TTiledataProvider.Create(GetFile('tiledata.mul'), True); // 0x0000 - UnUsed
// 0x01 - pre-alpha client ()
// 0x02 - Reserved (alpha client?)
// 0x04 - Reserved (use Verdata)
// 0x08 - HS Client Format
// Проверка путей
if (not FileExists(GetFile('art.mul'))) or
(not FileExists(GetFile('artidx.mul'))) or
(not FileExists(GetFile('hues.mul'))) or
(not FileExists(GetFile('tiledata.mul'))) or
(not FileExists(GetFile('animdata.mul')) and ((Flags and $01) = 0)) or
(not FileExists(GetFile('texmaps.mul')) and ((Flags and $01) = 0)) or
(not FileExists(GetFile('texidx.mul')) and ((Flags and $01) = 0)) or
(not FileExists(GetFile('light.mul')) and ((Flags and $01) = 0)) or
(not FileExists(GetFile('lightidx.mul')) and ((Flags and $01) = 0)) then
begin
MessageDlg(lbDlgErrorFilePathCaption, lbDlgErrorFilePathMsg, mtWarning, [mbOK], 0);
Success := False;
Destroy; exit;
end;
UseStaticsOldFormat := (Flags and $01) <> 0;
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['art.mul, artidx.mul']));
FArtProvider := TArtProvider.Create((Flags and $01) <> 0, GetFile('art.mul'), GetFile('artidx.mul'), True);
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['tiledata.mul']));
FTiledataProvider := TTiledataProvider.Create((Flags and $08) = 0, GetFile('tiledata.mul'), True);
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['animdata.mul']));
FAnimdataProvider := TAnimDataProvider.Create(GetFile('animdata.mul'), True); FAnimdataProvider := TAnimDataProvider.Create(GetFile('animdata.mul'), True);
FTexmapProvider := TTexmapProvider.Create(GetFile('texmaps.mul'),
GetFile('texidx.mul'), True); frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['texmaps.mul, texidx.mul']));
FTexmapProvider := TTexmapProvider.Create(Boolean(Flags and $01), GetFile('texmaps.mul'), GetFile('texidx.mul'), True);
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['hues.mul']));
FHueProvider := THueProvider.Create(GetFile('hues.mul'), True); FHueProvider := THueProvider.Create(GetFile('hues.mul'), True);
FLightProvider := TLightProvider.Create(GetFile('light.mul'),
GetFile('lightidx.mul'), True); frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['light.mul, lightidx.mul']));
FLightProvider := TLightProvider.Create(GetFile('light.mul'), GetFile('lightidx.mul'), True);
Success := True;
end; end;
destructor TGameResourceManager.Destroy; destructor TGameResourceManager.Destroy;
@ -115,6 +161,8 @@ end;
procedure TGameResourceManager.InitLandscape(AWidth, AHeight: Word); procedure TGameResourceManager.InitLandscape(AWidth, AHeight: Word);
begin begin
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['Landscape']));
FreeAndNil(FLandscape); FreeAndNil(FLandscape);
FLandscape := TLandscape.Create(AWidth, AHeight); FLandscape := TLandscape.Create(AWidth, AHeight);
end; end;

217
Client/ULandscape.pas
View File

@ -31,9 +31,9 @@ interface
uses uses
SysUtils, Classes, math, matrix, LCLIntf, GL, GLu, ImagingOpenGL, Imaging, SysUtils, Classes, math, matrix, LCLIntf, GL, GLu, ImagingOpenGL, Imaging,
ImagingClasses, ImagingTypes, ImagingUtility, ImagingClasses, ImagingTypes, ImagingUtility, DOM, XMLRead,
UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem, UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
UMulBlock, UAnimData, UMulBlock, UAnimData, UfrmInitialize,
UEnhancedMemoryStream, UGLFont, UEnhancedMemoryStream, UGLFont,
UCacheManager; UCacheManager;
@ -70,6 +70,7 @@ type
procedure AddRef; procedure AddRef;
procedure DelRef; procedure DelRef;
function HitTest(AX, AY: Integer): Boolean; function HitTest(AX, AY: Integer): Boolean;
function HitTest(AX, AY: Integer; Zoom: Single): Boolean;
{ICacheable} {ICacheable}
function CanBeRemoved: Boolean; function CanBeRemoved: Boolean;
@ -89,7 +90,7 @@ type
{ TAnimMaterial } { TAnimMaterial }
TAnimMaterial = class(TMaterial) TAnimMaterial = class(TMaterial)
constructor Create(ABaseID: Word; AAnimData: TAnimData; AHue: THue = nil; constructor Create(ABaseID: LongWord; AAnimData: TAnimData; AHue: THue = nil;
APartialHue: Boolean = False); APartialHue: Boolean = False);
destructor Destroy; override; destructor Destroy; override;
protected protected
@ -114,12 +115,12 @@ type
FUseAnims: Boolean; FUseAnims: Boolean;
public public
property UseAnims: Boolean read FUseAnims write FUseAnims; property UseAnims: Boolean read FUseAnims write FUseAnims;
function GetArtMaterial(ATileID: Word): TMaterial; overload; function GetArtMaterial(ATileID: LongWord): TMaterial; overload;
function GetArtMaterial(ATileID: Word; AHue: THue; function GetArtMaterial(ATileID: LongWord; AHue: THue;
APartialHue: Boolean): TMaterial; overload; APartialHue: Boolean): TMaterial; overload;
function GetStaticMaterial(AStaticItem: TStaticItem; function GetStaticMaterial(AStaticItem: TStaticItem;
AOverrideHue: Integer = -1): TMaterial; AOverrideHue: Integer = -1): TMaterial;
function GetTexMaterial(ATileID: Word): TMaterial; function GetTexMaterial(ATileID: LongWord): TMaterial;
end; end;
{ TSeperatedStaticBlock } { TSeperatedStaticBlock }
@ -175,6 +176,7 @@ type
FCellWidth: Word; FCellWidth: Word;
FCellHeight: Word; FCellHeight: Word;
FBlockCache: TBlockCache; FBlockCache: TBlockCache;
FBlockCacheBak: TBlockCache;
FOnChange: TLandscapeChangeEvent; FOnChange: TLandscapeChangeEvent;
FOnMapChanged: TMapChangedEvent; FOnMapChanged: TMapChangedEvent;
FOnNewBlock: TNewBlockEvent; FOnNewBlock: TNewBlockEvent;
@ -186,10 +188,11 @@ type
FWriteMap: TBits; FWriteMap: TBits;
FDrawMap: TBits; FDrawMap: TBits;
FMaxStaticID: Cardinal; FMaxStaticID: Cardinal;
BlockCacheSize: Integer;
{ Methods } { Methods }
function GetMapBlock(AX, AY: Word): TMapBlock; function GetMapBlock(AX, AY: Word): TMapBlock;
function GetMapCell(AX, AY: Word): TMapCell; function GetMapCell(AX, AY: Integer): TMapCell;
function GetNormals(AX, AY: Word): TNormals; function GetNormals(AX, AY: Integer): TNormals;
function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
function GetStaticList(AX, AY: Word): TStaticItemList; function GetStaticList(AX, AY: Word): TStaticItemList;
{ Events } { Events }
@ -207,9 +210,9 @@ type
property Height: Word read FHeight; property Height: Word read FHeight;
property CellWidth: Word read FCellWidth; property CellWidth: Word read FCellWidth;
property CellHeight: Word read FCellHeight; property CellHeight: Word read FCellHeight;
property MapCell[X, Y: Word]: TMapCell read GetMapCell; property MapCell[X, Y: Integer]: TMapCell read GetMapCell;
property StaticList[X, Y: Word]: TStaticItemList read GetStaticList; property StaticList[X, Y: Word]: TStaticItemList read GetStaticList;
property Normals[X, Y: Word]: TNormals read GetNormals; property Normals[X, Y: Integer]: TNormals read GetNormals;
property MaxStaticID: Cardinal read FMaxStaticID; property MaxStaticID: Cardinal read FMaxStaticID;
property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange; property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange;
property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged; property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged;
@ -224,9 +227,9 @@ type
write FOnStaticHued; write FOnStaticHued;
{ Methods } { Methods }
function CanWrite(AX, AY: Word): Boolean; function CanWrite(AX, AY: Word): Boolean;
procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, AHeight: Word;
AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean; AMap, AStatics, ATDWalls, ATDBridges, ATDRoofs, ATDSurfaces, ATDFoliage, ATDWet: Boolean;
AAdditionalTiles: TWorldItemList = nil); ANoDraw: Boolean; AAdditionalTiles: TWorldItemList = nil);
function GetEffectiveAltitude(ATile: TMapCell): ShortInt; function GetEffectiveAltitude(ATile: TMapCell): ShortInt;
function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt; function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
procedure GetNormals(AX, AY: Word; var ANormals: TNormals); procedure GetNormals(AX, AY: Word; var ANormals: TNormals);
@ -235,6 +238,7 @@ type
procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word); procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word);
procedure UpdateBlockAccess; procedure UpdateBlockAccess;
procedure UpdateWriteMap(AStream: TEnhancedMemoryStream); procedure UpdateWriteMap(AStream: TEnhancedMemoryStream);
procedure ResizeBlockCache(Count: Integer);
end; end;
{ TGLText } { TGLText }
@ -258,6 +262,8 @@ type
ScreenRect: TRect; ScreenRect: TRect;
DrawQuad: array[0..3,0..1] of TGLint; DrawQuad: array[0..3,0..1] of TGLint;
RealQuad: array[0..3,0..1] of TGLint; RealQuad: array[0..3,0..1] of TGLint;
LineWidth: array[0..2] of GLfloat;
LineDraw: array[0..2,0..1,0..1] of TGLint;
Item: TWorldItem; Item: TWorldItem;
HighRes: TMaterial; HighRes: TMaterial;
LowRes: TMaterial; LowRes: TMaterial;
@ -265,6 +271,7 @@ type
State: TScreenState; State: TScreenState;
Highlighted: Boolean; Highlighted: Boolean;
HueOverride: Boolean; HueOverride: Boolean;
Hue: Word;
CheckRealQuad: Boolean; CheckRealQuad: Boolean;
Translucent: Boolean; Translucent: Boolean;
WalkRestriction: TWalkRestriction; WalkRestriction: TWalkRestriction;
@ -288,7 +295,8 @@ type
function Add(AItem: TWorldItem): PBlockInfo; function Add(AItem: TWorldItem): PBlockInfo;
procedure Clear; procedure Clear;
procedure Delete(AItem: TWorldItem); procedure Delete(AItem: TWorldItem);
function Find(AScreenPosition: TPoint): PBlockInfo; function Find(AScreenPosition: TPoint; Zoom: Single): PBlockInfo;
function Find(AX, AY: Word): PBlockInfo;
function GetSerial: Cardinal; function GetSerial: Cardinal;
function Insert(AItem: TWorldItem): PBlockInfo; function Insert(AItem: TWorldItem): PBlockInfo;
function Iterate(var ABlockInfo: PBlockInfo): Boolean; function Iterate(var ABlockInfo: PBlockInfo): Boolean;
@ -342,7 +350,7 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function TLandTextureManager.GetArtMaterial(ATileID: Word): TMaterial; function TLandTextureManager.GetArtMaterial(ATileID: LongWord): TMaterial;
var var
artEntry: TArt; artEntry: TArt;
animData: TAnimData; animData: TAnimData;
@ -373,7 +381,7 @@ begin
Result.AddRef; Result.AddRef;
end; end;
function TLandTextureManager.GetArtMaterial(ATileID: Word; AHue: THue; function TLandTextureManager.GetArtMaterial(ATileID: LongWord; AHue: THue;
APartialHue: Boolean): TMaterial; APartialHue: Boolean): TMaterial;
var var
artEntry: TArt; artEntry: TArt;
@ -431,7 +439,7 @@ begin
tdfPartialHue in staticTiledata.Flags); tdfPartialHue in staticTiledata.Flags);
end; end;
function TLandTextureManager.GetTexMaterial(ATileID: Word): TMaterial; function TLandTextureManager.GetTexMaterial(ATileID: LongWord): TMaterial;
var var
texEntry: TTexture; texEntry: TTexture;
texID: Integer; texID: Integer;
@ -460,7 +468,7 @@ end;
constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
AX, AY: Word); AX, AY: Word);
var var
i: Integer; i, ts: Integer;
item: TStaticItem; item: TStaticItem;
block: TMemoryStream; block: TMemoryStream;
begin begin
@ -473,13 +481,18 @@ begin
for i := 0 to 63 do for i := 0 to 63 do
Cells[i] := TStaticItemList.Create; Cells[i] := TStaticItemList.Create;
if not UseStaticsOldFormat
then ts := 7
else ts := 11;
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
begin begin
AData.Position := AIndex.Lookup; AData.Position := AIndex.Lookup;
block := TMemoryStream.Create; block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size); block.CopyFrom(AData, AIndex.Size);
block.Position := 0; block.Position := 0;
for i := 1 to (AIndex.Size div 7) do
for i := 1 to (AIndex.Size div ts) do
begin begin
item := TStaticItem.Create(Self, block, AX, AY); item := TStaticItem.Create(Self, block, AX, AY);
Cells[(item.Y mod 8) * 8 + (item.X mod 8)].Add(item); Cells[(item.Y mod 8) * 8 + (item.X mod 8)].Add(item);
@ -592,7 +605,8 @@ begin
FHeight := AHeight; FHeight := AHeight;
FCellWidth := FWidth * 8; FCellWidth := FWidth * 8;
FCellHeight := FHeight * 8; FCellHeight := FHeight * 8;
FBlockCache := TBlockCache.Create(256); BlockCacheSize := 256;
FBlockCache := TBlockCache.Create(BlockCacheSize); //856
FBlockCache.OnRemoveObject := @OnRemoveCachedObject; FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
FOnChange := nil; FOnChange := nil;
@ -608,6 +622,7 @@ begin
for i := 0 to FWriteMap.Size - 1 do for i := 0 to FWriteMap.Size - 1 do
FWriteMap[i] := True; FWriteMap[i] := True;
//FMaxStaticID := $1FFDC;
FMaxStaticID := Min(Min(ResMan.Animdata.AnimCount, ResMan.Tiledata.StaticCount), FMaxStaticID := Min(Min(ResMan.Animdata.AnimCount, ResMan.Tiledata.StaticCount),
ResMan.Art.EntryCount - $4000); ResMan.Art.EntryCount - $4000);
Logger.Send([lcClient, lcInfo], 'Landscape recognizes $%x StaticTile IDs.', Logger.Send([lcClient, lcInfo], 'Landscape recognizes $%x StaticTile IDs.',
@ -628,6 +643,11 @@ end;
destructor TLandscape.Destroy; destructor TLandscape.Destroy;
begin begin
if (FBlockCacheBak <> nil) then
begin
FBlockCacheBak.OnRemoveObject := nil;
FreeAndNil(FBlockCacheBak);
end;
if FBlockCache <> nil then if FBlockCache <> nil then
begin begin
FBlockCache.OnRemoveObject := nil; FBlockCache.OnRemoveObject := nil;
@ -661,7 +681,7 @@ begin
end; end;
end; end;
function TLandscape.GetMapCell(AX, AY: Word): TMapCell; function TLandscape.GetMapCell(AX, AY: Integer): TMapCell;
var var
block: TMapBlock; block: TMapBlock;
begin begin
@ -674,7 +694,7 @@ begin
end; end;
end; end;
function TLandscape.GetNormals(AX, AY: Word): TNormals; function TLandscape.GetNormals(AX, AY: Integer): TNormals;
begin begin
GetNormals(AX, AY, Result); GetNormals(AX, AY, Result);
end; end;
@ -732,7 +752,9 @@ begin
index.Lookup := ABuffer.Position index.Lookup := ABuffer.Position
else else
index.Lookup := -1; index.Lookup := -1;
index.Size := count * 7; if not UseStaticsOldFormat
then index.Size := count * 7
else index.Size := count * 11;
statics := TSeperatedStaticBlock.Create(ABuffer, index, coords.X, coords.Y); statics := TSeperatedStaticBlock.Create(ABuffer, index, coords.X, coords.Y);
FBlockCache.RemoveID(id); FBlockCache.RemoveID(id);
@ -957,8 +979,8 @@ begin
end; end;
procedure TLandscape.FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth, procedure TLandscape.FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth,
AHeight: Word; AMap, AStatics: Boolean; ANoDraw: Boolean; AHeight: Word; AMap, AStatics, ATDWalls, ATDBridges, ATDRoofs, ATDSurfaces, ATDFoliage, ATDWet: Boolean;
AAdditionalTiles: TWorldItemList = nil); ANoDraw: Boolean; AAdditionalTiles: TWorldItemList = nil);
var var
drawMapCell: TMapCell; drawMapCell: TMapCell;
drawStatics: TStaticItemList; drawStatics: TStaticItemList;
@ -967,7 +989,7 @@ var
staticTileData: TStaticTiledata; staticTileData: TStaticTiledata;
begin begin
ADrawList.Clear; ADrawList.Clear;
tempDrawList := TWorldItemList.Create(False);; tempDrawList := TWorldItemList.Create(False);
for x := AX to AX + AWidth do for x := AX to AX + AWidth do
begin begin
for y := AY to AY + AWidth do for y := AY to AY + AWidth do
@ -993,8 +1015,13 @@ begin
staticTileData := ResMan.Tiledata.StaticTiles[drawStatics[i].TileID]; staticTileData := ResMan.Tiledata.StaticTiles[drawStatics[i].TileID];
if ANoDraw or FDrawMap[drawStatics[i].TileID + $4000] then if ANoDraw or FDrawMap[drawStatics[i].TileID + $4000] then
begin begin
drawStatics[i].UpdatePriorities(staticTileData, if not ATDWalls and ((tdfWall in staticTileData.Flags) or (tdfWindow in staticTileData.Flags)) then continue;
ADrawList.GetSerial); if not ATDBridges and ((tdfBridge in staticTileData.Flags) or (tdfStairBack in staticTileData.Flags) or (tdfStairRight in staticTileData.Flags)) then continue;
if not ATDRoofs and (tdfRoof in staticTileData.Flags) then continue;
if not ATDSurfaces and (tdfSurface in staticTileData.Flags) then continue;
if not ATDFoliage and (tdfFoliage in staticTileData.Flags) then continue;
if not ATDWet and (tdfWet in staticTileData.Flags) then continue;
drawStatics[i].UpdatePriorities(staticTileData, ADrawList.GetSerial);
tempDrawList.Add(drawStatics[i]); tempDrawList.Add(drawStatics[i]);
end; end;
end; end;
@ -1128,48 +1155,42 @@ end;
procedure TLandscape.LoadNoDrawMap(AFileName: String); procedure TLandscape.LoadNoDrawMap(AFileName: String);
var var
noDrawFile: TextFile; XMLDoc: TXMLDocument;
line, ids1, ids2: String; iNode, node: TDOMNode;
i, id1, id2, splitPos: Integer; s: string;
begin i, id: Integer;
AssignFile(noDrawFile, AFileName);
Reset(noDrawFile);
while not EOF(noDrawFile) do
begin
ReadLn(noDrawFile, line);
if (Length(line) > 0) and (line[1] in ['S', 'T']) then
begin
splitPos := Pos('-', line);
if splitPos > 1 then
begin
ids1 := Copy(line, 2, splitPos - 2);
ids2 := Copy(line, splitPos + 1, Length(line));
if TryStrToInt(ids1, id1) and TryStrToInt(ids2, id2) then
begin
if line[1] = 'S' then
begin
Inc(id1, $4000);
Inc(id2, $4000);
end;
for i := id1 to id2 do begin
if i < FDrawMap.Size then frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['VirtualTiles.xml']));
FDrawMap[i] := False; // Читаем xml файл с жесткого диска
end; ReadXMLFile(XMLDoc, AFileName);
end else if LowerCase(XMLDoc.DocumentElement.NodeName) = 'virtualtiles' then
begin
iNode := XMLDoc.DocumentElement.FirstChild;
while iNode <> nil do
begin
if LowerCase(iNode.NodeName) = 'nodraw' then
begin begin
ids1 := Copy(line, 2, Length(line)); node := iNode.FirstChild;
if TryStrToInt(ids1, id1) then while node <> nil do
begin begin
if line[1] = 'S' then s := LowerCase(node.NodeName);
Inc(id1, $4000); if (s = 'tile') or (s = 'land') or (s = 'item') then
if id1 < FDrawMap.Size then for i := node.Attributes.Length - 1 downto 0 do
FDrawMap[id1] := False; if LowerCase(node.Attributes[i].NodeName) = 'id' then
if TryStrToInt(node.Attributes[i].NodeValue, id) then
begin
if s = 'item'
then Inc(id, $4000);
if (id >= 0) and (id < FDrawMap.Size)
then FDrawMap[id] := False;
end;
node := node.NextSibling;
end; end;
end; end;
iNode := iNode.NextSibling;
end; end;
end; end;
CloseFile(noDrawFile);
end; end;
procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word); procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word);
@ -1272,6 +1293,28 @@ begin
Logger.ExitMethod([lcLandscape, lcDebug], 'TLandscape.UpdateWriteMap'); Logger.ExitMethod([lcLandscape, lcDebug], 'TLandscape.UpdateWriteMap');
end; end;
procedure TLandscape.ResizeBlockCache(Count: Integer);
begin
if Count < 0 then Count:= 256;
if FBlockCache <> nil then
begin
if BlockCacheSize = Count then exit;
FBlockCache.OnRemoveObject := nil;
if (FBlockCacheBak <> nil) then begin
FBlockCacheBak.Clear;
FreeAndNil(FBlockCacheBak);
FBlockCacheBak := nil;
end;
if Count = 0 then exit;
FBlockCacheBak := FBlockCache;
BlockCacheSize:= Count;
FBlockCache := TBlockCache.Create(BlockCacheSize); //256
FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
end;
end;
{ TMaterial } { TMaterial }
constructor TMaterial.Create; constructor TMaterial.Create;
@ -1328,6 +1371,13 @@ begin
Free; Free;
end; end;
function TMaterial.HitTest(AX, AY: Integer; Zoom: Single): Boolean;
begin
AX := Trunc(AX / Zoom);
AY := Trunc(AY / Zoom);
Result := HitTest(AX, AY);
end;
function TMaterial.HitTest(AX, AY: Integer): Boolean; function TMaterial.HitTest(AX, AY: Integer): Boolean;
var var
pixel: TColor32Rec; pixel: TColor32Rec;
@ -1453,7 +1503,7 @@ begin
end; end;
end; end;
function TScreenBuffer.Find(AScreenPosition: TPoint): PBlockInfo; function TScreenBuffer.Find(AScreenPosition: TPoint; Zoom: Single): PBlockInfo;
var var
current: PBlockInfo; current: PBlockInfo;
buff: array[0..3] of GLuint; buff: array[0..3] of GLuint;
@ -1498,13 +1548,46 @@ begin
Result := current; Result := current;
end else end else
if current^.LowRes.HitTest(AScreenPosition.x - current^.ScreenRect.Left, if current^.LowRes.HitTest(AScreenPosition.x - current^.ScreenRect.Left,
AScreenPosition.y - current^.ScreenRect.Top) then AScreenPosition.y - current^.ScreenRect.Top, Zoom) then
Result := current; Result := current;
end; end;
current := current^.Next; current := current^.Next;
end; end;
end; end;
function TScreenBuffer.Find(AX, AY: Word): PBlockInfo;
var
current: PBlockInfo;
tile: TWorldItem;
staticTileData: TStaticTiledata;
tileZ: Integer;
begin
Result := nil;
current := FShortCuts[0];
while current <> nil do //search the last matching tile
begin
if current^.State = ssNormal then begin
tile := current^.Item;
if (tile.X = AX) and (tile.Y = AY) then begin
tileZ := $FFFF;
if tile is TStaticItem then begin
staticTileData := ResMan.Tiledata.StaticTiles[tile.TileID];
if tdfSurface in staticTileData.Flags then
tileZ := tile.Z + staticTileData.Height;
end else if tile is TMapCell then begin
tileZ := ResMan.Landscape.GetEffectiveAltitude(tile as TMapCell)
end else if tile is TVirtualTile then
tileZ := tile.Z;
if (tileZ <> $FFFF) and ((Result = nil) or (tile.Z > Result^.Item.Z)) then
Result := current;
end;
end;
current := current^.Next;
end;
end;
function TScreenBuffer.GetSerial: Cardinal; function TScreenBuffer.GetSerial: Cardinal;
begin begin
Result := FSerial; Result := FSerial;
@ -1593,7 +1676,7 @@ begin
shortcut := 1; shortcut := 1;
blockInfo := FShortCuts[0]; blockInfo := FShortCuts[0];
repeat repeat
if step = nextStep then if (step = nextStep) and (shortcut <= 10) then
begin begin
FShortCuts[shortcut] := blockInfo; FShortCuts[shortcut] := blockInfo;
Inc(shortcut); Inc(shortcut);
@ -1713,7 +1796,7 @@ end;
{ TAnimMaterial } { TAnimMaterial }
constructor TAnimMaterial.Create(ABaseID: Word; AAnimData: TAnimData; constructor TAnimMaterial.Create(ABaseID: LongWord; AAnimData: TAnimData;
AHue: THue = nil; APartialHue: Boolean = False); AHue: THue = nil; APartialHue: Boolean = False);
var var
i: Integer; i: Integer;

215
Client/ULightManager.pas
View File

@ -31,10 +31,21 @@ interface
uses uses
Classes, SysUtils, Imaging, ImagingTypes, ImagingClasses, ImagingCanvases, Classes, SysUtils, Imaging, ImagingTypes, ImagingClasses, ImagingCanvases,
ImagingOpenGL, GL, GLu, GLext, fgl, ULandscape, UWorldItem, UCacheManager; ImagingOpenGL, GL, GLu, GLext, fgl, ULandscape, UWorldItem, UCacheManager,
Math, DOM, XMLRead;
const
ColorsCount = 15;
type type
TLightColor = record
r: Float;
g: Float;
b: Float;
end;
PLightColor = ^TLightColor;
TCalculateOffset = procedure(AX, AY: Integer; out DrawX, DrawY: Integer) of object; TCalculateOffset = procedure(AX, AY: Integer; out DrawX, DrawY: Integer) of object;
{ TLightMaterial } { TLightMaterial }
@ -55,14 +66,16 @@ type
{ TLightSource } { TLightSource }
TLightSource = class TLightSource = class
constructor Create(AManager: TLightManager; AWorldItem: TWorldItem); constructor Create(AManager: TLightManager; AWorldItem: TWorldItem; Zoom: Single);
destructor Destroy; override; destructor Destroy; override;
protected protected
FColorID: Byte;
FX: Integer; FX: Integer;
FY: Integer; FY: Integer;
FZ: SmallInt; FZ: SmallInt;
FMaterial: TLightMaterial; FMaterial: TLightMaterial;
public public
property ColorID: Byte read FColorID;
property X: Integer read FX; property X: Integer read FX;
property Y: Integer read FY; property Y: Integer read FY;
property Z: SmallInt read FZ; property Z: SmallInt read FZ;
@ -88,24 +101,132 @@ type
FInitialized: Boolean; FInitialized: Boolean;
function GetLight(AID: Integer): TLightMaterial; function GetLight(AID: Integer): TLightMaterial;
procedure SetLightLevel(AValue: Byte); procedure SetLightLevel(AValue: Byte);
procedure UpdateOverlay(AScreenRect: TRect); procedure UpdateOverlay(AScreenRect: TRect; Zoom: Single);
public public
property LightLevel: Byte read FLightLevel write SetLightLevel; property LightLevel: Byte read FLightLevel write SetLightLevel;
procedure InitGL; procedure InitGL;
procedure UpdateLightMap(ALeft, AWidth, ATop, AHeight: Integer; procedure UpdateLightMap(ALeft, AWidth, ATop, AHeight: Integer;
AScreenBuffer: TScreenBuffer); AScreenBuffer: TScreenBuffer; Zoom: Single);
procedure Draw(AScreenRect: TRect); procedure Draw(AScreenRect: TRect; Zoom: Single);
public
procedure LoadConfig(AFileName: String);
public
LColors: array[1..ColorsCount] of TLightColor;
TileCol: ^Byte;
end; end;
implementation implementation
uses uses
UGameResources, UTiledata, UStatics, UMap, ULight, Logging; UGameResources, UTiledata, UStatics, UMap, ULight, Logging, UfrmMain, UfrmInitialize;
{ TLightManager } { TLightManager }
constructor TLightManager.Create(ACalculateOffset: TCalculateOffset); procedure TLightManager.LoadConfig(AFileName: String);
var
XMLDoc: TXMLDocument;
iNode, node: TDOMNode;
s: string;
i, id, col, r, g, b: Integer;
begin begin
for i := 1 to ColorsCount do begin
LColors[i].R := 1.0;
LColors[i].G := 1.0;
LColors[i].B := 1.0;
end;
if (TileCol <> nil) then
Freemem(TileCol);
Getmem(TileCol, (ResMan.Landscape.MaxStaticID + 1) * SizeOf(Byte));
for i := 0 to ResMan.Landscape.MaxStaticID do
TileCol[i] := 1;
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['ColorLight.xml']));
// Читаем xml файл с жесткого диска
ReadXMLFile(XMLDoc, AFileName);
if LowerCase(XMLDoc.DocumentElement.NodeName) = 'colorlight' then
begin
iNode := XMLDoc.DocumentElement.FirstChild;
while iNode <> nil do
begin
if LowerCase(iNode.NodeName) = 'colors' then
begin
node := iNode.FirstChild;
while node <> nil do
begin
if (LowerCase(node.NodeName) = 'color') then begin
id := -1;
r := 255;
g := 255;
b := 255;
for i := node.Attributes.Length - 1 downto 0 do
begin
s := LowerCase(node.Attributes[i].NodeName);
if (s = 'id') then
TryStrToInt(node.Attributes[i].NodeValue, id);
if (s = 'r') then
TryStrToInt(node.Attributes[i].NodeValue, r);
if (s = 'g') then
TryStrToInt(node.Attributes[i].NodeValue, g);
if (s = 'b') then
TryStrToInt(node.Attributes[i].NodeValue, b);
end;
if (id > 0) and (id <= ColorsCount) then begin
if (r < 0) then r := 0;
if (g < 0) then g := 0;
if (b < 0) then b := 0;
if (r > 255) then r := 255;
if (g > 255) then g := 255;
if (b > 255) then b := 255;
LColors[id].R := (Float(r)) / 255.0;
LColors[id].G := (Float(g)) / 255.0;
LColors[id].B := (Float(b)) / 255.0;
end;
end;
node := node.NextSibling;
end;
end;
if LowerCase(iNode.NodeName) = 'sources' then
begin
node := iNode.FirstChild;
while node <> nil do
begin
s := LowerCase(node.NodeName);
if (s = 'tile') or (s = 'item') then begin
col := 1;
id := -1;
for i := node.Attributes.Length - 1 downto 0 do begin
if LowerCase(node.Attributes[i].NodeName) = 'id' then
if TryStrToInt(node.Attributes[i].NodeValue, id) then
begin
if s = 'tile'
then Dec(id, $4000);
end;
if LowerCase(node.Attributes[i].NodeName) = 'color' then
if TryStrToInt(node.Attributes[i].NodeValue, col) then
begin
if (col < 1) or (col > ColorsCount)
then col := 1;
end;
end;
if (id >= 0) and (id <= ResMan.Landscape.MaxStaticID)
then TileCol[id] := col;
end;
node := node.NextSibling;
end;
end;
iNode := iNode.NextSibling;
end;
end;
end;
constructor TLightManager.Create(ACalculateOffset: TCalculateOffset);
var
i: Integer;
begin
TileCol := nil;
FCalculateOffset := ACalculateOffset; FCalculateOffset := ACalculateOffset;
FLightSources := TLightSources.Create(True); FLightSources := TLightSources.Create(True);
FLightLevel := 0; FLightLevel := 0;
@ -115,6 +236,10 @@ end;
destructor TLightManager.Destroy; destructor TLightManager.Destroy;
begin begin
if (TileCol <> nil) then begin
Freemem(TileCol);
TileCol := nil;
end;
FreeAndNil(FLightSources); FreeAndNil(FLightSources);
FreeAndNil(FOverlay); FreeAndNil(FOverlay);
FreeAndNil(FLightCache); FreeAndNil(FLightCache);
@ -145,7 +270,7 @@ begin
FValid := False; FValid := False;
end; end;
procedure TLightManager.UpdateOverlay(AScreenRect: TRect); procedure TLightManager.UpdateOverlay(AScreenRect: TRect; Zoom: Single);
var var
canvas: TFastARGB32Canvas; canvas: TFastARGB32Canvas;
color: TColor32Rec; color: TColor32Rec;
@ -153,6 +278,7 @@ var
lightMaterial: TLightMaterial; lightMaterial: TLightMaterial;
colorGL: GLclampf; colorGL: GLclampf;
fbo: GLuint; fbo: GLuint;
ptilcol: PLightColor;
begin begin
glDeleteTextures(1, @FOverlayTexture); glDeleteTextures(1, @FOverlayTexture);
if FUseFBO then if FUseFBO then
@ -182,23 +308,25 @@ begin
lightMaterial := FLightSources[i].Material; lightMaterial := FLightSources[i].Material;
if lightMaterial <> nil then if lightMaterial <> nil then
begin begin
ptilcol := @LColors[FLightSources[i].ColorID];
glBindTexture(GL_TEXTURE_2D, lightMaterial.Texture); glBindTexture(GL_TEXTURE_2D, lightMaterial.Texture);
glColor3f(ptilcol^.R, ptilcol^.G, ptilcol^.B);
glBegin(GL_QUADS); glBegin(GL_QUADS);
glTexCoord2i(0, 0); glTexCoord2i(0, 0);
glVertex2i(FLightSources[i].FX - lightMaterial.RealWidth div 2, glVertex2i(FLightSources[i].FX - Trunc(Zoom*lightMaterial.RealWidth) div 2,
FLightSources[i].FY - lightMaterial.RealHeight div 2); FLightSources[i].FY - Trunc(Zoom*lightMaterial.RealHeight) div 2);
glTexCoord2i(0, 1); glTexCoord2i(0, 1);
glVertex2i(FLightSources[i].FX - lightMaterial.RealWidth div 2, glVertex2i(FLightSources[i].FX - Trunc(Zoom*lightMaterial.RealWidth) div 2,
FLightSources[i].FY - lightMaterial.RealHeight div 2 + FLightSources[i].FY - Trunc(Zoom*lightMaterial.RealHeight) div 2 +
lightMaterial.Height); Trunc(Zoom*lightMaterial.Height));
glTexCoord2i(1, 1); glTexCoord2i(1, 1);
glVertex2i(FLightSources[i].FX - lightMaterial.RealWidth div 2 + glVertex2i(FLightSources[i].FX - Trunc(Zoom*lightMaterial.RealWidth) div 2 +
lightMaterial.Width, FLightSources[i].FY - Trunc(Zoom*lightMaterial.Width), FLightSources[i].FY -
lightMaterial.RealHeight div 2 + lightMaterial.Height); Trunc(Zoom*lightMaterial.RealHeight) div 2 + Trunc(Zoom*lightMaterial.Height));
glTexCoord2i(1, 0); glTexCoord2i(1, 0);
glVertex2i(FLightSources[i].FX - lightMaterial.RealWidth div 2 + glVertex2i(FLightSources[i].FX - Trunc(Zoom*lightMaterial.RealWidth) div 2 +
lightMaterial.Width, Trunc(Zoom*lightMaterial.Width),
FLightSources[i].FY - lightMaterial.RealHeight div 2); FLightSources[i].FY - Trunc(Zoom*lightMaterial.RealHeight) div 2);
glEnd; glEnd;
end; end;
end; end;
@ -227,8 +355,8 @@ begin
if lightMaterial <> nil then if lightMaterial <> nil then
begin begin
lightMaterial.Canvas.DrawAdd(lightMaterial.Canvas.ClipRect, canvas, lightMaterial.Canvas.DrawAdd(lightMaterial.Canvas.ClipRect, canvas,
FLightSources[i].FX - lightMaterial.RealWidth div 2, FLightSources[i].FX - Trunc(Zoom*lightMaterial.RealWidth) div 2,
FLightSources[i].FY - lightMaterial.RealHeight div 2); FLightSources[i].FY - Trunc(Zoom*lightMaterial.RealHeight) div 2);
end; end;
end; end;
finally finally
@ -247,7 +375,7 @@ begin
end; end;
procedure TLightManager.UpdateLightMap(ALeft, AWidth, ATop, AHeight: Integer; procedure TLightManager.UpdateLightMap(ALeft, AWidth, ATop, AHeight: Integer;
AScreenBuffer: TScreenBuffer); AScreenBuffer: TScreenBuffer; Zoom: Single);
var var
blockInfo: PBlockInfo; blockInfo: PBlockInfo;
lights: TWorldItemList; lights: TWorldItemList;
@ -279,8 +407,10 @@ begin
if tdfLightSource in tileData.Flags then if tdfLightSource in tileData.Flags then
lights.Add(blockInfo^.Item) lights.Add(blockInfo^.Item)
else else
tileMap[blockInfo^.Item.X - ALeft, blockInfo^.Item.Y - ATop] := x := blockInfo^.Item.X - ALeft;
blockInfo^.Item; y := blockInfo^.Item.Y - ATop;
if InRange(x, 0, AWidth - 1) and InRange(y, 0, AHeight - 1) then
tileMap[x, y] := blockInfo^.Item;
end; end;
end; end;
@ -288,9 +418,10 @@ begin
begin begin
x := lights[i].X + 1 - ALeft; x := lights[i].X + 1 - ALeft;
y := lights[i].Y + 1 - ATop; y := lights[i].Y + 1 - ATop;
if (x = AWidth) or (y = AHeight) or (tileMap[x,y] = nil) or if (x = AWidth) or (y = AHeight) or
(tileMap[x,y].Z < lights[i].Z + 5) then (InRange(x, 0, AWidth - 1) and InRange(y, 0, AHeight - 1) and
FLightSources.Add(TLightSource.Create(Self, lights[i])); ((tileMap[x,y] = nil) or (tileMap[x,y].Z < lights[i].Z + 5))) then
FLightSources.Add(TLightSource.Create(Self, lights[i], Zoom));
end; end;
lights.Free; lights.Free;
@ -299,7 +430,7 @@ begin
//Logger.ExitMethod([lcClient, lcDebug], 'UpdateLightMap'); //Logger.ExitMethod([lcClient, lcDebug], 'UpdateLightMap');
end; end;
procedure TLightManager.Draw(AScreenRect: TRect); procedure TLightManager.Draw(AScreenRect: TRect; Zoom: Single);
begin begin
if not FInitialized then if not FInitialized then
InitGL; InitGL;
@ -307,38 +438,41 @@ begin
glColor4f(1, 1, 1, 1); glColor4f(1, 1, 1, 1);
if not FValid then if not FValid then
UpdateOverlay(AScreenRect); UpdateOverlay(AScreenRect, Zoom);
glBindTexture(GL_TEXTURE_2D, FOverlayTexture); glBindTexture(GL_TEXTURE_2D, FOverlayTexture);
glBlendFunc(GL_ZERO, GL_SRC_COLOR); glBlendFunc(GL_ZERO, GL_SRC_COLOR);
glBegin(GL_QUADS); glBegin(GL_QUADS);
Zoom := 1.0;
if FUseFBO then if FUseFBO then
begin begin
glColor3f(1.0, 1.0, 1.0);
glTexCoord2i(0, 1); glTexCoord2i(0, 1);
glVertex2i(AScreenRect.Left, AScreenRect.Top); glVertex2i(Trunc(Zoom*AScreenRect.Left), Trunc(Zoom*AScreenRect.Top));
glTexCoord2i(0, 0); glTexCoord2i(0, 0);
glVertex2i(AScreenRect.Left, AScreenRect.Bottom); glVertex2i(Trunc(Zoom*AScreenRect.Left), Trunc(Zoom*AScreenRect.Bottom));
glTexCoord2i(1, 0); glTexCoord2i(1, 0);
glVertex2i(AScreenRect.Right, AScreenRect.Bottom); glVertex2i(Trunc(Zoom*AScreenRect.Right), Trunc(Zoom*AScreenRect.Bottom));
glTexCoord2i(1, 1); glTexCoord2i(1, 1);
glVertex2i(AScreenRect.Right, AScreenRect.Top); glVertex2i(Trunc(Zoom*AScreenRect.Right), Trunc(Zoom*AScreenRect.Top));
end else end else
begin begin
glColor3f(1.0, 1.0, 1.0);
glTexCoord2i(0, 0); glTexCoord2i(0, 0);
glVertex2i(AScreenRect.Left, AScreenRect.Top); glVertex2i(Trunc(Zoom*AScreenRect.Left), Trunc(Zoom*AScreenRect.Top));
glTexCoord2i(0, 1); glTexCoord2i(0, 1);
glVertex2i(AScreenRect.Left, AScreenRect.Bottom); glVertex2i(Trunc(Zoom*AScreenRect.Left), Trunc(Zoom*AScreenRect.Bottom));
glTexCoord2i(1, 1); glTexCoord2i(1, 1);
glVertex2i(AScreenRect.Right, AScreenRect.Bottom); glVertex2i(Trunc(Zoom*AScreenRect.Right), Trunc(Zoom*AScreenRect.Bottom));
glTexCoord2i(1, 0); glTexCoord2i(1, 0);
glVertex2i(AScreenRect.Right, AScreenRect.Top); glVertex2i(Trunc(Zoom*AScreenRect.Right), Trunc(Zoom*AScreenRect.Top));
end; end;
glEnd; glEnd;
end; end;
{ TLightSource } { TLightSource }
constructor TLightSource.Create(AManager: TLightManager; AWorldItem: TWorldItem); constructor TLightSource.Create(AManager: TLightManager; AWorldItem: TWorldItem; Zoom: Single);
var var
lightID: Byte; lightID: Byte;
begin begin
@ -346,9 +480,12 @@ begin
FMaterial := AManager.GetLight(lightID); FMaterial := AManager.GetLight(lightID);
if FMaterial <> nil then if FMaterial <> nil then
begin begin
FColorID := AManager.TileCol[AWorldItem.TileID];
if (FColorID < 1) or (FColorID > ColorsCount)
then FColorID := 1;
AManager.FCalculateOffset(AWorldItem.X, AWorldItem.Y, FX, FY); AManager.FCalculateOffset(AWorldItem.X, AWorldItem.Y, FX, FY);
FZ := AWorldItem.Z * 4; FZ := AWorldItem.Z * 4;
FY := FY + 22 - FZ; FY := FY + Trunc(Zoom*(22 - FZ));
FMaterial.AddRef; FMaterial.AddRef;
end; end;
end; end;

4
Client/UOverlayUI.pas
View File

@ -177,7 +177,7 @@ begin
FActiveArrow := -1; FActiveArrow := -1;
FVisible := False; FVisible := False;
arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(0)); arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource('Overlay/LeftTopArrow.tga'));
for i := 0 to 3 do for i := 0 to 3 do
begin begin
FArrows[2*i] := TGLArrow.Create(arrow); FArrows[2*i] := TGLArrow.Create(arrow);
@ -186,7 +186,7 @@ begin
end; end;
arrow.Free; arrow.Free;
arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource(1)); arrow := TSingleImage.CreateFromStream(ResourceManager.GetResource('Overlay/TopArrow.tga'));
for i := 0 to 3 do for i := 0 to 3 do
begin begin
FArrows[2*i+1] := TGLArrow.Create(arrow); FArrows[2*i+1] := TGLArrow.Create(arrow);

7
Client/UPackets.pas
View File

@ -28,7 +28,7 @@ unit UPackets;
interface interface
uses uses
Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics; Classes, dzlib, UEnhancedMemoryStream, UPacket, UStatics, Logging;
type type
TBlockCoords = packed record TBlockCoords = packed record
@ -97,7 +97,7 @@ type
TElevateStaticPacket = class(TStaticPacket) TElevateStaticPacket = class(TStaticPacket)
constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt); constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word; constructor Create(AX, AY: Word; AZ: ShortInt; ATileID: Word; AHue: Word;
ANewZ: Word); ANewZ: ShortInt);
end; end;
{ TMoveStaticPacket } { TMoveStaticPacket }
@ -182,6 +182,7 @@ begin
FStream.WriteByte($03); FStream.WriteByte($03);
FStream.WriteStringNull(AUsername); FStream.WriteStringNull(AUsername);
FStream.WriteStringNull(APassword); FStream.WriteStringNull(APassword);
Logger.Send([lcClient, lcInfo], 'Отправлен пакет TLoginRequestPacket');
end; end;
{ TQuitPacket } { TQuitPacket }
@ -262,7 +263,7 @@ begin
end; end;
constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt; constructor TElevateStaticPacket.Create(AX, AY: Word; AZ: ShortInt;
ATileID: Word; AHue: Word; ANewZ: Word); ATileID: Word; AHue: Word; ANewZ: ShortInt);
begin begin
inherited Create($09, 11); inherited Create($09, 11);
FStream.WriteWord(AX); FStream.WriteWord(AX);

5
Client/UPlatformTypes.pas
View File

@ -30,10 +30,11 @@ unit UPlatformTypes;
interface interface
uses uses
Classes, SysUtils, ActiveX; Classes, SysUtils,
{$IFDEF WINDOWS}ActiveX{$ELSE}fakeactivex{$ENDIF};
type type
IDataObject = ActiveX.IDataObject; IDataObject = {$IFDEF WINDOWS}ActiveX{$ELSE}fakeactivex{$ENDIF}.IDataObject;
implementation implementation

24
Client/UResourceManager.pas
View File

@ -30,7 +30,7 @@ unit UResourceManager;
interface interface
uses uses
Classes, SysUtils; Classes, SysUtils, Crc32Hash;
type type
@ -43,10 +43,12 @@ type
FFileStream: TFileStream; FFileStream: TFileStream;
FCount: Integer; FCount: Integer;
FLookupTable: array of Cardinal; FLookupTable: array of Cardinal;
FfnHashTable: array of Cardinal;
FCurrentResource: Integer; FCurrentResource: Integer;
FResourceStream: TMemoryStream; FResourceStream: TMemoryStream;
public public
function GetResource(AIndex: Integer): TStream; function GetResource(AIndex: Integer): TStream;
function GetResource(AFileName: String): TStream;
end; end;
var var
@ -63,7 +65,9 @@ begin
FFileStream.Position := 0; FFileStream.Position := 0;
FFileStream.Read(FCount, SizeOf(Integer)); FFileStream.Read(FCount, SizeOf(Integer));
SetLength(FLookupTable, FCount); SetLength(FLookupTable, FCount);
SetLength(FfnHashTable, FCount);
FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal)); FFileStream.Read(FLookupTable[0], FCount * SizeOf(Cardinal));
FFileStream.Read(FfnHashTable[0], FCount * SizeOf(Cardinal));
FCurrentResource := -1; FCurrentResource := -1;
end; end;
@ -74,6 +78,22 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function TResourceManager.GetResource(AFileName: String): TStream;
var
i : Integer;
hash : DWORD;
begin
if not CalcStringCRC32(AnsiLowerCase(AFileName), hash)
then Result := nil
else begin
for i := 0 to FCount do
if FfnHashTable[i] = hash then begin
Result := GetResource(i);
break;
end;
end;
end;
function TResourceManager.GetResource(AIndex: Integer): TStream; function TResourceManager.GetResource(AIndex: Integer): TStream;
var var
size: Cardinal; size: Cardinal;
@ -93,7 +113,7 @@ end;
initialization initialization
begin begin
ResourceManager := TResourceManager.Create(ChangeFileExt(ParamStr(0), '.dat')); ResourceManager := TResourceManager.Create(ExtractFilePath(ParamStr(0)) + '../Assetspack.dat');
end; end;
finalization finalization

4
Client/UdmNetwork.lfm
View File

@ -2,10 +2,10 @@ object dmNetwork: TdmNetwork
OnCreate = DataModuleCreate OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy OnDestroy = DataModuleDestroy
OldCreateOrder = False OldCreateOrder = False
Height = 300 Height = 375
HorizontalOffset = 290 HorizontalOffset = 290
VerticalOffset = 171 VerticalOffset = 171
Width = 400 Width = 631
object TCPClient: TLTCPComponent object TCPClient: TLTCPComponent
Port = 0 Port = 0
OnReceive = TCPClientReceive OnReceive = TCPClientReceive

147
Client/UdmNetwork.pas
View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet, Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet,
UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils; UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils, LConvEncoding;
type type
@ -51,9 +51,11 @@ type
protected protected
FSendQueue: TEnhancedMemoryStream; FSendQueue: TEnhancedMemoryStream;
FReceiveQueue: TEnhancedMemoryStream; FReceiveQueue: TEnhancedMemoryStream;
FProfile: string;
FUsername: string; FUsername: string;
FPassword: string; FPassword: string;
FAccessLevel: TAccessLevel; FAccessLevel: TAccessLevel;
FServerStart: TDateTime;
FDataDir: string; FDataDir: string;
FLastPacket: TDateTime; FLastPacket: TDateTime;
procedure OnCanSend(ASocket: TLSocket); procedure OnCanSend(ASocket: TLSocket);
@ -61,11 +63,22 @@ type
procedure ProcessQueue; procedure ProcessQueue;
procedure DoLogin; procedure DoLogin;
public public
property Profile: string read FProfile;
property Username: string read FUsername; property Username: string read FUsername;
property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel; property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel;
property ServerStart: TDateTime read FServerStart;
procedure Send(APacket: TPacket); procedure Send(APacket: TPacket);
procedure Disconnect; procedure Disconnect;
procedure CheckClose(ASender: TForm); procedure CheckClose(ASender: TForm);
public
ErrorCaption: string;
WrongServer: string;
WrongAccount: string;
WrongPassword: string;
NoAccess: string;
AlreadyLogined: string;
TCPErrorCaption: string;
UnsuportedVersion: string;
end; end;
var var
@ -77,8 +90,10 @@ uses
UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize, UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize,
UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings, UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings, UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand, UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand, UfrmFillSettings,
UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel; UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel, UfrmSelectionSettings,
UfrmSurfElevateSettings, UfrmSurfStretchSettings, UfrmSurfSmoothSettings,
Logging, Language;
{$I version.inc} {$I version.inc}
@ -114,8 +129,11 @@ begin
end; end;
procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket); procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket);
var
rumsg : string;
begin begin
MessageDlg('Connection error', msg, mtError, [mbOK], 0); rumsg := CP1251ToUTF8(msg);
MessageDlg(TCPErrorCaption, rumsg, mtError, [mbOK], 0);
if not TCPClient.Connected then if not TCPClient.Connected then
TCPClientDisconnect(aSocket); TCPClientDisconnect(aSocket);
end; end;
@ -164,68 +182,98 @@ var
subID: Byte; subID: Byte;
loginState: TLoginState; loginState: TLoginState;
width, height: Word; width, height: Word;
flags: Cardinal;
serverState: TServerState; serverState: TServerState;
date, time: TDateTime;
begin begin
subID := ABuffer.ReadByte; subID := ABuffer.ReadByte;
case subID of case subID of
$01: $01:
begin begin
if ABuffer.ReadCardinal = ProtocolVersion then if (ABuffer.ReadCardinal - $1000) = ProtocolVersion then
begin begin
frmInitialize.lblStatus.Caption := 'Authenticating'; frmInitialize.lblStatus.Caption := frmInitialize.SplashAuthorization;
Send(TLoginRequestPacket.Create(FUsername, FPassword)); Send(TLoginRequestPacket.Create(FUsername, FPassword));
end else end else
begin begin // sLineBreak
MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0); MessageDlg(ErrorCaption, UnsuportedVersion, mtError, [mbOK], 0);
Disconnect; Disconnect;
end; end;
Logger.Send([lcClient, lcInfo], 'Текущая версия протокола подтверждена');
end; end;
$03: $03:
begin begin
loginState := TLoginState(ABuffer.ReadByte); loginState := TLoginState(ABuffer.ReadByte);
if loginState = lsOK then if loginState = lsOK then
begin begin
frmInitialize.lblStatus.Caption := 'Initializing'; frmInitialize.SetStatusLabel(frmInitialize.SplashInicialization);
frmInitialize.Repaint;
frmInitialize.lblStatus.Repaint;
Application.ProcessMessages; Application.ProcessMessages;
FAccessLevel := TAccessLevel(ABuffer.ReadByte); FAccessLevel := TAccessLevel(ABuffer.ReadByte);
InitGameResourceManager(FDataDir); FServerStart := IncSecond(Now, - ABuffer.ReadDWord);
width := ABuffer.ReadWord; width := ABuffer.ReadWord;
height := ABuffer.ReadWord; height := ABuffer.ReadWord;
ResMan.InitLandscape(width, height); flags := ABuffer.ReadCardinal;
ResMan.Landscape.UpdateWriteMap(ABuffer);
frmMain := TfrmMain.Create(dmNetwork); // Для совместимости с сервером 0.7.0 (ранее тут слалось число преметов)
frmRadarMap := TfrmRadarMap.Create(frmMain); if (flags and $FF000000) = 0 then // GameResourceManager.Tiledata.StaticCount
frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain); if flags < $C000 then flags := $F0000000 else flags := $F0000008;
frmRegionControl := TfrmRegionControl.Create(frmMain);
frmAccountControl := TfrmAccountControl.Create(frmMain); if not InitGameResourceManager(FDataDir, Flags) then begin
frmEditAccount := TfrmEditAccount.Create(frmAccountControl); Logger.Send([lcClient, lcInfo], 'CentrED+ загрузка отменена, не та версия *.mul файлов.');
frmConfirmation := TfrmConfirmation.Create(frmMain); Disconnect; exit;
frmDrawSettings := TfrmDrawSettings.Create(frmMain); end;
frmMoveSettings := TfrmMoveSettings.Create(frmMain);
frmElevateSettings := TfrmElevateSettings.Create(frmMain); ResMan.InitLandscape(width, height);
frmHueSettings := TfrmHueSettings.Create(frmMain);
frmBoundaries := TfrmBoundaries.Create(frmMain); // Проверка обновлений
frmFilter := TfrmFilter.Create(frmMain); frmInitialize.SetStatusLabel(frmInitialize.SplashUpdates);
frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
frmLightlevel := TfrmLightlevel.Create(frmMain);
frmAbout := TfrmAbout.Create(frmMain); Logger.Send([lcClient, lcInfo], 'Начало загрузки CentrED+');
frmMain.Show; frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['OpenGL Device']));
frmInitialize.Hide; ResMan.Landscape.UpdateWriteMap(ABuffer); Logger.Send([lcClient, lcInfo], 'ResMan.Landscape.UpdateWriteMap(ABuffer);');
tmNoOp.Enabled := True;
frmMain := TfrmMain.Create(dmNetwork); Logger.Send([lcClient, lcInfo], 'frmMain := TfrmMain.Create(dmNetwork);');
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['Windows Forms']));
frmRadarMap := TfrmRadarMap.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmRadarMap := TfrmRadarMap.Create(frmMain);');
frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain);');
frmRegionControl := TfrmRegionControl.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmRegionControl := TfrmRegionControl.Create(frmMain);');
frmAccountControl := TfrmAccountControl.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmAccountControl := TfrmAccountControl.Create(frmMain);');
frmEditAccount := TfrmEditAccount.Create(frmAccountControl); Logger.Send([lcClient, lcInfo], 'frmEditAccount := TfrmEditAccount.Create(frmAccountControl);');
frmConfirmation := TfrmConfirmation.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmConfirmation := TfrmConfirmation.Create(frmMain);');
frmSelectionSettings := TfrmSelectionSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmSelectionSettings := TfrmSelectionSettings.Create(frmMain);');
frmMoveSettings := TfrmMoveSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmMoveSettings := TfrmMoveSettings.Create(frmMain);');
frmElevateSettings := TfrmElevateSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmElevateSettings := TfrmElevateSettings.Create(frmMain);');
frmSurfElevateSettings := TfrmSurfElevateSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmSurfElevateSettings := TfrmSurfElevateSettings.Create(frmMain);');
frmSurfStretchSettings := TfrmSurfStretchSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmSurfStretchSettings := TfrmSurfStretchSettings.Create(frmMain);');
frmSurfSmoothSettings := TfrmSurfSmoothSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmSurfSmoothSettings := TfrmSurfSmoothSettings.Create(frmMain);');
frmDrawSettings := TfrmDrawSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmDrawSettings := TfrmDrawSettings.Create(frmMain);');
frmHueSettings := TfrmHueSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmHueSettings := TfrmHueSettings.Create(frmMain);');
frmFillSettings := TfrmFillSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmFillSettings := TfrmFillSettings.Create(frmMain);');
frmVirtualLayer := TfrmVirtualLayer.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmVirtualLayer := TfrmVirtualLayer.Create(frmMain)');
frmBoundaries := TfrmBoundaries.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmBoundaries := TfrmBoundaries.Create(frmMain);');
frmFilter := TfrmFilter.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmFilter := TfrmFilter.Create(frmMain);');
frmLightlevel := TfrmLightlevel.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmLightlevel := TfrmLightlevel.Create(frmMain);');
frmAbout := TfrmAbout.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmAbout := TfrmAbout.Create(frmMain);');
frmMain.mnuTileListViewClick(nil);
frmMain.Show; Logger.Send([lcClient, lcInfo], 'frmMain.Show;');
frmInitialize.Hide; Logger.Send([lcClient, lcInfo], 'frmInitialize.Hide;');
tmNoOp.Enabled := True; Logger.Send([lcClient, lcInfo], 'tmNoOp.Enabled := True;');
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['Done']));
end else end else
begin begin
if loginState = lsInvalidUser then if loginState = lsInvalidUser then
MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0) MessageDlg(ErrorCaption, WrongAccount, mtWarning, [mbOK], 0)
else if loginState = lsInvalidPassword then else if loginState = lsInvalidPassword then
MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0) MessageDlg(ErrorCaption, WrongPassword, mtWarning, [mbOK], 0)
else if loginState = lsAlreadyLoggedIn then else if loginState = lsAlreadyLoggedIn then
MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0) MessageDlg(ErrorCaption, AlreadyLogined, mtWarning, [mbOK], 0)
else if loginState = lsNoAccess then else if loginState = lsNoAccess then
MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0); MessageDlg(ErrorCaption, NoAccess, mtWarning, [mbOK], 0);
end; end;
Logger.Send([lcClient, lcInfo], 'CentrED+ запущен.');
end; end;
$04: //Server state $04: //Server state
begin begin
@ -238,7 +286,7 @@ begin
end else end else
begin begin
case serverState of case serverState of
ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.'; ssFrozen: frmInitialize.lblStatus.Caption := frmInitialize.SplashSuspend;
ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull
end; end;
tmNoOp.Enabled := False; tmNoOp.Enabled := False;
@ -296,18 +344,23 @@ begin
FreeAndNil(frmEditAccount); FreeAndNil(frmEditAccount);
FreeAndNil(frmAccountControl); FreeAndNil(frmAccountControl);
FreeAndNil(frmConfirmation); FreeAndNil(frmConfirmation);
FreeAndNil(frmDrawSettings); FreeAndNil(frmSelectionSettings);
FreeAndNil(frmMoveSettings); FreeAndNil(frmMoveSettings);
FreeAndNil(frmElevateSettings); FreeAndNil(frmElevateSettings);
FreeAndNil(frmSurfElevateSettings);
FreeAndNil(frmSurfStretchSettings);
FreeAndNil(frmSurfSmoothSettings);
FreeAndNil(frmDrawSettings);
FreeAndNil(frmHueSettings); FreeAndNil(frmHueSettings);
FreeAndNil(frmFillSettings);
FreeAndNil(frmVirtualLayer);
FreeAndNil(frmBoundaries); FreeAndNil(frmBoundaries);
FreeAndNil(frmFilter); FreeAndNil(frmFilter);
FreeAndNil(frmVirtualLayer); FreeAndNil(frmLightlevel);
FreeAndNil(frmAbout); FreeAndNil(frmAbout);
FreeAndNil(frmRegionControl); FreeAndNil(frmRegionControl);
FreeAndNil(frmLargeScaleCommand); FreeAndNil(frmLargeScaleCommand);
FreeAndNil(frmRadarMap); FreeAndNil(frmRadarMap);
FreeAndNil(frmLightlevel);
if frmMain <> nil then if frmMain <> nil then
begin begin
@ -320,16 +373,20 @@ begin
frmInitialize.Hide; frmInitialize.Hide;
while frmLogin.ShowModal = mrOK do while frmLogin.ShowModal = mrOK do
begin begin
LanguageTranslate(frmInitialize, self, nil);
if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then
begin begin
if frmLogin.cbProfile.ItemIndex > -1
then FProfile := frmLogin.cbProfile.Text
else FProfile := '---';
FUsername := frmLogin.edUsername.Text; FUsername := frmLogin.edUsername.Text;
FPassword := frmLogin.edPassword.Text; FPassword := frmLogin.edPassword.Text;
FDataDir := frmLogin.edData.Text; FDataDir := UTF8ToCP1251(frmLogin.edData.Text);
frmInitialize.lblStatus.Caption := 'Connecting'; frmInitialize.lblStatus.Caption := frmInitialize.SplashConnection;
frmInitialize.Show; frmInitialize.Show;
Break; Break;
end else end else
MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0); MessageDlg(ErrorCaption, WrongServer, mtError, [mbOK], 0);
end; end;
frmLogin.Close; frmLogin.Close;
FreeAndNil(frmLogin); FreeAndNil(frmLogin);

338
Client/UfrmAbout.lfm
View File

@ -1,146 +1,232 @@
object frmAbout: TfrmAbout object frmAbout: TfrmAbout
Left = 290 Left = 1412
Height = 308 Height = 255
Top = 171 Top = 424
Width = 354 Width = 324
AutoSize = True AutoSize = True
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'About CentrED' Caption = 'О программе CentrED+'
ClientHeight = 308 ClientHeight = 255
ClientWidth = 354 ClientWidth = 324
Color = clBlack
Font.Height = -11 Font.Height = -11
OnCreate = FormCreate OnCreate = FormCreate
OnHide = FormHide
OnShow = FormShow
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '0.9.29' LCLVersion = '0.9.30.2'
object Label3: TLabel
Left = 8
Height = 53
Top = 189
Width = 338
Align = alTop
BorderSpacing.Top = 16
BorderSpacing.Around = 8
Caption = 'Ultima(tm) Online (c) 1997 Electronic Arts Inc. Ultima, the UO logo, Are You With Us?, ORIGIN, the ORIGIN logo and We create worlds are trademarks or registered trademarks of Electronic Arts Inc. in the U.S. and/or other countries. All rights reserved.'
ParentColor = False
WordWrap = True
end
object Label5: TLabel
Left = 8
Height = 14
Top = 98
Width = 338
Align = alTop
BorderSpacing.Left = 8
BorderSpacing.Right = 8
Caption = 'It is using the following great components:'
ParentColor = False
end
object Label6: TLabel
Left = 16
Height = 53
Top = 112
Width = 330
Align = alTop
BorderSpacing.Left = 16
BorderSpacing.Right = 8
Caption = '- Vampyre Imaging Lib by Marek Mauder'#13#10'- lNet by Ales Katona and Micha Nelissen'#13#10'- VirtualTrees by Mike Lischke'#13#10'- Silk Icons by Mark James'
ParentColor = False
end
object Label7: TLabel
Left = 8
Height = 14
Top = 84
Width = 338
Align = alTop
BorderSpacing.Left = 8
BorderSpacing.Right = 8
Caption = 'CentrED has been developed using Lazarus and FreePascal.'
ParentColor = False
WordWrap = True
end
object Panel2: TPanel
Left = 0
Height = 76
Top = 0
Width = 354
Align = alTop
AutoSize = True
BorderSpacing.Bottom = 8
BevelOuter = bvNone
ClientHeight = 76
ClientWidth = 354
TabOrder = 0
object Panel1: TPanel
Left = 0
Height = 76
Top = 0
Width = 167
AutoSize = True
BevelInner = bvRaised
BevelOuter = bvLowered
ClientHeight = 76
ClientWidth = 167
TabOrder = 0
object Label1: TLabel
Left = 2
Height = 38
Top = 2
Width = 163
Align = alTop
Alignment = taCenter
AutoSize = False
Caption = 'UO CentrED'
Font.Height = -29
Font.Style = [fsBold]
Layout = tlCenter
ParentColor = False
ParentFont = False
end
object lblVersion: TLabel
Left = 6
Height = 14
Top = 40
Width = 155
Align = alTop
Alignment = taRightJustify
BorderSpacing.Left = 4
BorderSpacing.Right = 4
ParentColor = False
end
object lblCopyright: TLabel
Left = 6
Height = 14
Top = 58
Width = 155
Align = alTop
Alignment = taCenter
BorderSpacing.Around = 4
ParentColor = False
end
end
end
object Panel3: TPanel object Panel3: TPanel
AnchorSideTop.Control = Label3
Left = 8 Left = 8
Height = 25 Height = 22
Top = 250 Top = 225
Width = 338 Width = 308
Align = alTop Align = alBottom
BorderSpacing.Around = 8 BorderSpacing.Around = 8
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 25 ClientHeight = 22
ClientWidth = 338 ClientWidth = 308
TabOrder = 1 TabOrder = 1
object btnClose: TButton object btnClose: TButton
Left = 263 AnchorSideTop.Control = Panel3
Height = 25 Left = 0
Height = 22
Top = 0 Top = 0
Width = 75 Width = 96
Align = alRight Align = alLeft
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 4
Caption = 'Close' Caption = 'Закрыть'
OnClick = btnCloseClick OnClick = btnCloseClick
TabOrder = 0 TabOrder = 0
end end
end end
object Panel4: TPanel
Left = 0
Height = 96
Top = 124
Width = 324
Align = alTop
BevelOuter = bvNone
ClientHeight = 96
ClientWidth = 324
Color = clBlack
ParentColor = False
TabOrder = 2
object Label3: TLabel
Left = 8
Height = 28
Top = 61
Width = 308
Align = alTop
BorderSpacing.Left = 8
BorderSpacing.Top = 12
BorderSpacing.Right = 8
Caption = 'Ultima(tm) Online (c) 1997 Electronic Arts Inc. Ultima, the UO logo, Are You With Us?, ORIGIN, the ORIGIN logo and We create worlds are trademarks or registered trademarks of Electronic Arts Inc. in the U.S. and/or other countries. All rights reserved.'
Font.CharSet = RUSSIAN_CHARSET
Font.Color = 6836796
Font.Height = -8
Font.Name = 'Microsoft Sans Serif'
Font.Pitch = fpVariable
Font.Quality = fqDraft
ParentColor = False
ParentFont = False
WordWrap = True
end
object Label8: TLabel
AnchorSideTop.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 49
Top = 0
Width = 308
Align = alTop
BorderSpacing.Left = 8
BorderSpacing.Right = 8
Caption = '"UO CentrED+" (c) 2013 StaticZ (email: staticz@uoquint.ru)'#13#10'Special for "UO: Quintessence" (www.uoquint.ru) server.'#13#10'"UO CentrED+" is a modification of "UO CentrED" ver 0.6.1'#13#10'original "UO CentrED" (c) 2009 Andreas Schneider'
Font.CharSet = ANSI_CHARSET
Font.Color = 14405055
Font.Height = -9
Font.Name = 'Microsoft Sans Serif'
Font.Pitch = fpVariable
Font.Quality = fqDraft
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
WordWrap = True
end
end
object Panel2: TPanel
Left = 0
Height = 116
Top = 0
Width = 324
Align = alTop
BorderSpacing.Bottom = 8
BevelOuter = bvNone
ClientHeight = 116
ClientWidth = 324
Color = clOlive
ParentColor = False
TabOrder = 0
OnClick = Panel2Click
object imgLogo: TImage
Left = 0
Height = 116
Top = 0
Width = 324
Align = alClient
Proportional = True
Stretch = True
end
object lblVersion: TLabel
Left = 200
Height = 31
Top = 80
Width = 99
Align = alCustom
BorderSpacing.Left = 4
BorderSpacing.Right = 4
Caption = 'Version: 0.0.0'#13#10' Build: 1401'
Font.CharSet = RUSSIAN_CHARSET
Font.Color = clWhite
Font.Height = -13
Font.Name = 'Consolas'
Font.Pitch = fpFixed
Font.Quality = fqDraft
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lblCopyright: TLabel
AnchorSideLeft.Control = imgLogo
AnchorSideRight.Control = imgLogo
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = imgLogo
AnchorSideBottom.Side = asrBottom
Left = 28
Height = 15
Top = 97
Width = 162
Align = alCustom
Alignment = taCenter
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 24
BorderSpacing.Around = 4
Caption = 'Project of uoquint team'
Font.CharSet = RUSSIAN_CHARSET
Font.Color = clWhite
Font.Height = -12
Font.Name = 'Consolas'
Font.Pitch = fpFixed
Font.Quality = fqDraft
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object lblWebLink: TLabel
AnchorSideLeft.Control = imgLogo
AnchorSideTop.Control = lblVersion
AnchorSideRight.Control = lblVersion
AnchorSideRight.Side = asrBottom
Cursor = crHandPoint
Left = 26
Height = 16
Top = 80
Width = 148
Align = alCustom
Alignment = taRightJustify
BorderSpacing.Left = 26
BorderSpacing.Right = 4
Caption = 'http://dev.uoquint.ru'
Font.CharSet = RUSSIAN_CHARSET
Font.Color = 14781009
Font.Height = -13
Font.Name = 'Consolas'
Font.Pitch = fpFixed
Font.Quality = fqDraft
Font.Style = [fsBold, fsUnderline]
ParentColor = False
ParentFont = False
OnClick = lblWebLinkClick
OnMouseEnter = lblWebLinkMouseEnter
OnMouseLeave = lblWebLinkMouseLeave
end
end
object Panel5: TPanel
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 186
Height = 40
Top = 207
Width = 130
Align = alCustom
Anchors = [akRight, akBottom]
BorderSpacing.Around = 8
BevelOuter = bvNone
BorderStyle = bsSingle
ClientHeight = 36
ClientWidth = 126
ParentColor = False
TabOrder = 3
Visible = False
object imgBaner: TImage
Cursor = crHandPoint
Left = 0
Height = 36
Hint = 'Перейти на сайт "www.uoquint.ru"'
Top = 0
Width = 126
Align = alClient
Center = True
OnClick = imgBanerClick
OnMouseEnter = imgBanerMouseEnter
OnMouseLeave = imgBanerMouseLeave
ParentShowHint = False
Proportional = True
ShowHint = True
end
end
end end

104
Client/UfrmAbout.pas
View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls; ExtCtrls, ShellAPI, MMSystem;
type type
@ -39,22 +39,35 @@ type
TfrmAbout = class(TForm) TfrmAbout = class(TForm)
btnClose: TButton; btnClose: TButton;
Label1: TLabel; imgLogo: TImage;
imgBaner: TImage;
Label3: TLabel; Label3: TLabel;
Label5: TLabel; Label8: TLabel;
Label6: TLabel;
Label7: TLabel;
lblCopyright: TLabel; lblCopyright: TLabel;
lblVersion: TLabel; lblVersion: TLabel;
Panel1: TPanel; lblWebLink: TLabel;
Panel2: TPanel; Panel2: TPanel;
Panel3: TPanel; Panel3: TPanel;
Panel4: TPanel;
Panel5: TPanel;
procedure btnCloseClick(Sender: TObject); procedure btnCloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure imgBanerClick(Sender: TObject);
procedure imgBanerMouseEnter(Sender: TObject);
procedure imgBanerMouseLeave(Sender: TObject);
procedure lblWebLinkClick(Sender: TObject);
procedure lblWebLinkMouseEnter(Sender: TObject);
procedure lblWebLinkMouseLeave(Sender: TObject);
procedure Panel2Click(Sender: TObject);
private private
{ private declarations } { private declarations }
pSound: Pointer;
public public
{ public declarations } { public declarations }
lbVersion: string;
lbBuild: string;
end; end;
var var
@ -62,8 +75,10 @@ var
implementation implementation
uses vinfo, Language, UResourceManager;
{$I version.inc} {$I version.inc}
{ TfrmAbout } { TfrmAbout }
procedure TfrmAbout.btnCloseClick(Sender: TObject); procedure TfrmAbout.btnCloseClick(Sender: TObject);
@ -73,8 +88,81 @@ end;
procedure TfrmAbout.FormCreate(Sender: TObject); procedure TfrmAbout.FormCreate(Sender: TObject);
begin begin
lblVersion.Caption := Format('Version %s', [ProductVersion]); pSound:= nil;
lblCopyright.Caption := Format('Copyright %s', [Copyright]); LanguageTranslate(Self);
lblVersion.Caption := Format('%s %s%s %s %d',
[lbVersion, VersionInfo.GetFileVersionString, #13#10, lbBuild, VersionInfo.Build]);
imgLogo.Picture.Bitmap.LoadFromStream(ResourceManager.GetResource('Overlay/About.bmp'));
//lblVersion.Caption := Format('Version %s', [ProductVersion]);
//lblCopyright.Caption := Format('Copyright %s', [Copyright]);
end;
procedure TfrmAbout.FormShow(Sender: TObject);
var
stream: TStream;
begin
if (pSound = nil) then begin
stream := ResourceManager.GetResource('Sounds/MusicInf.wav');
GetMem(pSound, stream.Size);
stream.Read(pSound^, stream.Size);
end;
sndPlaySound(pSound, SND_MEMORY or SND_ASYNC or SND_LOOP);
end;
procedure TfrmAbout.FormHide(Sender: TObject);
begin
if pSound = nil then Exit;
sndPlaySound(nil, SND_ASYNC or SND_LOOP);
FreeMem(pSound);
pSound := nil;
end;
procedure TfrmAbout.imgBanerClick(Sender: TObject);
begin
// Открываем сайт в браузере по умолчанию
ShellExecute(Handle, 'open', PChar('http://uoquint.ru'), nil, nil, 1 {SW_SHOWNORMAL});
end;
procedure TfrmAbout.imgBanerMouseEnter(Sender: TObject);
var stream: TMemoryStream;
begin
stream := TMemoryStream.Create;
stream.Write(baner_h[0],SizeOf(baner_h));
stream.Position:=0;
imgBaner.Picture.Bitmap.LoadFromStream(stream);
stream.Free;
end;
procedure TfrmAbout.imgBanerMouseLeave(Sender: TObject);
var stream: TMemoryStream;
begin
stream := TMemoryStream.Create;
stream.Write(baner_u[0],SizeOf(baner_u));
stream.Position:=0;
imgBaner.Picture.Bitmap.LoadFromStream(stream);
stream.Free;
// sndPlaySound
end;
procedure TfrmAbout.lblWebLinkClick(Sender: TObject);
begin
// Открываем сайт в браузере по умолчанию
ShellExecute(Handle, 'open', PChar('http://dev.uoquint.ru/projects/centred'), nil, nil, 1 {SW_SHOWNORMAL});
end;
procedure TfrmAbout.lblWebLinkMouseEnter(Sender: TObject);
begin
lblWebLink.Font.Color := TColor($00EAAE86);
end;
procedure TfrmAbout.lblWebLinkMouseLeave(Sender: TObject);
begin
lblWebLink.Font.Color := TColor($00E18A51);
end;
procedure TfrmAbout.Panel2Click(Sender: TObject);
begin
end; end;
initialization initialization

906
Client/UfrmAccountControl.lfm
View File

@ -1,73 +1,74 @@
object frmAccountControl: TfrmAccountControl object frmAccountControl: TfrmAccountControl
Left = 290 Left = 1433
Height = 378 Height = 378
Top = 171 Top = 46
Width = 369 Width = 341
ActiveControl = vstAccounts ActiveControl = vstAccounts
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'Account Management' Caption = 'Управление Аккаунтами'
ClientHeight = 378 ClientHeight = 378
ClientWidth = 369 ClientWidth = 341
Font.Height = -11 Font.Height = -11
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnShow = FormShow OnShow = FormShow
Position = poOwnerFormCenter Position = poOwnerFormCenter
LCLVersion = '0.9.29' ShowInTaskBar = stAlways
LCLVersion = '0.9.30.2'
object tbMain: TToolBar object tbMain: TToolBar
Left = 0 Left = 0
Height = 26 Height = 26
Top = 0 Top = 0
Width = 369 Width = 341
Caption = 'tbMain' Caption = 'tbMain'
Images = ilToolbar Images = ilToolbar
TabOrder = 0 TabOrder = 0
object tbRefresh: TToolButton object tbRefresh: TToolButton
Left = 1 Left = 1
Hint = 'Refresh' Hint = 'Обновить список'
Top = 2 Top = 2
Caption = 'Refresh' Caption = 'Обновить'
ImageIndex = 0 ImageIndex = 0
OnClick = tbRefreshClick
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
OnClick = tbRefreshClick
end end
object tbAddUser: TToolButton object tbAddUser: TToolButton
Left = 32 Left = 28
Hint = 'Add User' Hint = 'Добавить пользователя'
Top = 2 Top = 2
Caption = 'Add User' Caption = 'Добавить'
ImageIndex = 1 ImageIndex = 1
OnClick = tbAddUserClick
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
OnClick = tbAddUserClick
end end
object tbEditUser: TToolButton object tbEditUser: TToolButton
Left = 55 Left = 51
Hint = 'Edit User' Hint = 'Редактировать пользователя'
Top = 2 Top = 2
Caption = 'Edit User' Caption = 'Редактировать'
ImageIndex = 2 ImageIndex = 2
OnClick = tbEditUserClick
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
OnClick = tbEditUserClick
end end
object tbDeleteUser: TToolButton object tbDeleteUser: TToolButton
Left = 78 Left = 74
Hint = 'Delete User' Hint = 'Удалить пользователя'
Top = 2 Top = 2
Caption = 'Delete User' Caption = 'Удалить'
ImageIndex = 3 ImageIndex = 3
OnClick = tbDeleteUserClick
ParentShowHint = False ParentShowHint = False
ShowHint = True ShowHint = True
OnClick = tbDeleteUserClick
end end
object tbSeparator1: TToolButton object tbSeparator1: TToolButton
Left = 24 Left = 24
Top = 2 Top = 2
Width = 8 Width = 4
Caption = 'tbSeparator1' Caption = 'tbSeparator1'
Style = tbsDivider Style = tbsDivider
end end
@ -76,7 +77,7 @@ object frmAccountControl: TfrmAccountControl
Left = 0 Left = 0
Height = 352 Height = 352
Top = 26 Top = 26
Width = 369 Width = 341
Align = alClient Align = alClient
DefaultText = 'Node' DefaultText = 'Node'
Header.AutoSizeIndex = 1 Header.AutoSizeIndex = 1
@ -87,294 +88,631 @@ object frmAccountControl: TfrmAccountControl
end end
item item
Position = 1 Position = 1
Text = 'Username' Text = 'Имя пользователя'
Width = 200 Width = 130
end end
item item
Position = 2 Position = 2
Text = 'Accesslevel' Text = 'Права'
Width = 100 Width = 100
end
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coShowDropMark, coVisible, coFixed, coAllowFocus]
Position = 3
Text = 'Регионы'
Width = 60
end> end>
Header.DefaultHeight = 17 Header.DefaultHeight = 17
Header.Options = [hoColumnResize, hoDrag, hoVisible] Header.Options = [hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
Header.ParentFont = True Header.ParentFont = True
Header.Style = hsFlatButtons Header.Style = hsFlatButtons
HintMode = hmHint
Images = ilAccesslevel Images = ilAccesslevel
ParentShowHint = False
ScrollBarOptions.AlwaysVisible = True
ScrollBarOptions.ScrollBars = ssVertical
SelectionCurveRadius = 8
ShowHint = True
TabOrder = 1 TabOrder = 1
TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes] TreeOptions.AutoOptions = [toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages] TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect] TreeOptions.SelectionOptions = [toFullRowSelect]
OnCompareNodes = vstAccountsCompareNodes
OnDblClick = vstAccountsDblClick OnDblClick = vstAccountsDblClick
OnFreeNode = vstAccountsFreeNode OnFreeNode = vstAccountsFreeNode
OnGetText = vstAccountsGetText OnGetText = vstAccountsGetText
OnGetImageIndex = vstAccountsGetImageIndex OnGetImageIndex = vstAccountsGetImageIndex
OnGetHint = vstAccountsGetHint
OnHeaderClick = vstAccountsHeaderClick
end end
object ilToolbar: TImageList object ilToolbar: TImageList
left = 144 left = 40
top = 56
Bitmap = { Bitmap = {
4C69040000001000000010000000000000000000000000000000000000000000 4C69050000001000000010000000F0F0F000F0F0F000F0F0F000F0F0F000F0F0
0000000000000000000000000000000000000000000000000000000000000000 F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0
0000000000000000000000000000000000000000000000000000000000000000 F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000D8D8
00000000000000000000000000000000000047994FFF419149FF000000000000 D8FF7A7A7AFF323232FF161616FF151515FF2D2D2DFF7C7C7CFFCDCDCDFF3333
0000000000000000000000000000000000000000000000000000000000005BB4 33FF3D3D3DFFF0F0F000F0F0F000F0F0F000F0F0F000F0F0F000A0A0A0FF0F0F
65FF56AD5FFF50A65AFF4B9E53FF45964DFF60A868FF5BA262FF347E3AFF0000 0FFF000000FF000000FF000000FF000000FF000000FF000000FF000000FF0000
000000000000000000000000000000000000000000005EB968FF79C383FF89CA 00FF000000FFF0F0F000F0F0F000F0F0F000F0F0F0009D9D9DFF010101FF0000
92FF94D09CFF95D19EFF90CF99FF8CCB94FF87C98FFF80C487FF4E9554FF276D 00FF474747FFB5B5B5FFE0E0E0FFE0E0E0FFA0A0A0FF020202FF000000FF0000
2CFF000000000000000000000000000000005CB667FF85C98EFF9BD4A4FF8FCE 00FF000000FFF0F0F000F0F0F000F0F0F000D6D6D6FF0E0E0EFF000000FF7E7E
98FF92CF9AFF8DCC95FF88CA90FF83C68BFF7EC485FF79C17FFF478D4CFF2265 7EFFF0F0F000F0F0F000F0F0F000F0F0F000323232FF000000FF000000FF0000
25FF0000000000000000000000000000000075BF7EFF98D2A1FF94CF9CFF86C7 00FF000000FFF0F0F000F0F0F000F0F0F000656565FF000000FF484848FFEFEF
8DFF5EA765FF398640FF347E3AFF2E7633FF49904FFF458B4AFF206324FF0000 EFFFF0F0F000F0F0F000F0F0F000F0F0F000383838FF000000FF000000FF0000
000000000000000000000000000054AB5EFF80C389FF8DCC95FF83C48AFF3D8B 00FF3C3C3CFFF0F0F000F0F0F000F0F0F0001D1D1DFF000000FFBBBBBBFFF0F0
44FF37833EFF000000000000000000000000236627FF1F6123FF000000000000 F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0
00000000000000000000000000004DA155FF47994FFF419149FF3B8842FF3580 F000F0F0F000F0F0F000F0F0F000F0F0F000373737FF3E3E3EFFF0F0F000F0F0
3CFF000000000000000000000000000000000000000000000000000000000000 F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0
0000000000000000000000000000000000000000000000000000000000000000 F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0
00000000000000000000000000000000000000000000000000004DA155FF4799 F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0
4FFF419149FF3B8842FF35803CFF000000000000000000000000000000000000 F000404040FF3E3E3EFFF0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0
000063C06EFF5FBB6AFF0000000000000000000000004B9E53FF45964DFF86C6 F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000B8B8
8EFF88C98FFF6FB376FF2E7633FF0000000000000000000000000000000062BE B8FF000000FF1F1F1FFFF0F0F000F0F0F000F0F0F000404040FF000000FF0000
6DFF7BC785FF77C281FF54AB5EFF4EA357FF499B51FF63AC6BFF83C38BFF87C9 00FF000000FF444444FFF0F0F000F0F0F000F0F0F000F0F0F000EFEFEFFF4545
8FFF82C689FF509756FF0000000000000000000000000000000060BC6CFF79C4 45FF000000FF686868FFF0F0F000F0F0F000F0F0F000000000FF000000FF0000
83FF9ED7A7FF9BD4A4FF97D29FFF92CF9AFF8DCC95FF88CA90FF7AC282FF7EC4 00FF000000FF303030FFF0F0F000F0F0F000F0F0F000F0F0F0007B7B7BFF0000
85FF5DA463FF266B2AFF000000000000000000000000000000005BB465FF73BD 00FF0F0F0FFFD8D8D8FFF0F0F000F0F0F000F0F0F000000000FF000000FF0000
7CFF96D19FFF94CF9CFF8FCD96FF8ACA91FF85C78BFF7ABE81FF65AD6CFF4B92 00FF020202FF9D9D9DFFE8E8E8FFE8E8E8FFB4B4B4FF454545FF000000FF0202
51FF246829FF0000000000000000000000000000000000000000000000004EA3 02FFA0A0A0FFF0F0F000F0F0F000F0F0F000F0F0F000000000FF000000FF0000
57FF66B06EFF61AA68FF3D8B44FF37833EFF327B37FF2C7432FF276D2CFF0000 00FF000000FF000000FF000000FF000000FF000000FF000000FF101010FFA2A2
0000000000000000000000000000000000000000000000000000000000000000 A2FFF0F0F000F0F0F000F0F0F000F0F0F000F0F0F000373737FF303030FFC1C1
0000419149FF3B8842FF00000000000000000000000000000000000000000000 C1FF767676FF2A2A2AFF090909FF0B0B0BFF303030FF7B7B7BFFD9D9D9FFF0F0
0000000000000000000000000000000000000000000000000000000000000000 F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0
0000000000000000000000000000000000000000000000000000000000000000 F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0F000F0F0
0000000000000000000000000000000000000000000000000000000000000000 F000F0F0F000F0F0F000F0F0F000FFFFFF009696960096969600969696002828
0000000000000000000000000000000000000000000000000000000000000000 2842343434B7333436DC25272ADE151515D7171717B322222271292929079696
0000000000000000000000000000000000000000000000000000000000000000 96009696960096969600FFFFFF00FFFFFF009696960096969600282828202C2C
00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000 2CFB323232FF222222FF101010FF0D0D0DFF121212FF181818FF3131314A9696
0000000000000000000000000000000000000000000000000000000000000000 96009696960096969600FFFFFF00FFFFFF009696960096969600343434643232
0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000 32FF313E4AFF7993A1FF5F727DFF45545CFF2A343CFF344759D8353535079696
0000000000000000000000000000000000000000000000000000000000000F4B 96009696960096969600FFFFFF00FFFFFF0096969600969696003A3A3A742727
97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000 27FF2F404EFFBFE8FDFFC2E9FEFFBFE7FEFFABD9F6FF5798D1D2969696009696
0000000000000000000000000000000000000000000000000000000000000C3E 96009696960096969600FFFFFF00FFFFFF009696960096969600343434501515
87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000 15FF23313DFFBFE7FDFFC2E9FDFFAADDFCFFACDAF6FF5798D1D2969696009696
0000000000000000000000000000000000000000000000000000000000001F5E 96009696960096969600FFFFFF00FFFFFF0096969600969696002A2A2A121011
9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000 12EE598DB9FFBDE6FDFFC1E8FDFFA8DCFBFFA6D5F3FF5498CBC800902C160090
0000000000000000000000000000000000000000000000000000000000002A5B 2C169696960096969600FFFFFF00FFFFFF009696960096969600969696001B1D
92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000 1E96395D7DFDB9E4FBFFBFE6FDFFB4E1FCFF9ED0EEFF0D9344F401982ECE0098
0000000000000000000000000000000000000000000000000000000000006A3C 2DCE00902C1696969600FFFFFF004B4B4B009696960096969600969696002424
25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000 2427436E94D77EB7E3FFA7D7F4FFADDBF7FF62B5AEFF10B849F502FF3EFF00C9
000000000000000000000000000000000000000000000000000000000000BC48 32E900902C6A96969600FFFFFF004B4B4B009696960096969600969696004D4D
1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000 4D1E909396817AA9D1975E9BD1DF5C9AD1EA389390DE04BA38E200F837FF00C2
0000000000000000000000000000000000000000000000000000C44C1FFFF6E4 31E900902C6A96969600FFFFFF004B4B4B004343431249494971525252E04343
D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFFAEAB78FF609772FF4F8E 43FF7D7D7DFFE4E4E4FF379023FF30A654FF1D9340FE08AF33FF00EB35FF00D6
66FF428357FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1 34FC00932CC900932CC900932CC64B4B4B00606060BF343434FF343434FF3434
98FFFEC76DFFFEBF68FFFEB964FFFEB15EFFA79B61FF61AB81FF95D4B4FFBAE6 34FF565656FFB8D8C2FF259C2AFF06F53FFF02ED37FF00EB35FF00DD35FF00CF
D0FF6ABB8FFF2D8F57FF196B37FF00000000287CCEFF78B3EAFFB39E94FFFFB7 35FF00C034FB00BD33FB00A630E04B4B4B00424242FB252525FF252525FF2525
60FFFFB663FFFEB261FFFEAC5DFFFEA559FF4A885DFF90D3B1FF92D6B1FFFFFF 25FF383838FFB2D2BCFF24A229FF00F837FF00EB35FF00DD35FF00CF35FF00C5
FFFF65BC8CFF67BC8FFF196B37FF00000000297DD1FF82BAEEFF9F6658FFF5BB 35FF00C134FF00BE34FF00A52FE04B4B4B00212121FE1A1A1AFF1A1A1AFF1A1A
84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF317B4CFF9CD4B6FFFFFFFFFFFFFF 1AFF1D1D1DFFF1F1F1FF228C27FF2EA852FF148D38FF039D2EFF00C535FF00BB
FFFFFFFFFFFF95D2B2FF196B37FF00000000000000002579CDFF866161FFBF60 33FF01902CD400932DCE00922CD019191909191919FF191919FF191919FF1919
35FFFEB961FFFEB962FFFEB962FFFEB962FF226E3AFF62BA8BFF60BA87FFFFFF 19FF191919FFD2D2D2FFA3550FFFD2DED5FF336141FF04902CFF00C134FF029D
FFFF60B987FF67BC8FFF196B37FF00000000000000000000000000000000B350 2EFF09732A9000902C1600902C0E3030300B353535E62D2D2DFE2E2E2EFF2E2E
20FFA0401FFFAA4522FFAC4622FFAB4422FF5C572DFF288C53FF64BA8DFF95D2 2EFF2E2E2EFFB3B3B3FF8F3511FFC7C7C7FF3D6B4BFF0A9532FF01B833FF03A1
B2FF64BA8DFF288C53FF196B37FF000000000000000000000000000000000000 30F90B85307D4B4B4B00FFFFFF004B4B4B004B4B4B004B4B4B006262629E6A6A
00000000000000000000000000000000000000000000196B37FF196B37FF196B 6AB36F6F6FC0A8A8A894AFAFAF9DAFAFAF8F7C7C7C97098D31DA068C2FDC048F
37FF196B37FF196B37FF00000000000000000000000000000000000000000000 2ED307892F144B4B4B00FFFFFF00000000000000000000000000000000002828
0000000000000000000000000000000000000000000000000000000000000000 2842343434B7333436DC25272ADE151515D7171717B322222271292929070000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000282828202C2C
000012488DFF104B90FF0F488AFF11427DFF15335BFF00000000000000000000 2CFB323232FF222222FF101010FF0D0D0DFF121212FF181818FF3131314A0000
000000000000000000000000000000000000000000000000000000000000114E 0000000000000000000000000000000000000000000000000000343434643232
96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF000000000000 32FF313E4AFF7993A1FF5F727DFF45545CFF2A343CFF344759D8353535070000
00000000000000000000000000000000000000000000000000000F4B97FF1258 00002A466101515E8303000000000000000000000000000000003A3A3A742727
9FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF000000000000 27FF2F404EFFBFE8FDFFC2E9FEFFBFE7FEFFABD9F6FF5798D1D2000000003C4B
00000000000000000000000000000000000000000000000000000C3E87FF7C97 59062B45644755628C5DC7CFE427000000000000000000000000343434501515
B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF000000000000 15FF23313DFFBFE7FDFFC2E9FDFFAADDFCFFACDAF6FF5798D1D2000000003B49
00000000000000000000000000000000000000000000000000001F5E9BFFD9E8 5B824956A2EC7474D9FF7E86C1940000000000000000000000002A2A2A121011
F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000000058A5 12EE598DB9FFBDE6FDFFC1E8FDFFA8DCFBFFA6D5F3FF5798D1C6707D843C5D6D
D8FF85B1DBFF469DD0FF000000000000000000000000000000002A5B92FFA6CA 83F29082CBFF4743A6F96370A266000000000000000000000000000000001B1D
EEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2884B7FF77BEE7FFB4D2 1E96395D7DFDB9E4FBFFBFE6FDFFB4E1FCFFA2D2F3FF5D99CFC76F8F9BC499D0
F0FFE5F3FFFFACD2EFFF488CC7FF0000000000000000000000006A3C25FF346D E2FF7391B4FF233354AD808DA303000000000000000000000000000000002424
A7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF2E8ABFFF7ED3EBFFB2E3F9FF8BC0 2427436E94D77EB7E3FFA7D7F4FFADDBF7FF90C6EBFF456C8DDB7BBCCCFC61CF
E7FFAED3F6FFC4E0FCFF669FD3FF000000000000000000000000BC481CFFF4E2 FDFF055190E7526F842F00000000000000000000000000000000000000004D4D
D4FF4E7BA9FF4D7BA8FF4D7BA8FF428CBAFF7DD4EEFFC4F6FDFF6CDDF6FF6DCA 4D1E909396817AA9D1975E9BD1DF5C9AD1EA5384B1D7668F9FE689E5FEFF086C
EDFF63A3D7FF5D9BD2FF000000000000000000000000C44C1FFFF6E4D6FFFFE4 BEFF2B58877D0000000000000000000000004343431249494971525252E04343
A4FFFFD472FFFFC969FFBFBB86FF79D3EEFFC7F7FDFF5FDCF5FF5BE2F7FF7AD6 43FF7D7D7DFFE4E4E4FFC37700FFE0E0E0FF647178FE97D7E4FF35A2E9FF0F45
F2FF4099DFFF0000000000000000000000008A5444FFFCC8ABFFFFD198FFFEC7 81DB728DA114000000000000000000000000606060BF343434FF343434FF3434
6DFFFEBF68FFB0A780FF77CBE7FFC7F7FDFF5EDCF5FF5AE1F7FF7BD4F1FF4691 34FF565656FFEDEDEDFFB05903FFACB1B4FF83A9B3FF6ED2FDFF024D9DFF414C
D4FF686672FF0000000000000000287CCEFF78B3EAFFB39E94FFFFB760FFFFB6 57E600000000000000000000000000000000424242FB252525FF252525FF2525
63FFB3A37DFF76B8D3FFC2F6FDFF63DFF7FF5DE2F8FF79D3F0FF4795D8FF75B2 25FF383838FFE5E5E5FFA97116FF84999FFF92E2FBFF1777C7FF244262FF2828
EAFF2974C7FF0000000000000000297DD1FF82BAEEFF9F6658FFF5BB84FFA792 29FD25252503000000000000000000000000212121FE1A1A1AFF1A1A1AFF1A1A
74FF7AB6D5FF90B7D1FF55C9E4FF5BDFF5FF78D0EDFF5196D2FF96645DFF83BC 1AFF1D1D1DFFF1F1F1FF836C3DFF92C9D6FF44AAF1FF034285FF262A2EFF1A1A
EFFF2A77CAFF0000000000000000000000002579CDFF866161FFBF6035FF4389 1AFF1D1D1D1D000000000000000019191909191919FF191919FF191919FF1919
AAFFE0F2FFFF549AD8FF1A7ABEFF4998C5FF4988B7FF9C5442FF7A646DFF2E7E 19FF191919FFCDCECFFF777060FF82D7FDFF105DB2FF2A3C4EFF191919FF1919
CEFF6DA2D3FF0000000000000000000000000000000000000000B35020FF2D64 19FF232323400E0E0E01595959013030300B353535E62D2D2DFE2E2E2EFF2E2E
81FF94C7F9FF91C9F9FF4185C9FF2362A4FF89493DFFB24F24FF000000000000 2EFF2E2E2EFFAEAFB0FF5D6B74FF407FABFF375979FF434648FE343434EB3535
000000000000000000000000000000000000000000000000000000000000113D 35B74646462111111102585858014B4B4B004B4B4B004B4B4B006262629E6A6A
55FF285F87FF4988BDFF428DBCFF000000000000000000000000000000000000 6AB36F6F6FC093979AB4394854FA55626CD073797DA0565656654B4B4B004B4B
0000000000000000000000000000000000000000000000000000000000000000 4B004B4B4B000000000000000000000000000000000000000000000000002828
0000000000000000000000000000000000000000000000000000000000000000 2842343434B7333436DC25272ADE151515D7171717B322222271292929070000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000282828202C2C
00000000000012488DFF104B90FF0F488AFF11427DFF15335BFF000000000000 2CFB323232FF222222FF101010FF0D0D0DFF121212FF181818FF3131314A0000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000343434643232
0000114E96FF12589BFF125899FF115393FF0F4A87FF0E3E71FF132E4BFF0000 32FF313E4AFF7993A1FF5F727DFF45545CFF2A343CFF344759D8353535070000
0000000000000000000000000000000000000000000000000000000000000F4B 00000000000000000000000000000000000000000000000000003A3A3A742727
97FF12589FFF0F4A8AFF0F4B87FF114B87FF154C85FF124175FF0F335CFF0000 27FF2F404EFFBFE8FDFFC2E9FEFFBFE7FEFFABD9F6FF5798D1D2000000000000
0000000000000000000000000000000000000000000000000000000000000C3E 0000000000000000000000000000000000000000000000000000343434501515
87FF7C97B8FF8AB7E4FF719CC8FF15406EFF194472FF22456BFF113B66FF0000 15FF23313DFFBFE7FDFFC2E9FDFFAADDFCFFACDAF6FF5798D1D2000000000000
0000000000000000000000000000000000000000000000000000000000001F5E 00000000000000000000000000000000000000000000000000002A2A2A121011
9BFFD9E8F7FF97C5F1FF8EBBE5FF7FA9D1FF89B5DFFFCDDFEEFF2368A7FF0000 12EE598DB9FFBDE6FDFFC1E8FDFFA8DCFBFFA6D5F3FF5798D1C6000000000000
0000000000000000000000000000000000000000000000000000000000002A5B 0000000000000000000000000000000000000000000000000000000000001B1D
92FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D629AFF0000 1E96395D7DFDB9E4FBFFBFE6FDFFB4E1FCFFA2D2F3FF5798D1C3000000000000
0000000000000000000000000000000000000000000000000000000000006A3C 0000000000000000000000000000000000000000000000000000000000002424
25FF346DA7FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF3474AEFF683E2DFF0000 2427436E94D77EB7E3FFA7D7F4FFADDBF7FF90C6EBFF5798D1BD000000000000
000000000000000000000000000000000000000000000000000000000000BC48 0000000000000000000000000000000000000000000000000000000000004D4D
1CFFF4E2D4FF4E7BA9FF4D7BA8FF4D7BA8FF4E7BA9FFF3D6C3FFBE461CFF0000 4D1E909396817AA9D1975E9BD1DF5C9AD1EA5895CBCE558BBA3A000000000000
0000000000000000000000000000000000000000000000000000C44C1FFFF6E4 0000000000000000000000000000000000004343431249494971525252E04343
D6FFFFE4A4FFFFD472FFFFC969FFFFC063FFFFB65FFF9590A0FF295DC1FF0542 43FF7D7D7DFFE4E4E4FFC37700FFD2D1DCFF7E7D88FC3E3D48FF44434FD93735
BBFF0B45B0FF000000000000000000000000000000008A5444FFFCC8ABFFFFD1 50650A0081160A0081160A00810E00000000606060BF343434FF343434FF3434
98FFFEC76DFFFEBF68FFFEB964FFFEB15EFF95828BFF3D74CEFF8DB5F7FFB8D6 34FF565656FFEDEDEDFF351B6BFF3C369BFF2A2387FF1B1579FF1B1579FF1B16
FEFF72A8F5FF2D6BCAFF0000000000000000287CCEFF78B3EAFFB39E94FFFFB7 7CF9150E89CE150E89CE100886D000000000424242FB252525FF252525FF2525
60FFFFB663FFFEB261FFFEAC5DFFFEA559FF2450ABFF8DB5F6FF4D92FFFF1177 25FF383838FFCAC9D9FF382275FF664AF8FF664AF8FF5D4AF0FF514AE2FF454A
FFFF2186FFFF408AEBFF0344B9FF00000000297DD1FF82BAEEFF9F6658FFF5BB D6FF3D4ACCFF3D4ACCFF2426A5E000000000212121FE1A1A1AFF1A1A1AFF1A1A
84FFFFAC5BFFFEA85AFFFEA257FFFE9C53FF0542BCFFAECDFEFFFFFFFFFFFFFF 1AFF1D1D1DFFD4D3E3FF341C75FF3904EBFF2C02DEFF1B00CCFF0C00BBFF0100
FFFFFFFFFFFF187FEFFF0442BCFF00000000000000002579CDFF866161FFBF60 B0FF0100B2FB0100B2FB0A059CE019191909191919FF191919FF191919FF1919
35FFFEB961FFFEB962FFFEB962FFFEB962FF1F52AFFF639DF4FF187FFFFF0076 19FF191919FFD2D2D2FF3E1E66FF3A319AFF191079FF0E056DFF0D056DFF0D05
F8FF0076EEFF0368E1FF0345B9FF00000000000000000000000000000000B350 6DFF0B027DD7090084C90A0184C63030300B353535E62D2D2DFE2E2E2EFF2E2E
20FFA0401FFFAA4522FFAC4622FFAB4422FF5F4C74FF2763C6FF2177E6FF0579 2EFF2E2E2EFFB3B3B3FF8F3511FFC7C7C7FF595959FF414141FE343434EB3434
EAFF0164DDFF044DBDFF00000000000000000000000000000000000000000000 34B74646462100000000000000004B4B4B004B4B4B004B4B4B006262629E6A6A
00000000000000000000000000000000000000000000000000000345B9FF0442 6AB36F6F6FC0A8A8A894AFAFAF9DAFAFAF8F7C7C7C97565656654B4B4B004B4B
BCFF0345B9FF0000000000000000 4B004B4B4B000000000000000000000000000000000000000000000000002828
2842343434B7333436DC25272ADE151515D7171717B322222271292929070000
0000000000000000000000000000000000000000000000000000282828202C2C
2CFB323232FF222222FF101010FF0D0D0DFF121212FF181818FF3131314A0000
0000000000000000000000000000000000000000000000000000343434643232
32FF313E4AFF7993A1FF5F727DFF45545CFF2A343CFF344759D8353535070000
00000000000000000000000000000000000000000000000000003A3A3A742727
27FF2F404EFFBFE8FDFFC2E9FEFFBFE7FEFFABD9F6FF5798D1D2000000000000
0000000000000000000000000000000000000000000000000000343434501515
15FF23313DFFBFE7FDFFC2E9FDFFAADDFCFFACDAF6FF5798D1D2000000000000
00000000000000000000000000000000000000000000000000002A2A2A121011
12EE598DB9FFBDE6FDFFC1E8FDFFA8DCFBFFA6D5F3FF5798D1C6000000000000
0000000000000000000000000000000000000000000000000000000000001B1D
1E96395D7DFDB9E4FBFFBFE6FDFFB4E1FCFFA2D2F3FF5798D1C3000000000000
0000197D38D612752E8600000000000000000000000000000000000000002424
2427436E94D77EB7E3FFA7D7F4FFADDBF7FF90C6EBFF5798D1BD10732C09187C
37DD3DA565F4157933F01478328F000000000000000000000000000000004D4D
4D1E909396817AA9D1975E9BD1DF5C9AD1EA5895CBCE4C88A840197D37D947B0
71F98FFECBFF4BB376FC187C36E1000000004343431249494971525252E04343
43FF7D7D7DFFCBD7CEFFC37700FFE4E4E4FF868887FC1F7439FF42AC6BFE84FC
C2FF48B675FE157932F01478318F00000000606060BF343434FF343434FF3434
34FF28733FFF20823EFF506E21FFDFE0DFFF287D42FF39A863FF72F9B2FF69ED
A6FF137831F210732C140000000000000000424242FB252525FF252525FF1969
31FF2EA056FF5DF59EFF26863BFF318B4CFF32A75CFF5DF59EFF56EA94FF1374
2FFF136A2B19000000000000000000000000212121FE1A1A1AFF1A1A1AFF1661
2CFF22984AFF46F18AFF46F18AFF3CDA79FF46F18AFF41E682FF12732EFF1922
1CFF1D1D1D1D000000000000000019191909191919FF191919FF191919FF1919
19FF155F2AFF249E4BFF31ED76FF31ED76FF2EE270FF11732DFF18211BFF1919
19FF2323234000000000000000003030300B353535E62D2D2DFE2E2E2EFF2E2E
2EFF2E2E2EFF3F8C55FF1B983EFF1EE061FF11742DFF3D453FFE343434EB3434
34B74646462100000000000000004B4B4B004B4B4B004B4B4B006262629E6A6A
6AB36F6F6FC0A8A8A894298443E913772FFC6D7B71A0565656654B4B4B004B4B
4B004B4B4B000000000000000000
} }
end end
object ilAccesslevel: TImageList object ilAccesslevel: TImageList
left = 176 left = 104
top = 56
Bitmap = { Bitmap = {
4C69040000001000000010000000000000000000000000000000000000000000 4C690D0000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000A3A3A3FFA0A0A0FF9D9D9DFF9A9A9AFF979797FF949494FF000000000000 FF00999A8E70999A8ED9999A8ED9999A8ED9999A8ED9999A8E70FFFFFF00FFFF
000000000000000000000000000000000000000000000000000000000000A2A2 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00999A
A2FFBCBCBCFFCACACAFFCCCCCCFFCACACAFFC2C2C2FFADADADFF8C8C8CFF0000 8E5F999A8ED9D0D1C5FFF4F6E5FFF4F6E5FFD0D1C5FF999A8ED9999A8E5FFFFF
0000000000000000000000000000000000000000000000000000A1A1A1FFC4C4 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00999A8E4F999A
C4FFBEBEBEFFA1A1A1FF969696FF939393FF979797FFAEAEAEFFAEAEAEFF8484 8EC8CCCDC1FF999A8ED9999A8ED9999A8ED9999A8ED9CCCDC1FF999A8ED9999A
84FF000000000000000000000000000000000000000000000000BABABAFFBFBF 8E70FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009B9C90BCC8C9
BFFF989898FF00000000000000000000000000000000878787FFA8A8A8FF9E9E BDFF999A8EC8999A8E5FFFFFFF00FFFFFF00999A8E5F9A9B8FDBD0D1C5FF999A
9EFF00000000000000000000000000000000000000009D9D9DFFC4C4C4FFA1A1 8ED9FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009B9C90F1BABB
A1FF000000000000000000000000000000000000000000000000898989FFA9A9 B1FF999A8EEBFFFFFF00FFFFFF00FFFFFF00FFFFFF00999A8EEBBABBB1FF999A
A9FF797979FF00000000000000000000000000000000999999FFC6C6C6FF9494 8EEBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00999A8EFFBDBE
94FF0000000000000000000000000000000000000000000000007D7D7DFFABAB B4FF999A8EFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00999A8EFFBDBEB4FF999A
ABFF767676FF00000000000000000000000061C3E1FF88A0A8FF919191FF8E8E 8EFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00999A8EFFBDBE
8EFF5AB9DCFF55B8DFFF51B5DEFF4DB1DDFF49ADDCFF46A8D7FF787878FF7676 B4FF999A8EFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00999A8EFFBDBEB4FF999A
76FF657E8DFF3199D8FF000000000000000060C2E1FFC9F3FCFFCBF3FDFFD4F6 8EFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0098988DFF98988DFF9898
FEFFD7F6FFFFD8F4FFFFE0F8FFFFDFF8FFFFDAF5FFFFCDF1FCFFC2EDFAFFBDEB 8DFF98988DFF98988DFF98988DFF98988DFF98988DFF98988DFF98988DFF9898
FAFFBDEBFAFF2B93D6FF00000000000000005CBFE0FFC8F3FCFF75DFF9FF89E6 8DFF98988DFFFFFFFF00FFFFFF00FFFFFF00FFFFFF0098988DFFD2D3C6FFEBED
FDFF95E7FFFF9AE5FFFFAAEEFFFFA8EDFFFF99E3FFFF74D5F9FF59CCF3FF4FC8 DDFFD6D8CAFFD6D8CAFFD6D8CAFFD6D7CAFFD5D7C9FFD5D7C9FFE8EADBFFD2D3
F1FFBBE9FAFF248DD5FF000000000000000058BBDFFFC7F1FCFF6FDCF9FF56BB C6FF98988DFFFFFFFF00FFFFFF00FFFFFF00FFFFFF0098988DFFB3B4AAFFDCDD
EDFF61BDEFFF9BE7FFFF35A6E2FF4BA4E1FF90E2FFFF49ADE9FF38A4E3FF49C4 CFFFB3B4AAFFB3B4AAFFB3B4AAFFB3B4AAFFB3B4AAFFB3B4AAFFD9DBCDFFB3B4
F0FFB8E8F9FF1E88D4FF000000000000000053B7DEFFC6F0FCFF6AD9F8FF7CE2 AAFF98988DFFFFFFFF00FFFFFF00FFFFFF00FFFFFF0098988DFFAEAFA4FFD5D7
FDFF90E8FFFF99E9FFFF329FDFFF548BB2FF8AE2FFFF6AD0F9FF50C5F1FF46C1 C9FFAEAFA4FFAEAFA4FFAEAFA4FFAEAFA4FFAEAFA4FFAEAFA4FFD2D4C6FFAEAF
F0FFB6E7F9FF1883D3FF00000000000000004EB2DDFFC3EFFBFF65D6F8FF4CB6 A4FF98988DFFFFFFFF00FFFFFF00FFFFFF00FFFFFF000268A4FF40B9E8FF3054
ECFF5ABDEFFF95EBFFFF3097DDFF4D82ABFF84E1FFFF41A9E9FF329FE1FF42BE 5FFF2B5F72FF01B1FBFF05A9EDFF2E5A68FF2E5A69FF00B2FDFF06A8ECFF3E65
EFFFB4E5F9FF137ED2FF000000000000000049ADDCFFC1EEFBFF5FD3F7FF6CDB 71FF313A3BFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00293940FF40C2F5FF64C7
FCFF7FE5FFFF8FEDFFFF97F2FFFF93EDFFFF7CDFFFFF5BCCF8FF46BEEFFF3CBA ECFF305560FF2A6276FF04ADF4FF05A9EDFF2E5A68FF2E5A69FF01AFF8FF40BB
EEFFB3E3F9FF0E79D1FF000000000000000043A8DBFFBFECFBFF59CFF5FF41B0 EDFF2D3A3EFFFFFFFF00FFFFFF00FFFFFF00FFFFFF002E3A3DFF3F8198FF67D2
ECFF4EBAEFFF5AC2EFFF60C6EFFF5CC4EFFF4CB6EFFF37A5E6FF2A9AE1FF38B8 FAFF1FA7DDFF335D6BFF2E7088FF1DAFE9FF1EAAE3FF33606FFF326C81FF40C5
EEFFB1E3F8FF0975D0FF00000000000000003DA3DAFFBCEBFAFFBCEBFCFFBFEE FBFF0566A0FFFFFFFF00FFFFFF00FFFFFF00FFFFFF0098988DFF9C9D91FFB7B8
FEFFC6F4FFFFCEF8FFFFD3FAFFFFD0F8FFFFC7F2FFFFBAE9FCFFB3E4F9FFB0E2 ABFF9C9D91FF9C9D91FF9C9D91FF9C9D91FF9C9D91FF9C9D91FFB2B4A6FF9C9D
F8FFB0E2F8FF0571CFFF0000000000000000369DD9FF3199D8FF2C94D7FF2890 91FF98988DFFFFFFFF00FFFFFF00FFFFFF00000000327C7E75FF7C7E75FF7C7E
D6FF238CD5FF1E88D4FF1A84D3FF1580D2FF117CD1FF0E79D1FF0A76D0FF0773 75FF7C7E75FF7C7E75FF7C7E75FF7C7E75FF7C7E75FF7C7E75FF7C7E75FF7C7E
CFFF0470CFFF016ECEFF00000000000000000000000000000000000000000000 75FF7C7E75FF00000032FFFFFF00FFFFFF000000000000000000000000000000
0000113D6D47185586FF1B578AFF174C7CFA113F714800000000000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000001138
67331E699CFF3685B7FF3F85B5FF346A98FF1A3D69FF102D5B33000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000001240
70FA2A79AAFF458BBAFF578EBAFF436C98FF25416DFF113261FA000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000E3F
6DFF1E608FFF376D9AFF6899BFFF7CB4D6FF487299FF0D2F5FFF000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000835
67FF88CEEDFFA3E7FFFF91D3F2FF86C8E7FF649CBEFF0A2F62FF000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000831
60AA88C9EAFF92D5F4FF82C3E4FF7AB9D9FF649DBFFF0B3663AA000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
001E85C8E8E486C8E9FF79B8DAFF6FACCFFF5E9BBEE40000001E000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
00005B7888657CBFE1FF70B1D4FF5F9FC3FF3F5A6A5500000000000000000000
000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000006361606D6966
63FFCDD1D3FF6D98ADFF547A8FFF3A6075FFB6BCBFFF676361F46362606E0000
000000000000FFFFFF00FFFFFF00FFFFFF009E9E9E21ACACACF84E4D4CFF504F
4DFFDFDCDAFF3F3B38FF423D39FF423E3BFFCFCBCAFF52504FFF4F4E4CFFACAC
ACE49E9E9E21FFFFFF00FFFFFF00FFFFFF00A1A1A1FFFFFFFF00454342FF4C4A
49FF5D5C5CFFFFFFFF00FFFFFF00FFFFFF005E5C5CFF4C4B4AFF454442FFFFFF
FF00A3A3A3FFFFFFFF00FFFFFF00FFFFFF00B6B6B6FFFFFFFF003B3A3AFF4746
46FF414040FFB0AFAFFFF3F2F1FFB0AFAFFF414040FF474646FF3C3A3BFFFFFF
FF009A9A9AFFFFFFFF00FFFFFF00FFFFFF00B8B8B8FFFFFFFF00353434FF4241
41FF3F3E3EFF4D4C4CFFFFFFFF004D4C4CFF3F3E3EFF424141FF353434FFFFFF
FF009B9B9BFFFFFFFF00FFFFFF00FFFFFF00909090C0A5A5A5FF313030FF3B3A
3AFF3B3A3AFF313030FFAEAFAFFF313030FF3B3A3AFF3B3A3AFF313030FFA6A6
A6FF929292C0FFFFFF00FFFFFF00FFFFFF000000002300000033000000330000
0033000000330000003300000033000000330000003300000033000000330000
003300000023FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
000011457647185586FF1B5788FF174B7BFA113E6E3300000000000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000001035
6348206E9FFF3685B7FF3F85B5FF336995FF193B67FF102D5B35000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000001142
71F82B7AABFF468ABAFF568DBAFF426B96FF24406EFF10305FD2000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000114174240F41
70FF1F608FFF386E9BFF6DA0C6FF7BB3D4FF477098FF0D2E5FFF000000000000
000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000000A2C50170730
61FFA9F1FFFFA2E4FFFF90D3F2FF86C7E7FF639BBDFF0A3063FF000000000000
000000000000FFFFFF00FFFFFF00FFFFFF00000000000000000000000003082F
5CAA92D3F3FF91D2F2FF83C3E3FF79B8D8FF5C94B8FF0B3461AB000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
001E86C6E5E486C7E7FF79B7D8FF6EACCDFF609AB9D40000001E000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
0000466E87677CBBDBFF70AED1FF619CBFFF344E5D4A00000000000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000649CBA5A68A1
BECB7EBAD8FF6B9FBAFF4F7E95FF2E5971FF6DA6C3FF6AA4C2B7649CBA460000
000000000000FFFFFF00FFFFFF00FFFFFF00659DBB2168A1BFF984C2E2FF9ADF
FEFF9CE1FFFF9CE1FFFF86C9E9FF86C7E7FF98DCFAFF9BE0FFFF84C2E2FF68A1
BFE5659EBC22FFFFFF00FFFFFF00FFFFFF00689FBDFF99DDFCFF8BCDEDFF87C8
E8FF87C7E7FF89C9E9FF85C6E6FF85C5E5FF88C9E9FF88C8E8FF8CCDEDFF9ADD
FCFF69A1BFFFFFFFFF00FFFFFF00FFFFFF0072AECBFFA5EBFFFF73B1D2FF76B4
D5FF76B4D6FF76B4D5FF76B4D5FF76B4D5FF76B4D6FF76B4D5FF73B1D3FFA6ED
FFFF629AB8FFFFFFFF00FFFFFF00FFFFFF0073AFCDFFA8EFFFFF6CA8CCFF5383
A0FF65A1C3FF64A0C1FF64A0C1FF64A0C1FF65A1C3FF5383A0FF67A3C5FFA9F0
FFFF649CB9FFFFFFFF00FFFFFF00FFFFFF005D90ACC0649DBBFF66A0BEFF5585
9EFF68A1C0FF67A0BEFF67A0BDFF67A0BEFF68A1C0FF56859FFF67A0BEFF659D
BBFF5D91ADC0FFFFFF00FFFFFF00FFFFFF000000002300000033000000330000
0033000000330000003300000033000000330000003300000033000000330000
003300000023FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004A4A4A004A4A4A004A4A4A004A4A
4A004D4D4D065353533B5353535E5353535E5353533B4D4D4D064A4A4A004A4A
4A004A4A4A004A4A4A00FFFFFF00FFFFFF004747470047474700474747004747
47004747473D8A8A8A9CCFCFCFECC9C9C9EC8181819C4747473D474747004747
47004747470047474700FFFFFF00FFFFFF003636360036363600363636003636
36003636366AADADADF1BCBCBCFFB4B4B4FFA0A0A0F13636366A363636003636
36003636360036363600FFFFFF00FFFFFF00153A6000153A6000153A6000153B
61002424247C99C0DFFF99CCF6FF99CCF6FF99C0DFFF2424247C153B6100153A
6000153A6000153A6000FFFFFF00FFFFFF00024C9800024C9800024C9800024D
99814C4C4CC1A1D4FAFF98CBF5FF98CBF5FFA1D4FAFF4C4C4CC1024D9981024C
9800024C9800024C9800FFFFFF00FFFFFF00024C9700024C9700024C9700024C
9783215890C498CBF5FF91C4F1FF91C4F1FF98CBF5FF215890C4024C9783024C
9700024C9700024C9700FFFFFF00FFFFFF00024B9400024B9400024B9400024B
9400024A929E7FB4E4F694A6B8FF94A6B8FF7FB4E4F6024A929E024B9400024B
9400024B9400024B9400FFFFFF00FFFFFF000000260001134300013776000148
8F0001488F463574B1D480B3E3FF80B3E3FF3574B1D401488F4601488F000137
76000113430000002600FFFFFF00FFFFFF000000260000002800000029000000
2A0000002A0C014385C64A7DB0FF4A7DB0FF014385C600002A0C00002A000000
29000000280000002600FFFFFF00FFFFFF000000260000002800000029000000
2A2700002A5B4D7AA6E680B3E3FF80B3E3FF4D7AA6E600002A5B00002A270000
29000000280000002600FFFFFF00FFFFFF00000026000000281B000029530000
296C9F9FB0FFC9D6E2FF959EB3FF959EB3FFC9D6E2FF9E9EAFFF0000296C0000
29530000281B00002600FFFFFF00FFFFFF00000026321F1F4086585873B7AEAE
BFFF9B9BACFFF3F3F3FF9AAEE0FF9AAEE0FFF3F3F3FF9A9AABFFADADBEFF5959
74B71F1F418600002632FFFFFF00FFFFFF000000247A8E8EA0F39898A9FFA9A9
BAFF9696A7FFEAEAEAFF6E87C7FF6E87C7FFEAEAEAFF9595A6FFA8A8B9FF9898
A9FF8F8FA1F30000247AFFFFFF00FFFFFF0001011F9B9494A5FF9797A8FFA9A9
BAFF9191A2FFDDDDDDF43D5CAAFF3D5CAAFFDDDDDDF49090A1FFA8A8B9FF9797
A8FF9595A6FF01011F9BFFFFFF00FFFFFF0001011B5601011BAA02021DA50202
1F9D030321952F2F2F6200157FCA00157FCA2F2F2F620303219602021F9D0202
1DA501011CAA01011B56FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004A4A4A004A4A4A004A4A4A004A4A
4A004D4D4D065353533B5353535E5353535E5353533B4D4D4D064A4A4A004A4A
4A004A4A4A004A4A4A00FFFFFF00FFFFFF004747470047474700474747004747
47004747473D8A8A8A9CCFCFCFECC9C9C9EC8181819C4747473D474747004747
47004747470047474700FFFFFF00FFFFFF003636360036363600363636003636
36003636366AADADADF1BCBCBCFFB4B4B4FFA0A0A0F13636366A363636003636
36003636360036363600FFFFFF00FFFFFF00153A6000153A6000153A6000153B
61002424247C99C0DFFF99CCF6FF99CCF6FF99C0DFFF2424247C153B6100153A
6000153A6000153A6000FFFFFF00FFFFFF00024C9800024C9800024C9800024D
99814C4C4CC1A1D4FAFF98CBF5FF98CBF5FFA1D4FAFF4C4C4CC1024D9981024C
9800024C9800024C9800FFFFFF00FFFFFF00024C9700024C9700024C9700024C
9783215890C498CBF5FF91C4F1FF91C4F1FF98CBF5FF215890C4024C9783024C
9700024C9700024C9700FFFFFF00FFFFFF00024B9400024B9400024B9400024B
9400024A929E7FB4E4F694A6B8FF94A6B8FF7FB4E4F6024A929E024B9400024B
9400024B9400024B9400FFFFFF00FFFFFF002A000000201325000C376C000148
8F0001488F463574B1D480B3E3FF80B3E3FF3574B1D401488F4601488F000C37
6C00201325002A000000FFFFFF00FFFFFF002A0000002A0000002A0000002B00
00002B000019014385C64A7DB0FF4A7DB0FF014385C62B0000192B0000002A00
00002A0000002A000000FFFFFF00FFFFFF002A0000002A0000002A0000002B00
004C2B0000B44D7AA6E680B3E3FF80B3E3FF4D7AA6E62B0000B42B00004C2A00
00002A0000002A000000FFFFFF00FFFFFF002A0000002A0000322A00009A2A00
00CB5F3D3DFFC9D6E2FF959EB3FF959EB3FFC9D6E2FF5F3D3DFF2A0000CB2A00
009A2A0000322A000000FFFFFF00FFFFFF002A000057320909D3492323E97351
51FF5B3939FFF3F3F3FF9AAEE0FF9AAEE0FFF3F3F3FF5B3939FF725050FF4A24
24E9320A0AD32A000057FFFFFF00FFFFFF00290000C8583535FC5D3B3BFF6E4C
4CFF563434FFEAEAEAFF6E87C7FF6E87C7FFEAEAEAFF563434FF6D4B4BFF5D3B
3BFF593636FC290000C8FFFFFF00FFFFFF00270000E2593737FF5C3A3AFF6E4C
4CFF512F2FFFDDDDDDF43D5CAAFF3D5CAAFFDDDDDDF4512F2FFF6D4B4BFF5C3A
3AFF5A3838FF270000E2FFFFFF00FFFFFF0026000078230000FE240000F52600
00E9280000DD2F2F2F6200157FCA00157FCA2F2F2F62280000DE260000EA2400
00F5230000FE26000078FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000202250002022500020225000202
2500020226100202265C02022676020226760202265C02022610020225000202
25000202250002022500FFFFFF00FFFFFF000202230002022300020223000202
25000202255F4A4A65A89D9DB0EE9D9DAFEE494964A80202255F020225000202
23000202230002022300FFFFFF00FFFFFF000101210001012100010121000101
2211424258A7C8C8CCF9EAEAEEFFE8E8ECFFC5C5C9F9424258A7010122110101
21000101210001012100FFFFFF00FFFFFF000101200001012000010120350101
207B34344CC6767687FF9191A2FF9696A7FF7E7E8FFF36364FC60101207B0101
20350101200001012000FFFFFF00FFFFFF0002275C0002275C0002275C00024D
99810E0E20EF83B6E3FF7FB2E0FF7FB2E0FF83B6E3FF0E0E20EF024D99810227
5C0002275C0002275C00FFFFFF00FFFFFF00024C9700024C9700024C9700024C
9783073E7AC498CBF5FF91C4F1FF91C4F1FF98CBF5FF073E7AC4024C9783024C
9700024C9700024C9700FFFFFF00FFFFFF00024B9400024B9400024B9400024B
9400024A929E7FB4E4F6546783FF546783FF7FB4E4F6024A929E024B9400024B
9400024B9400024B9400FFFFFF00FFFFFF000000260001134300013776000148
8F0001488F463574B1D480B3E3FF80B3E3FF3574B1D401488F4601488F000137
76000113430000002600FFFFFF00FFFFFF000000260000002800000029000000
2A0000002A0C014385C64A7DB0FF4A7DB0FF014385C600002A0C00002A000000
29000000280000002600FFFFFF00FFFFFF000000260000002800000029000000
2A2700002A5B4D7AA6E680B3E3FF80B3E3FF4D7AA6E600002A5B00002A270000
29000000280000002600FFFFFF00FFFFFF00000026000000281B000029530000
296C9F9FB0FFC9D6E2FFB3A699FFB3A699FFC9D6E2FF9E9EAFFF0000296C0000
29530000281B00002600FFFFFF00FFFFFF00000026321F1F4086585873B7AEAE
BFFF9B9BACFFF3F3F3FFDEC0A2FFDEC0A2FFF3F3F3FF9A9AABFFADADBEFF5959
74B71F1F418600002632FFFFFF00FFFFFF000000247A8E8EA0F39898A9FFA9A9
BAFF9696A7FFEAEAEAFFC19A74FFC09A74FFEAEAEAFF9595A6FFA8A8B9FF9898
A9FF8F8FA1F30000247AFFFFFF00FFFFFF0001011F9B9494A5FF9797A8FFA9A9
BAFF9191A2FFE1E1E1FF9D6F40FF9D6F40FFE1E1E1FF9090A1FFA8A8B9FF9797
A8FF9595A6FF01011F9BFFFFFF00FFFFFF0001011B5601011BAA02021DA50202
1F9D030321952F2F2F626A2A00CA6A2A00CA2F2F2F620303219602021F9D0202
1DA501011CAA01011B56FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B0000002B0000002B0000002B00
00002B00001B2B00009B2B0000C72B0000C72B00009B2B00001B2B0000002B00
00002B0000002B000000FFFFFF00FFFFFF002B0000002B0000002B0000002B00
00002B00009C4C2525DE7E5B5BF97E5A5AF94A2323DE2B00009C2B0000002B00
00002B0000002B000000FFFFFF00FFFFFF002A0000002A0000002A0000002B00
001A5A3D3DD9C0B8B8FDE1D8D8FFDFD6D6FFBCB3B3FD5A3D3DD92B00001A2A00
00002A0000002A000000FFFFFF00FFFFFF002A0000002A0000002A00004E2A00
00B6401A1AE7654343FF805E5EFF856363FF6D4B4BFF421C1CE72A0000B62A00
004E2A0000002A000000FFFFFF00FFFFFF0016264C0016264C0016264C00024D
99810E0E20EF83B6E3FF7FB2E0FF7FB2E0FF83B6E3FF0E0E20EF024D99811626
4C0016264C0016264C00FFFFFF00FFFFFF00024C9700024C9700024C9700024C
9783073E7AC498CBF5FF91C4F1FF91C4F1FF98CBF5FF073E7AC4024C9783024C
9700024C9700024C9700FFFFFF00FFFFFF00024B9400024B9400024B9400024B
9400024A929E7FB4E4F6546783FF546783FF7FB4E4F6024A929E024B9400024B
9400024B9400024B9400FFFFFF00FFFFFF002A000000201325000C376C000148
8F0001488F463574B1D480B3E3FF80B3E3FF3574B1D401488F4601488F000C37
6C00201325002A000000FFFFFF00FFFFFF002A0000002A0000002A0000002B00
00002B000019014385C64A7DB0FF4A7DB0FF014385C62B0000192B0000002A00
00002A0000002A000000FFFFFF00FFFFFF002A0000002A0000002A0000002B00
004C2B0000B44D7AA6E680B3E3FF80B3E3FF4D7AA6E62B0000B42B00004C2A00
00002A0000002A000000FFFFFF00FFFFFF002A0000002A0000322A00009A2A00
00CB5F3D3DFFC9D6E2FFB3A699FFB3A699FFC9D6E2FF5F3D3DFF2A0000CB2A00
009A2A0000322A000000FFFFFF00FFFFFF002A000057320909D3492323E97351
51FF5B3939FFF3F3F3FFDEC0A2FFDEC0A2FFF3F3F3FF5B3939FF725050FF4A24
24E9320A0AD32A000057FFFFFF00FFFFFF00290000C8583535FC5D3B3BFF6E4C
4CFF563434FFEAEAEAFFC19A74FFC09A74FFEAEAEAFF563434FF6D4B4BFF5D3B
3BFF593636FC290000C8FFFFFF00FFFFFF00270000E2593737FF5C3A3AFF6E4C
4CFF512F2FFFDDDDDDF49D6E40FF9D6E40FFDDDDDDF4512F2FFF6D4B4BFF5C3A
3AFF5A3838FF270000E2FFFFFF00FFFFFF0026000078230000FE240000F52600
00E9280000DD2F2F2F626A2A00CA6A2A00CA2F2F2F62280000DE260000EA2400
00F5230000FE26000078FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000000000000000D5D4D24EDEDE
DCA8DDDCDBFFE6E0DEFFF0E5E2FFE8E1DEFFDDDBDBFFDFDFDEA8D7D6D44D0000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000DEDCDCFFE9E9
E7FFFEF7F3FFDAF4FFFF00C3FFFFDCFFFFFFFFF7F6FFE9E8E8FFDDDDDCFFDADA
DA1700000000FFFFFF00FFFFFF00FFFFFF000000000000000000B8B6B58A0000
00FF200E07FF343F49FF00CEFFFF394C4DFF200D07FF000000FFB6B5B389BFBF
BF1E00000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000160100
00FF00C8FFFF00CEFFFF00D8FFFF00E5FFFF00F9FFFF000000FF000000150000
000500000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000B3B
72FFBBFFFFFF060000FF270A01FF573D35FF8FC9EBFF123F76FF000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000938
6EFFB0F7FFFFA1E5FFFF92D6F8FF84C5E7FF7BBADAFF103F72FF000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000A36
64AB85C7E9FF8ED0F0FF80C0E1FF74B3D4FF66A2C3FF0D3B69AB000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
001E69A6C8D382C4E5FF73B1D3FF69A7CAFF548DAEC30000001E000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
0000325164528BD1F1FF66A5C5FF4F86A4FF18303E3E00000000000000000000
000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000002D8CB7976C64
5FC9697076FFF8FFFFFFE8F3F9FFD6E1E7FF707273FF6A6766B7646363460000
000000000000FFFFFF00FFFFFF00FFFFFF00656463206A6461F85B8CA1FF857C
77FF4C4744FFB9B6B3FFFFFFFF00BBB8B5FF4C4847FF837F7DFF7A797AFF6666
67E565656522FFFFFF00FFFFFF00FFFFFF00666565FF7C7470FF228CBCFF6053
50FF433D3AFF4E4848FFFFFFFF004E4A49FF44403EFF5D5958FF645F5EFF7977
76FF656565FFFFFFFF00FFFFFF00FFFFFF00666565FF6C635FFF1893C5FF707C
82FF897773FF43322FFF3F696EFF423834FF59514AFF564F4BFF544D4CFF6964
63FF656565FFFFFFFF00FFFFFF00FFFFFF00615F5FFF524C4AFF4A4C4CFF00B8
FCFF0BAEDDFF05C1EDFF02CCEDFF55463FFF0285FFFF7C80C7FF5BE5CCFF4F49
49FF666565FFFFFFFF00FFFFFF00FFFFFF005E5E5EC0676665FF696462FF6B61
5DFF6C5F5CFF6C5F5CFF6B605EFF6A6360FF69635DFF67625DFF666160FF6664
64FF5D5D5DC0FFFFFF00FFFFFF00FFFFFF000000002300000033000000330000
0033000000330000003300000033000000330000003300000033000000330000
003300000023FFFFFF00FFFFFF00FFFFFF0000000000000000005B77564E5C77
57A8577250FF5F7552FF657752FF5F7451FF57724FFF5F7859A8637D5E4D0000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000577351FF5D76
55FF6F8361FF67968CFF00D3FFFF669D8AFF6F8260FF5C7755FF587452FF5773
521700000000FFFFFF00FFFFFF00FFFFFF000000000000000000495E438A4260
3BFF586B42FF557F6EFF00CFFFFF5A8D74FF5C6D48FF476340FF4A5E44894B64
471E00000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000164760
32FF00C2FFFF00CBFFFF00D7FFFF00E1FFFF00F3FFFF4C6237FF000000150000
000500000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000D3A
73FFBAFCFFFF060000FF270A01FF563C34FF8DC7EAFF143E78FF000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000938
6EFFB0F7FFFFA1E5FFFF92D6F8FF84C5E7FF7BBADAFF113F73FF000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000B36
64AB85C6E9FF8ED0F0FF80C0E1FF74B3D4FF66A2C4FF0E3A6AAB000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
001E6AA5C9D382C4E5FF73B1D3FF69A7CAFF548CAFC30000001E000000000000
000000000000FFFFFF00FFFFFF00FFFFFF000000000000000000000000000000
0000305161528BCFF1FF66A5C5FF4F85A4FF192E3F3E00000000000000000000
000000000000FFFFFF00FFFFFF00FFFFFF0000000000000000002491AC975E72
4BC9678770FFF6FFFFFFE8F2F8FFD5DEE6FF6E876EFF5B7753B753704D460000
000000000000FFFFFF00FFFFFF00FFFFFF0056714F205C724FF85FA4A3FF98AC
89FF5C6B54FFC4CDBEFFFFFFFF00C6CFC0FF5C6D56FF95AE8FFF7D9678FF5975
54E555715022FFFFFF00FFFFFF00FFFFFF00587351FF8B9F7CFF2A9FC4FF7384
60FF516147FF586451FFFFFFFF00596653FF51644BFF6F8768FF768E70FF87A1
82FF54704FFFFFFFFF00FFFFFF00FFFFFF005F7858FF809471FF1CA1CAFF789B
89FF929B7BFF4E5838FF4A8D77FF4D5D3DFF667E54FF637C55FF617956FF7D95
76FF54704FFFFFFFFF00FFFFFF00FFFFFF00597553FF667F5BFF587658FF00BC
FFFF10B9E0FF07C8EFFF06D3F2FF68784EFF017DFFFF7C7AC8FF5ADECDFF647D
5BFF557150FFFFFFFF00FFFFFF00FFFFFF004F694AC0577150FF59704DFF5B6E
48FF5C6D46FF5C6D47FF5B6E49FF5A704AFF597148FF577048FF566F4BFF5670
4FFF50694AC0FFFFFF00FFFFFF00FFFFFF000000002300000033000000330000
0033000000330000003300000033000000330000003300000033000000330000
003300000023FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF002B579DFF2B579D38FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B51
93FF2968B84C2B579DFF70B0EBFF2A5BA3FF2968B83B2B5193FFFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B57
9DFF2968B8FF70B0EBFF70B0EBFF70B0EBFF2968B8FF2A5EA7FFFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B52
95FF646464FF7F7F7FFFB7B7B7FFA7A7A7FF656565FF2B5295FFFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005757
57FF5E5E5EFF757575FF777777FF5287BEFF5287BEFF5D5D5DFFFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005757
57FF558ABFFF6D9BC9FF78A4CEFF7FA9D1FF558ABFFF5C5C5CFFFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF004E69
86FF558ABFFF82ABD2FF82ABD2FF82ABD2FF558ABFFF486B90FFFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF003770
A9CE558ABFFF86ADD3FF82ABD2FF82ABD2FF5086BCFF3871AACAFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0095999D389599
9DFF3E75ADFE699ACBFF73A1CEFF6697CAFF3871A9FD95999DFF95999D38FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0095999D3895999DFFFAFA
FAFF83A1C0FB568CC1FF5E94C8FF528AC0FF82A0C1FBFAFAFAFF95999DFF9599
9D38FFFFFF00FFFFFF00FFFFFF00FFFFFF00878F9D3E95999DFFECECECFFE5E5
E5FFFAFAFAFF7B9FC2FF30679EFF82A8CEFFFAFAFAFFE5E5E5FFECECECFF9599
9DFF878F9D3EFFFFFF00FFFFFF000A38A0510938A1E83358A9FFC7C8CAFF8B8B
8BFFE5E5E5FFBCBCBCFFA8C0D7FFFAFAFAFFE5E5E5FF717171FFC7C8CAFF355C
B1EB0A38A0E10A389F4EFFFFFF000938A1F4033DB9FF0837A1FF3257AAFFC7C8
CAFF9F9F9FFFBCBCBCFFE5E5E5FFCBCBCBFFAEAEAEFFC7C8CAFF2D5CC0FF023E
BDFF033DB9FF0A389FE3FFFFFF000A389FFF023EBDFF023EBDFF0837A1FF3257
AAFFBCBCBCFFE5E5E5FFCBCBCBFF7F7F7FFFBCBCBCFF2D5CC0FF023EBDFF023E
BDFF023EBDFF0A389FFFFFFFFF000A389FFF0A389FFF0A389FFF0A389FFF7688
B1FFBCBCBCFFBCBCBCFFB1B1B1FFBCBCBCFF3458A8FF0A389FFF0A389FFF0A38
9FFF0A389FFF0A389FFFFFFFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF002B579DFF2C579C39FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B51
93FF4D6C929E2B579DFF70B0EBFF2A5BA3FF596D86BF2B5193FFFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B51
93FF2968B8FF70B0EBFF70B0EBFF70B0EBFF2968B8FF2B5193FFFFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF002B51
93FF646464FF7F7F7FFFB7B7B7FFA7A7A7FF656565FF2B5193FF615C5A09FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF006F6F6F0B5757
57FF5E5E5EFF757575FF777777FF5381B7FF5186BDFF5D5D5DFF615C5A12FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00615C5A10615C5A225757
57FF575757FF82ABD2FF82ABD2FF82ABD2FF558ABFFF5C5C5CFF615C5A2C615C
5A0CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00615C5A34615C5ADD5757
57FF558ABFFF82ABD2FF82ABD2FF82ABD2FF558ABFFF5E6F82FF615C5AE5615C
5A1FFFFFFF00FFFFFF00FFFFFF00FFFFFF00615C5A09615C5AFF615C5AFF6E6F
70FF5D82A6FF86ADD3FF82ABD2FF82ABD2FF5086BCFF516E8AFF615C5AFF615C
5AFF615C5A07FFFFFF00FFFFFF00FFFFFF00615C5A11615C5AFF6C6969FF9599
9DFF4275A8FE699ACBFF73A1CEFF6697CAFF3871A9FD95999DFF6C6969FF615C
5AFF615C5A10FFFFFF00FFFFFF00FFFFFF00615C5A0C726F6FB195999DFFFAFA
FAFF87A1BCFF568CC1FF5E94C8FF528AC0FF83A1C0FFFAFAFAFF95999DFF6F6C
6CD3615C5A07FFFFFF00FFFFFF00FFFFFF00868D9A4195999DFFECECECFFE5E5
E5FFFAFAFAFF7B9FC2FF30679EFF82A8CEFFFAFAFAFFE5E5E5FFECECECFF9599
9DFF868E9B40FFFFFF00FFFFFF0009369F510937A0E83359B0F9C7C8CAFF8B8B
8BFFE5E5E5FFBCBCBCFFA8C0D7FFFAFAFAFFE5E5E5FF717171FFC7C8CAFF365B
AFEF09369FE109369E4EFFFFFF000937A0F4033DB9FF023EBDFF2D5CC0FFC7C8
CAFF9F9F9FFFBCBCBCFFE5E5E5FFCBCBCBFFAEAEAEFFC7C8CAFF2D5CC0FF023E
BDFF033DB9FF09369EE3FFFFFF0009369EFF023EBDFF023EBDFF023EBDFF2D5C
C0FFBCBCBCFFE5E5E5FFCBCBCBFF7F7F7FFFBCBCBCFF2D5CC0FF023EBDFF023E
BDFF023EBDFF09369EFFFFFFFF0009369EFF09369EFF09369EFF09369EFF7687
B0FFBCBCBCFFBCBCBCFFB1B1B1FFBCBCBCFF3356A8FF09369EFF09369EFF0936
9EFF09369EFF09369EFFFFFFFF00000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000 00000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000005F63 FF0035353534353535B0343535EB3A3C3EFB414141FF363636F433333347FFFF
69FF284D7DFF2D6196FF0F4988FF2C6093FF0C3E73FF1B3D60FF595E63FF0000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000003752 FF00363636F5505050FF6A6A6AFF5C5C5CFF4E4E4EFF484848FF323437E6FFFF
79FF255A93FF0C3E76FF245485FF0E3E73FF265584FF163E69FF143050FF0000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000001136 FF003A3A3AF3626262FF707070FF6D6D6DFF535353FF565656FF353638FE3333
67FF2A4B71FF4C759EFF3B638EFF11355BFF28527BFF1C3959FF103255FF0000 33EE333333ADFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000001848 FF003D3D3DF7565656FF5E5E5EFF555555FF4F4F4EFF4C4C4CFF4E4E4AFF3737
78FF9BB7D1FFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFF96B3CEFF1A4C7EFF0000 37FF313131D2FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00353535383537
000000000000000000000000000000000000000000000000000000000000305D 39CD404040FF606058FF83836DFF767665FF4E4E4CFF424242FF333333FF2E2F
8FFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2E629AFF0000 2FE93C3D3D72FFFFFF00FFFFFF00FFFFFF00FFFFFF0033333324333333FC3636
0000000000000000000000000000000000000000000000000000000000003D3D 36FD373737FF323232FF333333FF343434FF313131FF2B2B2BFF1E2327FF3B42
3DFF416F9EFF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF4176A6FF373737FF0000 4775FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00353A
0000000000000000000000000000000000000000000000000000494949FF4B4B 4024223549F8151515FF1C1E21FF4F6275FF202020FF202020FF293D52FE3856
4BFF989898FF5C5C5CFF557CA3FF557CA3FF4C4C4CFF989898FF4E4E4EFF4C4C 743EFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005353
4CFF0000000000000000000000000000000000000000777777FF4C4C4CFF4E4E 53F736404BFF5482B1FF6F9ECDFF86ADD3FF73A1CEFF6296C9FF3F5164FF5454
4EFF979797FF595959FFABABABFFA5A5A5FF545454FF868686FF626262FF4A4A 54EDFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00696462205453
4AFF0000000000000000000000000000000000000000636363FFA4A4A4FF5050 53FF4E4D4DFF467DB2FF6195C9FF6B9BCCFF6396C9FF4C82B9FF4A4A4BFD5958
50FF525252FF5B5B5BFFB8B8B8FFC1C1C1FF575757FF4D4D4DFF5A5A5AFF7E7E 58FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF005E5957034342
7EFF606060FF000000000000000000000000287CCEFF78B3EAFF7A7A7AFF8383 42FF444343FC3A628AFF4F84B9FF5D91C5FF558ABEFF396086FF363637E84544
83FF7E7E7EFF5D5D5DFF494949FF4C4C4CFF555555FF646464FF5F5F5FFF6D6D 44FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0044413F084542405D3737
6DFF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF5F5F5FFF8F8F 37FD3B3A3AFF394857FF2B6299FF2A6097FF2C639AFF394D60FF3A3939FF3636
8FFF7A7A7AFF777777FF6D6D6DFF4E4E4EFF727272FF6F6F6FFF848484FF5555 36FA44413F5B44413F08FFFFFF00FFFFFF0045424051464341E84F4B49F34744
55FF83BCEFFF2A77CAFF0000000000000000000000002579CDFF5E5E5EFF4F4F 43FF3B3A39FF363739FF4070A0FF4381BFFF3F70A0FF353C43FF3C3E41FF4745
4FFF848484FF848484FF808080FF545454FF838383FF848484FF4A4A4AFF4545 44FF4E4A48E6454240E144413F4EFFFFFF00464341F45D5957FF615C5AFF615C
45FF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000003D3D 5AFF4F4C4BFF383737FF37424DFF4381BFFF374654FF383737FF504D4BFF615C
3DFF4D4D4DFF494949FF474747FF474747FF454545FF474747FF383838FF0000 5AFF615C5AFF5D5957FF44413FE3FFFFFF0044413FFF615C5AFF615C5AFF615C
0000000000000000000000000000000000000000000000000000000000000000 5AFF53504EFF504D4CFF383737FF3D4E5FFF383737FF4F545CFF615C5AFF615C
0000000000000000000000000000000000000000000000000000000000000000 5AFF615C5AFF615C5AFF44413FFF615C5A0144413FFF44413FFF44413FFF4441
0000000000000000000000000000000000000000000000000000000000000000 3FFF44413FFF44413FFF44413FFF44413FFF44413FFF44413FFF44413FFF4441
0000000000000000000000000000000000000000000000000000000000000000 3FFF44413FFF44413FFF44413FFFFFFFFF000000003800000038000000380000
0000000000000000000000000000000000000000000000000000000000000000 0038000000380000003800000038000000380000003800000038000000380000
000027B2E5FF1BA7F3FF1CACF4FF1CA8F4FF1BA1F1FF27ACDEFF000000000000 0038000000380000003C00000038000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000000000000028B5
E5FF1BB6F5FF1CB6F5FF1CB6F5FF1CB2F5FF1CABF4FF1DAAF0FF28B0E0FF0000
0000000000000000000000000000000000000000000000000000000000001DBA
F5FF1CB6F5FF1CAAF4FF1CACF4FF1CACF4FF1CACF3FF1CA1F0FF1C93E4FF0000
0000000000000000000000000000000000000000000000000000000000001B9E
F3FF62ABCEFF8AB7E4FF3EC6EBFF1C9FEDFF1DA4EEFF1EA5EBFF1C9AE9FF0000
0000000000000000000000000000000000000000000000000000000000001E6D
ADFFBDD7EFFFA3C9EDFF9DC5E8FF44CEEFFF5BCDEFFFA8DCF1FF207CBDFF0000
0000000000000000000000000000000000000000000000000000000000002C61
8EFFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2D6299FF0000
0000000000000000000000000000000000000000000000000000000000004C72
49FF347499FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF357AA1FF4A6A46FF0000
000000000000000000000000000000000000000000000000000079935DFF2785
4EFFB3F5C8FF49898FFF4B7FA0FF4B7FA0FF49898FFFA9E8BAFF26844DFF738C
59FF0000000000000000000000000000000000000000AFE0ACFF37945DFF9FFD
C6FF91EFB8FF78D69FFF6FCD96FF69C68FFF62BF88FF73CF98FF94F0B9FF3088
51FF788754FF000000000000000000000000849D6CFF45A26BFF82E0A9FF82E0
A9FF6FCD96FF69C790FF64C28BFF5EBC85FF57B57EFF50AE77FF6BC891FF67C0
8AFF4F9A66FF769264FF0000000000000000287CCEFF78B3EAFF5AB881FF62C0
89FF62C089FF5FBD86FF5AB881FF55B37CFF4FAD76FF49A770FF419E67FF4DAB
74FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFF409E67FF6ECC
95FF5BB881FF58B57EFF53B17AFF4FAC75FF54B17AFF51AD76FF67C18AFF3B92
5CFF83BCEFFF2A77CAFF0000000000000000000000002579CDFF429D67FF318F
58FF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF63C18AFF2D8A53FF2F88
53FF2E7ECEFF6DA2D3FF0000000000000000000000000000000000000000668C
57FF428B55FF338952FF2E8851FF2D8750FF2E854EFF39854EFF4F824EFF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000565D68FF133F7AFF0D3E7DFF0C3C76FF123969FF4E5663FF000000000000
0000000000000000000000000000000000000000000000000000000000005F63
69FF284D7DFF0F498AFF0F4988FF0E4581FF0C3E73FF1B3D60FF595E63FF0000
0000000000000000000000000000000000000000000000000000000000003752
79FF0F498FFF0C3E76FF0C3E73FF0E3E73FF113F70FF0F3661FF143050FF0000
0000000000000000000000000000000000000000000000000000000000001037
73FF7893B5FF8AB7E4FF6793C3FF11355BFF15395FFF1C3959FF103255FF0000
0000000000000000000000000000000000000000000000000000000000001F5C
99FFBDD7EFFFA3C9EDFF9FC5E8FF74A1CDFF81B0DDFFB7D3EBFF2365A4FF0000
000000000000000000000000000000000000000000000000000000000000395F
89FFA6CAEEFFABCCEAFFA7D0F6FFA8D0F6FFABCCEAFFA7CDEEFF2F6299FF0000
000000000000000000000000000000000000000000000000000000000000966B
3EFF537291FF9CCCF8FFAFD4F7FFAFD4F7FFA5CFF6FF51799AFF8C643CFF0000
0000000000000000000000000000000000000000000000000000A57645FFB17D
3FFFD8BEA0FF968271FF5572A4FF435EB5FFA2795FFFD9BEA0FFB48042FFA875
46FF0000000000000000000000000000000000000000C29A70FFB27D41FFB480
42FFDCBF9EFFBE8A4CFFC4B6BCFF5E67C8FFB3814DFFD3B088FFC29159FFAF7A
3EFF9F6F41FF000000000000000000000000A5774AFFC3925BFFE2CAB0FFB682
44FFB78345FFB88855FF4A5BD0FF5060D2FFBA874CFFB37F41FFBF8A4EFFD0A9
7DFFBE8D57FF9C6F46FF0000000000000000287CCEFF78B3EAFFCEA679FFD2AE
83FFD0A97DFFB78859FF4D4EA6FF77627CFFB6844BFFC4935CFFC18E55FFC79A
67FF7EB8EDFF2974C7FF0000000000000000297DD1FF82BAEEFFC18F55FFD8B9
94FFCEA678FFCCA375FFBA9370FFB27F44FFCA9F6EFFC89C69FFD3AE85FFB884
49FF83BCEFFF2A77CAFF0000000000000000000000002579CDFFC08E54FFB581
43FFD3AF85FFD3AF85FFD1AB7FFFB98547FFD2AE83FFD3AF85FFB07B3FFFA976
3CFF2E7ECEFF6DA2D3FF00000000000000000000000000000000000000009966
34FFAF7A41FFAE793DFFAD783CFFAD783CFFAA7539FFAA753CFF936131FF0000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000DE8D077BDD8A00FFDD8A00FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000DD8A0054DD8A
00FFDD8B00FFE19A20FFDD8A00FF000000000000000000000000000000000000
00000000000000000000000000000000000000000000DD8A0054DA8900FFE29D
27FFE9BB64FFE9BB64FFDA8900FF000000000000000000000000000000000000
000000000000000000000000000000000000DD8A0054D78600FFE19C25FFE7B8
60FFE8B960FFE8B960FFD88600FF000000000000000000000000000000000000
000000000000000000000000000000000000D38300FFE09B23FFE6B55AFFE5B5
5BFFE5B65BFFE6B55BFFD48300FF000000000000000000000000000000000000
0000000000000000000000000000DD8A0054CF8000FFE3B154FFE3B154FFE3B1
55FFE3B155FFE3B154FFD08000FF00000000000000000000000000000000DD8A
002E000000000000000000000000CB7C00FFDE971EFFE0AC4DFFE0AC4DFFE0AD
4DFFE0AD4DFFDF981EFFCB7C00FF0000000000000000DD8A0054C77800FFC779
00FF0000000000000000DD8A0054C77900FFDEA846FFDDA745FFDEA846FFDD96
1BFFC67800FFC67800FFDD8A008CDD8A0054C27500FFC17400FFDB9A29FFC275
00FFDD8A015500000000C17400FFDC9418FFDAA23DFFDAA23DFFDC9418FFC175
00FFDD8A00540000000000000000BC7100FFCB8615FFD79D36FFD79E36FFD997
23FFBC7100FFDD8A0054BC7000FFD79E35FFD79D35FFDB9115FFBD7100FFDD8A
0054000000000000000000000000DA8E0D7AB76D00FFC78821FFD3982EFFD398
2DFFD7931EFFB86D00FFD7931EFFD3982DFFDA9012FFB46A00FFDD8A00540000
000000000000000000000000000000000000DD8A0155B36900FFC5851CFFD094
26FFD09425FFD59019FFD19426FFC5851CFFB36900FFDD8A0054000000000000
00000000000000000000000000000000000000000000DD8A0054AF6600FFC281
17FFCE8F1FFFCE8F1FFFCE8F1EFFAF6600FFDD8A005400000000000000000000
0000000000000000000000000000000000000000000000000000DD8A0054AA62
00FFC07F12FFCB8B18FFC07F12FFAA6200FF0000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000DD8A
0054A66000FFBF7C0EFFB86E00FF000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000DD8A0054A35D00FFDD8A0054000000000000000000000000000000000000
0000000000000000000000000000 0000000000000000000000000000
} }
end end

137
Client/UfrmAccountControl.pas
View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
VirtualTrees, Math, UEnhancedMemoryStream, UEnums; StdCtrls, ExtCtrls, VirtualTrees, Math, UEnhancedMemoryStream, UEnums;
type type
@ -55,18 +55,41 @@ type
procedure tbAddUserClick(Sender: TObject); procedure tbAddUserClick(Sender: TObject);
procedure tbDeleteUserClick(Sender: TObject); procedure tbDeleteUserClick(Sender: TObject);
procedure tbRefreshClick(Sender: TObject); procedure tbRefreshClick(Sender: TObject);
procedure vstAccountsCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure vstAccountsDblClick(Sender: TObject); procedure vstAccountsDblClick(Sender: TObject);
procedure vstAccountsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vstAccountsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstAccountsGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: String);
procedure GetAccountImageIndex(AccessLevel: TAccessLevel; var ImageIndex: Integer);
procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree; procedure vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer); var Ghosted: Boolean; var ImageIndex: Integer);
procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; procedure vstAccountsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
procedure vstAccountsHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
protected protected
procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream); procedure OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream); procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream); procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
function FindNode(AUsername: string): PVirtualNode; function FindNode(AUsername: string): PVirtualNode;
private
procedure OnListModified;
public
lbDlgDelConfCaption: string;
lbDlgDelConf: string;
lbDlgAddNotiCaption: string;
lbDlgAddNoti: string;
lbDlgModNotiCaption: string;
lbDlgModNoti: string;
lbDlgInvlErrCaption: string;
lbDlgInvlErr: string;
lbDlgDelNotiCaption: string;
lbDlgDelNoti: string;
lbDlgDelfErrCaption: string;
lbDlgDelfErr: string;
end; end;
var var
@ -75,7 +98,8 @@ var
implementation implementation
uses uses
UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount; UdmNetwork, UPacket, UPacketHandlers, UAdminHandling, UfrmEditAccount, UfrmMain,
UGUIPlatformUtils, Language;
type type
PAccountInfo = ^TAccountInfo; PAccountInfo = ^TAccountInfo;
@ -146,6 +170,8 @@ end;
procedure TfrmAccountControl.FormCreate(Sender: TObject); procedure TfrmAccountControl.FormCreate(Sender: TObject);
begin begin
LanguageTranslate(Self);
vstAccounts.NodeDataSize := SizeOf(TAccountInfo); vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse)); AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse));
@ -198,6 +224,7 @@ end;
procedure TfrmAccountControl.FormShow(Sender: TObject); procedure TfrmAccountControl.FormShow(Sender: TObject);
begin begin
SetWindowParent(Handle, frmMain.Handle);
tbRefreshClick(Sender); tbRefreshClick(Sender);
end; end;
@ -233,7 +260,7 @@ begin
if selected <> nil then if selected <> nil then
begin begin
accountInfo := vstAccounts.GetNodeData(selected); accountInfo := vstAccounts.GetNodeData(selected);
if MessageDlg('Confirmation', Format('Do you really want to delete "%s"?', if MessageDlg(lbDlgDelConfCaption, Format(lbDlgDelConf,
[accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then [accountInfo^.Username]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username)); dmNetwork.Send(TDeleteUserPacket.Create(accountInfo^.Username));
end; end;
@ -244,6 +271,19 @@ begin
dmNetwork.Send(TRequestUserListPacket.Create); dmNetwork.Send(TRequestUserListPacket.Create);
end; end;
procedure TfrmAccountControl.vstAccountsCompareNodes(Sender: TBaseVirtualTree;
Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
accountInfo1, accountInfo2: PAccountInfo;
begin
accountInfo1 := Sender.GetNodeData(Node1);
accountInfo2 := Sender.GetNodeData(Node2);
case Column of
1: Result := CompareText(accountInfo1^.Username, accountInfo2^.Username);
2: Result := Integer(accountInfo1^.AccessLevel) - Integer(accountInfo2^.AccessLevel);
end;
end;
procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject); procedure TfrmAccountControl.vstAccountsDblClick(Sender: TObject);
begin begin
tbEditUserClick(Sender); tbEditUserClick(Sender);
@ -259,21 +299,63 @@ begin
if accountInfo^.Regions <> nil then FreeAndNil(accountInfo^.Regions); if accountInfo^.Regions <> nil then FreeAndNil(accountInfo^.Regions);
end; end;
procedure TfrmAccountControl.vstAccountsGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: String);
var
accountInfo: PAccountInfo;
begin
if Column = 3 then
begin
accountInfo := Sender.GetNodeData(Node);
if accountInfo^.Regions.Count > 0 then
HintText := Trim(accountInfo^.Regions.Text);
end;
end;
procedure TfrmAccountControl.GetAccountImageIndex(AccessLevel: TAccessLevel; var ImageIndex: Integer);
begin
case AccessLevel of
alNone: ImageIndex := 0;
alView: ImageIndex := 1;
alNormal: ImageIndex := 6;
alDeveloper: ImageIndex := 8;
alAdministrator: ImageIndex := 10;
end;
end;
procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree; procedure TfrmAccountControl.vstAccountsGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer); var Ghosted: Boolean; var ImageIndex: Integer);
var var
accountInfo: PAccountInfo; accountInfo: PAccountInfo;
begin begin
accountInfo := Sender.GetNodeData(Node);
if Column = 0 then if Column = 0 then
begin begin
accountInfo := Sender.GetNodeData(Node);
case accountInfo^.AccessLevel of case accountInfo^.AccessLevel of
alNone: ImageIndex := 0; alNone: ImageIndex := 0;
alView: ImageIndex := 1; alView: ImageIndex := 1;
alNormal: ImageIndex := 2; alNormal:
alAdministrator: ImageIndex := 3; begin
if accountInfo^.Regions.Count > 0 then
ImageIndex := 5
else
ImageIndex := 6;
end;
alDeveloper:
begin
if accountInfo^.Regions.Count > 0 then
ImageIndex := 7
else
ImageIndex := 8;
end;
alAdministrator: ImageIndex := 10;
end; end;
end else if Column = 3 then
begin
if accountInfo^.Regions.Count > 0 then
ImageIndex := 12;
end; end;
end; end;
@ -286,12 +368,32 @@ begin
accountInfo := Sender.GetNodeData(Node); accountInfo := Sender.GetNodeData(Node);
case Column of case Column of
1: CellText := accountInfo^.Username; 1: CellText := accountInfo^.Username;
2: CellText := GetAccessLevelString(accountInfo^.AccessLevel); 2: CellText := GetAccessLevel(accountInfo^.AccessLevel);
else else
CellText := ''; CellText := '';
end; end;
end; end;
procedure TfrmAccountControl.vstAccountsHeaderClick(Sender: TVTHeader;
Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Column in [1, 2] then
begin
if Sender.SortColumn <> Column then
begin
Sender.SortColumn := Column;
Sender.SortDirection := sdAscending;
end else
begin
case Sender.SortDirection of
sdAscending: Sender.SortDirection := sdDescending;
sdDescending: Sender.SortDirection := sdAscending;
end;
end;
Sender.Treeview.SortTree(Sender.SortColumn, Sender.SortDirection);
end;
end;
procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream); procedure TfrmAccountControl.OnModifyUserResponse(ABuffer: TEnhancedMemoryStream);
var var
node: PVirtualNode; node: PVirtualNode;
@ -313,8 +415,9 @@ begin
regions := ABuffer.ReadByte; regions := ABuffer.ReadByte;
for i := 0 to regions - 1 do for i := 0 to regions - 1 do
accountInfo^.Regions.Add(ABuffer.ReadStringNull); accountInfo^.Regions.Add(ABuffer.ReadStringNull);
OnListModified;
Messagedlg('Success', Format('The user "%s" has been added.', [username]), Messagedlg(lbDlgAddNotiCaption, Format(lbDlgAddNoti, [username]),
mtInformation, [mbOK], 0); mtInformation, [mbOK], 0);
end; end;
muModified: muModified:
@ -328,13 +431,14 @@ begin
regions := ABuffer.ReadByte; regions := ABuffer.ReadByte;
for i := 0 to regions - 1 do for i := 0 to regions - 1 do
accountInfo^.Regions.Add(ABuffer.ReadStringNull); accountInfo^.Regions.Add(ABuffer.ReadStringNull);
OnListModified;
Messagedlg('Success', Format('The user "%s" has been modified.', [username]), Messagedlg(lbDlgModNotiCaption, Format(lbDlgModNoti, [username]),
mtInformation, [mbOK], 0); mtInformation, [mbOK], 0);
end; end;
end; end;
muInvalidUsername: muInvalidUsername:
MessageDlg('Error', Format('The username "%s" is not valid.', [username]), MessageDlg(lbDlgInvlErrCaption, Format(lbDlgInvlErr, [username]),
mtError, [mbOK], 0); mtError, [mbOK], 0);
end; end;
end; end;
@ -354,13 +458,14 @@ begin
if node <> nil then if node <> nil then
begin begin
vstAccounts.DeleteNode(node); vstAccounts.DeleteNode(node);
Messagedlg('Success', Format('The user "%s" has been deleted.', [username]), OnListModified;
Messagedlg(lbDlgDelNotiCaption, Format(lbDlgDelNoti, [username]),
mtInformation, [mbOK], 0); mtInformation, [mbOK], 0);
end; end;
end; end;
duNotFound: duNotFound:
MessageDlg('Error', Format('The user "%s" could not be deleted. Maybe ' + MessageDlg(lbDlgDelfErrCaption, Format(lbDlgDelfErr, [username]),
'your list is out of date or you tried to delete yourself.', [username]),
mtError, [mbOK], 0); mtError, [mbOK], 0);
end; end;
end; end;
@ -386,6 +491,7 @@ begin
accountInfo^.Regions.Add(ABuffer.ReadStringNull); accountInfo^.Regions.Add(ABuffer.ReadStringNull);
end; end;
vstAccounts.EndUpdate; vstAccounts.EndUpdate;
OnListModified;
end; end;
function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode; function TfrmAccountControl.FindNode(AUsername: string): PVirtualNode;
@ -404,6 +510,11 @@ begin
end; end;
end; end;
procedure TfrmAccountControl.OnListModified;
begin
vstAccounts.Header.SortColumn := -1;
end;
initialization initialization
{$I UfrmAccountControl.lrs} {$I UfrmAccountControl.lrs}

61
Client/UfrmEditAccount.lfm
View File

@ -1,39 +1,39 @@
object frmEditAccount: TfrmEditAccount object frmEditAccount: TfrmEditAccount
Left = 290 Left = 1146
Height = 214 Height = 214
Top = 171 Top = 205
Width = 261 Width = 261
ActiveControl = PageControl1
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'Edit Account' Caption = 'Редактирование аккаунта'
ClientHeight = 214 ClientHeight = 214
ClientWidth = 261 ClientWidth = 261
Font.Height = -11 Font.Height = -11
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnShow = FormShow OnShow = FormShow
ParentFont = False
Position = poOwnerFormCenter Position = poOwnerFormCenter
LCLVersion = '0.9.27' LCLVersion = '0.9.30.2'
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 0
Height = 173 Height = 173
Top = 0
Width = 261 Width = 261
ActivePage = tsGeneral ActivePage = tsGeneral
Align = alClient Align = alClient
TabIndex = 0 TabIndex = 0
TabOrder = 0 TabOrder = 0
object tsGeneral: TTabSheet object tsGeneral: TTabSheet
Caption = 'General' Caption = 'Общие'
ClientHeight = 148 ClientHeight = 147
ClientWidth = 259 ClientWidth = 253
object lblPasswordHint: TLabel object lblPasswordHint: TLabel
Left = 86 Left = 86
Height = 28 Height = 28
Top = 64 Top = 64
Width = 160 Width = 160
AutoSize = False AutoSize = False
Caption = 'Leave empty to leave the password unchanged.' Caption = 'Не заполнять поле, если не хотите изменить пароль.'
Enabled = False Enabled = False
ParentColor = False ParentColor = False
WordWrap = True WordWrap = True
@ -42,29 +42,29 @@ object frmEditAccount: TfrmEditAccount
Left = 6 Left = 6
Height = 14 Height = 14
Top = 12 Top = 12
Width = 58 Width = 46
Caption = 'Username:' Caption = 'Аккаунт:'
ParentColor = False ParentColor = False
end end
object lblPassword: TLabel object lblPassword: TLabel
Left = 6 Left = 6
Height = 14 Height = 14
Top = 44 Top = 44
Width = 54 Width = 44
Caption = 'Password:' Caption = 'Пароль:'
ParentColor = False ParentColor = False
end end
object lblAccessLevel: TLabel object lblAccessLevel: TLabel
Left = 6 Left = 6
Height = 14 Height = 14
Top = 108 Top = 108
Width = 63 Width = 37
Caption = 'Accesslevel:' Caption = 'Права:'
ParentColor = False ParentColor = False
end end
object edUsername: TEdit object edUsername: TEdit
Left = 86 Left = 86
Height = 23 Height = 21
Top = 8 Top = 8
Width = 160 Width = 160
Color = clBtnFace Color = clBtnFace
@ -73,7 +73,7 @@ object frmEditAccount: TfrmEditAccount
end end
object edPassword: TEdit object edPassword: TEdit
Left = 86 Left = 86
Height = 23 Height = 21
Top = 40 Top = 40
Width = 160 Width = 160
EchoMode = emPassword EchoMode = emPassword
@ -82,13 +82,15 @@ object frmEditAccount: TfrmEditAccount
end end
object cbAccessLevel: TComboBox object cbAccessLevel: TComboBox
Left = 86 Left = 86
Height = 25 Height = 21
Top = 104 Top = 104
Width = 160 Width = 160
ItemHeight = 13
Items.Strings = ( Items.Strings = (
'None' 'None'
'Viewer' 'Viewer'
'Normal' 'Normal'
'Developer'
'Administrator' 'Administrator'
) )
Style = csDropDownList Style = csDropDownList
@ -96,35 +98,34 @@ object frmEditAccount: TfrmEditAccount
end end
end end
object tsRegions: TTabSheet object tsRegions: TTabSheet
Caption = 'Regions' Caption = 'Регионы'
ClientHeight = 148 ClientHeight = 147
ClientWidth = 259 ClientWidth = 253
object Label1: TLabel object Label1: TLabel
Left = 8 Left = 8
Height = 14 Height = 14
Top = 8 Top = 8
Width = 243 Width = 237
Align = alTop Align = alTop
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
Caption = 'Allowed Regions:' Caption = 'Разрешенные регионы:'
ParentColor = False ParentColor = False
end end
object cbRegions: TCheckListBox object cbRegions: TCheckListBox
Left = 8 Left = 8
Height = 114 Height = 113
Top = 26 Top = 26
Width = 243 Width = 237
Align = alClient Align = alClient
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
ItemHeight = 13 ItemHeight = 0
TabOrder = 0 TabOrder = 0
TopIndex = -1
end end
end end
end end
@ -142,18 +143,20 @@ object frmEditAccount: TfrmEditAccount
object btnCancel: TButton object btnCancel: TButton
Left = 170 Left = 170
Height = 25 Height = 25
Top = 0
Width = 75 Width = 75
Align = alRight Align = alRight
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.InnerBorder = 4 BorderSpacing.InnerBorder = 4
Cancel = True Cancel = True
Caption = 'Cancel' Caption = 'Отмена'
ModalResult = 2 ModalResult = 2
TabOrder = 0 TabOrder = 0
end end
object btnOK: TButton object btnOK: TButton
Left = 91 Left = 91
Height = 25 Height = 25
Top = 0
Width = 75 Width = 75
Align = alRight Align = alRight
BorderSpacing.Right = 4 BorderSpacing.Right = 4

54
Client/UfrmEditAccount.pas
View File

@ -33,10 +33,11 @@ uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
UEnums, ComCtrls, ExtCtrls, CheckLst, UfrmRegionControl, VirtualTrees; UEnums, ComCtrls, ExtCtrls, CheckLst, UfrmRegionControl, VirtualTrees;
function GetAccessLevel(AAccessLevel: TAccessLevel): string;
type type
{ TfrmEditAccount } { TfrmEditAccount }
TfrmEditAccount = class(TForm) TfrmEditAccount = class(TForm)
btnCancel: TButton; btnCancel: TButton;
btnOK: TButton; btnOK: TButton;
@ -56,6 +57,7 @@ type
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
//constructor Create();// override;
public public
function GetAccessLevel: TAccessLevel; function GetAccessLevel: TAccessLevel;
function GetRegions: TStrings; function GetRegions: TStrings;
@ -72,20 +74,52 @@ var
implementation implementation
uses Language;
{ TfrmEditAccount } { TfrmEditAccount }
function GetAccessLevel(AAccessLevel: TAccessLevel): string;
var
index: Integer;
form: TfrmEditAccount;
begin
if frmEditAccount = nil
then form := TfrmEditAccount.Create(nil)
else form := frmEditAccount;
case AAccessLevel of
alNone: index := 0;
alView: index := 1;
alNormal: index := 2;
alDeveloper: index := 3;
alAdministrator: index := 4;
end;
Result := form.cbAccessLevel.Items[index];
if frmEditAccount = nil
then form.Destroy;
end;
//procedure TfrmEditAccount.Create;// override;
//begin
// LanguageTranslate(Self);
//end;
procedure TfrmEditAccount.FormCreate(Sender: TObject); procedure TfrmEditAccount.FormCreate(Sender: TObject);
begin begin
frmRegionControl.OnRegionModified := @RegionModified; LanguageTranslate(Self);
frmRegionControl.OnRegionDeleted := @RegionDeleted; if frmRegionControl <> nil then begin
frmRegionControl.OnRegionList := @RegionList; frmRegionControl.OnRegionModified := @RegionModified;
frmRegionControl.OnRegionDeleted := @RegionDeleted;
frmRegionControl.OnRegionList := @RegionList;
end;
end; end;
procedure TfrmEditAccount.FormDestroy(Sender: TObject); procedure TfrmEditAccount.FormDestroy(Sender: TObject);
begin begin
frmRegionControl.OnRegionModified := nil; if frmRegionControl <> nil then begin
frmRegionControl.OnRegionDeleted := nil; frmRegionControl.OnRegionModified := nil;
frmRegionControl.OnRegionList := nil; frmRegionControl.OnRegionDeleted := nil;
frmRegionControl.OnRegionList := nil;
end;
end; end;
procedure TfrmEditAccount.FormShow(Sender: TObject); procedure TfrmEditAccount.FormShow(Sender: TObject);
@ -99,7 +133,8 @@ begin
0: Result := alNone; 0: Result := alNone;
1: Result := alView; 1: Result := alView;
2: Result := alNormal; 2: Result := alNormal;
3: Result := alAdministrator; 3: Result := alDeveloper;
4: Result := alAdministrator;
end; end;
end; end;
@ -123,7 +158,8 @@ begin
alNone: cbAccessLevel.ItemIndex := 0; alNone: cbAccessLevel.ItemIndex := 0;
alView: cbAccessLevel.ItemIndex := 1; alView: cbAccessLevel.ItemIndex := 1;
alNormal: cbAccessLevel.ItemIndex := 2; alNormal: cbAccessLevel.ItemIndex := 2;
alAdministrator: cbAccessLevel.ItemIndex := 3; alDeveloper: cbAccessLevel.ItemIndex := 3;
alAdministrator: cbAccessLevel.ItemIndex := 4;
end; end;
end; end;

72
Client/UfrmInitialize.lfm
View File

@ -1,40 +1,48 @@
object frmInitialize: TfrmInitialize object frmInitialize: TfrmInitialize
Left = 290 Cursor = crHourGlass
Height = 65 Left = 1190
Top = 171 Height = 360
Width = 241 Top = 662
Width = 640
AlphaBlend = True
AlphaBlendValue = 240
BorderIcons = [] BorderIcons = []
BorderStyle = bsDialog BorderStyle = bsNone
Caption = 'Please wait ...' Caption = 'Пожалуйста подождите ...'
ClientHeight = 65 ClientHeight = 360
ClientWidth = 241 ClientWidth = 640
Font.Height = -11 Font.Height = -11
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '0.9.25' LCLVersion = '0.9.30.2'
object pnlMain: TPanel object imgSplah: TImage
Left = 8 Cursor = crHourGlass
Height = 50 Left = 0
Top = 8 Height = 360
Width = 226 Top = 0
BevelInner = bvRaised Width = 640
BevelOuter = bvLowered Align = alClient
ClientHeight = 50 Center = True
ClientWidth = 226 end
ParentFont = True object lblStatus: TLabel
TabOrder = 0 Cursor = crHourGlass
object lblStatus: TLabel Left = 0
Left = 8 Height = 32
Height = 32 Top = 304
Top = 8 Width = 640
Width = 208 Alignment = taCenter
Alignment = taCenter AutoSize = False
AutoSize = False Caption = 'Пожалуйста подождите...'
Layout = tlCenter Font.CharSet = RUSSIAN_CHARSET
ParentColor = False Font.Color = clWhite
ParentFont = True Font.Height = -16
WordWrap = True Font.Name = 'Consolas'
end Font.Pitch = fpFixed
Font.Quality = fqDraft
Layout = tlCenter
ParentColor = False
ParentFont = False
WordWrap = True
end end
end end

23
Client/UfrmInitialize.pas
View File

@ -38,8 +38,8 @@ type
{ TfrmInitialize } { TfrmInitialize }
TfrmInitialize = class(TForm) TfrmInitialize = class(TForm)
imgSplah: TImage;
lblStatus: TLabel; lblStatus: TLabel;
pnlMain: TPanel;
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
protected protected
@ -48,6 +48,15 @@ type
public public
procedure SetModal; procedure SetModal;
procedure UnsetModal; procedure UnsetModal;
procedure SetStatusLabel(message: string);
public // Локализация
SplashConnection: string;
SplashAuthorization: string;
SplashInicialization: string;
SplashLoading: string;
SplashUpdates: string;
SplashSuspend: string;
SplashUpdatingMiniMap: string;
end; end;
var var
@ -55,6 +64,8 @@ var
implementation implementation
uses UResourceManager;
{ TfrmInitialize } { TfrmInitialize }
procedure TfrmInitialize.FormClose(Sender: TObject; procedure TfrmInitialize.FormClose(Sender: TObject;
@ -66,6 +77,7 @@ end;
procedure TfrmInitialize.FormCreate(Sender: TObject); procedure TfrmInitialize.FormCreate(Sender: TObject);
begin begin
FModal := False; FModal := False;
imgSplah.Picture.Bitmap.LoadFromStream(ResourceManager.GetResource('Overlay/Splash.bmp'));
end; end;
procedure TfrmInitialize.SetModal; procedure TfrmInitialize.SetModal;
@ -89,6 +101,15 @@ begin
FModal := False; FModal := False;
end; end;
procedure TfrmInitialize.SetStatusLabel(message: string);
begin
frmInitialize.lblStatus.Caption := message;
frmInitialize.Update;
frmInitialize.Repaint;
frmInitialize.lblStatus.Repaint;
Application.ProcessMessages;
end;
initialization initialization
{$I UfrmInitialize.lrs} {$I UfrmInitialize.lrs}

893
Client/UfrmLargeScaleCommand.lfm
View File

File diff suppressed because it is too large Load Diff

109
Client/UfrmLargeScaleCommand.pas
View File

@ -31,8 +31,8 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Math, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Math,
VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf, VirtualTrees, VirtualList, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin,
Menus, UPlatformTypes, UEnhancedMemoryStream, UWorldItem; LCLIntf, Menus, UPlatformTypes, UEnhancedMemoryStream, UWorldItem;
type type
@ -113,8 +113,11 @@ type
btnGrab2: TSpeedButton; btnGrab2: TSpeedButton;
btnGrabOffset: TSpeedButton; btnGrabOffset: TSpeedButton;
vdtTerrainTiles: TVirtualDrawTree; vdtTerrainTiles: TVirtualDrawTree;
vdlTerrainTiles: TVirtualList;
vdtInsertStaticsTiles: TVirtualDrawTree; vdtInsertStaticsTiles: TVirtualDrawTree;
vdlInsertStaticsTiles: TVirtualList;
vdtDeleteStaticsTiles: TVirtualDrawTree; vdtDeleteStaticsTiles: TVirtualDrawTree;
vdlDeleteStaticsTiles: TVirtualList;
vstActions: TVirtualStringTree; vstActions: TVirtualStringTree;
vstArea: TVirtualStringTree; vstArea: TVirtualStringTree;
procedure btnGrab1Click(Sender: TObject); procedure btnGrab1Click(Sender: TObject);
@ -159,6 +162,7 @@ type
procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vstAreaChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; procedure vstAreaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
procedure RenameNode(AActionID: Integer; ACaption: String);
protected protected
FLastX: Integer; FLastX: Integer;
FLastY: Integer; FLastY: Integer;
@ -176,7 +180,7 @@ type
function FindNode(AActionID: Integer): PVirtualNode; function FindNode(AActionID: Integer): PVirtualNode;
procedure TileSelection(AWorldItem: TWorldItem); procedure TileSelection(AWorldItem: TWorldItem);
procedure OffsetSelection(AWorldItem: TWorldItem); procedure OffsetSelection(AWorldItem: TWorldItem);
procedure SerializeTiles(ATileList: TVirtualDrawTree; procedure SerializeTiles(ATileList: TVirtualList;
AStream: TEnhancedMemoryStream); AStream: TEnhancedMemoryStream);
public public
{ public declarations } { public declarations }
@ -189,7 +193,7 @@ implementation
uses uses
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets, UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets,
UGUIPlatformUtils; UGUIPlatformUtils, Language;
type type
PNodeInfo = ^TNodeInfo; PNodeInfo = ^TNodeInfo;
@ -200,19 +204,29 @@ type
PTileInfo = ^TTileInfo; PTileInfo = ^TTileInfo;
TTileInfo = record TTileInfo = record
ID: Word; ID: Word;
ptr: Pointer;
end; end;
{ TfrmLargeScaleCommand } { TfrmLargeScaleCommand }
procedure TfrmLargeScaleCommand.FormCreate(Sender: TObject); procedure TfrmLargeScaleCommand.FormCreate(Sender: TObject);
begin begin
vdlTerrainTiles := TVirtualList.Create(vdtTerrainTiles);
vdtTerrainTiles := vdlTerrainTiles;
vdlInsertStaticsTiles := TVirtualList.Create(vdtInsertStaticsTiles);
vdtInsertStaticsTiles := vdlInsertStaticsTiles;
vdlDeleteStaticsTiles := TVirtualList.Create(vdtDeleteStaticsTiles);
vdtDeleteStaticsTiles := vdlDeleteStaticsTiles;
LanguageTranslate(Self);
vstActions.NodeDataSize := SizeOf(TNodeInfo); vstActions.NodeDataSize := SizeOf(TNodeInfo);
FAreaNode := AddNode(-1, 'Target Area'); FAreaNode := AddNode(-1, pgArea.Caption);
FCopyMoveNode := AddNode( 0, 'Copy/Move'); FCopyMoveNode := AddNode( 0, pgCopyMove.Caption);
FAltitudeNode := AddNode( 1, 'Modify altitude'); FAltitudeNode := AddNode( 1, pgModifyAltitude.Caption);
FDrawTerrainNode := AddNode( 2, 'Draw terrain'); FDrawTerrainNode := AddNode( 2, pgDrawTerrain.Caption);
FDelStaticsNode := AddNode( 3, 'Delete statics'); FDelStaticsNode := AddNode( 3, pgDeleteStatics.Caption);
FAddStaticsNode := AddNode( 4, 'Insert statics'); FAddStaticsNode := AddNode( 4, pgInsertStatics.Caption);
vstActions.Selected[vstActions.GetFirst] := True; vstActions.Selected[vstActions.GetFirst] := True;
vstArea.NodeDataSize := SizeOf(TRect); vstArea.NodeDataSize := SizeOf(TRect);
@ -224,9 +238,9 @@ begin
seY1.MaxValue := ResMan.Landscape.CellHeight; seY1.MaxValue := ResMan.Landscape.CellHeight;
seY2.MaxValue := ResMan.Landscape.CellHeight; seY2.MaxValue := ResMan.Landscape.CellHeight;
vdtTerrainTiles.NodeDataSize := SizeOf(TTileInfo); vdlTerrainTiles.NodeDataSize := SizeOf(TTileInfo);
vdtInsertStaticsTiles.NodeDataSize := SizeOf(TTileInfo); vdlInsertStaticsTiles.NodeDataSize := SizeOf(TTileInfo);
vdtDeleteStaticsTiles.NodeDataSize := SizeOf(TTileInfo); vdlDeleteStaticsTiles.NodeDataSize := SizeOf(TTileInfo);
seCMOffsetX.MinValue := -ResMan.Landscape.CellWidth; seCMOffsetX.MinValue := -ResMan.Landscape.CellWidth;
seCMOffsetX.MaxValue := ResMan.Landscape.CellWidth; seCMOffsetX.MaxValue := ResMan.Landscape.CellWidth;
@ -349,17 +363,17 @@ end;
procedure TfrmLargeScaleCommand.btnClearDStaticsTilesClick(Sender: TObject); procedure TfrmLargeScaleCommand.btnClearDStaticsTilesClick(Sender: TObject);
begin begin
vdtDeleteStaticsTiles.Clear; vdlDeleteStaticsTiles.Clear;
end; end;
procedure TfrmLargeScaleCommand.btnClearIStaticsTilesClick(Sender: TObject); procedure TfrmLargeScaleCommand.btnClearIStaticsTilesClick(Sender: TObject);
begin begin
vdtInsertStaticsTiles.Clear; vdlInsertStaticsTiles.Clear;
end; end;
procedure TfrmLargeScaleCommand.btnClearTerrainClick(Sender: TObject); procedure TfrmLargeScaleCommand.btnClearTerrainClick(Sender: TObject);
begin begin
vdtTerrainTiles.Clear; vdlTerrainTiles.Clear;
end; end;
procedure TfrmLargeScaleCommand.btnCloseClick(Sender: TObject); procedure TfrmLargeScaleCommand.btnCloseClick(Sender: TObject);
@ -369,17 +383,17 @@ end;
procedure TfrmLargeScaleCommand.btnDeleteDStaticsTilesClick(Sender: TObject); procedure TfrmLargeScaleCommand.btnDeleteDStaticsTilesClick(Sender: TObject);
begin begin
vdtDeleteStaticsTiles.DeleteSelectedNodes; vdlDeleteStaticsTiles.DeleteSelectedNodes;
end; end;
procedure TfrmLargeScaleCommand.btnDeleteIStaticsTilesClick(Sender: TObject); procedure TfrmLargeScaleCommand.btnDeleteIStaticsTilesClick(Sender: TObject);
begin begin
vdtInsertStaticsTiles.DeleteSelectedNodes; vdlInsertStaticsTiles.DeleteSelectedNodes;
end; end;
procedure TfrmLargeScaleCommand.btnDeleteTerrainClick(Sender: TObject); procedure TfrmLargeScaleCommand.btnDeleteTerrainClick(Sender: TObject);
begin begin
vdtTerrainTiles.DeleteSelectedNodes; vdlTerrainTiles.DeleteSelectedNodes;
end; end;
procedure TfrmLargeScaleCommand.btnExecuteClick(Sender: TObject); procedure TfrmLargeScaleCommand.btnExecuteClick(Sender: TObject);
@ -447,7 +461,7 @@ begin
if vstActions.CheckState[node] = csCheckedNormal then if vstActions.CheckState[node] = csCheckedNormal then
begin begin
stream.WriteBoolean(True); stream.WriteBoolean(True);
SerializeTiles(vdtTerrainTiles, stream); SerializeTiles(vdlTerrainTiles, stream);
end else end else
stream.WriteBoolean(False); stream.WriteBoolean(False);
@ -456,7 +470,7 @@ begin
if vstActions.CheckState[node] = csCheckedNormal then if vstActions.CheckState[node] = csCheckedNormal then
begin begin
stream.WriteBoolean(True); stream.WriteBoolean(True);
SerializeTiles(vdtDeleteStaticsTiles, stream); SerializeTiles(vdlDeleteStaticsTiles, stream);
stream.WriteShortInt(Min(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value)); stream.WriteShortInt(Min(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value));
stream.WriteShortInt(Max(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value)); stream.WriteShortInt(Max(seDeleteStaticsZ1.Value, seDeleteStaticsZ2.Value));
end else end else
@ -467,7 +481,7 @@ begin
if vstActions.CheckState[node] = csCheckedNormal then if vstActions.CheckState[node] = csCheckedNormal then
begin begin
stream.WriteBoolean(True); stream.WriteBoolean(True);
SerializeTiles(vdtInsertStaticsTiles, stream); SerializeTiles(vdlInsertStaticsTiles, stream);
stream.WriteByte(seStaticsProbability.Value); stream.WriteByte(seStaticsProbability.Value);
if rbPlaceStaticsOnZ.Checked then if rbPlaceStaticsOnZ.Checked then
begin begin
@ -565,30 +579,32 @@ procedure TfrmLargeScaleCommand.vdtTerrainTilesDragDrop(Sender: TBaseVirtualTree
Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var var
sourceTree: TVirtualDrawTree; SenderTVList: TVirtualList;
selected, node: PVirtualNode; sourceTree: TVirtualList;
selected: PVirtualItem;
node: PVirtualItem;
sourceTileInfo, targetTileInfo: PTileInfo; sourceTileInfo, targetTileInfo: PTileInfo;
begin begin
sourceTree := Source as TVirtualDrawTree; SenderTVList := Sender as TVirtualList;
if (sourceTree <> Sender) and (sourceTree <> nil) and sourceTree := Source as TVirtualList;
(sourceTree.Tag = 1) then if (sourceTree <> Sender) and (sourceTree <> nil) then
begin begin
Sender.BeginUpdate; SenderTVList.BeginUpdate;
selected := sourceTree.GetFirstSelected; selected := sourceTree.GetFirstSelected;
while selected <> nil do while selected <> nil do
begin begin
sourceTileInfo := sourceTree.GetNodeData(selected); sourceTileInfo := sourceTree.GetNodeData(selected);
if ((Sender = vdtTerrainTiles) and (sourceTileInfo^.ID < $4000)) or if ((Sender = vdlTerrainTiles) and (sourceTileInfo^.ID < $4000)) or
((Sender = vdtInsertStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) or ((Sender = vdlInsertStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) or
((Sender = vdtDeleteStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) then ((Sender = vdlDeleteStaticsTiles) and (sourceTileInfo^.ID > $3FFF)) then
begin begin
node := Sender.AddChild(nil); node := SenderTVList.AddItem(nil);
targetTileInfo := Sender.GetNodeData(node); targetTileInfo := SenderTVList.GetNodeData(node);
targetTileInfo^.ID := sourceTileInfo^.ID; targetTileInfo^.ID := sourceTileInfo^.ID;
end; end;
selected := sourceTree.GetNextSelected(selected); selected := sourceTree.GetNextSelected(selected);
end; end;
Sender.EndUpdate; SenderTVList.EndUpdate;
end; end;
end; end;
@ -596,8 +612,7 @@ procedure TfrmLargeScaleCommand.vdtTerrainTilesDragOver(Sender: TBaseVirtualTree
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean); Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin begin
if (Source <> Sender) and (Source is TVirtualDrawTree) and if (Source <> Sender) and (Source is TVirtualDrawTree) then
(TVirtualDrawTree(Source).Tag = 1) then
begin begin
Accept := True; Accept := True;
end; end;
@ -717,6 +732,16 @@ begin
end; end;
end; end;
procedure TfrmLargeScaleCommand.RenameNode(AActionID: Integer; ACaption: String);
var
nodeInfo: PNodeInfo;
begin
nodeInfo := vstActions.GetNodeData(FindNode(AActionID));
if (nodeInfo = nil) then exit;
nodeInfo^.Caption := ACaption;
vstActions.Repaint;
end;
procedure TfrmLargeScaleCommand.TileSelection(AWorldItem: TWorldItem); procedure TfrmLargeScaleCommand.TileSelection(AWorldItem: TWorldItem);
begin begin
if FSelectFirst then if FSelectFirst then
@ -759,19 +784,19 @@ begin
WindowState := FOldWindowState; WindowState := FOldWindowState;
end; end;
procedure TfrmLargeScaleCommand.SerializeTiles(ATileList: TVirtualDrawTree; procedure TfrmLargeScaleCommand.SerializeTiles(ATileList: TVirtualList;
AStream: TEnhancedMemoryStream); AStream: TEnhancedMemoryStream);
var var
node: PVirtualNode; item: PVirtualItem;
tileInfo: PTileInfo; tileInfo: PTileInfo;
begin begin
AStream.WriteWord(ATileList.RootNodeCount); AStream.WriteWord(ATileList.RootNodeCount);
node := ATileList.GetFirst; item := ATileList.GetFirst;
while node <> nil do while item <> nil do
begin begin
tileInfo := ATileList.GetNodeData(node); tileInfo := ATileList.GetNodeData(item);
AStream.WriteWord(tileInfo^.ID); AStream.WriteWord(tileInfo^.ID);
node := ATileList.GetNext(node); item := ATileList.GetNext(item);
end; end;
end; end;

1416
Client/UfrmLogin.lfm
View File

File diff suppressed because it is too large Load Diff

246
Client/UfrmLogin.pas
View File

@ -31,7 +31,8 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, Spin, EditBtn, Buttons, IniFiles; ExtCtrls, Spin, EditBtn, Buttons, IniFiles, LConvEncoding, LazHelpHTML,
ShellAPI, Registry, AeroGlass;
type type
@ -40,46 +41,66 @@ type
TfrmLogin = class(TForm) TfrmLogin = class(TForm)
btnOK: TButton; btnOK: TButton;
btnCancel: TButton; btnCancel: TButton;
btnDefaultOptions: TSpeedButton;
cbProfile: TComboBox; cbProfile: TComboBox;
cbLanguage: TComboBox;
edData: TDirectoryEdit; edData: TDirectoryEdit;
edHost: TEdit; edHost: TEdit;
edUsername: TEdit; edUsername: TEdit;
edPassword: TEdit; edPassword: TEdit;
gbBaner: TGroupBox;
gbConnection: TGroupBox; gbConnection: TGroupBox;
gbData: TGroupBox; gbData: TGroupBox;
gbActions: TGroupBox; gbActions: TGroupBox;
gbProfiles: TGroupBox; gbProfiles: TGroupBox;
imgBaner: TImage;
imgHost: TImage; imgHost: TImage;
imgUsername: TImage; imgUsername: TImage;
imgPassword: TImage; imgPassword: TImage;
lblCopyright: TLabel; lblCopyright: TLabel;
lblHost: TLabel; lblHost: TLabel;
lblPlusCopyright: TLabel;
lblUsername: TLabel; lblUsername: TLabel;
lblPassword: TLabel; lblPassword: TLabel;
edPort: TSpinEdit; edPort: TSpinEdit;
lblData: TLabel; lblData: TLabel;
btnSaveProfile: TSpeedButton; btnSaveProfile: TSpeedButton;
btnDeleteProfile: TSpeedButton; btnDeleteProfile: TSpeedButton;
BanerAnim: TTimer;
pLayout: TPanel;
procedure BanerAnimTimer(Sender: TObject);
procedure btnCancelClick(Sender: TObject); procedure btnCancelClick(Sender: TObject);
procedure btnDefaultOptionsClick(Sender: TObject);
procedure btnDeleteProfileClick(Sender: TObject); procedure btnDeleteProfileClick(Sender: TObject);
procedure btnOKClick(Sender: TObject); procedure btnOKClick(Sender: TObject);
procedure btnSaveProfileClick(Sender: TObject); procedure btnSaveProfileClick(Sender: TObject);
procedure cbLanguageChange(Sender: TObject);
procedure cbProfileChange(Sender: TObject); procedure cbProfileChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure BanerClick(Sender: TObject);
procedure BanerMouseEnter(Sender: TObject);
procedure BanerMouseLeave(Sender: TObject);
procedure BanerDrawImage(baner : array of Byte);
protected protected
FProfilePath: string; FProfilePath: string;
public public
{ public declarations } { public declarations }
SaveProfileCaption: string;
SaveProfileDescription: string;
end; end;
var var
frmLogin: TfrmLogin; frmLogin: TfrmLogin;
sprofile: string;
LastTickCount: DWORD;
implementation implementation
uses uses
UdmNetwork; UdmNetwork, Logging, vinfo, Language;
{$I version.inc} {$I version.inc}
@ -90,22 +111,67 @@ begin
Close; Close;
end; end;
procedure TfrmLogin.btnDefaultOptionsClick(Sender: TObject);
begin
if cbProfile.ItemIndex > -1 then
begin
DeleteFile(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'RadarMap.cache');
DeleteFile(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'TilesEntry.cache');
DeleteFile(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'Config.xml');
end;
end;
procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject); procedure TfrmLogin.btnDeleteProfileClick(Sender: TObject);
begin begin
if cbProfile.ItemIndex > -1 then if cbProfile.ItemIndex > -1 then
begin begin
DeleteFile(FProfilePath + cbProfile.Text + '.ini'); DeleteFile(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'login.ini');
RemoveDir(FProfilePath + UTF8ToCP1251(cbProfile.Text));
cbProfile.Items.Delete(cbProfile.ItemIndex); cbProfile.Items.Delete(cbProfile.ItemIndex);
sprofile := '';
end; end;
end; end;
procedure TfrmLogin.btnOKClick(Sender: TObject); procedure TfrmLogin.btnOKClick(Sender: TObject);
var var
path: string; path: string;
configDir: string;
settings: TIniFile;
ARegistry: TRegistry;
begin begin
path := IncludeTrailingPathDelimiter(edData.Text); // Загрузка настроек
ARegistry := TRegistry.Create();
ARegistry.RootKey := HKEY_LOCAL_MACHINE;
ARegistry.OpenKey('\SOFTWARE\Quintessence\UO CentrED+', False);
if ARegistry.ReadBool('UseConfigDir')
then configDir := GetAppConfigDir(False)
else configDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))
+ '..' + PathDelim + 'LocalData' + PathDelim + 'UsersData' + PathDelim ;
ARegistry.Free;
// Сохранение настроек
settings := TIniFile.Create(configDir + 'LoginSettings.ini');
settings.WriteString('Connection', 'Host', edHost.Text);
settings.WriteInteger('Connection', 'Port', edPort.Value);
settings.WriteString('Connection', 'Username', edUsername.Text);
settings.WriteString('Data', 'Path', edData.Text);
if (cbProfile.ItemIndex > -1) and (cbProfile.ItemIndex < cbProfile.Items.Count) then
settings.WriteString('Profile', 'Last', cbProfile.Items[cbProfile.ItemIndex])
else
settings.WriteString('Profile', 'Last', '');
if (cbLanguage.ItemIndex > -1) and (cbLanguage.ItemIndex < cbLanguage.Items.Count) then
settings.WriteString('Profile', 'Lang', LanguageGetName)
else
settings.WriteString('Profile', 'Lang', '');
settings.Free;
{
// Проверка путей
path := IncludeTrailingPathDelimiter(UTF8ToCP1251(edData.Text));
if (not FileExists(path + 'art.mul')) or if (not FileExists(path + 'art.mul')) or
(not FileExists(path + 'artidx.mul')) or (not FileExists(path + 'artidx.mul')) or LangDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + PathDelim + 'Language' + PathDelim;
(not FileExists(path + 'hues.mul')) or (not FileExists(path + 'hues.mul')) or
(not FileExists(path + 'tiledata.mul')) or (not FileExists(path + 'tiledata.mul')) or
(not FileExists(path + 'animdata.mul')) or (not FileExists(path + 'animdata.mul')) or
@ -114,11 +180,12 @@ begin
(not FileExists(path + 'light.mul')) or (not FileExists(path + 'light.mul')) or
(not FileExists(path + 'lightidx.mul')) then (not FileExists(path + 'lightidx.mul')) then
begin begin
MessageDlg('Incorrect directory', 'The data path you specified does not ' MessageDlg('Неверный путь', 'Указанный вами путь, не является коректным,'
+ 'seem to be correct.', mtWarning, [mbOK], 0); + ' т.к. не содержит требуемые файлы.', mtWarning, [mbOK], 0);
edData.SetFocus; edData.SetFocus;
end else end else }
ModalResult := mrOK; ModalResult := mrOK;
Logger.Send([lcClient, lcInfo], 'Начинаем соеденинение с сервером');
end; end;
procedure TfrmLogin.btnSaveProfileClick(Sender: TObject); procedure TfrmLogin.btnSaveProfileClick(Sender: TObject);
@ -127,40 +194,64 @@ var
profile: TIniFile; profile: TIniFile;
begin begin
profileName := cbProfile.Text; profileName := cbProfile.Text;
if InputQuery('Save profile', 'Enter the name of the profile:', profileName) then if InputQuery(SaveProfileCaption, SaveProfileDescription, profileName) then
begin begin
profile := TIniFile.Create(FProfilePath + profileName + '.ini'); if not DirectoryExists(FProfilePath + UTF8ToCP1251(profileName))
profile.WriteString('Connection', 'Host', edHost.Text); then ForceDirectories(FProfilePath + UTF8ToCP1251(profileName));
profile := TIniFile.Create(FProfilePath + UTF8ToCP1251(profileName) + PathDelim + 'login.ini');
profile.WriteString('Connection', 'Host', UTF8ToCP1251(edHost.Text));
profile.WriteInteger('Connection', 'Port', edPort.Value); profile.WriteInteger('Connection', 'Port', edPort.Value);
profile.WriteString('Connection', 'Username', edUsername.Text); profile.WriteString('Connection', 'Username', UTF8ToCP1251(edUsername.Text));
profile.WriteString('Data', 'Path', edData.Text); profile.WriteString('Data', 'Path', UTF8ToCP1251(edData.Text));
profile.Free; profile.Free;
cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName); cbProfile.ItemIndex := cbProfile.Items.IndexOf(profileName);
if cbProfile.ItemIndex = -1 then if cbProfile.ItemIndex = -1 then
begin begin
cbProfile.Items.Add(profileName); cbProfile.Items.Add(profileName);
cbProfile.ItemIndex := cbProfile.Items.Count - 1; cbProfile.ItemIndex := cbProfile.Items.Count - 1;
cbProfileChange(nil);
end; end;
end; end;
end; end;
procedure TfrmLogin.cbLanguageChange(Sender: TObject);
begin
LanguageSet(cbLanguage.ItemIndex);
LanguageTranslate(Self);
cbLanguage.Hint := LanguageGetName();
Self.Repaint;
end;
procedure TfrmLogin.cbProfileChange(Sender: TObject); procedure TfrmLogin.cbProfileChange(Sender: TObject);
var var
profile: TIniFile; profile: TIniFile;
begin begin
if cbProfile.ItemIndex > -1 then if cbProfile.ItemIndex > -1 then
begin begin
profile := TIniFile.Create(FProfilePath + cbProfile.Text + '.ini'); btnDefaultOptions.Enabled := true;
edHost.Text := profile.ReadString('Connection', 'Host', ''); btnDeleteProfile.Enabled := true;
sprofile := cbProfile.Text;
profile := TIniFile.Create(FProfilePath + UTF8ToCP1251(cbProfile.Text) + PathDelim + 'login.ini');
edHost.Text := CP1251ToUTF8(profile.ReadString('Connection', 'Host', ''));
edPort.Value := profile.ReadInteger('Connection', 'Port', 2597); edPort.Value := profile.ReadInteger('Connection', 'Port', 2597);
edUsername.Text := profile.ReadString('Connection', 'Username', ''); edUsername.Text := CP1251ToUTF8(profile.ReadString('Connection', 'Username', ''));
edPassword.Text := ''; edPassword.Text := '';
edData.Text := profile.ReadString('Data', 'Path', ''); edData.Text := CP1251ToUTF8(profile.ReadString('Data', 'Path', ''));
edPassword.SetFocus; if Sender <> nil then
edPassword.SetFocus;
profile.Free; profile.Free;
end else begin
btnDefaultOptions.Enabled := false;
btnDeleteProfile.Enabled := false;
sprofile := '';
end; end;
end; end;
procedure TfrmLogin.FormActivate(Sender: TObject);
begin
GlassForm(frmLogin);
end;
procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure TfrmLogin.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin begin
if ModalResult <> mrOK then if ModalResult <> mrOK then
@ -170,19 +261,128 @@ end;
procedure TfrmLogin.FormCreate(Sender: TObject); procedure TfrmLogin.FormCreate(Sender: TObject);
var var
searchRec: TSearchRec; searchRec: TSearchRec;
iniSettings: TIniFile;
lastProfile: string;
lastLanguage: string;
nodeindex: integer;
langDirectory: string;
langFileName : string;
ARegistry: TRegistry;
configDir: string;
begin begin
lblCopyright.Caption := Format('UO CentrED Client Version %s (c) %s', Width := 494;
[ProductVersion, Copyright]); Height := 266;
FProfilePath := GetAppConfigDir(False) + 'Profiles' + PathDelim; Caption := Format('UO CentrED+ v%s build: %d',
//Caption := Format('UO CentrED+ v%s build: %d !!! pre-release (not stable version) !!! ',
[VersionInfo.GetProductVersionString, VersionInfo.Build]);
lblCopyright.Caption := Format('%s || "UO CentrED+" ver %s (c) %s',
[Original, VersionInfo.GetFileVersionString, Copyright]);
BanerMouseLeave(Sender);
edData.DialogTitle:=lblData.Caption;
// Загрузка настроек
ARegistry := TRegistry.Create();
ARegistry.RootKey := HKEY_LOCAL_MACHINE;
ARegistry.OpenKey('\SOFTWARE\Quintessence\UO CentrED+', False);
if ARegistry.ReadBool('UseConfigDir')
then configDir := GetAppConfigDir(False)
else configDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))
+ '..' + PathDelim + 'LocalData' + PathDelim + 'UsersData' + PathDelim ;
ARegistry.Free;
sprofile := '';
iniSettings := TIniFile.Create(configDir + 'LoginSettings.ini');
lastProfile := iniSettings.ReadString('Profile', 'Last', '');
lastLanguage:= iniSettings.ReadString('Profile', 'Lang', '');
FProfilePath := configDir + 'Profiles' + PathDelim;
ForceDirectories(FProfilePath); ForceDirectories(FProfilePath);
if FindFirst(FProfilePath + '*.ini', faAnyFile, searchRec) = 0 then if FindFirst(FProfilePath + '*', faDirectory, searchRec) = 0 then
begin begin
repeat repeat
cbProfile.Items.Add(ChangeFileExt(searchRec.Name, '')); if FileExists(FProfilePath + PathDelim + searchRec.Name + PathDelim + 'login.ini') then
begin
nodeindex := cbProfile.Items.Add(CP1251ToUTF8(searchRec.Name));
if (cbProfile.Items[nodeindex] <> '') and (cbProfile.Items[nodeindex] = lastProfile) then
begin
cbProfile.ItemIndex := nodeindex;
cbProfileChange(nil);
end;
end;
until FindNext(searchRec) <> 0; until FindNext(searchRec) <> 0;
end; end;
FindClose(searchRec); FindClose(searchRec);
if (cbProfile.ItemIndex < 0) or (lastprofile = '') then
begin
edHost.Text := iniSettings.ReadString('Connection', 'Host', 'localhost');
edPort.Value := iniSettings.ReadInteger('Connection', 'Port', 2597);
edUsername.Text := iniSettings.ReadString('Connection', 'Username', '');
edPassword.Text := '';
edData.Text := iniSettings.ReadString('Data', 'Path', '');
end;
iniSettings.Free;
// Загрузка локализаций
LangDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))
+ PathDelim + '..' + PathDelim +'Language' + PathDelim;
LanguageLoad(Self, lastLanguage, LangDirectory);
end;
procedure TfrmLogin.FormShow(Sender: TObject);
begin
edPassword.SetFocus;
end;
procedure TfrmLogin.BanerClick(Sender: TObject);
begin
// Открываем сайт в браузере по умолчанию
ShellExecute(Handle, 'open', PChar('http://dev.uoquint.ru'), nil, nil, 1 {SW_SHOWNORMAL});
end;
procedure TfrmLogin.BanerDrawImage(baner : array of Byte);
var stream: TMemoryStream;
begin
stream := TMemoryStream.Create;
stream.Write(baner[0],SizeOf(baner));
stream.Position:=0;
imgBaner.Picture.Bitmap.LoadFromStream(stream);
imgBaner.Update;
stream.Free;
end;
//function GetTickCount:DWORD; external 'kernel32' name 'GetTickCount';
procedure TfrmLogin.BanerAnimTimer(Sender: TObject);
var NowsTickCount : DWORD;
begin { Таймер и GetTickCount вообще не работают!!!
NowsTickCount := GetTickCount;
if (NowsTickCount - LastTickCount) < 10000 then exit;
LastTickCount := NowsTickCount;
if BanerAnim.Tag = 1 then begin
BanerAnim.Tag := 2; BanerDrawImage(baner_u);
end;
if BanerAnim.Tag = 2 then begin
BanerAnim.Tag := 1; BanerDrawImage(baner_h);
end; }
end;
procedure TfrmLogin.BanerMouseEnter(Sender: TObject);
var stream: TMemoryStream;
begin
lblPlusCopyright.Font.Color:= $FF0000;
lblPlusCopyright.Font.Size := 10;
BanerDrawImage(baner_h);
end;
procedure TfrmLogin.BanerMouseLeave(Sender: TObject);
var stream: TMemoryStream;
begin
lblPlusCopyright.Font.Color:= $000000;
lblPlusCopyright.Font.Size := 8;
BanerDrawImage(baner_u);
end; end;
initialization initialization

6917
Client/UfrmMain.lfm
View File

File diff suppressed because it is too large Load Diff

5197
Client/UfrmMain.pas
View File

File diff suppressed because it is too large Load Diff

53
Client/UfrmRadar.lfm
View File

@ -1,50 +1,69 @@
object frmRadarMap: TfrmRadarMap object frmRadarMap: TfrmRadarMap
Left = 290 Left = 1091
Height = 360 Height = 262
Top = 171 Top = 724
Width = 479 Width = 603
HorzScrollBar.Page = 478 HorzScrollBar.Page = 478
VertScrollBar.Page = 359 VertScrollBar.Page = 359
ActiveControl = sbMain Caption = 'Миникарта (1:8)'
Caption = 'Radar Map (1:8)' ClientHeight = 262
ClientHeight = 360 ClientWidth = 603
ClientWidth = 479 Constraints.MinHeight = 192
Constraints.MinWidth = 230
FormStyle = fsStayOnTop
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnResize = FormResize OnResize = FormResize
Position = poOwnerFormCenter Position = poOwnerFormCenter
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
LCLVersion = '0.9.29' LCLVersion = '0.9.30.2'
object pnlBottom: TPanel object pnlBottom: TPanel
Left = 0 Left = 0
Height = 21 Height = 21
Top = 339 Top = 241
Width = 479 Width = 603
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 21 ClientHeight = 21
ClientWidth = 479 ClientWidth = 603
TabOrder = 0 TabOrder = 0
object lblPosition: TLabel object lblPosition: TLabel
Left = 8 Left = 8
Height = 21 Height = 21
Top = 0 Top = 0
Width = 41 Width = 1
Align = alLeft Align = alLeft
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Layout = tlCenter Layout = tlCenter
ParentColor = False ParentColor = False
end end
object cbStayOnTop: TCheckBox
Left = 461
Height = 21
Top = 0
Width = 142
Align = alRight
Caption = 'Поверх главного окна'
Checked = True
OnChange = cbStayOnTopChange
State = cbChecked
TabOrder = 0
end
end end
object sbMain: TScrollBox object sbMain: TScrollBox
Left = 0 Left = 0
Height = 339 Height = 241
Top = 0 Top = 0
Width = 479 Width = 603
HorzScrollBar.Page = 475
HorzScrollBar.Range = 292
VertScrollBar.Page = 335
VertScrollBar.Range = 202
Align = alClient Align = alClient
ClientHeight = 335 AutoScroll = False
ClientWidth = 475 ClientHeight = 237
ClientWidth = 599
TabOrder = 1 TabOrder = 1
object pbRadar: TPaintBox object pbRadar: TPaintBox
Left = 0 Left = 0

95
Client/UfrmRadar.pas
View File

@ -32,7 +32,7 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls,
ImagingClasses, ImagingComponents, ImagingTypes, UEnhancedMemoryStream, crc, ImagingClasses, ImagingComponents, ImagingTypes, UEnhancedMemoryStream, crc,
StdCtrls; StdCtrls, LConvEncoding, Windows, ShellAPI, Logging, LCLIntf;
type type
@ -41,10 +41,12 @@ type
{ TfrmRadarMap } { TfrmRadarMap }
TfrmRadarMap = class(TForm) TfrmRadarMap = class(TForm)
cbStayOnTop: TCheckBox;
lblPosition: TLabel; lblPosition: TLabel;
pbRadar: TPaintBox; pbRadar: TPaintBox;
pnlBottom: TPanel; pnlBottom: TPanel;
sbMain: TScrollBox; sbMain: TScrollBox;
procedure cbStayOnTopChange(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
@ -68,28 +70,53 @@ type
var var
frmRadarMap: TfrmRadarMap; frmRadarMap: TfrmRadarMap;
FormMaxWidthConst : Integer;
FormMaxHeightConst: Integer;
implementation implementation
uses uses
UdmNetwork, UGameResources, UPacketHandlers, UPackets, UfrmInitialize, UdmNetwork, UGameResources, UPacketHandlers, UPackets, UfrmInitialize,
UfrmMain, UGraphicHelper; UfrmMain, UfrmLogin, UGraphicHelper, Language;
{ TfrmRadarMap } { TfrmRadarMap }
//{$I winapi.inc}
procedure TfrmRadarMap.FormCreate(Sender: TObject); procedure TfrmRadarMap.FormCreate(Sender: TObject);
var IntfWidth, IntfHeight: integer;
begin begin
LanguageTranslate(Self);
FRadar := TSingleImage.CreateFromParams(ResMan.Landscape.Width, FRadar := TSingleImage.CreateFromParams(ResMan.Landscape.Width,
ResMan.Landscape.Height, ifA8R8G8B8); ResMan.Landscape.Height, ifA8R8G8B8);
pbRadar.Width := FRadar.Width; pbRadar.Width := FRadar.Width;
pbRadar.Height := FRadar.Height; pbRadar.Height := FRadar.Height;
sbMain.ClientWidth := FRadar.Width; sbMain.ClientWidth := FRadar.Width;
sbMain.ClientHeight := FRadar.Height; sbMain.ClientHeight := FRadar.Height;
ClientWidth := sbMain.Width + sbMain.VertScrollBar.Size; ClientWidth := sbMain.Width;// + sbMain.VertScrollBar.Size;
ClientHeight := sbMain.Height + sbMain.HorzScrollBar.Size + pnlBottom.Height; ClientHeight := sbMain.Height + pnlBottom.Height;// + sbMain.HorzScrollBar.Size;
Constraints.MaxWidth := Width; Constraints.MaxWidth := Width;
Constraints.MaxHeight := Height; Constraints.MaxHeight := Height;
//LCLIntf.GetWindowSize(Handle, IntfWidth, IntfHeight); Screen.Width
if (Width >= frmMain.Width) then begin
Left := frmMain.Left;
Width := frmMain.Width;
end;
if (Height >= frmMain.Height) then begin
Top := frmMain.Top;
Height:= frmMain.Height;
end;
//sbMain.HorzScrollBar.Increment:=8;
//sbMain.VertScrollBar.Increment:=8;
sbMain.HorzScrollBar.Range := FRadar.Width;
sbMain.VertScrollBar.Range := FRadar.Height;
FormMaxWidthConst := Constraints.MaxWidth;
FormMaxHeightConst := Constraints.MaxHeight;
cbStayOnTopChange(Sender);
FRadarDependencies := TList.Create; FRadarDependencies := TList.Create;
RegisterPacketHandler($0D, TPacketHandler.Create(0, @OnRadarHandlingPacket)); RegisterPacketHandler($0D, TPacketHandler.Create(0, @OnRadarHandlingPacket));
@ -102,8 +129,16 @@ begin
CloseAction := caHide; CloseAction := caHide;
end; end;
procedure TfrmRadarMap.cbStayOnTopChange(Sender: TObject);
begin
if cbStayOnTop.Checked
then FormStyle := fsStayOnTop
else FormStyle := fsNormal;
end;
procedure TfrmRadarMap.FormDestroy(Sender: TObject); procedure TfrmRadarMap.FormDestroy(Sender: TObject);
var var
confdir : string;
radarMap: TRadarColorMap; radarMap: TRadarColorMap;
x, y: Integer; x, y: Integer;
radarMapFile: TFileStream; radarMapFile: TFileStream;
@ -115,8 +150,12 @@ begin
for y := 0 to FRadar.Height - 1 do for y := 0 to FRadar.Height - 1 do
radarMap[x * FRadar.Height + y] := EncodeUOColor(PInteger(FRadar.PixelPointers[x, y])^); radarMap[x * FRadar.Height + y] := EncodeUOColor(PInteger(FRadar.PixelPointers[x, y])^);
radarMapFile := TFileStream.Create(GetAppConfigDir(False) + 'RadarMap.cache', if (sprofile <> '') then
fmCreate); if (frmMain.ProfileDir <> '')
then confdir := frmMain.ProfileDir
else confdir := frmMain.ConfigDir;
radarMapFile := TFileStream.Create(confdir + 'RadarMap.cache', fmCreate);
radarMapFile.Write(radarMap[0], Length(radarMap) * SizeOf(Word)); radarMapFile.Write(radarMap[0], Length(radarMap) * SizeOf(Word));
radarMapFile.Free; radarMapFile.Free;
@ -125,8 +164,36 @@ begin
end; end;
procedure TfrmRadarMap.FormResize(Sender: TObject); procedure TfrmRadarMap.FormResize(Sender: TObject);
var hScroll, vScroll : Boolean;
begin begin
sbMain.AutoScroll := (Width < Constraints.MaxWidth) or (Height < Constraints.MaxHeight); if (Width > FormMaxWidthConst-10) and (Height > FormMaxHeightConst-10) then begin
Width := FormMaxWidthConst;
Height := FormMaxHeightConst;
Constraints.MaxWidth := FormMaxWidthConst;
Constraints.MaxHeight := FormMaxHeightConst;
end;
hScroll := (Width < Constraints.MaxWidth);
vScroll := (Height < Constraints.MaxHeight);
if hScroll <> sbMain.HorzScrollBar.Visible then begin
if hScroll
then Constraints.MaxHeight := FormMaxHeightConst + sbMain.HorzScrollBar.Size
else Constraints.MaxHeight := FormMaxHeightConst;
sbMain.HorzScrollBar.Visible := hScroll;
//FormResize(Sender); // Повторный вызов, для коррекции
end;
if vScroll <> sbMain.VertScrollBar.Visible then begin
if vScroll
then Constraints.MaxWidth := FormMaxWidthConst + sbMain.VertScrollBar.Size
else Constraints.MaxWidth := FormMaxWidthConst;
sbMain.VertScrollBar.Visible := vScroll;
FormResize(Sender); exit; // Повторный вызов, для коррекции
end;
sbMain.HorzScrollBar.Page := sbMain.ClientWidth;
sbMain.VertScrollBar.Page := sbMain.ClientHeight;
end; end;
procedure TfrmRadarMap.pbRadarMouseDown(Sender: TObject; Button: TMouseButton; procedure TfrmRadarMap.pbRadarMouseDown(Sender: TObject; Button: TMouseButton;
@ -166,6 +233,7 @@ end;
procedure TfrmRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream); procedure TfrmRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream);
var var
confdir: string;
subID: Byte; subID: Byte;
checksum, realChecksum: Cardinal; checksum, realChecksum: Cardinal;
radarMapFile: TFileStream; radarMapFile: TFileStream;
@ -179,7 +247,14 @@ begin
begin begin
checksum := ABuffer.ReadCardinal; checksum := ABuffer.ReadCardinal;
realChecksum := crc32(0, nil, 0); realChecksum := crc32(0, nil, 0);
radarMapFileName := GetAppConfigDir(False) + 'RadarMap.cache'; if (sprofile <> '') then
if (frmMain.ProfileDir <> '')
then confdir := frmMain.ProfileDir
else confdir := frmMain.ConfigDir;
//if (sprofile <> '')
// then confdir := GetAppConfigDir(False) + 'Profiles' + PathDelim + UTF8ToCP1251(sprofile) + PathDelim
// else confdir := GetAppConfigDir(False);
radarMapFileName := confdir + 'RadarMap.cache';
if FileExists(radarMapFileName) then if FileExists(radarMapFileName) then
begin begin
radarMapFile := TFileStream.Create(radarMapFileName, fmOpenRead); radarMapFile := TFileStream.Create(radarMapFileName, fmOpenRead);
@ -192,7 +267,7 @@ begin
if checksum <> realChecksum then if checksum <> realChecksum then
begin begin
frmInitialize.lblStatus.Caption := 'Updating Radar Map'; frmInitialize.lblStatus.Caption := frmInitialize.SplashUpdatingMiniMap;
frmInitialize.Show; frmInitialize.Show;
frmInitialize.SetModal; frmInitialize.SetModal;
//frmMain.Enabled := False; //frmMain.Enabled := False;

443
Client/UfrmRegionControl.lfm
View File

@ -1,20 +1,22 @@
object frmRegionControl: TfrmRegionControl object frmRegionControl: TfrmRegionControl
Left = 247 Left = 1069
Height = 413 Height = 390
Top = 139 Top = 110
Width = 620 Width = 620
ActiveControl = vstRegions Caption = 'Управление Регионами'
Caption = 'Region Control' ClientHeight = 390
ClientHeight = 413
ClientWidth = 620 ClientWidth = 620
Constraints.MinHeight = 390
Constraints.MinWidth = 620
Font.Height = -11 Font.Height = -11
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnResize = FormResize
OnShow = FormShow OnShow = FormShow
Position = poOwnerFormCenter Position = poOwnerFormCenter
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
LCLVersion = '0.9.29' LCLVersion = '0.9.30.2'
object sbArea: TScrollBox object sbArea: TScrollBox
AnchorSideLeft.Control = vstRegions AnchorSideLeft.Control = vstRegions
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
@ -23,11 +25,11 @@ object frmRegionControl: TfrmRegionControl
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnClose AnchorSideBottom.Control = btnClose
Left = 160 Left = 160
Height = 372 Height = 349
Top = 0 Top = 0
Width = 460 Width = 460
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
ClientHeight = 368 ClientHeight = 345
ClientWidth = 456 ClientWidth = 456
TabOrder = 0 TabOrder = 0
object pbArea: TPaintBox object pbArea: TPaintBox
@ -47,11 +49,11 @@ object frmRegionControl: TfrmRegionControl
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 548 Left = 548
Height = 25 Height = 25
Top = 380 Top = 357
Width = 64 Width = 64
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Caption = 'Close' Caption = 'Закрыть'
OnClick = btnCloseClick OnClick = btnCloseClick
TabOrder = 1 TabOrder = 1
end end
@ -61,11 +63,11 @@ object frmRegionControl: TfrmRegionControl
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 476 Left = 476
Height = 25 Height = 25
Top = 380 Top = 357
Width = 64 Width = 64
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
Caption = 'Save' Caption = 'Сохранить'
Enabled = False Enabled = False
OnClick = btnSaveClick OnClick = btnSaveClick
TabOrder = 2 TabOrder = 2
@ -84,7 +86,7 @@ object frmRegionControl: TfrmRegionControl
Header.Columns = < Header.Columns = <
item item
Position = 0 Position = 0
Text = 'Regions' Text = 'Регионы'
Width = 156 Width = 156
end> end>
Header.DefaultHeight = 17 Header.DefaultHeight = 17
@ -105,47 +107,46 @@ object frmRegionControl: TfrmRegionControl
AnchorSideBottom.Control = spRegionsArea AnchorSideBottom.Control = spRegionsArea
Left = 4 Left = 4
Height = 22 Height = 22
Hint = 'Add region' Hint = 'Добавить регион'
Top = 134 Top = 134
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Color = clBtnFace
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000464
0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84 000C025D0073025D00BA025D00CC025D00CC025D00CC025D00CC025D00CC025D
37FF000000000000000000000000000000000000000000000000000000000000 00CC025D00CC025D00CC025D00BA025D00730464000CFFFFFF00FFFFFF00066D
00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE 0073129208DD20CC10F922D911FF22D911FF22D911FF22D911FF22D911FF22D9
89FF368D42FF2C8134FF00000000000000000000000000000000000000000000 11FF22D911FF22D911FF1FCC0FF9109207DD066D0073FFFFFF00FFFFFF000A7D
0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB 00BA25CA15F922D111FF22D111FF22D111FF22D111FF22B611FF22B611FF22D1
98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000 11FF22D111FF22D111FF22D111FF20C80FF90A7D00BAFFFFFF00FFFFFF000C84
000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5 00CC2BCC1AFF22C811FF22C811FF22C811FF22BC11FFE8E8E8FFECECECFF22BC
6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000 11FF22C811FF22C811FF22C811FF22C811FF0C8400CCFFFFFF00FFFFFF000D89
000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8 00CC31C620FF22BE11FF22BE11FF22BE11FF22B511FFE4E4E4FFE8E8E8FF22B5
70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC 11FF22BE11FF22BE11FF22BE11FF23BE12FF0D8900CCFFFFFF00FFFFFF000E8D
75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8 00CC41C330FF23B412FF22A811FF22A811FF22A411FFE0E0E0FFE4E4E4FF22A4
70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF 11FF22A811FF22A811FF22B411FF25B514FF0E8D00CCFFFFFF00FFFFFF000F92
7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 00CC52C941FF33AF22FFD4D4D4FFD3D3D3FFD7D7D7FFDCDCDCFFE0E0E0FFE4E4
FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2 E4FFE8E8E8FFECECECFF22A611FF28AF17FF0F9200CCFFFFFF00FFFFFF001096
7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 00CC55CC44FF3CB32BFFF8F8F8FFE1E1E1FFD5D5D5FFD7D7D7FFDCDCDCFFE0E0
FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5 E0FFE4E4E4FFE8E8E8FF22A011FF2CAA1BFF109600CCFFFFFF00FFFFFF00119A
83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC 00CC5AD149FF47BE36FF3EB52DFF3EB52DFF37AE26FFEBEBEBFFE2E2E2FF259D
6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000 14FF239B12FF239B12FF279F16FF39B128FF119A00CCFFFFFF00FFFFFF00129E
000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD 00CC60D74FFF4EC53DFF4EC53DFF4EC53DFF44BB33FFFFFFFFFFFFFFFFFF44BB
85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000 33FF4EC53DFF4EC53DFF4EC53DFF58CF47FF129E00CCFFFFFF00FFFFFF0013A2
000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4 00CC67DE56FF57CE46FF57CE46FF57CE46FF4AC139FFFFFFFFFFFFFFFFFF4AC1
95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000 39FF57CE46FF57CE46FF57CE46FF60D74FFF13A200CCFFFFFF00FFFFFF0014A5
00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF 00BA64DE53F95FD64EFF5FD64EFF5FD64EFF5FD64EFF50C73FFF50C73FFF5FD6
AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000 4EFF5FD64EFF5FD64EFF5FD64EFF60DA4FF914A500BAFFFFFF00FFFFFF0014A8
0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD 007337C124DD66E054F96EE55DFF6EE55DFF6EE55DFF6EE55DFF6DE45CFF6DE4
B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000 5CFF6DE45CFF6DE45CFF64DF53F936BF23DD14A80073FFFFFF00FFFFFF0015A9
0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE 000C15AA007315AA00BA15AA00CC15AA00CC15AA00CC15AA00CC15AA00CC15AA
77FF000000000000000000000000000000000000000000000000000000000000 00CC15AA00CC15AA00CC15AA00BA15AA007315A9000CFFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0 NumGlyphs = 0
OnClick = mnuAddRegionClick OnClick = mnuAddRegionClick
@ -159,48 +160,47 @@ object frmRegionControl: TfrmRegionControl
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 30 Left = 30
Height = 22 Height = 22
Hint = 'Delete region' Hint = 'Удалить регион'
Top = 134 Top = 134
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E 640C00005D7300005DBA00005DCC00005DCC00005DCC00005DCC00005DCC0000
B8FF000000000000000000000000000000000000000000000000000000000000 5DCC00005DCC00005DCC00005DBA00005D730000640CFFFFFF00FFFFFF000000
000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111
E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D73FFFFFF00FFFFFF000000
0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 7DBA1616CBF91111D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111
EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 D1FF1111D1FF1111D1FF1111D1FF0F0FC8F900007DBAFFFFFF00FFFFFF000000
00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 84CC1C1CCEFF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 C8FF1111C8FF1111C8FF1111C8FF1111C8FF000084CCFFFFFF00FFFFFF000000
00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 89CC2222C8FF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 BEFF1111BEFF1111BEFF1111BEFF1212BEFF000089CCFFFFFF00FFFFFF000000
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 8DCC3434C7FF1212B4FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 A8FF1111A8FF1111A8FF1111B4FF1414B6FF00008DCCFFFFFF00FFFFFF000000
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 92CC4646CEFF2626B5FFD0D0D0FFCCCCCCFFD1D1D1FFDCDCDCFFE8E8E8FFEEEE
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 EEFFEEEEEEFFEEEEEEFF1111AAFF1818B0FF000092CCFFFFFF00FFFFFF000000
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 96CC4A4AD2FF3333BBFFF8F8F8FFDEDEDEFFCECECEFFD1D1D1FFDCDCDCFFE8E8
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A E8FFEEEEEEFFEEEEEEFF1111A1FF1D1DACFF000096CCFFFFFF00FFFFFF000000
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F 9ACC5050D8FF3737BFFF3737BFFF3737BFFF3232BAFF2727B0FF1C1CA6FF1616
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 A0FF12129CFF12129CFF1616A0FF2B2BB5FF00009ACCFFFFFF00FFFFFF000000
00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 9ECC5A5AE2FF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 CAFF4242CAFF4242CAFF4242CAFF4E4ED6FF00009ECCFFFFFF00FFFFFF000000
00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 A2CC6262EAFF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4F
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 D7FF4F4FD7FF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CCFFFFFF00FFFFFF000000
0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B
FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BAFFFFFF00FFFFFF000000
000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D
F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A873FFFFFF00FFFFFF000000
000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000
D9FF000000000000000000000000000000000000000000000000000000000000 AACC0000AACC0000AACC0000AABA0000AA730000A90CFFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0 NumGlyphs = 0
OnClick = mnuDeleteRegionClick OnClick = mnuDeleteRegionClick
@ -215,7 +215,7 @@ object frmRegionControl: TfrmRegionControl
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDeleteArea AnchorSideBottom.Control = btnDeleteArea
Left = 4 Left = 4
Height = 124 Height = 97
Top = 179 Top = 179
Width = 152 Width = 152
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@ -247,7 +247,7 @@ object frmRegionControl: TfrmRegionControl
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
Caption = 'Area:' Caption = 'Область:'
ParentColor = False ParentColor = False
end end
object spRegionsArea: TSplitter object spRegionsArea: TSplitter
@ -269,47 +269,46 @@ object frmRegionControl: TfrmRegionControl
AnchorSideRight.Control = btnDeleteArea AnchorSideRight.Control = btnDeleteArea
Left = 43 Left = 43
Height = 22 Height = 22
Hint = 'Add area' Hint = 'Добавить область'
Top = 307 Top = 280
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000464
0000000000000000000000000000000000003A8C44FF368940FF32873CFF2F84 000C025D0073025D00BA025D00CC025D00CC025D00CC025D00CC025D00CC025D
37FF000000000000000000000000000000000000000000000000000000000000 00CC025D00CC025D00CC025D00BA025D00730464000CFFFFFF00FFFFFF00066D
00000000000000000000459653FF419950FF7DC28FFF96D0A6FF96CFA6FF78BE 0073129208DD20CC10F922D911FF22D911FF22D911FF22D911FF22D911FF22D9
89FF368D42FF2C8134FF00000000000000000000000000000000000000000000 11FF22D911FF22D911FF1FCC0FF9109207DD066D0073FFFFFF00FFFFFF000A7D
0000000000004D9C5DFF64B478FFA8DBB5FF87CC98FF66BC7DFF64BA7CFF86CB 00BA25CA15F922D111FF22D111FF22D111FF22D111FF22B611FF22B611FF22D1
98FFA5D9B4FF58AA6BFF2C8134FF000000000000000000000000000000000000 11FF22D111FF22D111FF22D111FF20C80FF90A7D00BAFFFFFF00FFFFFF000C84
000056A366FF6AB97DFFA8DBB2FF60BC77FF5CBA73FF59B870FF59B56FFF58B5 00CC2BCC1AFF22C811FF22C811FF22C811FF22BC11FFE8E8E8FFECECECFF22BC
6FFF5BB774FFA5D9B3FF5AAA6CFF2C8234FF0000000000000000000000000000 11FF22C811FF22C811FF22C811FF22C811FF0C8400CCFFFFFF00FFFFFF000D89
000053AB68FFAADDB4FF64C179FF5FBE71FF60BC77FFFFFFFFFFFFFFFFFF59B8 00CC31C620FF22BE11FF22BE11FF22BE11FF22B511FFE4E4E4FFE8E8E8FF22B5
70FF58B56EFF5CB774FFA6DAB4FF388F43FF00000000000000000000000061AC 11FF22BE11FF22BE11FF22BE11FF23BE12FF0D8900CCFFFFFF00FFFFFF000E8D
75FF8ACC98FF89D396FF6BC67AFF63C170FF55AB65FFFFFFFFFFFFFFFFFF59B8 00CC41C330FF23B412FF22A811FF22A811FF22A411FFE0E0E0FFE4E4E4FF22A4
70FF59B870FF5BB972FF85CC97FF7BBE8DFF308539FF000000000000000065AF 11FF22A811FF22A811FF22B411FF25B514FF0E8D00CCFFFFFF00FFFFFF000F92
7AFFA9DDB3FF7DCF8AFF75CC81FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 00CC52C941FF33AF22FFD4D4D4FFD3D3D3FFD7D7D7FFDCDCDCFFE0E0E0FFE4E4
FFFFFFFFFFFF59B870FF67BE7DFF9CD4ABFF34883DFF000000000000000069B2 E4FFE8E8E8FFECECECFF22A611FF28AF17FF0F9200CCFFFFFF00FFFFFF001096
7EFFB6E2BEFF8BD597FF7AC986FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 00CC55CC44FF3CB32BFFF8F8F8FFE1E1E1FFD5D5D5FFD7D7D7FFDCDCDCFFE0E0
FFFFFFFFFFFF59B870FF69C17EFF9DD4AAFF388B42FF00000000000000006DB5 E0FFE4E4E4FFE8E8E8FF22A011FF2CAA1BFF109600CCFFFFFF00FFFFFF00119A
83FFACDDB6FFA6DFAFFF81CB8CFF7CC986FF6EBD79FFFFFFFFFFFFFFFFFF5BAC 00CC5AD149FF47BE36FF3EB52DFF3EB52DFF37AE26FFEBEBEBFFE2E2E2FF259D
6AFF60BC77FF5CBA73FF8BD199FF80C592FF3C8E47FF00000000000000000000 14FF239B12FF239B12FF279F16FF39B128FF119A00CCFFFFFF00FFFFFF00129E
000085C797FFD2EED7FF95D9A0FF8AD394FF7FC889FFFFFFFFFFFFFFFFFF79CD 00CC60D74FFF4EC53DFF4EC53DFF4EC53DFF44BB33FFFFFFFFFFFFFFFFFF44BB
85FF6BC37CFF6FC77EFFACDFB5FF459E57FF0000000000000000000000000000 33FF4EC53DFF4EC53DFF4EC53DFF58CF47FF129E00CCFFFFFF00FFFFFF0013A2
000070B887FFAADAB7FFD8F1DCFF92D89DFF88CD93FF84CC8EFF8BD496FF8AD4 00CC67DE56FF57CE46FF57CE46FF57CE46FF4AC139FFFFFFFFFFFFFFFFFF4AC1
95FF83D28EFFAFE0B7FF6BB97DFF489856FF0000000000000000000000000000 39FF57CE46FF57CE46FF57CE46FF60D74FFF13A200CCFFFFFF00FFFFFF0014A5
00000000000070B887FFAFDCBBFFDCF2E0FFB6E4BDFF9BDBA5FF96D9A0FFA5DF 00BA64DE53F95FD64EFF5FD64EFF5FD64EFF5FD64EFF50C73FFF50C73FFF5FD6
AFFFC0E8C5FF79C28AFF509E5FFF000000000000000000000000000000000000 4EFF5FD64EFF5FD64EFF5FD64EFF60DA4FF914A500BAFFFFFF00FFFFFF0014A8
0000000000000000000071B887FF94CEA4FFC3E6CBFFCFEBD4FFC9E9CEFFAFDD 007337C124DD66E054F96EE55DFF6EE55DFF6EE55DFF6EE55DFF6DE45CFF6DE4
B8FF6DB97FFF58A569FF00000000000000000000000000000000000000000000 5CFF6DE45CFF6DE45CFF64DF53F936BF23DD14A80073FFFFFF00FFFFFF0015A9
0000000000000000000000000000000000006EB684FF6AB380FF67B17CFF63AE 000C15AA007315AA00BA15AA00CC15AA00CC15AA00CC15AA00CC15AA00CC15AA
77FF000000000000000000000000000000000000000000000000000000000000 00CC15AA00CC15AA00CC15AA00BA15AA007315A9000CFFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0 NumGlyphs = 0
OnClick = btnAddAreaClick OnClick = btnAddAreaClick
@ -322,49 +321,48 @@ object frmRegionControl: TfrmRegionControl
AnchorSideBottom.Control = seX1 AnchorSideBottom.Control = seX1
Left = 69 Left = 69
Height = 22 Height = 22
Hint = 'Delete area' Hint = 'Удалить область'
Top = 307 Top = 280
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
0000000000000000000000000000000000003853BEFF3551BDFF304BBCFF2E4E 640C00005D7300005DBA00005DCC00005DCC00005DCC00005DCC00005DCC0000
B8FF000000000000000000000000000000000000000000000000000000000000 5DCC00005DCC00005DCC00005DBA00005D730000640CFFFFFF00FFFFFF000000
000000000000000000004255C6FF3C52CCFF757AE8FF8F92EEFF8F92EEFF7178 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111
E4FF334DC1FF2B4AB7FF00000000000000000000000000000000000000000000 D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D73FFFFFF00FFFFFF000000
0000000000004959CBFF5C65E0FFA1A6F5FF7E86EFFF5B63E9FF595DE7FF7D84 7DBA1616CBF91111D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111D1FF1111
EEFF9EA0F4FF515DD7FF2B4AB7FF000000000000000000000000000000000000 D1FF1111D1FF1111D1FF1111D1FF0F0FC8F900007DBAFFFFFF00FFFFFF000000
00005361CFFF616BE3FFA1ACF5FF545FECFF505CEAFF4D59E9FF4E59E6FF4C56 84CC1C1CCEFF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111C8FF1111
E6FF5056E6FF9EA2F4FF5460D6FF2A4AB8FF0000000000000000000000000000 C8FF1111C8FF1111C8FF1111C8FF1111C8FF000084CCFFFFFF00FFFFFF000000
00004B56DBFFA2ABF6FF5664F0FF5266EEFF4D59E9FF4D59E9FF4D59E9FF4D59 89CC2222C8FF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111BEFF1111
E9FF4C58E6FF525AE6FF9FA3F5FF3450C4FF0000000000000000000000005C62 BEFF1111BEFF1111BEFF1111BEFF1212BEFF000089CCFFFFFF00FFFFFF000000
D7FF818CEEFF7E91F7FF5D73F3FF4D59E9FF4D59E9FF4D59E9FF4D59E9FF4D59 8DCC3434C7FF1212B4FF1111A8FF1111A8FF1111A8FF1111A8FF1111A8FF1111
E9FF4D59E9FF4F5BE9FF7B83F0FF757BE2FF2E4BBAFF00000000000000005F63 A8FF1111A8FF1111A8FF1111B4FF1414B6FF00008DCCFFFFFF00FFFFFF000000
DAFFA1ABF7FF7086F8FF6882F6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 92CC4646CEFF2626B5FFD0D0D0FFCCCCCCFFD1D1D1FFDCDCDCFFE8E8E8FFEEEE
FFFFFFFFFFFF4D59E9FF5C66EAFF969CF1FF3250BCFF00000000000000006469 EEFFEEEEEEFFEEEEEEFF1111AAFF1818B0FF000092CCFFFFFF00FFFFFF000000
DBFFAFB9F9FF7F93FAFF7085F0FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF 96CC4A4AD2FF3333BBFFF8F8F8FFDEDEDEFFCECECEFFD1D1D1FFDCDCDCFFE8E8
FFFFFFFFFFFF4D59E9FF5E6AEEFF969DF1FF364FBEFF0000000000000000676A E8FFEEEEEEFFEEEEEEFF1111A1FF1D1DACFF000096CCFFFFFF00FFFFFF000000
DEFFA5AFF5FF9DABFAFF778CF0FF545FECFF545FECFF545FECFF545FECFF545F 9ACC5050D8FF3737BFFF3737BFFF3737BFFF3232BAFF2727B0FF1C1CA6FF1616
ECFF545FECFF6377F2FF818EF4FF787FE9FF3A53C0FF00000000000000000000 A0FF12129CFF12129CFF1616A0FF2B2BB5FF00009ACCFFFFFF00FFFFFF000000
00007D83EAFFCDD4FCFF8B9DFAFF7E93F7FF758AEEFF6C84F6FF6C84F6FF6C84 9ECC5A5AE2FF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242CAFF4242
F6FF6C84F6FF6379F3FFA4AFF8FF3E4FD0FF0000000000000000000000000000 CAFF4242CAFF4242CAFF4242CAFF4E4ED6FF00009ECCFFFFFF00FFFFFF000000
00006A69E0FFA3A7F3FFD4DBFDFF879AFAFF7F91F0FF7A8EF1FF7F94F8FF7E92 A2CC6262EAFF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4FD7FF4F4F
F9FF768CF8FFA8B6F8FF636EE3FF4557C7FF0000000000000000000000000000 D7FF4F4FD7FF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CCFFFFFF00FFFFFF000000
0000000000006A69E0FFAAADF2FFD8DCFDFFAEBAFAFF91A3FAFF8B9DFAFF9CA9 A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B
FBFFBAC7FCFF707BE9FF4C5BCCFF000000000000000000000000000000000000 E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BAFFFFFF00FFFFFF000000
000000000000000000006A6ADFFF8E93EDFFBEC3F8FFCCD3F9FFC4CBF9FFAAB4 A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D
F4FF6670E2FF535ED1FF00000000000000000000000000000000000000000000 F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A873FFFFFF00FFFFFF000000
000000000000000000000000000000000000686ADDFF6364DCFF6164DAFF5D63 A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000
D9FF000000000000000000000000000000000000000000000000000000000000 AACC0000AACC0000AACC0000AABA0000AA730000A90CFFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0 NumGlyphs = 0
OnClick = btnDeleteAreaClick OnClick = btnDeleteAreaClick
@ -377,46 +375,45 @@ object frmRegionControl: TfrmRegionControl
AnchorSideTop.Control = btnDeleteArea AnchorSideTop.Control = btnDeleteArea
Left = 95 Left = 95
Height = 22 Height = 22
Hint = 'Delete all areas' Hint = 'Удалить все области'
Top = 307 Top = 280
Width = 22 Width = 22
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000
000000000000000000000000F1FF0000F1FF0000F1FF0000F1FF0000EFFF0000 640C00005D7300005DBA00005DCC00005DCC00005DCC00005DCC00005DCC0000
EFFF0000EDFF0000EDFF00000000000000000000000000000000000000000000 5DCC00005DCC00005DCC00005DBA00005D730000640CFFFFFF00FFFFFF000000
0000000000000000F5FF1A20F5FF3C4CF9FF3A49F8FF3847F8FF3545F8FF3443 6D73080893DD1010CCF91111D9FF1111D9FF1111D9FF1111D9FF1111D9FF1111
F7FF3242F7FF141BF1FF0000EDFF000000000000000000000000000000000000 D9FF1111D9FF1111D9FF0F0FCCF9070792DD00006D73FFFFFF00FFFFFF000000
00000000F7FF1D23F9FF4453FAFF2429F9FF1212F7FF0F0FF6FF0C0CF5FF0909 7DBA1616CBF91111D1FF1111D1FF1111B6FF1111D1FF1111D1FF1111D1FF1111
F5FF161BF5FF3343F7FF141BF1FF0000EDFF0000000000000000000000000000 D1FF1111B6FF1111D1FF1111D1FF0F0FC8F900007DBAFFFFFF00FFFFFF000000
F9FF1F25FAFF4A58FBFF4247FBFFC9C9FDFF3B3BF9FF1313F7FF1010F6FF3333 84CC1C1CCEFF1111C8FF1111B2FFDCDCDCFF1111B2FF1111C8FF1111C8FF1111
F7FFC5C5FDFF3035F7FF3444F7FF141BF2FF0000EDFF00000000000000000000 B2FFEEEEEEFF1111B2FF1111C8FF1111C8FF000084CCFFFFFF00FFFFFF000000
FBFF4F5DFDFF3237FBFFCBCBFEFFF2F2FFFFEBEBFEFF3B3BF9FF3939F8FFEAEA 89CC2222C8FF1111BEFFD1D1D1FFD6D6D6FFDCDCDCFF1111ADFF1111ADFFEAEA
FEFFF1F1FEFFC5C5FDFF181DF6FF3343F7FF0000EFFF00000000000000000000 EAFFEEEEEEFFEEEEEEFF1111BEFF1212BEFF000089CCFFFFFF00FFFFFF000000
FDFF525FFDFF2828FCFF4747FCFFECECFFFFF2F2FFFFECECFFFFECECFEFFF1F1 8DCC3434C7FF1212B4FF1111B4FFD1D1D1FFD6D6D6FFDCDCDCFFE2E2E2FFE6E6
FFFFEAEAFEFF3434F7FF0B0BF5FF3545F8FF0000EFFF00000000000000000000 E6FFEAEAEAFF1111B4FF1111B4FF1414B6FF00008DCCFFFFFF00FFFFFF000000
FDFF5562FEFF2C2CFDFF2929FCFF4848FCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC 92CC4646CEFF2626B5FF1414ABFF1111AAFFD1D1D1FFD6D6D6FFDCDCDCFFE2E2
FEFF3A3AF9FF1212F7FF0F0FF6FF3848F8FF0000F1FF00000000000000000000 E2FF1111AAFF1111AAFF1111AAFF1818B0FF000092CCFFFFFF00FFFFFF000000
FDFF5764FEFF3030FDFF2D2DFDFF4B4BFCFFEDEDFFFFF2F2FFFFF2F2FFFFECEC 96CC4A4AD2FF3333BBFF2E2EB8FF13139FFFCECECEFFD1D1D1FFD6D6D6FFDCDC
FFFF3D3DF9FF1616F8FF1313F7FF3C4BF8FF0000F1FF00000000000000000000 DCFF11119EFF1111A1FF1111A1FF1D1DACFF000096CCFFFFFF00FFFFFF000000
FFFF5A67FEFF3333FEFF5050FDFFEDEDFFFFF3F3FFFFEDEDFFFFEDEDFFFFF2F2 9ACC5050D8FF3737BFFF2323ABFFFFFFFFFFF7F7F7FFE8E8E8FFDEDEDEFFDBDB
FFFFECECFEFF3E3EFAFF1717F8FF3F4EF9FF0000F1FF00000000000000000000 DBFFDDDDDDFF11119BFF1616A0FF2B2BB5FF00009ACCFFFFFF00FFFFFF000000
FFFF5B68FFFF4347FEFFCFCFFFFFF3F3FFFFEDEDFFFF4C4CFCFF4A4AFCFFECEC 9ECC5A5AE2FF4242CAFFFFFFFFFFFFFFFFFFFFFFFFFF4242CAFF4242CAFFFFFF
FFFFF2F2FFFFCACAFEFF2A2FFAFF4251FAFF0000F3FF00000000000000000000 FFFFFFFFFFFFFFFFFFFF4242CAFF4E4ED6FF00009ECCFFFFFF00FFFFFF000000
FFFF262BFFFF5D6AFFFF585BFFFFCFCFFFFF5252FEFF2F2FFDFF2C2CFDFF4B4B A2CC6262EAFF4F4FD7FF4F4FD7FFFFFFFFFF4F4FD7FF4F4FD7FF4F4FD7FF4F4F
FCFFCCCCFEFF484CFBFF4957FBFF1D23F9FF0000F5FF00000000000000000000 D7FFFFFFFFFF4F4FD7FF4F4FD7FF5A5AE2FF0000A2CCFFFFFF00FFFFFF000000
00000000FFFF262BFFFF5D6AFFFF4347FFFF3434FEFF3232FEFF3030FDFF2D2D A5BA6060ECF95B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5B
FDFF383CFCFF4F5DFCFF1F25FAFF0000F7FF0000000000000000000000000000 E3FF5B5BE3FF5B5BE3FF5B5BE3FF5B5BE7F90000A5BAFFFFFF00FFFFFF000000
0000000000000000FFFF262BFFFF5C69FFFF5B68FFFF5A67FEFF5865FEFF5663 A8732A2AC7DD6363EFF96D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6DF5FF6D6D
FEFF5461FEFF2227FCFF0000FBFF000000000000000000000000000000000000 F5FF6D6DF5FF6C6CF4FF6262EEF92929C5DD0000A873FFFFFF00FFFFFF000000
000000000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FDFF0000 A90C0000AA730000AABA0000AACC0000AACC0000AACC0000AACC0000AACC0000
FDFF0000FDFF0000FDFF00000000000000000000000000000000000000000000 AACC0000AACC0000AACC0000AABA0000AA730000A90CFFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
0000000000000000000000000000000000000000000000000000 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0 NumGlyphs = 0
OnClick = btnClearAreaClick OnClick = btnClearAreaClick
@ -429,8 +426,9 @@ object frmRegionControl: TfrmRegionControl
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 14 Height = 14
Top = 339 Top = 313
Width = 8 Width = 7
AutoSize = False
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Caption = 'X' Caption = 'X'
Enabled = False Enabled = False
@ -439,11 +437,12 @@ object frmRegionControl: TfrmRegionControl
object seX1: TSpinEdit object seX1: TSpinEdit
AnchorSideLeft.Control = seY1 AnchorSideLeft.Control = seY1
AnchorSideBottom.Control = seY1 AnchorSideBottom.Control = seY1
Left = 20 Left = 18
Height = 19 Height = 21
Top = 337 Top = 310
Width = 50 Width = 50
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
AutoSize = False
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Enabled = False Enabled = False
OnChange = seX1Change OnChange = seX1Change
@ -454,10 +453,11 @@ object frmRegionControl: TfrmRegionControl
AnchorSideLeft.Control = seX1 AnchorSideLeft.Control = seX1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seX1 AnchorSideTop.Control = seX1
Left = 78 Left = 76
Height = 19 Height = 21
Top = 337 Top = 310
Width = 50 Width = 50
AutoSize = False
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Enabled = False Enabled = False
OnChange = seX1Change OnChange = seX1Change
@ -470,8 +470,9 @@ object frmRegionControl: TfrmRegionControl
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 14 Height = 14
Top = 366 Top = 342
Width = 8 Width = 6
AutoSize = False
Caption = 'Y' Caption = 'Y'
Enabled = False Enabled = False
ParentColor = False ParentColor = False
@ -482,11 +483,12 @@ object frmRegionControl: TfrmRegionControl
AnchorSideRight.Control = seX1 AnchorSideRight.Control = seX1
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnGrab1 AnchorSideBottom.Control = btnGrab1
Left = 20 Left = 18
Height = 19 Height = 21
Top = 364 Top = 339
Width = 50 Width = 50
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akBottom]
AutoSize = False
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Enabled = False Enabled = False
OnChange = seX1Change OnChange = seX1Change
@ -499,11 +501,12 @@ object frmRegionControl: TfrmRegionControl
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = seX2 AnchorSideRight.Control = seX2
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 78 Left = 76
Height = 19 Height = 21
Top = 364 Top = 339
Width = 50 Width = 50
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
AutoSize = False
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Enabled = False Enabled = False
OnChange = seX1Change OnChange = seX1Change
@ -515,14 +518,13 @@ object frmRegionControl: TfrmRegionControl
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 34 Left = 32
Height = 22 Height = 22
Hint = 'Grab coordinates from the main window.' Hint = 'Выбрать тайл в главном окне и взять его координаты.'
Top = 387 Top = 364
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -570,13 +572,12 @@ object frmRegionControl: TfrmRegionControl
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideBottom.Control = btnGrab1 AnchorSideBottom.Control = btnGrab1
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 92 Left = 90
Height = 22 Height = 22
Hint = 'Grab coordinates from the main window.' Hint = 'Выбрать тайл в главном окне и взять его координаты.'
Top = 387 Top = 364
Width = 22 Width = 22
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
Color = clBtnFace
Enabled = False Enabled = False
Glyph.Data = { Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100 36040000424D3604000000000000360000002800000010000000100000000100
@ -623,11 +624,11 @@ object frmRegionControl: TfrmRegionControl
left = 48 left = 48
top = 43 top = 43
object mnuAddRegion: TMenuItem object mnuAddRegion: TMenuItem
Caption = 'Add' Caption = 'Добавить'
OnClick = mnuAddRegionClick OnClick = mnuAddRegionClick
end end
object mnuDeleteRegion: TMenuItem object mnuDeleteRegion: TMenuItem
Caption = 'Delete' Caption = 'Удалить'
Enabled = False Enabled = False
OnClick = mnuDeleteRegionClick OnClick = mnuDeleteRegionClick
end end

50
Client/UfrmRegionControl.pas
View File

@ -77,6 +77,7 @@ type
vstRegions: TVirtualStringTree; vstRegions: TVirtualStringTree;
procedure btnGrab1Click(Sender: TObject); procedure btnGrab1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormResize(Sender: TObject);
procedure mnuAddRegionClick(Sender: TObject); procedure mnuAddRegionClick(Sender: TObject);
procedure mnuDeleteRegionClick(Sender: TObject); procedure mnuDeleteRegionClick(Sender: TObject);
procedure btnAddAreaClick(Sender: TObject); procedure btnAddAreaClick(Sender: TObject);
@ -121,6 +122,15 @@ type
property OnRegionModified: TRegionModifiedEvent read FOnRegionModified write FOnRegionModified; property OnRegionModified: TRegionModifiedEvent read FOnRegionModified write FOnRegionModified;
property OnRegionDeleted: TRegionDeletedEvent read FOnRegionDeleted write FOnRegionDeleted; property OnRegionDeleted: TRegionDeletedEvent read FOnRegionDeleted write FOnRegionDeleted;
property OnRegionList: TRegionListEvent read FOnRegionList write FOnRegionList; property OnRegionList: TRegionListEvent read FOnRegionList write FOnRegionList;
public
lbDlgUnsaveCaption: string;
lbDlgUnsave: string;
lbDlgDelConfCaption: string;
lbDlgDelConf: string;
lbDlgNewExistsCaption: string;
lbDlgNewExists: string;
lbNewInputQueryCaption: string;
lbNewInputQuery: string;
end; end;
var var
@ -130,7 +140,7 @@ implementation
uses uses
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils, UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils,
UAdminHandling, UPacketHandlers; UAdminHandling, UPacketHandlers, Language;
type type
{ TModifyRegionPacket } { TModifyRegionPacket }
@ -195,6 +205,8 @@ end;
procedure TfrmRegionControl.FormCreate(Sender: TObject); procedure TfrmRegionControl.FormCreate(Sender: TObject);
begin begin
LanguageTranslate(Self);
pbArea.Width := frmRadarMap.Radar.Width; pbArea.Width := frmRadarMap.Radar.Width;
pbArea.Height := frmRadarMap.Radar.Height; pbArea.Height := frmRadarMap.Radar.Height;
seX1.MaxValue := ResMan.Landscape.CellWidth; seX1.MaxValue := ResMan.Landscape.CellWidth;
@ -202,6 +214,18 @@ begin
seY1.MaxValue := ResMan.Landscape.CellHeight; seY1.MaxValue := ResMan.Landscape.CellHeight;
seY2.MaxValue := ResMan.Landscape.CellHeight; seY2.MaxValue := ResMan.Landscape.CellHeight;
Constraints.MaxWidth := 4 + Width - sbArea.ClientWidth + pbArea.Width + sbArea.VertScrollBar.Size;
Width := Constraints.MaxWidth;
Height := Height - sbArea.ClientHeight + frmRadarMap.Radar.Height;
if (Width >= frmMain.Width) then begin
Left := frmMain.Left;
Width := frmMain.Width;
end;
if (Height >= frmMain.Height) then begin
Top := frmMain.Top;
Height:= frmMain.Height;
end;
vstArea.NodeDataSize := SizeOf(TRect); vstArea.NodeDataSize := SizeOf(TRect);
vstRegions.NodeDataSize := SizeOf(TRegionInfo); vstRegions.NodeDataSize := SizeOf(TRegionInfo);
@ -274,7 +298,7 @@ var
regionInfo: PRegionInfo; regionInfo: PRegionInfo;
begin begin
regionName := ''; regionName := '';
if InputQuery('New Region', 'Enter the name for the new region:', regionName) then if InputQuery(lbNewInputQueryCaption, lbNewInputQuery, regionName) then
begin begin
CheckUnsaved; CheckUnsaved;
@ -289,8 +313,7 @@ begin
btnSave.Enabled := True; btnSave.Enabled := True;
end else end else
begin begin
MessageDlg('New Region', 'The region could not be added. A region with ' + MessageDlg(lbDlgNewExistsCaption, lbDlgNewExists, mtError, [mbOK], 0);
'that name already exists.', mtError, [mbOK], 0);
end; end;
end; end;
end; end;
@ -301,6 +324,16 @@ begin
CheckUnsaved; CheckUnsaved;
end; end;
procedure TfrmRegionControl.FormResize(Sender: TObject);
var maxW: Integer;
begin
seY1.Update; seY1.Repaint;
seX1.Update; seX1.Repaint;
seX2.Update; seX2.Repaint;
seY2.Update; seY2.Repaint;
end;
procedure TfrmRegionControl.btnGrab1Click(Sender: TObject); procedure TfrmRegionControl.btnGrab1Click(Sender: TObject);
begin begin
FSelectFirst := (Sender = btnGrab1); FSelectFirst := (Sender = btnGrab1);
@ -316,8 +349,8 @@ var
regionInfo: PRegionInfo; regionInfo: PRegionInfo;
begin begin
regionNode := vstRegions.GetFirstSelected; regionNode := vstRegions.GetFirstSelected;
if (regionNode <> nil) and (MessageDlg('Delete Region', 'Are you sure, you ' + if (regionNode <> nil) and (MessageDlg(lbDlgDelConfCaption, lbDlgDelConf,
'want to delete the selected region?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
begin begin
regionInfo := vstRegions.GetNodeData(regionNode); regionInfo := vstRegions.GetNodeData(regionNode);
dmNetwork.Send(TDeleteRegionPacket.Create(regionInfo^.Name)); dmNetwork.Send(TDeleteRegionPacket.Create(regionInfo^.Name));
@ -577,7 +610,7 @@ var
regionInfo: PRegionInfo; regionInfo: PRegionInfo;
begin begin
regionInfo := Sender.GetNodeData(Node); regionInfo := Sender.GetNodeData(Node);
CellText := UTF8Encode(regionInfo^.Name); CellText := regionInfo^.Name;
end; end;
function TfrmRegionControl.FindRegion(AName: string): PVirtualNode; function TfrmRegionControl.FindRegion(AName: string): PVirtualNode;
@ -601,8 +634,7 @@ procedure TfrmRegionControl.CheckUnsaved;
begin begin
if btnSave.Enabled then if btnSave.Enabled then
begin begin
if MessageDlg('Unsaved changes', 'There are unsaved ' + if MessageDlg(lbDlgUnsaveCaption, lbDlgUnsave,
'changes.' + #13#10+#13#10+ 'Do you want to save them now?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes then mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin begin
btnSaveClick(nil); btnSaveClick(nil);

281
Client/UndoRedoCmd.pas Normal file
View File

@ -0,0 +1,281 @@
unit UndoRedoCmd;
interface
uses
Classes, SysUtils, VirtualTrees;
type
IUndoRedoCommand = interface (IUnknown)
['{D84BFD00-8396-11D6-B4FA-000021D960D4}']
procedure Execute;
procedure Redo;
procedure Undo;
end;
IUndoRedoCommandGroup = interface (IUndoRedoCommand)
['{9169AE00-839B-11D6-B4FA-000021D960D4}']
function GetUndoRedoCommands: TInterfaceList;
property UndoRedoCommands: TInterfaceList read GetUndoRedoCommands;
end;
TUndoRedoCommandGroup = class (TInterfacedObject, IUndoRedoCommandGroup,
IUndoRedoCommand)
private
FList: TInterfaceList;
FCanRedo: Boolean;
public
constructor Create;
destructor Destroy; override;
procedure Add(const AUndoRedoCommand: IUndoRedoCommand);
procedure Execute;
function GetUndoRedoCommands: TInterfaceList;
procedure Redo;
procedure Undo;
property UndoRedoCommands: TInterfaceList read GetUndoRedoCommands;
end;
TUndoRedoManager = class (TObject)
private
FRedoList: TInterfaceList;
FUndoList: TInterfaceList;
FTransactLevel: Integer;
FTransaction: IUndoRedoCommandGroup;
function GetCanRedo: Integer;
function GetCanUndo: Integer;
public
Enabled: Boolean;
constructor Create;
destructor Destroy; override;
procedure BeginTransaction;
procedure EndTransaction;
procedure ExecCommand(const AUndoRedoCommand: IUndoRedoCommand);
procedure Redo(RedoCount: Integer = 1);
procedure Undo(UndoCount: Integer = 1);
property CanRedo: Integer read GetCanRedo;
property CanUndo: Integer read GetCanUndo;
end;
TUndoRedoSelectVirtualNodeCommand = class (TInterfacedObject, IUndoRedoCommand)
private
m_UndoRedoManag : TUndoRedoManager;
m_VirtualTree: TBaseVirtualTree;
m_VirtualNode: PVirtualNode;
m_ForwardDir : Boolean;
public
constructor Create(UndoRedoManag: TUndoRedoManager; VirtualTree: TBaseVirtualTree; VirtualNode: PVirtualNode);
//destructor Destroy; override;
procedure Execute;
procedure Redo;
procedure Undo;
end;
implementation
{
**************************** TCommands Types ***********************************
}
constructor TUndoRedoSelectVirtualNodeCommand.Create(
UndoRedoManag: TUndoRedoManager; VirtualTree: TBaseVirtualTree; VirtualNode: PVirtualNode);
begin
m_UndoRedoManag := UndoRedoManag;
m_VirtualTree := VirtualTree;
m_VirtualNode := VirtualNode;
m_ForwardDir := VirtualTree.Selected[VirtualNode];
end;
procedure TUndoRedoSelectVirtualNodeCommand.Execute;
begin
end;
procedure TUndoRedoSelectVirtualNodeCommand.Redo;
begin
m_UndoRedoManag.Enabled := False;
m_VirtualTree.Selected[m_VirtualNode] := m_ForwardDir;
m_UndoRedoManag.Enabled := True;
end;
procedure TUndoRedoSelectVirtualNodeCommand.Undo;
begin
m_UndoRedoManag.Enabled := False;
//m_VirtualTree.Selected[m_VirtualNode] := not m_ForwardDir;
if m_ForwardDir
then m_VirtualTree.Selected[m_VirtualNode] := False
else m_VirtualTree.Selected[m_VirtualNode] := True;
m_UndoRedoManag.Enabled := True;
end;
{
**************************** TUndoRedoCommandGroup *****************************
}
constructor TUndoRedoCommandGroup.Create;
begin
inherited Create;
FList:= TInterfaceList.Create;
end;
destructor TUndoRedoCommandGroup.Destroy;
begin
FList.Free;
inherited Destroy;
end;
procedure TUndoRedoCommandGroup.Add(const AUndoRedoCommand: IUndoRedoCommand);
begin
FList.Add(AUndoRedoCommand);
end;
procedure TUndoRedoCommandGroup.Execute;
var
I: Integer;
begin
for I:= 0 to FList.Count-1 do
(FList[I] as IUndoRedoCommand).Execute;
end;
function TUndoRedoCommandGroup.GetUndoRedoCommands: TInterfaceList;
begin
Result:= FList;
end;
procedure TUndoRedoCommandGroup.Redo;
var
I: Integer;
begin
if FCanRedo then
begin
for I:= 0 to FList.Count-1 do
(FList[I] as IUndoRedoCommand).Redo;
FCanRedo:= False;
end
else
raise Exception.Create('Must call TUndoRedoCommandGroup.Undo before calling Redo.');
end;
procedure TUndoRedoCommandGroup.Undo;
var
I: Integer;
begin
if FCanRedo then
raise Exception.Create('TUndoRedoCommandGroup.Undo already called');
for I:= FList.Count-1 downto 0 do
(FList[I] as IUndoRedoCommand).Undo;
FCanRedo:= True;
end;
{
******************************* TUndoRedoManager *******************************
}
constructor TUndoRedoManager.Create;
begin
inherited Create;
FRedoList:= TInterfaceList.Create;
FUndoList:= TInterfaceList.Create;
Enabled := True;
end;
destructor TUndoRedoManager.Destroy;
begin
FRedoList.Free;
FUndoList.Free;
inherited Destroy;
end;
procedure TUndoRedoManager.BeginTransaction;
begin
Inc(FTransactLevel);
if FTransactLevel = 1 then
FTransaction:= TUndoRedoCommandGroup.Create;
end;
procedure TUndoRedoManager.EndTransaction;
begin
Dec(FTransactLevel);
if (FTransactLevel = 0) then
begin
if FTransaction.UndoRedoCommands.Count > 0 then
begin
FRedoList.Clear;
FUndoList.Add(FTransaction);
end;
FTransaction:= nil;
end
else if FTransactLevel < 0 then
raise Exception.Create('Unmatched TUndoRedoManager.BeginTransaction and EndTransaction');
end;
procedure TUndoRedoManager.ExecCommand(const AUndoRedoCommand: IUndoRedoCommand);
begin
if Enabled then begin
BeginTransaction;
try
FTransaction.UndoRedoCommands.Add(AUndoRedoCommand);
AUndoRedoCommand.Execute;
finally
EndTransaction;
end;
end;
end;
function TUndoRedoManager.GetCanRedo: Integer;
begin
Result:= FRedoList.Count;
end;
function TUndoRedoManager.GetCanUndo: Integer;
begin
Result:= FUndoList.Count;
end;
procedure TUndoRedoManager.Redo(RedoCount: Integer = 1);
var
I: Integer;
Item: IUndoRedoCommand;
RedoLast: Integer;
begin
if FTransactLevel <> 0 then
raise Exception.Create('Cannot Redo while in Transaction');
// Index of last redo item
RedoLast:= FRedoList.Count - RedoCount;
if RedoLast < 0 then
RedoLast:= 0;
for I:= FRedoList.Count-1 downto RedoLast do
begin
Item:= FRedoList[I] as IUndoRedoCommand;
FRedoList.Delete(I);
FUndoList.Add(Item);
Item.Redo;
end;
end;
procedure TUndoRedoManager.Undo(UndoCount: Integer = 1);
var
I: Integer;
Item: IUndoRedoCommand;
UndoLast: Integer;
begin
if FTransactLevel <> 0 then
raise Exception.Create('Cannot undo while in Transaction');
// Index of last undo item
UndoLast:= FUndoList.Count - UndoCount;
if UndoLast < 0 then
UndoLast:= 0;
for I:= FUndoList.Count-1 downto UndoLast do
begin
Item:= FUndoList[I] as IUndoRedoCommand;
FUndoList.Delete(I);
FRedoList.Add(Item);
Item.Undo;
end;
end;
end.

980
Client/language.pas Normal file
View File

@ -0,0 +1,980 @@
(*
* CDDL HEADER START
*
* gfgfgfg
*)
unit Language;
{$mode objfpc}{$H+}
interface
uses IniFiles, UfrmLogin, UdmNetwork, UfrmInitialize, UfrmMain, UfrmDrawSettings,
UfrmConfirmation, UfrmMoveSettings, UfrmElevateSettings, UfrmHueSettings,
UfrmBoundaries, UfrmVirtualLayer, UfrmFilter, UfrmLightlevel, UfrmRadar,
UfrmAccountControl, UfrmEditAccount, UfrmRegionControl, UfrmLargeScaleCommand,
UfrmAbout, UGameResources, UfrmFillSettings, UfrmSelectionSettings,
UfrmSurfElevateSettings, UfrmSurfStretchSettings, UfrmSurfSmoothSettings;
procedure LanguageLoad(form: TfrmLogin; lang: string; path: string);
procedure LanguageSet(index: Integer);
function LanguageGetName() : string;
procedure ReloadLanguageTranslation();
procedure LanguageTranslate(form: TfrmLogin);
procedure LanguageTranslate(form: TfrmInitialize; unet: TdmNetwork; resm: TGameResourceManager);
procedure LanguageTranslate(form: TfrmMain);
procedure LanguageTranslate(form: TfrmConfirmation);
procedure LanguageTranslate(form: TfrmSelectionSettings);
procedure LanguageTranslate(form: TfrmMoveSettings);
procedure LanguageTranslate(form: TfrmElevateSettings);
procedure LanguageTranslate(form: TfrmSurfElevateSettings);
procedure LanguageTranslate(form: TfrmSurfStretchSettings);
procedure LanguageTranslate(form: TfrmSurfSmoothSettings);
procedure LanguageTranslate(form: TfrmDrawSettings);
procedure LanguageTranslate(form: TfrmHueSettings);
procedure LanguageTranslate(form: TfrmFillSettings);
procedure LanguageTranslate(form: TfrmVirtualLayer);
procedure LanguageTranslate(form: TfrmBoundaries);
procedure LanguageTranslate(form: TfrmFilter);
procedure LanguageTranslate(form: TfrmLightlevel);
procedure LanguageTranslate(form: TfrmRadarMap);
procedure LanguageTranslate(form: TfrmAccountControl);
procedure LanguageTranslate(form: TfrmEditAccount);
procedure LanguageTranslate(form: TfrmRegionControl);
procedure LanguageTranslate(form: TfrmLargeScaleCommand);
procedure LanguageTranslate(form: TfrmAbout);
function GetParseErText(key: string) : string;
implementation
uses SysUtils, Classes, LConvEncoding, Menus;
var
LangPath : string;
LangFile : TIniFile;
LangIndex: Integer;
LangFlags: array of Integer;
LangAbbrs: array of string;
Languages: array of string;
LangFiles: array of string;
CodePages: array of Integer;
procedure LanguageLoad(form: TfrmLogin; lang: string; path: string);
var
langSize : Integer;
nodeIndex: Integer;
tempIndex: Integer;
searchRec: TSearchRec;
flags: array of Integer;
abbrs: array of string;
langs: array of string;
files: array of string;
pages: array of Integer;
begin
LangPath := path;
LangIndex:= -1;
LangSize := -1;
if FindFirst(LangPath+'*.ini', faAnyFile, searchRec) = 0 then
begin
repeat
inc(LangSize);
SetLength(flags, LangSize+1);
SetLength(abbrs, LangSize+1);
SetLength(langs, LangSize+1);
SetLength(files, LangSize+1);
SetLength(pages, LangSize+1);
files[langSize] := CP1251ToUTF8(searchRec.Name);
LangFile := TIniFile.Create(LangPath + files[langSize]);
flags[langSize] := LangFile.ReadInteger('info', 'LangFlag', -1);
abbrs[langSize] := LangFile.ReadString( 'info', 'LangAbbr', '');
langs[langSize] := LangFile.ReadString( 'info', 'Language', '');
pages[langSize] := LangFile.ReadInteger('info', 'CodePage', 1250);
LangFile.Free;
LangFile:=nil;
if ((flags[langSize] < 100) or (flags[langSize] > 107))
then flags[langSize] := 99;
if ((LowerCase(abbrs[langSize]) = 'rus') or (LowerCase(langs[langSize]) = 'русский'))
then form.cbLanguage.Items.Insert(0, files[langSize])
else if ((LowerCase(abbrs[langSize]) = 'eng') or (LowerCase(langs[langSize]) = 'english'))
then if form.cbLanguage.Items.Count > 1
then form.cbLanguage.Items.Insert(1, files[langSize])
else form.cbLanguage.Items.Insert(0, files[langSize])
else form.cbLanguage.Items.Add(files[langSize]);
until FindNext(searchRec) <> 0;
end;
FindClose(searchRec);
SetLength(LangFlags, LangSize+1);
SetLength(LangAbbrs, LangSize+1);
SetLength(Languages, LangSize+1);
SetLength(CodePages, LangSize+1);
SetLength(LangFiles, LangSize+1);
for nodeIndex := 0 to langSize do
for tempIndex := 0 to langSize do
if form.cbLanguage.Items[nodeIndex] = files[tempIndex] then
begin
LangFlags[nodeIndex] := flags[tempIndex];
LangAbbrs[nodeIndex] := abbrs[tempIndex];
Languages[nodeIndex] := langs[tempIndex];
CodePages[nodeIndex] := pages[tempIndex];
LangFiles[nodeIndex] := files[tempIndex];
form.cbLanguage.Items[nodeIndex] := UpCase(LangAbbrs[nodeIndex]);
if Languages[nodeIndex] = lang then
begin
LangIndex := nodeIndex;
form.cbLanguage.ItemIndex := nodeIndex;
form.cbLanguageChange(nil);
end;
end;
if LangIndex < 0 then begin
LangIndex := 0;
form.cbLanguage.ItemIndex := 0;
form.cbLanguageChange(nil);
end;
SetLength(flags, 0);
SetLength(abbrs, 0);
SetLength(langs, 0);
SetLength(files, 0);
SetLength(pages, 0);
end;
procedure LanguageSet(index: Integer);
begin
LangIndex := index;
if (LangFile <> nil)
then LangFile.Free;
LangFile := TIniFile.Create(LangPath + LangFiles[LangIndex]);
end;
function LanguageGetName() : string;
begin
Result := Languages[LangIndex];
end;
function GetText(section : string; key: string) : string;
var text : string;
begin
text := LangFile.ReadString(section, key, '');
if (text <> '')
then result := text
else result := Format('%%%%[%s]%s%%%%', [section, key]);
end;
procedure ReloadLanguageTranslation();
begin
//LangFile.Free;
//LanguageSet(LangIndex);
// LanguageTranslate(frmLogin);
LanguageTranslate(frmInitialize, dmNetwork, nil);
LanguageTranslate(frmMain);
LanguageTranslate(frmConfirmation);
LanguageTranslate(frmSelectionSettings);
LanguageTranslate(frmMoveSettings);
LanguageTranslate(frmElevateSettings);
LanguageTranslate(frmSurfElevateSettings);
LanguageTranslate(frmSurfStretchSettings);
LanguageTranslate(frmSurfSmoothSettings);
LanguageTranslate(frmDrawSettings);
LanguageTranslate(frmHueSettings);
LanguageTranslate(frmFillSettings);
LanguageTranslate(frmVirtualLayer);
LanguageTranslate(frmBoundaries);
LanguageTranslate(frmFilter);
LanguageTranslate(frmLightlevel);
LanguageTranslate(frmRadarMap);
LanguageTranslate(frmAccountControl);
LanguageTranslate(frmEditAccount);
LanguageTranslate(frmRegionControl);
LanguageTranslate(frmLargeScaleCommand);
LanguageTranslate(frmAbout);
end;
// ----------------------------------------------------------------------------=
procedure LanguageTranslate(form: TfrmLogin);
begin
form.gbConnection.Caption := GetText('Login', 'ConnectionSettings');
form.lblHost.Caption := GetText('Login', 'Server');
form.lblUsername.Caption := GetText('Login', 'Account');
form.lblPassword.Caption := GetText('Login', 'Password');
form.gbData.Caption := GetText('Login', 'MulFiles');
form.lblData.Caption := GetText('Login', 'MulFilesDesc');
form.edData.DialogTitle := form.lblData.Caption;
form.gbBaner.Caption := GetText('Login', 'Project');
form.imgBaner.Hint := GetText('Login', 'WebSite');
form.btnOK.Caption := GetText('Login', 'Connect');
form.btnCancel.Caption := GetText('Login', 'Exit');
form.gbProfiles.Caption := GetText('Login', 'Profile');
form.btnSaveProfile.Hint := GetText('Login', 'SaveProfile');
form.btnDefaultOptions.Hint := GetText('Login', 'ClearProfile');
form.btnDeleteProfile.Hint := GetText('Login', 'DeleteProfile');
form.SaveProfileCaption := GetText('Login', 'SaveProfileCaption');
form.SaveProfileDescription := GetText('Login', 'SaveProfileDescription');
end;
procedure LanguageTranslate(form: TfrmInitialize; unet: TdmNetwork; resm: TGameResourceManager);
begin
if form <> nil then begin
form.SplashConnection := GetText('Splash', 'Connection');
form.SplashAuthorization := GetText('Splash', 'Authorization');
form.SplashInicialization := GetText('Splash', 'Inicialization');
form.SplashLoading := GetText('Splash', 'Loading');
form.SplashUpdates := GetText('Splash', 'Updates');
form.SplashSuspend := GetText('Splash', 'Suspend');
form.SplashUpdatingMiniMap := GetText('Splash', 'UpdatingMiniMap');
end;
if unet <> nil then begin
unet.ErrorCaption := GetText('Splash', 'ErrorCaption');
unet.WrongServer := GetText('Splash', 'WrongServer');
unet.WrongAccount := GetText('Splash', 'WrongAccount');
unet.WrongPassword := GetText('Splash', 'WrongPassword');
unet.NoAccess := GetText('Splash', 'NoAccess');
unet.AlreadyLogined := GetText('Splash', 'AlreadyLogined');
unet.TCPErrorCaption := GetText('Splash', 'TCPErrorCaption');
unet.UnsuportedVersion := GetText('Splash', 'UnsuportedVersion');
end;
if resm <> nil then begin
resm.lbDlgErrorFilePathCaption := GetText('Splash', 'DlgErrorFilePathCaption');
resm.lbDlgErrorFilePathMsg := GetText('Splash', 'DlgErrorFilePathMsg');
end;
end;
procedure LanguageTranslate(form: TfrmMain);
var
index: Integer;
entry: TMenuItem;
begin
form.lbFormTitleProfile := GetText('Login', 'Account');
form.lbFormTitleAccount := GetText('Login', 'Profile');
// ----------
form.mnuCentrED.Caption := GetText('MainMenu', 'File');
form.mnuCentrED.Hint := GetText('MainMenu', 'FileHint');
form.mnuMakeScreenShot.Caption := GetText('MainMenu', 'FileScreenShoot');
form.mnuMakeScreenShot.Hint := GetText('MainMenu', 'FileScreenShootHint');
form.mnuReloadGroups.Caption := GetText('MainMenu', 'FileReloadGroups');
form.mnuReloadGroups.Hint := GetText('MainMenu', 'FileReloadGroupsHint');
form.mnuSetLanguage.Caption := GetText('MainMenu', 'FileSetLanguage');
form.mnuSetLanguage.Hint := GetText('MainMenu', 'FileSetLanguageHint');
form.mnuSetLanguage.ImageIndex := LangFlags[LangIndex];
form.mnuSetLanguage.Tag := PtrInt(LangIndex);
form.mnuSetLanguage.Clear;
for index:= 0 to length(Languages)-1 do begin
entry:= TMenuItem.Create(form);
entry.Caption := Languages[index];
entry.ImageIndex := LangFlags[index];
entry.Tag := PtrInt(index);
entry.OnClick := @form.mnuSetLanguageClick;
form.mnuSetLanguage.Add(entry);
end;
form.mnuDisconnect.Caption := GetText('MainMenu', 'FileDisconnetct');
form.mnuDisconnect.Hint := GetText('MainMenu', 'FileDisconnetctHint');
form.mnuExit.Caption := GetText('MainMenu', 'FileExit');
form.mnuExit.Hint := GetText('MainMenu', 'FileExitHint');
form.mnuAdministration.Caption := GetText('MainMenu', 'Admin');
form.mnuAdministration.Hint := GetText('MainMenu', 'AdminHint');
form.mnuFlush.Caption := GetText('MainMenu', 'AdminFlush');
form.mnuFlush.Hint := GetText('MainMenu', 'AdminFlushHint');
form.mnuShutdown.Caption := GetText('MainMenu', 'AdminShutDown');
form.mnuShutdown.Hint := GetText('MainMenu', 'AdminShutDownHint');
form.mnuAccountControl.Caption := GetText('MainMenu', 'AdminAccounts');
form.mnuAccountControl.Hint := GetText('MainMenu', 'AdminAccountsHint');
form.mnuRegionControl.Caption := GetText('MainMenu', 'AdminRegions');
form.mnuRegionControl.Hint := GetText('MainMenu', 'AdminRegionsHint');
form.mnuLargeScaleCommands.Caption := GetText('MainMenu', 'AdminCommands');
form.mnuLargeScaleCommands.Hint := GetText('MainMenu', 'AdminCommandsHint');
form.mnuSettings.Caption := GetText('MainMenu', 'Settings');
form.mnuSettings.Hint := GetText('MainMenu', 'SettingsHint');
form.mnuWindowedMode.Caption := GetText('MainMenu', 'SettingsWindowed');
form.mnuWindowedMode.Hint := GetText('MainMenu', 'SettingsWindowedHint');
form.mnuTileList.Caption := GetText('MainMenu', 'SettingsMainTileList');
form.mnuTileList.Hint := GetText('MainMenu', 'SettingsMainTileListHint');
form.mnuTileListTable.Caption := GetText('MainMenu', 'SettingsTileListTable');
form.mnuTileListTable.Hint := GetText('MainMenu', 'SettingsTileListTableHint');
form.mnuTileListSmall.Caption := GetText('MainMenu', 'SettingsTileListSmall');
form.mnuTileListSmall.Hint := GetText('MainMenu', 'SettingsTileListSmallHint');
form.mnuTileListMidle.Caption := GetText('MainMenu', 'SettingsTileListMidle');
form.mnuTileListMidle.Hint := GetText('MainMenu', 'SettingsTileListMidleHint');
form.mnuTileListLarge.Caption := GetText('MainMenu', 'SettingsTileListLarge');
form.mnuTileListLarge.Hint := GetText('MainMenu', 'SettingsTileListLargeHint');
form.mnuTileListStretch.Caption := GetText('MainMenu', 'SettingsTileListStretch');
form.mnuTileListStretch.Hint := GetText('MainMenu', 'SettingsTileListStretchHint');
form.mnuTileListClip.Caption := GetText('MainMenu', 'SettingsTileListClip');
form.mnuTileListClip.Hint := GetText('MainMenu', 'SettingsTileListClipHint');
form.mnuTileListCentre.Caption := GetText('MainMenu', 'SettingsTileListCentre');
form.mnuTileListCentre.Hint := GetText('MainMenu', 'SettingsTileListCentreHint');
form.mnuTileListDrawInfo.Caption := GetText('MainMenu', 'SettingsTileListDrawInfo');
form.mnuTileListDrawInfo.Hint := GetText('MainMenu', 'SettingsTileListDrawInfoHint');
form.mnuMiscTileList.Caption := GetText('MainMenu', 'SettingsMiscTileList');
form.mnuMiscTileList.Hint := GetText('MainMenu', 'SettingsMiscTileListHint');
form.mnuMiscTileListTable.Caption := GetText('MainMenu', 'SettingsTileListTable');
form.mnuMiscTileListTable.Hint := GetText('MainMenu', 'SettingsTileListTableHint');
form.mnuMiscTileListSmall.Caption := GetText('MainMenu', 'SettingsTileListSmall');
form.mnuMiscTileListSmall.Hint := GetText('MainMenu', 'SettingsTileListSmallHint');
form.mnuMiscTileListMidle.Caption := GetText('MainMenu', 'SettingsTileListMidle');
form.mnuMiscTileListMidle.Hint := GetText('MainMenu', 'SettingsTileListMidleHint');
form.mnuMiscTileListLarge.Caption := GetText('MainMenu', 'SettingsTileListLarge');
form.mnuMiscTileListLarge.Hint := GetText('MainMenu', 'SettingsTileListLargeHint');
form.mnuMiscTileListStretch.Caption:= GetText('MainMenu', 'SettingsTileListStretch');
form.mnuMiscTileListStretch.Hint := GetText('MainMenu', 'SettingsTileListStretchHint');
form.mnuMiscTileListClip.Caption := GetText('MainMenu', 'SettingsTileListClip');
form.mnuMiscTileListClip.Hint := GetText('MainMenu', 'SettingsTileListClipHint');
form.mnuMiscTileListCentre.Caption := GetText('MainMenu', 'SettingsTileListCentre');
form.mnuMiscTileListCentre.Hint := GetText('MainMenu', 'SettingsTileListCentreHint');
form.mnuMiscTileListDrawInfo.Caption:=GetText('MainMenu', 'SettingsTileListDrawInfo');
form.mnuMiscTileListDrawInfo.Hint := GetText('MainMenu', 'SettingsTileListDrawInfoHint');
form.mnuAutoHideGroupList.Caption := GetText('MainMenu', 'SettingsHideGroups');
form.mnuAutoHideGroupList.Hint := GetText('MainMenu', 'SettingsHideGroupsHint');
form.mnuAutoHideRandomList.Caption := GetText('MainMenu', 'SettingsHideRandom');
form.mnuAutoHideRandomList.Hint := GetText('MainMenu', 'SettingsHideRandomHint');
form.mnuAutoShowFilterWindow.Caption:=GetText('MainMenu', 'SettingsAutoShowFilter');
form.mnuAutoShowFilterWindow.Hint := GetText('MainMenu', 'SettingsAutoShowFilterHint');
form.mnuShowAnimations.Caption := GetText('MainMenu', 'SettingsPlayAnimation');
form.mnuShowAnimations.Hint := GetText('MainMenu', 'SettingsPlayAnimationHint');
form.mnuSecurityQuestion.Caption := GetText('MainMenu', 'SettingsQuestion');
form.mnuSecurityQuestion.Hint := GetText('MainMenu', 'SettingsQuestionHint');
form.mnuWhiteBackground.Caption := GetText('MainMenu', 'SettingsWhiteBack');
form.mnuWhiteBackground.Hint := GetText('MainMenu', 'SettingsWhiteBackHint');
form.mnuHelp.Caption := GetText('MainMenu', 'Help');
form.mnuHelp.Hint := GetText('MainMenu', 'HelpHint');
form.mnuDocs.Caption := GetText('MainMenu', 'HelpDocs');
form.mnuDocs.Hint := GetText('MainMenu', 'HelpDocsHint');
form.mnuSupport.Caption := GetText('MainMenu', 'HelpSupport');
form.mnuSupport.Hint := GetText('MainMenu', 'HelpSupportHint');
form.mnuEngCom.Caption := GetText('MainMenu', 'HelpSupportEng');
form.mnuEngCom.Hint := GetText('MainMenu', 'HelpSupportEngHint');
form.mnuEng2Com.Caption := GetText('MainMenu', 'HelpSupportEng2');
form.mnuEng2Com.Hint := GetText('MainMenu', 'HelpSupportEng2Hint');
form.mnuRusCom.Caption := GetText('MainMenu', 'HelpSupportRus');
form.mnuRusCom.Hint := GetText('MainMenu', 'HelpSupportRusHint');
form.mnuAbout.Caption := GetText('MainMenu', 'HelpAbout');
form.mnuAbout.Hint := GetText('MainMenu', 'HelpAboutHint');
// ----------
form.lbFormTitleAccount := GetText('MainForm', 'FormTitleAccount');
form.lbFormTitleProfile := GetText('MainForm', 'FormTitleProfile');
form.lblChatHeaderCaption.Caption := GetText('MainForm', 'BottomChatHeader');
form.lblTileInfoWLabel.Caption := GetText('MainForm', 'BottomCursorWidth');
form.lblTileInfoHLabel.Caption := GetText('MainForm', 'BottomCursorHeight');
form.lbBottomCursorVLayer1 := GetText('MainForm', 'BottomCursorVLayer1');
form.lbBottomCursorVLayer2 := GetText('MainForm', 'BottomCursorVLayer2');
form.lbBottomCursorItemId := GetText('MainForm', 'BottomCursorItemId');
form.lbBottomCursorLandId := GetText('MainForm', 'BottomCursorLandId');
form.lbBottomCursorPosX := GetText('MainForm', 'BottomCursorPosX');
form.lbBottomCursorPosY := GetText('MainForm', 'BottomCursorPosY');
form.lbBottomCursorPosZ := GetText('MainForm', 'BottomCursorPosZ');
form.lbBottomCursorItemHue := GetText('MainForm', 'BottomCursorItemHue');
form.vstChat.Header.Columns[0].Text:= GetText('MainForm', 'BottomChatTime');
form.vstChat.Header.Columns[1].Text:= GetText('MainForm', 'BottomChatSender');
form.vstChat.Header.Columns[2].Text:= GetText('MainForm', 'BottomChatMessage');
form.mnuGrabTileID.Caption := GetText('MainForm', 'GrabTileId');
form.mnuGrabTileID.Hint := GetText('MainForm', 'GrabTileIdHint');
form.mnuGrabHue.Caption := GetText('MainForm', 'GrabTileHue');
form.mnuGrabHue.Hint := GetText('MainForm', 'GrabTileHueHint');
form.mnuGrabFilterTileID.Caption := GetText('MainForm', 'GrabTileAddIdToFilter');
form.mnuGrabFilterTileID.Hint := GetText('MainForm', 'GrabTileAddIdToFilterHint');
form.mnuGrabFilterHue.Caption := GetText('MainForm', 'GrabTileAddHueToFilter');
form.mnuGrabFilterHue.Hint := GetText('MainForm', 'GrabTileAddHueToFilterHint');
form.mnuGrabVirtualLayerZ.Caption := GetText('MainForm', 'GrabTileSetVLayer');
form.mnuGrabVirtualLayerZ.Hint := GetText('MainForm', 'GrabTileSetVLayerHint');
form.mnuGrabBoundaries.Caption := GetText('MainForm', 'GrabBoundaries');
form.mnuGrabBoundaries.Hint := GetText('MainForm', 'GrabBoundariesHint');
form.mnuGrabBoundMinZ.Caption := GetText('MainForm', 'GrabBoundMinZ');
form.mnuGrabBoundMinZ.Hint := GetText('MainForm', 'GrabBoundMinZHint');
form.mnuGrabBoundMaxZ.Caption := GetText('MainForm', 'GrabBoundMaxZ');
form.mnuGrabBoundMaxZ.Hint := GetText('MainForm', 'GrabBoundMaxZHint');
form.mnuGrabBoundMinX.Caption := GetText('MainForm', 'GrabBoundMinX');
form.mnuGrabBoundMinX.Hint := GetText('MainForm', 'GrabBoundMinXHint');
form.mnuGrabBoundMaxX.Caption := GetText('MainForm', 'GrabBoundMaxX');
form.mnuGrabBoundMaxX.Hint := GetText('MainForm', 'GrabBoundMaxXHint');
form.mnuGrabBoundMinY.Caption := GetText('MainForm', 'GrabBoundMinY');
form.mnuGrabBoundMinY.Hint := GetText('MainForm', 'GrabBoundMinYHint');
form.mnuGrabBoundMaxY.Caption := GetText('MainForm', 'GrabBoundMaxY');
form.mnuGrabBoundMaxY.Hint := GetText('MainForm', 'GrabBoundMaxYHint');
form.mnuSelect.Caption := GetText('MainForm', 'ToolsSelect');
form.mnuSelect.Hint := GetText('MainForm', 'ToolsSelectHint');
form.mnuSelection.Caption := GetText('MainForm', 'ToolsSelection');
form.mnuSelection.Hint := GetText('MainForm', 'ToolsSelectionHint');
form.mnuMove.Caption := GetText('MainForm', 'ToolsMove');
form.mnuMove.Hint := GetText('MainForm', 'ToolsMoveHint');
form.mnuElevate.Caption := GetText('MainForm', 'ToolsElevate');
form.mnuElevate.Hint := GetText('MainForm', 'ToolsElevateHint');
form.mnuSurfElevate.Caption := GetText('MainForm', 'ToolsSurfElevate');
form.mnuSurfElevate.Hint := GetText('MainForm', 'ToolsSurfElevateHint');
form.mnuSurfStretch.Caption := GetText('MainForm', 'ToolsSurfStretch');
form.mnuSurfStretch.Hint := GetText('MainForm', 'ToolsSurfStretchHint');
form.mnuSurfSmooth.Caption := GetText('MainForm', 'ToolsSurfSmooth');
form.mnuSurfSmooth.Hint := GetText('MainForm', 'ToolsSurfSmoothHint');
form.mnuDraw.Caption := GetText('MainForm', 'ToolsDraw');
form.mnuDraw.Hint := GetText('MainForm', 'ToolsDrawHint');
form.mnuSetHue.Caption := GetText('MainForm', 'ToolsSetHue');
form.mnuSetHue.Hint := GetText('MainForm', 'ToolsSetHueHint');
form.mnuFill.Caption := GetText('MainForm', 'ToolsFill');
form.mnuFill.Hint := GetText('MainForm', 'ToolsSetFill');
form.mnuDelete.Caption := GetText('MainForm', 'ToolsDelete');
form.mnuDelete.Hint := GetText('MainForm', 'ToolsDeleteHint');
form.mnuVirtualLayer.Caption := GetText('MainForm', 'ToolsVLayer');
form.mnuVirtualLayer.Hint := GetText('MainForm', 'ToolsVLayerHint');
form.mnuBoundaries.Caption := GetText('MainForm', 'ToolsBoundaries');
form.mnuBoundaries.Hint := GetText('MainForm', 'ToolsBoundariesHint');
form.lbDlgWindowedModeSwitchCaption:= GetText('MainForm', 'DlgWindowedModeSwitchCaption');
form.lbDlgWindowedModeSwitch := GetText('MainForm', 'DlgWindowedModeSwitch');
form.lbScreenShotMsg := GetText('MainForm', 'ScreenShotMsg');
form.lbUserLoginedMsg := GetText('MainForm', 'UserLoginedMsg');
form.lbUserLogoutedMsg := GetText('MainForm', 'UserLogoutedMsg');
form.lbDlgGetDcErrCaption := GetText('MainForm', 'DlgGetDcErrCaption');
form.lbDlgGetDcErr := GetText('MainForm', 'DlgGetDcErr');
form.lbDlgFreeDcErrCaption := GetText('MainForm', 'DlgFreeDcErrCaption');
form.lbDlgFreeDcErr := GetText('MainForm', 'DlgFreeDcErr');
form.lbDlgCnangedAccessCaption := GetText('MainForm', 'DlgCnangedAccessCaption');
form.lbDlgCnangedAccess := GetText('MainForm', 'DlgCnangedAccess');
form.lbDlgBlockedAccessCaption := GetText('MainForm', 'DlgBlockedAccessCaption');
form.lbDlgBlockedAccess := GetText('MainForm', 'DlgBlockedAccess');
// ----------
form.tbDisconnect.Hint := GetText('ToolBar', 'DisconnectHint');
form.tbSelect.Hint := GetText('ToolBar', 'SelectHint');
form.tbSelection.Hint := GetText('ToolBar', 'SelectionHint');
form.tbMoveTile.Hint := GetText('ToolBar', 'MoveTileHint');
form.tbElevateTile.Hint := GetText('ToolBar', 'ElevateTileHint');
form.tbSurfElevate.Hint := GetText('ToolBar', 'SurfElevateHint');
form.tbSurfStretch.Hint := GetText('ToolBar', 'SurfStretchHint');
form.tbSurfSmooth.Hint := GetText('ToolBar', 'SurfSmoothHint');
form.tbDrawTile.Hint := GetText('ToolBar', 'DrawTileHint');
form.tbSetHue.Hint := GetText('ToolBar', 'SetHueHint');
form.tbFill.Hint := GetText('ToolBar', 'FillHint');
form.tbDeleteTile.Hint := GetText('ToolBar', 'DeleteTileHint');
form.tbUndo.Hint := GetText('ToolBar', 'UndoHint') + ' (0).';
form.lbToolbarUndo := GetText('ToolBar', 'UndoHint');
form.tbRedo.Hint := GetText('ToolBar', 'RedoHint') + ' (0).';
// form.lbToolbarRedo -- ????????
form.tbVirtualLayer.Hint := GetText('ToolBar', 'VirtualLayerHint');
form.tbBoundaries.Hint := GetText('ToolBar', 'BoundariesHint');
form.tbFilter.Hint := GetText('ToolBar', 'FilterHint');
form.tbTerrain.Hint := GetText('ToolBar', 'TerrainHint');
form.tbStatics.Hint := GetText('ToolBar', 'StaticsHint');
form.tbNoDraw.Hint := GetText('ToolBar', 'NoDrawHint');
form.tbWalkable.Hint := GetText('ToolBar', 'WalkableHint');
form.tbFlat.Hint := GetText('ToolBar', 'FlatHint');
form.tbLightlevel.Hint := GetText('ToolBar', 'LightlevelHint');;
form.tbZoom.Hint := GetText('ToolBar', 'ZoomHint');
form.tbRadarMap.Hint := GetText('ToolBar', 'RadarMapHint');
form.mnuShowGrid.Caption := GetText('ToolBar', 'ShowGrid');
form.mnuShowGrid.Hint := GetText('ToolBar', 'ShowGridHint');
form.mnuShowBlocks.Caption := GetText('ToolBar', 'ShowBlocks');
form.mnuShowBlocks.Hint := GetText('ToolBar', 'ShowBlocksHint');
form.mnuShowWalls.Caption := GetText('ToolBar', 'ShowWalls');
form.mnuShowWalls.Hint := GetText('ToolBar', 'ShowWallsHint');
form.mnuShowBridges.Caption := GetText('ToolBar', 'ShowBridges');
form.mnuShowBridges.Hint := GetText('ToolBar', 'ShowBridgesHint');
form.mnuShowSurfaces.Caption := GetText('ToolBar', 'ShowSurfaces');
form.mnuShowSurfaces.Hint := GetText('ToolBar', 'ShowSurfacesHint');
form.mnuShowRoofs.Caption := GetText('ToolBar', 'ShowRoofs');
form.mnuShowRoofs.Hint := GetText('ToolBar', 'ShowRoofsHint');
form.mnuShowFoliage.Caption := GetText('ToolBar', 'ShowFoliage');
form.mnuShowFoliage.Hint := GetText('ToolBar', 'ShowFoliageHint');
form.mnuShowWater.Caption := GetText('ToolBar', 'ShowWater');
form.mnuShowWater.Hint := GetText('ToolBar', 'ShowWaterHint');
form.mnuShowNoDrawTiles.Caption := GetText('ToolBar', 'ShowNoDrawTiles');
form.mnuShowNoDrawTiles.Hint := GetText('ToolBar', 'ShowNoDrawTilesHint');
form.mnuShowLightSource.Caption := GetText('ToolBar', 'ShowLightSource');
form.mnuShowLightSource.Hint := GetText('ToolBar', 'ShowLightSourceHint');
form.mnuFlatShowHeight.Caption := GetText('ToolBar', 'FlatShowHeight');
form.mnuFlatShowHeight.Hint := GetText('ToolBar', 'FlatShowHeightHint');
form.mnuZoom025.Caption := GetText('ToolBar', 'Zoom025');
form.mnuZoom025.Hint := GetText('ToolBar', 'Zoom025Hint');
form.mnuZoom033.Caption := GetText('ToolBar', 'Zoom033');
form.mnuZoom033.Hint := GetText('ToolBar', 'Zoom033Hint');
form.mnuZoom050.Caption := GetText('ToolBar', 'Zoom050');
form.mnuZoom050.Hint := GetText('ToolBar', 'Zoom050Hint');
form.mnuZoom075.Caption := GetText('ToolBar', 'Zoom075');
form.mnuZoom075.Hint := GetText('ToolBar', 'Zoom075Hint');
form.mnuZoom100.Caption := GetText('ToolBar', 'Zoom100');
form.mnuZoom100.Hint := GetText('ToolBar', 'Zoom100Hint');
form.mnuZoom150.Caption := GetText('ToolBar', 'Zoom150');
form.mnuZoom150.Hint := GetText('ToolBar', 'Zoom150Hint');
form.mnuZoom200.Caption := GetText('ToolBar', 'Zoom200');
form.mnuZoom200.Hint := GetText('ToolBar', 'Zoom200Hint');
form.mnuZoom300.Caption := GetText('ToolBar', 'Zoom300');
form.mnuZoom300.Hint := GetText('ToolBar', 'Zoom300Hint');
form.mnuZoom400.Caption := GetText('ToolBar', 'Zoom400');
form.mnuZoom400.Hint := GetText('ToolBar', 'Zoom400Hint');
// ----------
form.tsTiles.Caption := GetText('TabTiles', 'TabPage');
form.cbTerrain.Caption := GetText('TabTiles', 'Lands');
form.cbTerrain.Hint := GetText('TabTiles', 'LandsHint');
form.cbStatics.Caption := GetText('TabTiles', 'Items');
form.cbStatics.Hint := GetText('TabTiles', 'ItemsHint');
form.lblFilter.Caption := GetText('TabTiles', 'edFilterLabel');
form.edFilter.Hint := GetText('TabTiles', 'edFilterHint');
form.vdtTiles.Header.Columns[0].Text := GetText('TabTiles', 'TilesId');
form.vdtTiles.Header.Columns[1].Text := GetText('TabTiles', 'TilesImage');
form.vdtTiles.Header.Columns[2].Text := GetText('TabTiles', 'TilesName');
form.mnuAddToRandom.Caption := GetText('TabTiles', 'TilesAddToRandom');
form.mnuAddToRandom.Hint := GetText('TabTiles', 'TilesAddToRandomHint');
form.gbRandom.Caption := GetText('TabTiles', 'RandomBlock');
form.vdtRandom.Header.Columns[0].Text := GetText('TabTiles', 'RandomId');
form.vdtRandom.Header.Columns[1].Text := GetText('TabTiles', 'RandomImage');
form.vdtRandom.Header.Columns[2].Text := GetText('TabTiles', 'RandomName');
form.btnClearRandom.Hint := GetText('TabTiles', 'RandomClearHint');
form.btnDeleteRandom.Hint := GetText('TabTiles', 'RandomRemoveHint');
form.btnAddRandom.Hint := GetText('TabTiles', 'RandomAddHint');
form.btnRandomPresetSave.Hint := GetText('TabTiles', 'RandomSaveHint');
form.btnRandomPresetDelete.Hint := GetText('TabTiles', 'RandomDeleteHint');
form.lbDlgSaveRandPrsCaption := GetText('TabTiles', 'DlgSaveRandPrsCaption');
form.lbDlgSaveRandPrs := GetText('TabTiles', 'DlgSaveRandPrs');
form.lbDlgSearchIdErrCaption := GetText('TabTiles', 'DlgSearchIdErrCaption');
form.lbDlgSearchIdErr := GetText('TabTiles', 'DlgSearchIdErr');
form.lbDlgNotFoundErrCaption := GetText('TabTiles', 'DlgNotFoundErrCaption');
form.lbDlgNotFoundErr := GetText('TabTiles', 'DlgNotFoundErr');
// ----------
form.tsObjects.Caption := GetText('TabObjects', 'TabPage');
// ----------
form.tsNavigation.Caption := GetText('TabNavigation', 'TabPage');
form.vstClients.Header.Columns[1].Text := GetText('TabNavigation', 'ClientsAccounts');
form.vstClients.Header.Columns[2].Text := GetText('TabNavigation', 'ClientsUptime');
form.mnuGoToClient.Caption := GetText('TabNavigation', 'ClientsGoTo');
form.mnuGoToClient.Hint := GetText('TabNavigation', 'ClientsGoToHint');
form.vstLocations.Header.Columns[0].Text := GetText('TabNavigation', 'LocationsPosition');
form.vstLocations.Header.Columns[1].Text := GetText('TabNavigation', 'LocationsName');
form.btnClearLocations.Hint := GetText('TabNavigation', 'LocationsClearHint');
form.btnDeleteLocation.Hint := GetText('TabNavigation', 'LocationsRemoveHint');
form.btnAddLocation.Hint := GetText('TabNavigation', 'LocationsAddHint');
form.gbGoTo.Caption := GetText('TabNavigation', 'GoToBlock');
form.lblX.Caption := GetText('TabNavigation', 'GoToPosX');
form.lblY.Caption := GetText('TabNavigation', 'GoToPosY');
form.btnGoTo.Caption := GetText('TabNavigation', 'GoToButton');
form.btnGoTo.Hint := GetText('TabNavigation', 'GoToButtonHint');
form.lbDlgDelConfCaption := GetText('TabNavigation', 'DlgDelConfCaption');
form.lbDlgDelConf := GetText('TabNavigation', 'DlgDelConf');
form.lbDlgNewQuerryCaption := GetText('TabNavigation', 'DlgNewQuerryCaption');
form.lbDlgNewQuerry := GetText('TabNavigation', 'DlgNewQuerry');
end;
procedure LanguageTranslate(form: TfrmConfirmation);
begin
form.Caption := GetText('ConfForm', 'FormTitle');
form.btnYes.Caption := GetText('ConfForm', 'Yes');
form.btnNo.Caption := GetText('ConfForm', 'No');
end;
procedure LanguageTranslate(form: TfrmSelectionSettings);
begin
form.Caption := GetText('SelnForm', 'FormTitle');
// TODO
end;
procedure LanguageTranslate(form: TfrmMoveSettings);
begin
form.Caption := GetText('MoveForm', 'FormTitle');
form.seOffset.Hint := GetText('MoveForm', 'OffsetHint');
form.cbAsk.Caption := GetText('MoveForm', 'Ask');
form.cbAsk.Hint := GetText('MoveForm', 'AskHint');
form.btnCancel.Caption := GetText('MoveForm', 'Cancel');
form.gbMovment.Caption := GetText('MoveForm', 'Movment');
form.cbLand.Caption := GetText('MoveForm', 'Land');
form.cbLand.Hint := GetText('MoveForm', 'LandHint');
form.cbItem.Caption := GetText('MoveForm', 'Item');
form.cbItem.Hint := GetText('MoveForm', 'ItemHint');
end;
procedure LanguageTranslate(form: TfrmElevateSettings);
begin
form.Caption := GetText('ElevForm', 'FormTitle');
form.rbRaise.Caption := GetText('ElevForm', 'Raise');
form.rbRaise.Hint := GetText('ElevForm', 'RaiseHint');
form.rbLower.Caption := GetText('ElevForm', 'Lower');
form.rbLower.Hint := GetText('ElevForm', 'LowerHint');
form.rbSet.Caption := GetText('ElevForm', 'Set');
form.rbSet.Hint := GetText('ElevForm', 'SetHint');
form.cbRandomHeight.Caption := GetText('ElevForm', 'AddRandom');
form.cbRandomHeight.Hint := GetText('ElevForm', 'AddRandomHint');
end;
procedure LanguageTranslate(form: TfrmSurfElevateSettings);
begin
form.Caption := GetText('SElvForm', 'FormTitle');
// TODO
end;
procedure LanguageTranslate(form: TfrmSurfStretchSettings);
begin
form.Caption := GetText('SStrForm', 'FormTitle');
// TODO
end;
procedure LanguageTranslate(form: TfrmSurfSmoothSettings);
begin
form.Caption := GetText('SSmtForm', 'FormTitle');
// TODO
end;
procedure LanguageTranslate(form: TfrmDrawSettings);
begin
form.Caption := GetText('DrawForm', 'FormTitle');
form.rbTileList.Caption := GetText('DrawForm', 'UseTiles');
form.rbTileList.Hint := GetText('DrawForm', 'UseTilesHint');
form.rbRandom.Caption := GetText('DrawForm', 'UseRandom');
form.rbRandom.Hint := GetText('DrawForm', 'UseRandomHint');
form.cbProbability.Caption := GetText('DrawForm', 'Probability');
form.cbProbability.Hint := GetText('DrawForm', 'ProbabilityHint');
form.cbUseFreeTilesOnly.Caption := GetText('DrawForm', 'FreeTiles');
form.cbUseFreeTilesOnly.Hint := GetText('DrawForm', 'FreeTilesHint');
form.cbUseSurfaceAltitude.Caption := GetText('DrawForm', 'SurfaceAlt');
form.cbUseSurfaceAltitude.Hint := GetText('DrawForm', 'SurfaceAltHint');
form.cbForceAltitude.Caption := GetText('DrawForm', 'ForceAlt');
form.cbForceAltitude.Hint := GetText('DrawForm', 'ForceAltHint');
form.cbRandomHeight.Caption := GetText('DrawForm', 'AddRandomAlt');
form.cbRandomHeight.Hint := GetText('DrawForm', 'AddRandomAltHint');
form.gbHue.Caption := GetText('DrawForm', 'ItemColor');
end;
procedure LanguageTranslate(form: TfrmHueSettings);
begin
form.Caption := GetText('HuesForm', 'FormTitle');
form.cbRandom.Caption := GetText('HuesForm', 'Random');
form.cbRandom.Hint := GetText('HuesForm', 'RandomHint');
form.lblHue.Caption := GetText('HuesForm', 'Color');
form.gbPreview.Caption := GetText('HuesForm', 'PreviewBlock');
form.ShowAll.Caption := GetText('HuesForm', 'ShowAll');
form.ShowAll.Hint := GetText('HuesForm', 'ShowAllHint');
form.lblTileId.Caption := GetText('HuesForm', 'Tile');
form.gbLastUsed.Caption := GetText('HuesForm', 'LastUsedBlock');
form.gbRandom.Caption := GetText('HuesForm', 'RandomBlock');
form.btnAddRandom.Hint := GetText('HuesForm', 'AddPresetHint');
form.btnDeleteRandom.Hint := GetText('HuesForm', 'RemovePresetHint');
form.btnClearRandom.Hint := GetText('HuesForm', 'ClearPresetHint');
form.btnRandomPresetSave.Hint := GetText('HuesForm', 'SavePresetHint');
form.btnRandomPresetDelete.Hint := GetText('HuesForm', 'DeletePresetHint');
form.lbDlgBadColrCaption := GetText('HuesForm', 'DlgBadColrCaption');
form.lbDlgBadColr := GetText('HuesForm', 'DlgBadColr');
form.lbDlgBadTileCaption := GetText('HuesForm', 'DlgBadTileCaption');
form.lbDlgBadTile := GetText('HuesForm', 'DlgBadTile');
form.lbDlgSavePrsCaption := GetText('HuesForm', 'DlgSavePrsCaption');
form.lbDlgSavePrs := GetText('HuesForm', 'DlgSavePrs');
form.lbNoHuesName := GetText('HuesForm', 'NoHuesName');
end;
procedure LanguageTranslate(form: TfrmFillSettings);
begin
form.Caption := GetText('FillForm', 'FormTitle');
form.lblFillType.Caption := GetText('FillForm', 'FillType');
form.cbFillReview.Caption := GetText('FillForm', 'FillReview');
form.cbFillConfirm.Caption := GetText('FillForm', 'FillConfirm');
form.gbHue.Caption := GetText('FillForm', 'ItemColor');
// TODO
end;
procedure LanguageTranslate(form: TfrmVirtualLayer);
begin
form.Caption := GetText('VLayForm', 'FormTitle');
form.cbShowLayer.Caption := GetText('VLayForm', 'ShowLayer');
form.cbShowLayer.Hint := GetText('VLayForm', 'ShowLayerHint');
form.cbShowBlocks.Caption := GetText('VLayForm', 'ShowBlocks');
form.cbShowBlocks.Hint := GetText('VLayForm', 'ShowBlocksHint');
end;
procedure LanguageTranslate(form: TfrmBoundaries);
begin
form.Caption := GetText('BounForm', 'FormTitle');
form.GroupBox1.Caption := GetText('BounForm', 'AltBlock');;
form.lblMinZ.Caption := GetText('BounForm', 'MinAlt');
form.lblMinZ.Hint := GetText('BounForm', 'MinAltHint');
form.lblMaxZ.Caption := GetText('BounForm', 'MaxAlt');
form.lblMaxZ.Hint := GetText('BounForm', 'MaxAltHint');
form.GroupBox2.Caption := GetText('BounForm', 'XYBlock');
form.lblAxeX.Caption := GetText('BounForm', 'AxeXName');
form.seMinX.Hint := GetText('BounForm', 'MinXHint');
form.seMaxX.Hint := GetText('BounForm', 'MaxXHint');
form.sbClearXbnd.Hint := GetText('BounForm', 'XClearHint');
form.lblAxeY.Caption := GetText('BounForm', 'AxeYName');
form.seMinY.Hint := GetText('BounForm', 'MinYHint');
form.seMaxY.Hint := GetText('BounForm', 'MaxYHint');
form.sbClearYbnd.Hint := GetText('BounForm', 'YClearHint');
end;
procedure LanguageTranslate(form: TfrmFilter);
begin
form.Caption := GetText('FiltForm', 'FormTitle');
form.rgFilterType.Caption := GetText('FiltForm', 'FilterBlock');
form.rgFilterType.Items[0] := GetText('FiltForm', 'FilterType1');
form.rgFilterType.Items[1] := GetText('FiltForm', 'FilterType2');
form.GroupBox1.Caption := GetText('FiltForm', 'TileBlock');
form.cbTileFilter.Caption := GetText('FiltForm', 'TileUse');
form.cbTileFilter.Hint := GetText('FiltForm', 'TileUseHint');
form.Label1.Caption := GetText('FiltForm', 'TileHelp');
form.vdtFilter.Header.Columns[0].Text := GetText('FiltForm', 'TileId');
form.vdtFilter.Header.Columns[1].Text := GetText('FiltForm', 'TileImage');
form.vdtFilter.Header.Columns[2].Text := GetText('FiltForm', 'TileName');
form.btnDelete.Hint := GetText('FiltForm', 'TileRemoveHint');
form.btnClear.Hint := GetText('FiltForm', 'TileClearHint');
form.GroupBox2.Caption := GetText('FiltForm', 'ColorBlock');
form.cbHueFilter.Caption := GetText('FiltForm', 'ColorUse');
form.cbHueFilter.Hint := GetText('FiltForm', 'ColorUseHint');
form.vdtHues.Header.Columns[1].Text := GetText('FiltForm', 'ColorHue');
form.vdtHues.Header.Columns[2].Text := GetText('FiltForm', 'ColorName');
form.mnuCheckHues.Caption := GetText('FiltForm', 'ColorCheck');
form.mnuCheckHues.Hint := GetText('FiltForm', 'ColorCheckHint');
form.mnuUncheckHues.Caption := GetText('FiltForm', 'ColorUncheck');
form.mnuUncheckHues.Hint := GetText('FiltForm', 'ColorUncheckHint');
end;
procedure LanguageTranslate(form: TfrmLightlevel);
begin
form.Caption := GetText('LighForm', 'FormTitle');
end;
procedure LanguageTranslate(form: TfrmRadarMap);
begin
form.Caption := GetText('RMapForm', 'FormTitle');
form.cbStayOnTop.Caption := GetText('RMapForm', 'StayOnTop');
form.cbStayOnTop.Hint := GetText('RMapForm', 'StayOnTopHint');
end;
procedure LanguageTranslate(form: TfrmAccountControl);
begin
form.Caption := GetText('MAccForm', 'FormTitle');
form.tbRefresh.Hint := GetText('MAccForm', 'RefreshHint');
form.tbAddUser.Hint := GetText('MAccForm', 'AddUserHint');
form.tbEditUser.Hint := GetText('MAccForm', 'EditUserHint');
form.tbDeleteUser.Hint := GetText('MAccForm', 'DeleteUserHint');
form.vstAccounts.Header.Columns[1].Text := GetText('MAccForm', 'UserName');
form.vstAccounts.Header.Columns[2].Text := GetText('MAccForm', 'Access');
form.vstAccounts.Header.Columns[3].Text := GetText('MAccForm', 'Regions');
form.lbDlgDelConfCaption := GetText('MAccForm', 'DlgDelConfCaption');
form.lbDlgDelConf := GetText('MAccForm', 'DlgDelConf');
form.lbDlgAddNotiCaption := GetText('MAccForm', 'DlgAddNotiCaption');
form.lbDlgAddNoti := GetText('MAccForm', 'DlgAddNoti');
form.lbDlgModNotiCaption := GetText('MAccForm', 'DlgModNotiCaption');
form.lbDlgModNoti := GetText('MAccForm', 'DlgModNoti');
form.lbDlgInvlErrCaption := GetText('MAccForm', 'DlgInvlErrCaption');
form.lbDlgInvlErr := GetText('MAccForm', 'DlgInvlErr');
form.lbDlgDelNotiCaption := GetText('MAccForm', 'DlgDelNotiCaption');
form.lbDlgDelNoti := GetText('MAccForm', 'DlgDelNoti');
form.lbDlgDelfErrCaption := GetText('MAccForm', 'DlgDelfErrCaption');
form.lbDlgDelfErr := GetText('MAccForm', 'DlgDelfErr');
end;
procedure LanguageTranslate(form: TfrmEditAccount);
begin
form.Caption := GetText('EAccForm', 'FormTitle');
form.tsGeneral.Caption := GetText('EAccForm', 'TabGeneral');
form.tsRegions.Caption := GetText('EAccForm', 'TabRegions');
form.lblUsername.Caption := GetText('EAccForm', 'Account');
form.lblPassword.Caption := GetText('EAccForm', 'Password');
form.lblAccessLevel.Caption := GetText('EAccForm', 'Access');
form.lblPasswordHint.Caption := GetText('EAccForm', 'PswHelp');
form.Label1.Caption := GetText('EAccForm', 'AllowRegions');
form.btnOK.Caption := GetText('EAccForm', 'Apply');
form.btnCancel.Caption := GetText('EAccForm', 'Cancel');
form.cbAccessLevel.Items[0] := GetText('EAccForm', 'AccessNone');
form.cbAccessLevel.Items[1] := GetText('EAccForm', 'AccessViewer');
form.cbAccessLevel.Items[2] := GetText('EAccForm', 'AccessNormal');
form.cbAccessLevel.Items[3] := GetText('EAccForm', 'AccessDevelop');
form.cbAccessLevel.Items[4] := GetText('EAccForm', 'AccessAdmin');
end;
procedure LanguageTranslate(form: TfrmRegionControl);
begin
form.Caption := GetText('MRegForm', 'FormTitle');
form.vstRegions.Header.Columns[0].Text := GetText('MRegForm', 'Regions');
form.mnuAddRegion.Caption := GetText('MRegForm', 'AddRegion');
form.mnuAddRegion.Hint := GetText('MRegForm', 'AddRegionHint');
form.btnAddRegion.Hint := GetText('MRegForm', 'AddRegionHint');
form.mnuDeleteRegion.Caption := GetText('MRegForm', 'DeleteRegion');
form.mnuDeleteRegion.Hint := GetText('MRegForm', 'DeleteRegionHint');
form.btnDeleteRegion.Hint := GetText('MRegForm', 'DeleteRegionHint');
form.Label1.Caption := GetText('MRegForm', 'Area');
form.btnAddArea.Hint := GetText('MRegForm', 'AddAreaHint');
form.btnDeleteArea.Hint := GetText('MRegForm', 'DeleteAreaHint');
form.btnClearArea.Hint := GetText('MRegForm', 'ClearAreaHint');
form.lblX.Caption := GetText('MRegForm', 'PosX');
form.lblY.Caption := GetText('MRegForm', 'PosY');
form.btnGrab1.Hint := GetText('MRegForm', 'PosGrab1Hint');
form.btnGrab2.Hint := GetText('MRegForm', 'PosGrab2Hint');
form.btnSave.Caption := GetText('MRegForm', 'Save');
form.btnClose.Caption := GetText('MRegForm', 'Close');
form.lbDlgUnsaveCaption := GetText('MRegForm', 'DlgUnsaveCaption');
form.lbDlgUnsave := GetText('MRegForm', 'DlgUnsave');
form.lbDlgDelConfCaption := GetText('MRegForm', 'DlgDelConfCaption');
form.lbDlgDelConf := GetText('MRegForm', 'DlgDelConf');
form.lbDlgNewExistsCaption := GetText('MRegForm', 'DlgNewExistsCaption');
form.lbDlgNewExists := GetText('MRegForm', 'DlgNewExists');
form.lbNewInputQueryCaption := GetText('MRegForm', 'NewInputQueryCaption');
form.lbNewInputQuery := GetText('MRegForm', 'NewInputQuery');
end;
procedure LanguageTranslate(form: TfrmLargeScaleCommand);
begin
form.Caption := GetText('GCmdForm', 'FormTitle');
form.vstActions.Header.Columns[0].Text := GetText('GCmdForm', 'Actions');
form.Label1.Caption := GetText('GCmdForm', 'Ares');
form.btnAddArea.Hint := GetText('GCmdForm', 'AddAreaHint');
form.btnDeleteArea.Hint := GetText('GCmdForm', 'DeleteAreaHint');
form.btnClearArea.Hint := GetText('GCmdForm', 'ClearAreaHint');
form.lblY.Caption := GetText('GCmdForm', 'PosX');
form.lblX.Caption := GetText('GCmdForm', 'PosY');
form.btnGrab1.Hint := GetText('GCmdForm', 'PosGrab1Hint');
form.btnGrab2.Hint := GetText('GCmdForm', 'PosGrab2Hint');
form.btnExecute.Caption := GetText('GCmdForm', 'Execute');
form.btnClose.Caption := GetText('GCmdForm', 'Close');
// ----------
form.pgArea.Caption := GetText('GCmdForm', 'PageSelectArea');
form.mnuSelectTopLeft.Caption := GetText('GCmdForm', 'psaSelectTL');
form.mnuSelectTopLeft.Hint := GetText('GCmdForm', 'psaSelectTLHint');
form.mnuSelectTopRight.Caption := GetText('GCmdForm', 'psaSelectTR');
form.mnuSelectTopRight.Hint := GetText('GCmdForm', 'psaSelectTRHint');
form.mnuSelectBottomLeft.Caption := GetText('GCmdForm', 'psaSelectBL');
form.mnuSelectBottomLeft.Hint := GetText('GCmdForm', 'psaSelectBLHint');
form.mnuSelectBottomRight.Caption := GetText('GCmdForm', 'psaSelectBR');
form.mnuSelectBottomRight.Hint := GetText('GCmdForm', 'psaSelectBRHint');
// ----------
form.pgCopyMove.Caption := GetText('GCmdForm', 'PageCopyMove');
form.rgCMAction.Caption := GetText('GCmdForm', 'pcmActionBloack');
form.rgCMAction.Items[0] := GetText('GCmdForm', 'pcmAction1');
form.rgCMAction.Items[1] := GetText('GCmdForm', 'pcmAction2');
form.gbCMOffset.Caption := GetText('GCmdForm', 'pcmOffsetBlock');
form.Label9.Caption := GetText('GCmdForm', 'pcmOffsetPosX');
form.Label10.Caption := GetText('GCmdForm', 'pcmOffsetPosY');
form.btnGrabOffset.Hint := GetText('GCmdForm', 'pcmOffsetGrabHint');
form.cbCMEraseTarget.Caption := GetText('GCmdForm', 'pcmEraseTarget');
form.cbCMEraseTarget.Hint := GetText('GCmdForm', 'pcmEraseTargetHint');
// ----------
form.pgModifyAltitude.Caption := GetText('GCmdForm', 'PageModifyAlt');
form.rbSetTerrainAltitude.Caption := GetText('GCmdForm', 'pmaSetLandAlt');
form.rbSetTerrainAltitude.Hint := GetText('GCmdForm', 'pmaSetLandAltHint');
form.Label2.Caption := GetText('GCmdForm', 'pmaSetLandAltHelp');
form.rbRelativeAltitudeChange.Caption := GetText('GCmdForm', 'pmaChangeRelativeAlt');
form.rbRelativeAltitudeChange.Hint := GetText('GCmdForm', 'pmaChangeRelativeAltHint');
form.Label3.Caption := GetText('GCmdForm', 'pmaSetAltFromTo');
form.Label4.Caption := GetText('GCmdForm', 'pmaTo');
// ----------
form.pgDrawTerrain.Caption := GetText('GCmdForm', 'PageDrawTerrain');
form.gbDrawTerrainTiles.Caption := GetText('GCmdForm', 'pdtTileBlock');
form.lblDrawTerrainTilesDesc.Caption := GetText('GCmdForm', 'pdtTileHelp');
form.vdtTerrainTiles.Header.Columns[0].Text := GetText('GCmdForm', 'pdtId');
form.vdtTerrainTiles.Header.Columns[1].Text := GetText('GCmdForm', 'pdtImage');
form.vdtTerrainTiles.Header.Columns[2].Text := GetText('GCmdForm', 'pdtName');
form.btnDeleteTerrain.Hint := GetText('GCmdForm', 'pdtDeleteHint');
form.btnClearTerrain.Hint := GetText('GCmdForm', 'pdtClearHint');
// ----------
form.pgDeleteStatics.Caption := GetText('GCmdForm', 'PageDeleteItems');
form.gbDeleteStaticsTiles.Caption := GetText('GCmdForm', 'pdiTileBlock');
form.lblDeleteStaticsTilesDesc.Caption := GetText('GCmdForm', 'pdiTileHelp');
form.vdtDeleteStaticsTiles.Header.Columns[0].Text := GetText('GCmdForm', 'pdiId');
form.vdtDeleteStaticsTiles.Header.Columns[1].Text := GetText('GCmdForm', 'pdiImage');
form.vdtDeleteStaticsTiles.Header.Columns[2].Text := GetText('GCmdForm', 'pdiName');
form.btnDeleteDStaticsTiles.Hint := GetText('GCmdForm', 'pdiDeleteHint');
form.btnClearDStaticsTiles.Hint := GetText('GCmdForm', 'pdiClearHint');
form.GroupBox1.Caption := GetText('GCmdForm', 'pdiAltBoundBlock');
form.Label7.Caption := GetText('GCmdForm', 'pdiAltBoundHelp');
form.Label8.Caption := GetText('GCmdForm', 'pdiAltBoundTo');
// ----------
form.pgInsertStatics.Caption := GetText('GCmdForm', 'PageInsertItems');
form.gbInserStaticsTiles.Caption := GetText('GCmdForm', 'piiTileBlock');
form.lblInsertStaticsTiles.Caption := GetText('GCmdForm', 'piiTileHelp');
form.vdtInsertStaticsTiles.Header.Columns[0].Text := GetText('GCmdForm', 'piiId');
form.vdtInsertStaticsTiles.Header.Columns[1].Text := GetText('GCmdForm', 'piiImage');
form.vdtInsertStaticsTiles.Header.Columns[2].Text := GetText('GCmdForm', 'piiName');
form.btnDeleteIStaticsTiles.Hint := GetText('GCmdForm', 'piiDeleteHint');
form.btnClearIStaticsTiles.Hint := GetText('GCmdForm', 'piiClearHint');
form.gbStaticsProbability.Caption := GetText('GCmdForm', 'piiProbBlock');
form.Label5.Caption := GetText('GCmdForm', 'piiProbHelp');
form.Label6.Caption := GetText('GCmdForm', 'piiProbPercent');
form.gbStaticsPlacement.Caption := GetText('GCmdForm', 'piiAltPlaceBlock');
form.rbPlaceStaticsOnTerrain.Caption := GetText('GCmdForm', 'piiAltPlace1');
form.rbPlaceStaticsOnTop.Caption := GetText('GCmdForm', 'piiAltPlace2');
form.rbPlaceStaticsOnZ.Caption := GetText('GCmdForm', 'piiAltPlace3');
// ----------
// Обновляем вписок для перезагрузки текста
form.RenameNode(-1, form.pgArea.Caption);
form.RenameNode( 0, form.pgCopyMove.Caption);
form.RenameNode( 1, form.pgModifyAltitude.Caption);
form.RenameNode( 2, form.pgDrawTerrain.Caption);
form.RenameNode( 3, form.pgDeleteStatics.Caption);
form.RenameNode( 4, form.pgInsertStatics.Caption);
end;
{
procedure LanguageTranslate(form: TfrmMain);
begin
form.Caption := GetText('MainForm', '');
form.Hint := GetText('MainForm', 'Hint');
end;
procedure LanguageTranslate(form: TfrmMain);
begin
form.Caption := GetText('MainForm', '');
form.Hint := GetText('MainForm', 'Hint');
end;
}
procedure LanguageTranslate(form: TfrmAbout);
begin
form.Caption := GetText('AbouForm', 'FormTitle');
form.lbVersion := GetText('AbouForm', 'Version');
form.lbBuild := GetText('AbouForm', 'Build');
end;
function GetParseErText(key: string) : string;
begin
Result := GetText('ParseErr', key);
end;
end.

2
Imaging/ImagingClasses.pas
View File

@ -144,7 +144,7 @@ type
{ Indicates whether the current image is valid (proper format, { Indicates whether the current image is valid (proper format,
allowed dimensions, right size, ...).} allowed dimensions, right size, ...).}
property Valid: Boolean read GetValid; property Valid: Boolean read GetValid;
{{ Specifies the bounding rectangle of the image.} { Specifies the bounding rectangle of the image.}
property BoundsRect: TRect read GetBoundsRect; property BoundsRect: TRect read GetBoundsRect;
{ This event occurs when the image data size has just changed. That means { This event occurs when the image data size has just changed. That means
image width, height, or format has been changed.} image width, height, or format has been changed.}

2
Imaging/ImagingComponents.pas
View File

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

61
MulProvider/UArtProvider.pas
View File

@ -30,23 +30,49 @@ unit UArtProvider;
interface interface
uses uses
Graphics, UMulProvider, UMulBlock, UGenericIndex, UArt, UHue; Classes, Graphics, UMulProvider, UMulBlock, UGenericIndex, UArt, UHue, types;
type type
TArtProvider = class(TIndexedMulProvider) TArtProvider = class(TIndexedMulProvider)
constructor Create(OldFormat: Boolean; AData, AIndex: TStream; AReadOnly: Boolean = False); overload;
constructor Create(OldFormat: Boolean; AData, AIndex: string; AReadOnly: Boolean = False); overload;
protected protected
UseOldArtFormat: Boolean;
function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; override; function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; override;
function GetArtData(AID: Integer; AIndex: TGenericIndex; AColor: Word; function GetArtData(AID: Integer; AIndex: TGenericIndex; AColor: Word;
AHue: THue; APartialHue: Boolean): TArt; AHue: THue; APartialHue: Boolean): TArt;
public public
function GetArt(AID: Integer; AColor: Word; AHue: THue; APartialHue: Boolean): TArt; function GetArt(AID: Integer; AColor: Word; AHue: THue; APartialHue: Boolean): TArt;
function GetFlatLand(AID: Integer): TArt; function GetFlatLand(AID: Integer): TArt;
function GetArtSize(AID: Integer): TSize;
end; end;
implementation implementation
uses
Logging;
{ TArtProvider } { TArtProvider }
constructor TArtProvider.Create(OldFormat: Boolean; AData, AIndex: TStream; AReadOnly: Boolean = False);
begin
inherited Create(AData, AIndex, AReadOnly);
UseOldArtFormat := OldFormat;
if UseOldArtFormat
then Logger.Send([lcInfo], 'Using pre-Alpha ArtData Format')
else Logger.Send([lcInfo], 'Using common ArtData Format');
end;
constructor TArtProvider.Create(OldFormat: Boolean; AData, AIndex: string; AReadOnly: Boolean = False);
begin
inherited Create(AData, AIndex, AReadOnly);
UseOldArtFormat := OldFormat;
if UseOldArtFormat
then Logger.Send([lcInfo], 'Using pre-Alpha ArtData Format')
else Logger.Send([lcInfo], 'Using common ArtData Format');
end;
function TArtProvider.GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; function TArtProvider.GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock;
begin begin
Result := GetArtData(AID, AIndex, clBlack, nil, False); Result := GetArtData(AID, AIndex, clBlack, nil, False);
@ -60,14 +86,14 @@ begin
if AID < $4000 then if AID < $4000 then
Result := TArt.Create(FData, AIndex, atLand, AColor, AHue, APartialHue) Result := TArt.Create(FData, AIndex, atLand, AColor, AHue, APartialHue)
else else
Result := TArt.Create(FData, AIndex, atStatic, AColor, AHue, APartialHue); Result := TArt.Create(FData, AIndex, atStatic, AColor, AHue, APartialHue, UseOldArtFormat);
end end
else else
begin begin
if AID < $4000 then if AID < $4000 then
Result := TArt.Create(nil, nil, atLand, AColor, AHue, APartialHue) Result := TArt.Create(nil, nil, atLand, AColor, AHue, APartialHue)
else else
Result := TArt.Create(nil, nil, atStatic, AColor, AHue, APartialHue); Result := TArt.Create(nil, nil, atStatic, AColor, AHue, APartialHue, UseOldArtFormat);
end; end;
Result.ID := AID; Result.ID := AID;
end; end;
@ -91,11 +117,38 @@ var
begin begin
FIndex.Position := CalculateIndexOffset(AID); FIndex.Position := CalculateIndexOffset(AID);
genericIndex := TGenericIndex.Create(FIndex); genericIndex := TGenericIndex.Create(FIndex);
Result := TArt.Create(FData, genericIndex, atLandFlat); Result := TArt.Create(FData, genericIndex, atLandFlat, UseOldArtFormat);
genericIndex.Free; genericIndex.Free;
Result.OnChanged := @OnChanged; Result.OnChanged := @OnChanged;
Result.OnFinished := @OnFinished; Result.OnFinished := @OnFinished;
end; end;
function TArtProvider.GetArtSize(AID: Integer): TSize;
var
genericIndex: TGenericIndex;
//genericBlock: TMemoryStream;
value: SmallInt;
begin
if (AID < $4000)
then Result := Size(44, 44)
else begin
FIndex.Position := CalculateIndexOffset(AID);
genericIndex := TGenericIndex.Create(FIndex);
if (genericIndex.Lookup <> -1) and (genericIndex.Size > 0) then begin
FData.Position := genericIndex.Lookup + 4;
//genericBlock := TMemoryStream.Create;
//genericBlock.CopyFrom(FData, 8);
//genericBlock.Position := 4;
FData.Read(value, SizeOf(SmallInt)); Result.cx := value;
FData.Read(value, SizeOf(SmallInt)); Result.cy := value;
//if Assigned(genericBlock) then genericBlock.Free;
end else
Result := Size(0, 0);
genericIndex.Free;
end;
end;
end. end.

35
MulProvider/UTexmapProvider.pas
View File

@ -30,23 +30,50 @@ unit UTexmapProvider;
interface interface
uses uses
UMulProvider, UMulBlock, UGenericIndex, UTexture; Classes, UMulProvider, UMulBlock, UGenericIndex, UTexture;
type type
TTexmapProvider = class(TIndexedMulProvider) TTexmapProvider = class(TIndexedMulProvider)
constructor Create(OldFormat: Boolean; AData, AIndex: TStream; AReadOnly: Boolean = False); overload;
constructor Create(OldFormat: Boolean; AData, AIndex: string; AReadOnly: Boolean = False); overload;
protected protected
UseOldArtFormat: Boolean;
function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; override; function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; override;
end; end;
implementation implementation
uses
Logging;
{ TTexmapProvider } { TTexmapProvider }
constructor TTexmapProvider.Create(OldFormat: Boolean; AData, AIndex: TStream; AReadOnly: Boolean = False);
begin
inherited Create(AData, AIndex, AReadOnly);
UseOldArtFormat := OldFormat;
if UseOldArtFormat
then Logger.Send([lcInfo], 'Using textures in ArtData')
else Logger.Send([lcInfo], 'Using textures in TexMaps');
end;
constructor TTexmapProvider.Create(OldFormat: Boolean; AData, AIndex: string; AReadOnly: Boolean = False);
begin
inherited Create(AData, AIndex, AReadOnly);
UseOldArtFormat := OldFormat;
if UseOldArtFormat
then Logger.Send([lcInfo], 'Using textures in ArtData')
else Logger.Send([lcInfo], 'Using textures in TexMaps');
end;
function TTexmapProvider.GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; function TTexmapProvider.GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock;
begin begin
if (AIndex.Lookup > -1) and (AIndex.Size > 0) then if (AIndex.Lookup > -1) and (AIndex.Size > 0) then begin
Result := TTexture.Create(FData, AIndex) //Result := TTexture.Create(FData, AIndex)
else if not UseOldArtFormat
then Result := TTexture.Create(FData, AIndex)
else Result := TOldTexture.Create(Cardinal(AID));
end else
Result := TTexture.Create(-1); Result := TTexture.Create(-1);
Result.ID := AID; Result.ID := AID;
end; end;

120
MulProvider/UTileDataProvider.pas
View File

@ -39,22 +39,27 @@ type
{ TTiledataProvider } { TTiledataProvider }
TTiledataProvider = class(TMulProvider) TTiledataProvider = class(TMulProvider)
constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; override; constructor Create(OldFormat: Boolean; AData: TStream; AReadOnly: Boolean = False); overload;
constructor Create(AData: string; AReadOnly: Boolean = False); overload; override; constructor Create(OldFormat: Boolean; AData: string; AReadOnly: Boolean = False); overload;
destructor Destroy; override; destructor Destroy; override;
protected protected
FLandTiles: TLandTileDataArray; FLandTiles: TLandTileDataArray;
FEmptyLandTile: TLandTileData;
FStaticTiles: TStaticTileDataArray; FStaticTiles: TStaticTileDataArray;
FEmptyStaticTile: TStaticTileData;
FStaticCount: Cardinal; FStaticCount: Cardinal;
UseOldTileDataFormat: Boolean;
procedure InitArray; procedure InitArray;
function CalculateOffset(AID: Integer): Integer; override; function CalculateOffset(AID: Integer): Integer; override;
function GetData(AID, AOffset: Integer): TMulBlock; override; function GetData(AID, AOffset: Integer): TMulBlock; override;
procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override; procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override;
function GetTileData(AID: Integer): TTiledata; function GetTileData(AID: Integer): TTiledata;
function GetLandTileData(AID: Integer): TLandTileData;
function GetStaticTileData(AID: Integer): TStaticTileData;
public public
function GetBlock(AID: Integer): TMulBlock; override; function GetBlock(AID: Integer): TMulBlock; override;
property LandTiles: TLandTileDataArray read FLandTiles; property LandTiles[AID: Integer]: TLandTileData read GetLandTileData;
property StaticTiles: TStaticTileDataArray read FStaticTiles; property StaticTiles[AID: Integer]: TStaticTileData read GetStaticTileData;
property TileData[AID: Integer]: TTiledata read GetTileData; //all tiles, no cloning property TileData[AID: Integer]: TTiledata read GetTileData; //all tiles, no cloning
property StaticCount: Cardinal read FStaticCount; property StaticCount: Cardinal read FStaticCount;
end; end;
@ -68,18 +73,26 @@ uses
function TTiledataProvider.CalculateOffset(AID: Integer): Integer; function TTiledataProvider.CalculateOffset(AID: Integer): Integer;
begin begin
Result := GetTileDataOffset(AID); Result := GetTileDataOffset(AID, UseOldTileDataFormat);
end; end;
constructor TTiledataProvider.Create(AData: TStream; AReadOnly: Boolean = False); constructor TTiledataProvider.Create(OldFormat: Boolean; AData: TStream; AReadOnly: Boolean = False);
begin begin
inherited; inherited Create(AData, AReadOnly);
UseOldTileDataFormat := OldFormat; //(FData.Size <= 1644544);
if UseOldTileDataFormat
then Logger.Send([lcInfo], 'Using Old TileData Format')
else Logger.Send([lcInfo], 'Using New TileData Format');
InitArray; InitArray;
end; end;
constructor TTiledataProvider.Create(AData: string; AReadOnly: Boolean = False); constructor TTiledataProvider.Create(OldFormat: Boolean; AData: string; AReadOnly: Boolean = False);
begin begin
inherited; inherited Create(AData, AReadOnly);
UseOldTileDataFormat := OldFormat; //(FData.Size <= 1644544);
if UseOldTileDataFormat
then Logger.Send([lcInfo], 'Using Old TileData Format')
else Logger.Send([lcInfo], 'Using New TileData Format');
InitArray; InitArray;
end; end;
@ -117,23 +130,60 @@ var
begin begin
FData.Position := 0; FData.Position := 0;
Logger.Send([lcInfo], 'Loading $4000 LandTiledata Entries'); Logger.Send([lcInfo], 'Loading $4000 LandTiledata Entries');
for i := $0 to $3FFF do if UseOldTileDataFormat
begin then for i := $0 to $3FFF do
if i mod 32 = 0 then begin
FData.Seek(4, soFromCurrent); if i mod 32 = 0 then
FLandTiles[i] := TLandTileData.Create(FData); FData.Seek(4, soFromCurrent);
end; FLandTiles[i] := TLandOldTileData.Create(FData);
end
else for i := $0 to $3FFF do
begin
if i mod 32 = 0 then
FData.Seek(4, soFromCurrent);
FLandTiles[i] := TLandTileData.Create(FData);
end;
FStaticCount := ((FData.Size - FData.Position) div StaticTileGroupSize) * 32; if UseOldTileDataFormat
then FStaticCount := ((FData.Size - FData.Position) div StaticOldTileGroupSize) * 32
else FStaticCount := ((FData.Size - FData.Position) div StaticTileGroupSize) * 32;
Logger.Send([lcInfo], 'Loading $%x StaticTiledata Entries', [FStaticCount]); Logger.Send([lcInfo], 'Loading $%x StaticTiledata Entries', [FStaticCount]);
SetLength(FStaticTiles, FStaticCount); SetLength(FStaticTiles, FStaticCount);
for i := 0 to FStaticCount - 1 do if UseOldTileDataFormat
begin then for i := 0 to FStaticCount - 1 do
if i mod 32 = 0 then begin
FData.Seek(4, soFromCurrent); if i mod 32 = 0 then
FStaticTiles[i] := TStaticTileData.Create(FData); FData.Seek(4, soFromCurrent);
end; FStaticTiles[i] := TStaticOldTileData.Create(FData);
end
else for i := 0 to FStaticCount - 1 do
begin
if i mod 32 = 0 then
FData.Seek(4, soFromCurrent);
FStaticTiles[i] := TStaticTileData.Create(FData);
end;
// empty
FEmptyLandTile := FLandTiles[0].Clone;
FEmptyLandTile.Flags := [];
FEmptyLandTile.TextureID := 0;
FEmptyStaticTile := FStaticTiles[0].Clone;
FEmptyStaticTile.Flags := [];
//FEmptyStaticTile.Flags2 := 0;
FEmptyStaticTile.TileName := '!! NOT EXISTING !!';
FEmptyStaticTile.Weight := 0;
FEmptyStaticTile.Quality := 0;
FEmptyStaticTile.Unknown1 := 0;
FEmptyStaticTile.Unknown2 := 0;
FEmptyStaticTile.Quantity := 0;
FEmptyStaticTile.AnimID := 0;
FEmptyStaticTile.Unknown3 := 0;
FEmptyStaticTile.Hue := 0;
FEmptyStaticTile.Unknown4 := 0;
FEmptyStaticTile.Height := 0;
end; end;
procedure TTiledataProvider.SetData(AID, AOffset: Integer; procedure TTiledataProvider.SetData(AID, AOffset: Integer;
@ -145,11 +195,15 @@ begin
if AID < $4000 then if AID < $4000 then
begin begin
FreeAndNil(FLandTiles[AID]); FreeAndNil(FLandTiles[AID]);
FLandTiles[AID] := TLandTileData(ABlock.Clone); if UseOldTileDataFormat
then FLandTiles[AID] := TLandOldTileData(ABlock.Clone)
else FLandTiles[AID] := TLandTileData(ABlock.Clone);
end else end else
begin begin
FreeAndNil(FStaticTiles[AID - $4000]); FreeAndNil(FStaticTiles[AID - $4000]);
FStaticTiles[AID - $4000] := TStaticTileData(ABlock.Clone); if UseOldTileDataFormat
then FStaticTiles[AID - $4000] := TStaticOldTileData(ABlock.Clone)
else FStaticTiles[AID - $4000] := TStaticTileData(ABlock.Clone);
end; end;
if not FReadOnly then if not FReadOnly then
@ -164,7 +218,23 @@ begin
if AID < $4000 then if AID < $4000 then
Result := FLandTiles[AID] Result := FLandTiles[AID]
else else
Result := FStaticTiles[AID - $4000]; Result := StaticTiles[AID - $4000];
end;
function TTiledataProvider.GetLandTileData(AID: Integer): TLandTileData;
begin
if (AID >= 0) and (AID < $4000) then
Result := FLandTiles[AID]
else
Result := FEmptyLandTile;
end;
function TTiledataProvider.GetStaticTileData(AID: Integer): TStaticTileData;
begin
if (AID >= 0) and (AID < FStaticCount) then
Result := FStaticTiles[AID]
else
Result := FEmptyStaticTile;
end; end;
end. end.

10
ResourceBuilder.pas
View File

@ -27,8 +27,9 @@ program ResourceBuilder;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
uses uses
SysUtils, Classes; SysUtils, Classes, strutils, Crc32Hash;
var var
fileList: TStringList; fileList: TStringList;
@ -36,6 +37,7 @@ var
i, count: Integer; i, count: Integer;
size: Cardinal; size: Cardinal;
lookupTable: array of Cardinal; lookupTable: array of Cardinal;
fnHashTable: array of Cardinal;
begin begin
if ParamCount <> 2 then if ParamCount <> 2 then
@ -50,11 +52,14 @@ begin
count := fileList.Count; count := fileList.Count;
outfile.Write(count, SizeOf(Integer)); outfile.Write(count, SizeOf(Integer));
SetLength(lookupTable, count); SetLength(lookupTable, count);
SetLength(fnHashTable, count);
outfile.Write(lookupTable[0], count * SizeOf(Cardinal)); outfile.Write(lookupTable[0], count * SizeOf(Cardinal));
outfile.Write(fnHashTable[0], count * SizeOf(Cardinal));
for i := 0 to count - 1 do for i := 0 to count - 1 do
begin begin
lookupTable[i] := outfile.Position; lookupTable[i] := outfile.Position;
writeln(i, ': ', fileList.Strings[i]); CalcStringCRC32(AnsiLowerCase(fileList.Strings[i]), fnHashTable[i]);
writeln(Format('#%.3d 0x%.8x : %s', [i, Int64(fnHashTable[i]), fileList.Strings[i]]));
infile := TFileStream.Create(fileList.Strings[i], fmOpenRead); infile := TFileStream.Create(fileList.Strings[i], fmOpenRead);
infile.Position := 0; infile.Position := 0;
size := infile.Size; size := infile.Size;
@ -64,6 +69,7 @@ begin
end; end;
outfile.Position := SizeOf(Integer); outfile.Position := SizeOf(Integer);
outfile.Write(lookupTable[0], count * SizeOf(Cardinal)); outfile.Write(lookupTable[0], count * SizeOf(Cardinal));
outfile.Write(fnHashTable[0], count * SizeOf(Cardinal));
outfile.Free; outfile.Free;
fileList.Free; fileList.Free;
end. end.

8
Server/UAccount.pas
View File

@ -49,15 +49,18 @@ type
FPasswordHash: string; FPasswordHash: string;
FLastPos: TPoint; FLastPos: TPoint;
FRegions: TStringList; FRegions: TStringList;
FLastLogon: TDateTime;
procedure SetAccessLevel(const AValue: TAccessLevel); procedure SetAccessLevel(const AValue: TAccessLevel);
procedure SetPasswordHash(const AValue: string); procedure SetPasswordHash(const AValue: string);
procedure SetLastPos(const AValue: TPoint); procedure SetLastPos(const AValue: TPoint);
procedure SetLastLogon(const ADateTime: TDateTime);
public public
property Name: string read FName; property Name: string read FName;
property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel; property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel;
property PasswordHash: string read FPasswordHash write SetPasswordHash; property PasswordHash: string read FPasswordHash write SetPasswordHash;
property LastPos: TPoint read FLastPos write SetLastPos; property LastPos: TPoint read FLastPos write SetLastPos;
property Regions: TStringList read FRegions; property Regions: TStringList read FRegions;
property LastLogon: TDateTime read FLastLogon write SetLastLogon;
procedure Invalidate; procedure Invalidate;
end; end;
@ -154,6 +157,11 @@ begin
Invalidate; Invalidate;
end; end;
procedure TAccount.SetLastLogon(const ADateTime: TDateTime);
begin
FLastLogon := ADateTime;
end;
procedure TAccount.Invalidate; procedure TAccount.Invalidate;
begin begin
FOwner.Invalidate; FOwner.Invalidate;

8
Server/UAdminHandling.pas
View File

@ -108,9 +108,13 @@ procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState); ANetState: TNetState);
var var
packetHandler: TPacketHandler; packetHandler: TPacketHandler;
packetID: Byte;
begin begin
if not ValidateAccess(ANetState, alAdministrator) then Exit; if not ValidateAccess(ANetState, alDeveloper) then Exit;
packetHandler := AdminPacketHandlers[ABuffer.ReadByte]; packetID := ABuffer.ReadByte;
if ((packetID <> $01) and not ValidateAccess(ANetState, alAdministrator)) then Exit;
packetHandler := AdminPacketHandlers[packetID];
if packetHandler <> nil then if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState); packetHandler.Process(ABuffer, ANetState);
end; end;

59
Server/UCEDServer.pas
View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, lNet, UEnhancedMemoryStream, UConfig, ULandscape, Classes, SysUtils, lNet, UEnhancedMemoryStream, UConfig, ULandscape,
UNetState, UPacket, dateutils, UNetState, UPacket, dateutils, LConvEncoding, Language,
{$IFDEF Linux}BaseUnix,{$ENDIF} {$IFDEF Linux}BaseUnix,{$ENDIF}
{$IFDEF Windows}Windows,{$ENDIF} {$IFDEF Windows}Windows,{$ENDIF}
UPacketHandlers, UConnectionHandling; UPacketHandlers, UConnectionHandling;
@ -44,6 +44,7 @@ type
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
protected protected
FWorkStart: TDateTime;
FLandscape: TLandscape; FLandscape: TLandscape;
FTCPServer: TLTcp; FTCPServer: TLTcp;
FQuit: Boolean; FQuit: Boolean;
@ -57,6 +58,7 @@ type
procedure ProcessBuffer(ANetState: TNetState); procedure ProcessBuffer(ANetState: TNetState);
procedure CheckNetStates; procedure CheckNetStates;
public public
property WorkStart: TDateTime read FWorkStart;
property Landscape: TLandscape read FLandscape; property Landscape: TLandscape read FLandscape;
property TCPServer: TLTcp read FTCPServer; property TCPServer: TLTcp read FTCPServer;
property Quit: Boolean read FQuit write FQuit; property Quit: Boolean read FQuit write FQuit;
@ -79,13 +81,13 @@ uses
{$IFDEF Linux} {$IFDEF Linux}
procedure OnSigInt(ASignal: cint); cdecl; procedure OnSigInt(ASignal: cint); cdecl;
begin begin
Writeln(TimeStamp, 'Killed'); Writeln(TimeStamp, GetText('Aborting'));
if CEDServerInstance <> nil then CEDServerInstance.Quit := True; if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end; end;
procedure OnSigSegv(ASignal: cint); cdecl; procedure OnSigSegv(ASignal: cint); cdecl;
begin begin
Writeln(TimeStamp, 'Internal error'); Writeln(TimeStamp, GetText('InternEr'));
Halt; Halt;
//if CEDServerInstance <> nil then CEDServerInstance.Quit := True; //if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end; end;
@ -97,7 +99,7 @@ begin
Result := False; Result := False;
if (ACtrl = CTRL_C_EVENT) or (ACtrl = CTRL_BREAK_EVENT) then if (ACtrl = CTRL_C_EVENT) or (ACtrl = CTRL_BREAK_EVENT) then
begin begin
Writeln(TimeStamp, 'Killed'); Writeln(TimeStamp, GetText('Aborting'));
if CEDServerInstance <> nil then CEDServerInstance.Quit := True; if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
Result := True; Result := True;
end; end;
@ -109,9 +111,10 @@ end;
constructor TCEDServer.Create; constructor TCEDServer.Create;
begin begin
inherited Create; inherited Create;
FWorkStart := Now;
FLandscape := TLandscape.Create(Config.Map.MapFile, Config.Map.StaticsFile, FLandscape := TLandscape.Create(Config.Map.MapFile, Config.Map.StaticsFile,
Config.Map.StaIdxFile, Config.Tiledata, Config.Radarcol, Config.Map.Width, Config.Map.StaIdxFile, Config.Tiledata, Config.Radarcol, Config.Map.Width,
Config.Map.Height, FValid); Config.Map.Height, Config.Map.FormatFlags, FValid);
FTCPServer := TLTcp.Create(nil); FTCPServer := TLTcp.Create(nil);
FTCPServer.OnAccept := @OnAccept; FTCPServer.OnAccept := @OnAccept;
FTCPServer.OnCanSend := @OnCanSend; FTCPServer.OnCanSend := @OnCanSend;
@ -145,7 +148,7 @@ end;
procedure TCEDServer.OnAccept(ASocket: TLSocket); procedure TCEDServer.OnAccept(ASocket: TLSocket);
begin begin
writeln(TimeStamp, 'Connect: ', ASocket.PeerAddress); writeln(TimeStamp, GetText('Connects') + ' ', ASocket.PeerAddress);
ASocket.UserData := TNetState.Create(ASocket); ASocket.UserData := TNetState.Create(ASocket);
SendPacket(TNetState(ASocket.UserData), TProtocolVersionPacket.Create(ProtocolVersion)); SendPacket(TNetState(ASocket.UserData), TProtocolVersionPacket.Create(ProtocolVersion));
end; end;
@ -172,11 +175,16 @@ procedure TCEDServer.OnDisconnect(ASocket: TLSocket);
var var
netState: TNetState; netState: TNetState;
begin begin
writeln(TimeStamp, 'Disconnect: ', ASocket.PeerAddress); writeln(TimeStamp, GetText('ConLosts') + ' ', ASocket.PeerAddress);
if ASocket.UserData <> nil then if ASocket.UserData <> nil then
begin begin
netState := TNetState(ASocket.UserData); netState := TNetState(ASocket.UserData);
ASocket.UserData := nil; ASocket.UserData := nil;
{$IFDEF NetLog}
if netState.Account <> nil
then writeln(TimeStamp, '$OnDisconnect("',netState.Account.Name,'")')
else writeln(TimeStamp, '$OnDisconnect("UNKNOWN")')
{$ENDIF}
if netState.Account <> nil then if netState.Account <> nil then
SendPacket(nil, TClientDisconnectedPacket.Create(netState.Account.Name)); SendPacket(nil, TClientDisconnectedPacket.Create(netState.Account.Name));
netState.Free; netState.Free;
@ -203,8 +211,9 @@ end;
procedure TCEDServer.OnError(const AError: string; ASocket: TLSocket); procedure TCEDServer.OnError(const AError: string; ASocket: TLSocket);
begin begin
writeln(TimeStamp, 'Error: ', ASocket.PeerAddress, ' :: ', AError); writeln(TimeStamp, GetText('ErrorLbl') + ' ', ASocket.PeerAddress, ' :: ', TranslateTextA(AError));
//OnDisconnect(ASocket); //OnDisconnect(ASocket);
ASocket.Disconnect(True);
end; end;
procedure TCEDServer.ProcessBuffer(ANetState: TNetState); procedure TCEDServer.ProcessBuffer(ANetState: TNetState);
@ -220,6 +229,12 @@ begin
while (buffer.Size >= 1) and ANetState.Socket.Connected do while (buffer.Size >= 1) and ANetState.Socket.Connected do
begin begin
packetID := buffer.ReadByte; packetID := buffer.ReadByte;
{$IFDEF NetLog}
if (ANetState.Account <> nil)
then writeln(TimeStamp, Format('NetState: [0x%.2x] <<-- "%s"', [packetID, ANetState.Account.Name]))
else writeln(TimeStamp, Format('NetState: [0x%.2x] <<-- "NEW (%s:%d)"', [packetID, ANetState.Socket.PeerAddress, ANetState.Socket.PeerPort]));
{$ENDIF}
packetHandler := PacketHandlers[packetID]; packetHandler := PacketHandlers[packetID];
if packetHandler <> nil then if packetHandler <> nil then
begin begin
@ -243,7 +258,7 @@ begin
Break; //wait for more data Break; //wait for more data
end else end else
begin begin
Writeln(TimeStamp, 'Dropping client due to unknown packet [', packetID, ']: ', ANetState.Socket.PeerAddress); Writeln(TimeStamp, GetText('UnkPack1'), packetID, GetText('UnkPack2') + ' ', ANetState.Socket.PeerAddress);
Disconnect(ANetState.Socket); Disconnect(ANetState.Socket);
buffer.Clear; buffer.Clear;
end; end;
@ -253,7 +268,7 @@ begin
on E: Exception do on E: Exception do
begin begin
Logger.SendException([lcServer], 'Error processing buffer', E); Logger.SendException([lcServer], 'Error processing buffer', E);
Writeln(TimeStamp, 'Error processing buffer of client: ', ANetState.Socket.PeerAddress); Writeln(TimeStamp, GetText('BufferEr') + ' ', ANetState.Socket.PeerAddress);
end; end;
end; end;
end; end;
@ -273,13 +288,16 @@ begin
if (SecondsBetween(netState.LastAction, Now) > 120) then if (SecondsBetween(netState.LastAction, Now) > 120) then
begin begin
if netState.Account <> nil then if netState.Account <> nil then
Writeln(TimeStamp, 'Timeout: ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')') Writeln(TimeStamp, GetText('TimeOuts') + ' ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')')
else else
Writeln(TimeStamp, 'Timeout: ', netState.Socket.PeerAddress); Writeln(TimeStamp, GetText('TimeOuts') + ' ', netState.Socket.PeerAddress);
Disconnect(netState.Socket); Disconnect(netState.Socket);
end; end;
end else {TODO : Unnecessary ...} end else {TODO : Unnecessary ...}
begin begin
{$IFDEF NetLog}
Writeln(TimeStamp, GetText('$CheckNetStates - OnDisconnect'));
{$ENDIF}
OnDisconnect(FTCPServer.Iterator); OnDisconnect(FTCPServer.Iterator);
end; end;
end; end;
@ -290,7 +308,7 @@ procedure TCEDServer.Run;
begin begin
if not FValid then if not FValid then
begin begin
Writeln(TimeStamp, 'Invalid data. Check the map size and the files.'); Writeln(TimeStamp, GetText('BadFacet'));
Exit; Exit;
end; end;
@ -317,22 +335,37 @@ var
begin begin
if ANetState <> nil then if ANetState <> nil then
begin begin
{$IFDEF NetLog}
if (ANetState.Account <> nil)
then writeln(TimeStamp, Format('NetState: [0x%.2x] -->> "%s"', [APacket.PacketID, ANetState.Account.Name]))
else writeln(TimeStamp, Format('NetState: [0x%.2x] -->> "NEW (%s:%d)"', [APacket.PacketID, ANetState.Socket.PeerAddress, ANetState.Socket.PeerPort]));
{$ENDIF}
ANetState.SendQueue.Seek(0, soFromEnd); ANetState.SendQueue.Seek(0, soFromEnd);
ANetState.SendQueue.CopyFrom(APacket.Stream, 0); ANetState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(ANetState.Socket); OnCanSend(ANetState.Socket);
end else //broadcast end else //broadcast
begin begin
{$IFDEF NetLog}
write(TimeStamp, Format('NetState: [0x%.2x] -->> "BROADCAST: ', [APacket.PacketID]));
{$ENDIF}
FTCPServer.IterReset; FTCPServer.IterReset;
while FTCPServer.IterNext do while FTCPServer.IterNext do
begin begin
netState := TNetState(FTCPServer.Iterator.UserData); netState := TNetState(FTCPServer.Iterator.UserData);
if (netState <> nil) and (FTCPServer.Iterator.Connected) then if (netState <> nil) and (FTCPServer.Iterator.Connected) then
begin begin
{$IFDEF NetLog}
write('.');
{$ENDIF}
netState.SendQueue.Seek(0, soFromEnd); netState.SendQueue.Seek(0, soFromEnd);
netState.SendQueue.CopyFrom(APacket.Stream, 0); netState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(netState.Socket); OnCanSend(netState.Socket);
end; end;
end; end;
{$IFDEF NetLog}
writeln(' "');
{$ENDIF}
end; end;
if AFreePacket then if AFreePacket then
APacket.Free; APacket.Free;

14
Server/UClientHandling.pas
View File

@ -31,14 +31,14 @@ interface
uses uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState, Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, Math; UEnhancedMemoryStream, UEnums, dateutils, Math;
type type
{ TClientConnectedPacket } { TClientConnectedPacket }
TClientConnectedPacket = class(TPacket) TClientConnectedPacket = class(TPacket)
constructor Create(AUsername: string); constructor Create(AAccount: TAccount);
end; end;
{ TClientDisconnectedPacket } { TClientDisconnectedPacket }
@ -170,11 +170,12 @@ end;
{ TClientConnectedPacket } { TClientConnectedPacket }
constructor TClientConnectedPacket.Create(AUsername: string); constructor TClientConnectedPacket.Create(AAccount: TAccount);
begin begin
inherited Create($0C, 0); inherited Create($0C, 0);
FStream.WriteByte($01); FStream.WriteByte($01);
FStream.WriteStringNull(AUsername); FStream.WriteStringNull(AAccount.Name);
FStream.WriteByte(Byte(AAccount.AccessLevel));
end; end;
{ TClientDisconnectedPacket } { TClientDisconnectedPacket }
@ -200,8 +201,11 @@ begin
repeat repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData); netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState <> AAvoid) and if (netState <> nil) and (netState <> AAvoid) and
(netState.Account <> nil) then (netState.Account <> nil) then begin
FStream.WriteStringNull(netState.Account.Name); FStream.WriteStringNull(netState.Account.Name);
FStream.WriteByte(Byte(netState.Account.AccessLevel));
FStream.WriteDWord(DWord(SecondsBetween(netState.Account.LastLogon, CEDServerInstance.WorkStart)));
end;
until not CEDServerInstance.TCPServer.IterNext; until not CEDServerInstance.TCPServer.IterNext;
end; end;
end; end;

104
Server/UConfig.pas
View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount, Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount,
UXmlHelper, UInterfaces, UEnums, URegions; UXmlHelper, UInterfaces, UEnums, URegions, LConvEncoding, Language;
type type
@ -50,17 +50,20 @@ type
FStaIdxFile: string; FStaIdxFile: string;
FWidth: Word; FWidth: Word;
FHeight: Word; FHeight: Word;
FFormatFlags: Cardinal;
procedure SetHeight(const AValue: Word); procedure SetHeight(const AValue: Word);
procedure SetMapFile(const AValue: string); procedure SetMapFile(const AValue: string);
procedure SetStaIdxFile(const AValue: string); procedure SetStaIdxFile(const AValue: string);
procedure SetStaticsFile(const AValue: string); procedure SetStaticsFile(const AValue: string);
procedure SetWidth(const AValue: Word); procedure SetWidth(const AValue: Word);
procedure SetFormatFlags(const AValue: Cardinal);
public public
property MapFile: string read FMapFile write SetMapFile; property MapFile: string read FMapFile write SetMapFile;
property StaticsFile: string read FStaticsFile write SetStaticsFile; property StaticsFile: string read FStaticsFile write SetStaticsFile;
property StaIdxFile: string read FStaIdxFile write SetStaIdxFile; property StaIdxFile: string read FStaIdxFile write SetStaIdxFile;
property Width: Word read FWidth write SetWidth; property Width: Word read FWidth write SetWidth;
property Height: Word read FHeight write SetHeight; property Height: Word read FHeight write SetHeight;
property FormatFlags: Cardinal read FFormatFlags write SetFormatFlags;
end; end;
{ TConfig } { TConfig }
@ -76,6 +79,7 @@ type
FMap: TMapInfo; FMap: TMapInfo;
FTiledata: string; FTiledata: string;
FRadarcol: string; FRadarcol: string;
FLanguage: string;
FRegions: TRegionList; FRegions: TRegionList;
FAccounts: TAccountList; FAccounts: TAccountList;
FChanged: Boolean; FChanged: Boolean;
@ -89,6 +93,7 @@ type
property Radarcol: string read FRadarcol write SetRadarcol; property Radarcol: string read FRadarcol write SetRadarcol;
property Regions: TRegionList read FRegions; property Regions: TRegionList read FRegions;
property Accounts: TAccountList read FAccounts; property Accounts: TAccountList read FAccounts;
property Language: string read FLanguage;
procedure Flush; procedure Flush;
procedure Invalidate; procedure Invalidate;
end; end;
@ -97,13 +102,14 @@ var
AppDir: string; AppDir: string;
ConfigFile: string; ConfigFile: string;
Config: TConfig; Config: TConfig;
tmp_i: Integer;
function TimeStamp: string; function TimeStamp: string;
implementation implementation
const const
CONFIGVERSION = 3; CONFIGVERSION = 5;
function QueryPassword: String; function QueryPassword: String;
var var
@ -130,7 +136,9 @@ end;
function TimeStamp: string; function TimeStamp: string;
begin begin
Result := '[' + DateTimeToStr(Now) + '] '; //Result := '[' + DateTimeToStr(Now) + '] ';
//Result := FormatDateTime('[yyyy.mm.dd hh:mm:ss] ', Now);
Result := FormatDateTime('[hh:mm:ss] ', Now);
end; end;
{ TMapInfo } { TMapInfo }
@ -149,22 +157,19 @@ begin
FStaticsFile := TXmlHelper.ReadString(AElement, 'Statics', 'statics0.mul'); FStaticsFile := TXmlHelper.ReadString(AElement, 'Statics', 'statics0.mul');
FWidth := TXmlHelper.ReadInteger(AElement, 'Width', 768); FWidth := TXmlHelper.ReadInteger(AElement, 'Width', 768);
FHeight := TXmlHelper.ReadInteger(AElement, 'Height', 512); FHeight := TXmlHelper.ReadInteger(AElement, 'Height', 512);
FFormatFlags := $F0000000 + Cardinal(TXmlHelper.ReadInteger(AElement, 'Format', $0000) and $0000FFFF);
end; end;
procedure TMapInfo.Serialize(AElement: TDOMElement); procedure TMapInfo.Serialize(AElement: TDOMElement);
begin begin
TXmlHelper.WriteString(AElement, 'Map', FMapFile); TXmlHelper.WriteString(AElement, 'Map', FMapFile);
TXmlHelper.WriteString(AElement, 'StaIdx', FStaIdxFile); TXmlHelper.WriteString(AElement, 'StaIdx', FStaIdxFile);
TXmlHelper.WriteString(AElement, 'Statics', FStaticsFile); TXmlHelper.WriteString(AElement, 'Statics',FStaticsFile);
TXmlHelper.WriteInteger(AElement, 'Width', FWidth); TXmlHelper.WriteInteger(AElement,'Width', FWidth);
TXmlHelper.WriteInteger(AElement, 'Height', FHeight); TXmlHelper.WriteInteger(AElement,'Height', FHeight);
TXmlHelper.WriteString(AElement, 'Format', Format('0x%.8x', [(FFormatFlags and $0000FFFF)]));
end; end;
procedure TMapInfo.SetHeight(const AValue: Word);
begin
FHeight := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetMapFile(const AValue: string); procedure TMapInfo.SetMapFile(const AValue: string);
begin begin
@ -190,6 +195,18 @@ begin
FOwner.Invalidate; FOwner.Invalidate;
end; end;
procedure TMapInfo.SetHeight(const AValue: Word);
begin
FHeight := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetFormatFlags(const AValue: Cardinal);
begin
FFormatFlags := AValue;
FOwner.Invalidate;
end;
{ TConfig } { TConfig }
constructor TConfig.Create(AFilename: string); constructor TConfig.Create(AFilename: string);
@ -216,8 +233,9 @@ begin
FTiledata := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Tiledata', 'tiledata.mul'); FTiledata := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Tiledata', 'tiledata.mul');
FRadarcol := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Radarcol', 'radarcol.mul'); FRadarcol := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Radarcol', 'radarcol.mul');
FLanguage := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Language', '..\Language\English.ini');
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Regions')); xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Regions'));
if assigned(xmlElement) then if assigned(xmlElement) then
FRegions := TRegionList.Deserialize(Self, xmlElement) FRegions := TRegionList.Deserialize(Self, xmlElement)
else else
@ -244,26 +262,36 @@ begin
FAccounts := TAccountList.Create(Self); FAccounts := TAccountList.Create(Self);
FRegions := TRegionList.Create(Self); FRegions := TRegionList.Create(Self);
Writeln('Configuring Network'); Writeln('');
Writeln('==================='); Writeln('==============');
Write ('Port [2597]: '); FLanguage := '..\Language\English.ini';
Writeln(UTF8ToCP866('language file [' + FLanguage + ']'));
Readln (stringValue);
if (stringValue <> '')
then FLanguage := stringValue;
LanguageLoad(FLanguage);
Writeln('');
Writeln(GetText('iNetwork'));
Writeln('==============');
Write (GetText('iSetPort') + UTF8ToCP866(' [2597]: '));
Readln (stringValue); Readln (stringValue);
intValue := 0; intValue := 0;
if not TryStrToInt(stringValue, intValue) then intValue := 2597; if not TryStrToInt(stringValue, intValue) then intValue := 2597;
FPort := intValue; FPort := intValue;
Writeln(''); Writeln('');
Writeln('Configuring Paths'); Writeln(GetText('iDatPath'));
Writeln('================='); Writeln('===============');
Write ('map [map0.mul]: '); Write ('map [map0.mul]: ');
Readln (FMap.FMapFile); Readln (FMap.FMapFile);
if FMap.MapFile = '' then FMap.MapFile := 'map0.mul'; if FMap.MapFile = '' then FMap.MapFile := 'map0.mul';
Write ('statics [statics0.mul]: '); Write ('staidx [staidx0.mul]: ');
Readln (FMap.FStaticsFile);
if FMap.StaticsFile = '' then FMap.StaticsFile := 'statics0.mul';
Write ('staidx [staidx0.mul]: ');
Readln (FMap.FStaIdxFile); Readln (FMap.FStaIdxFile);
if FMap.StaIdxFile = '' then FMap.StaIdxFile := 'staidx0.mul'; if FMap.StaIdxFile = '' then FMap.StaIdxFile := 'staidx0.mul';
Write ('statics [statics0.mul]: ');
Readln (FMap.FStaticsFile);
if FMap.StaticsFile = '' then FMap.StaticsFile := 'statics0.mul';
Write ('tiledata [tiledata.mul]: '); Write ('tiledata [tiledata.mul]: ');
Readln (FTiledata); Readln (FTiledata);
if FTiledata = '' then FTiledata := 'tiledata.mul'; if FTiledata = '' then FTiledata := 'tiledata.mul';
@ -272,25 +300,29 @@ begin
if FRadarcol = '' then FRadarcol := 'radarcol.mul'; if FRadarcol = '' then FRadarcol := 'radarcol.mul';
Writeln(''); Writeln('');
Writeln('Parameters'); Writeln(GetText('iMapDesc'));
Writeln('=========='); Writeln('===============');
Write ('Map width [768]: '); Write (GetText('iMapWidt') + UTF8ToCP866(' [768]: '));
Readln (stringValue); Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 768; if not TryStrToInt(stringValue, intValue) then intValue := 768;
FMap.Width := intValue; FMap.Width := intValue;
Write ('Map height [512]: '); Write (GetText('iMapHeig') + UTF8ToCP866(' [512]: '));
Readln (stringValue); Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 512; if not TryStrToInt(stringValue, intValue) then intValue := 512;
FMap.Height := intValue; FMap.Height := intValue;
Write (GetText('iDFormat') + UTF8ToCP866(' [0x0000]: '));
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := $0000;
FMap.FormatFlags := $F0000000 + Cardinal(intValue);
Writeln(''); Writeln('');
Writeln('Admin account'); Writeln(GetText('iAccount'));
Writeln('============='); Writeln('======================');
repeat repeat
Write('Account name: '); Write(GetText('iUserAcc') + UTF8ToCP866(' '));
Readln(stringValue); Readln(stringValue);
until stringValue <> ''; until stringValue <> '';
Write ('Password [hidden]: '); Write (GetText('iUserPas') + UTF8ToCP866(' '));
password := QueryPassword; password := QueryPassword;
FAccounts.Add(TAccount.Create(FAccounts, stringValue, FAccounts.Add(TAccount.Create(FAccounts, stringValue,
MD5Print(MD5String(password)), alAdministrator, nil)); MD5Print(MD5String(password)), alAdministrator, nil));
@ -308,6 +340,7 @@ end;
procedure TConfig.Serialize(AElement: TDOMElement); procedure TConfig.Serialize(AElement: TDOMElement);
begin begin
TXmlHelper.WriteString(AElement, 'Language', FLanguage);
TXmlHelper.WriteInteger(AElement, 'Port', FPort); TXmlHelper.WriteInteger(AElement, 'Port', FPort);
FMap.Serialize(TXmlHelper.AssureElement(AElement, 'Map')); FMap.Serialize(TXmlHelper.AssureElement(AElement, 'Map'));
TXmlHelper.WriteString(AElement, 'Tiledata', FTiledata); TXmlHelper.WriteString(AElement, 'Tiledata', FTiledata);
@ -361,9 +394,14 @@ begin
if AppDir[Length(AppDir)] <> PathDelim then if AppDir[Length(AppDir)] <> PathDelim then
AppDir := AppDir + PathDelim; AppDir := AppDir + PathDelim;
{TODO : add command line parameter to specify the config}
Config := nil; Config := nil;
ConfigFile := ChangeFileExt(ParamStr(0), '.xml'); ConfigFile := '';
for tmp_i := 0 to ParamCount do begin
if LowerCase(ExtractFileExt(ParamStr(tmp_i))) = '.xml'
then ConfigFile := ExtractFilePath(ParamStr(0)) + ParamStr(1);
end;
if ConfigFile = ''
then ConfigFile := ChangeFileExt(ParamStr(0), '.xml');
end; end;
end. end.

22
Server/UConnectionHandling.pas
View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState, Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums; UEnhancedMemoryStream, UEnums, dateutils, LConvEncoding, Language;
type type
@ -109,29 +109,29 @@ begin
if not invalid then if not invalid then
begin begin
Writeln(TimeStamp, 'Login (', username, '): ', ANetState.Socket.PeerAddress); Writeln(TimeStamp, GetText('UserReg1'), username, GetText('UserReg2'), ANetState.Socket.PeerAddress);
ANetState.Account := account; ANetState.Account := account;
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsOK, account)); CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsOK, account));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create( CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TClientListPacket.Create(ANetState))); TClientListPacket.Create(ANetState)));
CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(username)); CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(account));
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos)); CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end; end;
end else end else
begin begin
Writeln(TimeStamp, 'Invalid password for ', username); Writeln(TimeStamp, GetText('WrongPas') + ' ', username);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidPassword)); CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidPassword));
CEDServerInstance.Disconnect(ANetState.Socket); CEDServerInstance.Disconnect(ANetState.Socket);
end; end;
end else end else
begin begin
Writeln(TimeStamp, 'Access denied for ', username); Writeln(TimeStamp, GetText('UserBan1') + ' ', username, ' ' + GetText('UserBan2'));
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsNoAccess)); CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsNoAccess));
CEDServerInstance.Disconnect(ANetState.Socket); CEDServerInstance.Disconnect(ANetState.Socket);
end; end;
end else end else
begin begin
Writeln(TimeStamp, 'Invalid account specified: ', ANetState.Socket.PeerAddress); Writeln(TimeStamp, GetText('WrongAcc') + ' ', ANetState.Socket.PeerAddress);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidUser)); CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidUser));
CEDServerInstance.Disconnect(ANetState.Socket); CEDServerInstance.Disconnect(ANetState.Socket);
end; end;
@ -148,22 +148,26 @@ constructor TProtocolVersionPacket.Create(AVersion: Cardinal);
begin begin
inherited Create($02, 0); inherited Create($02, 0);
FStream.WriteByte($01); FStream.WriteByte($01);
FStream.WriteCardinal(AVersion); FStream.WriteCardinal($1000 + AVersion);
end; end;
{ TLoginResponsePacket } { TLoginResponsePacket }
constructor TLoginResponsePacket.Create(AState: TLoginState; constructor TLoginResponsePacket.Create(AState: TLoginState; AAccount: TAccount = nil);
AAccount: TAccount = nil); var
val1, val2, val3, val4 : Word;
begin begin
inherited Create($02, 0); inherited Create($02, 0);
FStream.WriteByte($03); FStream.WriteByte($03);
FStream.WriteByte(Byte(AState)); FStream.WriteByte(Byte(AState));
if AState = lsOK then if AState = lsOK then
begin begin
AAccount.LastLogon := Now;
FStream.WriteByte(Byte(AAccount.AccessLevel)); FStream.WriteByte(Byte(AAccount.AccessLevel));
FStream.WriteDWord(DWord(SecondsBetween(Now, CEDServerInstance.WorkStart)));
FStream.WriteWord(Config.Map.Width); FStream.WriteWord(Config.Map.Width);
FStream.WriteWord(Config.Map.Height); FStream.WriteWord(Config.Map.Height);
FStream.WriteCardinal(Config.Map.FormatFlags);
WriteAccountRestrictions(FStream, AAccount); WriteAccountRestrictions(FStream, AAccount);
end; end;
end; end;

51
Server/ULandscape.pas
View File

@ -32,8 +32,8 @@ interface
uses uses
SysUtils, Classes, math, UGenericIndex, UMap, UStatics, UWorldItem, SysUtils, Classes, math, UGenericIndex, UMap, UStatics, UWorldItem,
UTileDataProvider, URadarMap, UTileDataProvider, URadarMap,
UCacheManager, ULinkedList, UBufferedStreams, UCacheManager, ULinkedList, UBufferedStreams, Language,
UEnhancedMemoryStream, UPacketHandlers, UPackets, UNetState, UEnums; UEnhancedMemoryStream, UPacketHandlers, UPackets, UNetState, UEnums, LConvEncoding;
type type
PRadarBlock = ^TRadarBlock; PRadarBlock = ^TRadarBlock;
@ -79,9 +79,9 @@ type
TLandscape = class TLandscape = class
constructor Create(AMap, AStatics, AStaIdx, ATiledata, ARadarCol: string; constructor Create(AMap, AStatics, AStaIdx, ATiledata, ARadarCol: string;
AWidth, AHeight: Word; var AValid: Boolean); AWidth, AHeight: Word; FormatFlags: Cardinal; var AValid: Boolean);
constructor Create(AMap, AStatics, AStaIdx, ATiledata: TStream; constructor Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean); ARadarCol: string; AWidth, AHeight: Word; FormatFlags: Cardinal; var AValid: Boolean);
destructor Destroy; override; destructor Destroy; override;
protected protected
FWidth: Word; FWidth: Word;
@ -194,7 +194,7 @@ begin
for i := 0 to 63 do for i := 0 to 63 do
Cells[i] := TStaticItemList.Create(True); Cells[i] := TStaticItemList.Create(True);
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then if (AData <> nil) and (AIndex.Lookup >= 0) and (AIndex.Size > 0) then
begin begin
AData.Position := AIndex.Lookup; AData.Position := AIndex.Lookup;
block := TMemoryStream.Create; block := TMemoryStream.Create;
@ -285,11 +285,11 @@ end;
{ TLandscape } { TLandscape }
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata, constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata,
ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean); ARadarCol: string; AWidth, AHeight: Word; FormatFlags: Cardinal; var AValid: Boolean);
var var
map, statics, staidx, tiledata: TStream; map, statics, staidx, tiledata: TStream;
begin begin
Write(TimeStamp, 'Loading Map'); Write(TimeStamp, GetText('dfLoader') + ' Map');
map := TFileStream.Create(AMap, fmOpenReadWrite); map := TFileStream.Create(AMap, fmOpenReadWrite);
Write(', Statics'); Write(', Statics');
statics := TFileStream.Create(AStatics, fmOpenReadWrite); statics := TFileStream.Create(AStatics, fmOpenReadWrite);
@ -297,12 +297,12 @@ begin
staidx := TBufferedReader.Create(TFileStream.Create(AStaIdx, fmOpenReadWrite), True); staidx := TBufferedReader.Create(TFileStream.Create(AStaIdx, fmOpenReadWrite), True);
Writeln(', Tiledata'); Writeln(', Tiledata');
tiledata := TFileStream.Create(ATiledata, fmOpenRead or fmShareDenyWrite); tiledata := TFileStream.Create(ATiledata, fmOpenRead or fmShareDenyWrite);
Create(map, statics, staidx, tiledata, ARadarCol, AWidth, AHeight, AValid); Create(map, statics, staidx, tiledata, ARadarCol, AWidth, AHeight, FormatFlags, AValid);
FOwnsStreams := True; FOwnsStreams := True;
end; end;
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata: TStream; constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean); ARadarCol: string; AWidth, AHeight: Word; FormatFlags: Cardinal; var AValid: Boolean);
var var
blockID: Integer; blockID: Integer;
begin begin
@ -316,30 +316,33 @@ begin
FStaIdx := AStaIdx; FStaIdx := AStaIdx;
FTiledata := ATiledata; FTiledata := ATiledata;
FOwnsStreams := False; FOwnsStreams := False;
if (FormatFlags and $F0000000) = 0 then
raise Exception.Create('TLandscape.Create Unknown Format data flags.');
UseStaticsOldFormat := (FormatFlags and $00000001) <> 0;
AValid := Validate; AValid := Validate;
if AValid then if AValid then
begin begin
Write(TimeStamp, 'Creating Cache'); Write(TimeStamp, GetText('Creating') + ' ' + GetText('crtCache'));
FBlockCache := TBlockCache.Create(256); FBlockCache := TBlockCache.Create(256);
FBlockCache.OnRemoveObject := @OnRemoveCachedObject; FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
Write(', Tiledata'); Write(', Tiledata');
FTiledataProvider := TTiledataProvider.Create(ATiledata); FTiledataProvider := TTiledataProvider.Create((FormatFlags and $00000008) = 0, ATiledata);
Write(', Subscriptions'); Write(UTF8ToCP866(', ') + GetText('crtIndex')); //Subscriptions
SetLength(FBlockSubscriptions, AWidth * AHeight); SetLength(FBlockSubscriptions, AWidth * AHeight);
for blockID := 0 to AWidth * AHeight - 1 do for blockID := 0 to AWidth * AHeight - 1 do
FBlockSubscriptions[blockID] := TLinkedList.Create; FBlockSubscriptions[blockID] := TLinkedList.Create;
Writeln(', RadarMap'); Writeln(', RadarMap');
FRadarMap := TRadarMap.Create(FMap, FStatics, FStaIdx, FWidth, FHeight, FRadarMap := TRadarMap.Create(FMap, FStatics, FStaIdx, FWidth, FHeight, ARadarCol);
ARadarCol);
RegisterPacketHandler($06, TPacketHandler.Create(8, @OnDrawMapPacket)); RegisterPacketHandler($06, TPacketHandler.Create( 8, @OnDrawMapPacket));
RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket)); RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket));
RegisterPacketHandler($08, TPacketHandler.Create(10, @OnDeleteStaticPacket)); RegisterPacketHandler($08, TPacketHandler.Create(10, @OnDeleteStaticPacket));
RegisterPacketHandler($09, TPacketHandler.Create(11, @OnElevateStaticPacket)); RegisterPacketHandler($09, TPacketHandler.Create(11, @OnElevateStaticPacket));
RegisterPacketHandler($0A, TPacketHandler.Create(14, @OnMoveStaticPacket)); RegisterPacketHandler($0A, TPacketHandler.Create(14, @OnMoveStaticPacket));
RegisterPacketHandler($0B, TPacketHandler.Create(12, @OnHueStaticPacket)); RegisterPacketHandler($0B, TPacketHandler.Create(12, @OnHueStaticPacket));
RegisterPacketHandler($0E, TPacketHandler.Create(0, @OnLargeScaleCommandPacket)); RegisterPacketHandler($0E, TPacketHandler.Create( 0, @OnLargeScaleCommandPacket));
end; end;
end; end;
@ -562,17 +565,21 @@ var
size: Integer; size: Integer;
index: TGenericIndex; index: TGenericIndex;
begin begin
// Карта
if AWorldBlock is TMapBlock then if AWorldBlock is TMapBlock then
begin begin
FMap.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 196; FMap.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 196;
AWorldBlock.Write(FMap); AWorldBlock.Write(FMap);
AWorldBlock.Changed := False; AWorldBlock.Changed := False;
// Статика
end else if AWorldBlock is TStaticBlock then end else if AWorldBlock is TStaticBlock then
begin begin
FStaIdx.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 12; FStaIdx.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 12;
index := TGenericIndex.Create(FStaIdx); index := TGenericIndex.Create(FStaIdx);
size := AWorldBlock.GetSize; size := AWorldBlock.GetSize;
if (size > index.Size) or (index.Lookup < 0) then // Если размер блока больше чем в мул файле или в мул файле блока нет или
// смещение на блок равно 0 (статика океана), то создаем новый блок в конце файла
if (size > index.Size) or (index.Lookup <= 0) then
begin begin
FStatics.Position := FStatics.Size; FStatics.Position := FStatics.Size;
index.Lookup := FStatics.Position; index.Lookup := FStatics.Position;
@ -799,7 +806,7 @@ begin
if (staticInfo.X = newX) and (staticInfo.Y = newY) then Exit; if (staticInfo.X = newX) and (staticInfo.Y = newY) then Exit;
if ((abs(staticInfo.X - newX) > 8) or (abs(staticInfo.Y - newY) > 8)) and if ((abs(staticInfo.X - newX) > 8) or (abs(staticInfo.Y - newY) > 8)) and
(not ValidateAccess(ANetState, alAdministrator)) then Exit; (not ValidateAccess(ANetState, alDeveloper)) then Exit;
sourceBlock := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); sourceBlock := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
targetBlock := GetStaticBlock(newX div 8, newY div 8); targetBlock := GetStaticBlock(newX div 8, newY div 8);
@ -946,10 +953,10 @@ var
cmOperation: TLSCopyMove; cmOperation: TLSCopyMove;
additionalAffectedBlocks: TBits; additionalAffectedBlocks: TBits;
begin begin
if not ValidateAccess(ANetState, alAdministrator) then Exit; if not ValidateAccess(ANetState, alDeveloper) then Exit;
Writeln(TimeStamp, ANetState.Account.Name, ' begins large scale operation'); Writeln(TimeStamp, ANetState.Account.Name, ' ' + GetText('LCmdRuns'));
CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssOther, CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssOther,
Format('%s is performing large scale operations ...', [ANetState.Account.Name]))); Format(GetText('LCmdUsed'), [ANetState.Account.Name])));
//Bitmask //Bitmask
emptyBits := TBits.Create(64); emptyBits := TBits.Create(64);
@ -1157,7 +1164,7 @@ begin
end; end;
CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssRunning)); CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssRunning));
Writeln(TimeStamp, 'Large scale operation ended.'); Writeln(TimeStamp, GetText('LCmdEnds'));
end; end;
end. end.

4
Server/UPacketHandlers.pas
View File

@ -29,7 +29,7 @@ interface
uses uses
Classes, SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums, Classes, SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList, URegions; ULinkedList, URegions, LConvEncoding, Language;
type type
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
@ -151,7 +151,7 @@ begin
uncompStream.Unlock; uncompStream.Unlock;
end else end else
begin begin
Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress); Writeln(TimeStamp, GetText('UnkPack1'), packetID, GetText('UnkPack2') + ' ', ANetState.Socket.PeerAddress);
ANetState.ReceiveQueue.Clear; ANetState.ReceiveQueue.Clear;
CEDServerInstance.Disconnect(ANetState.Socket); CEDServerInstance.Disconnect(ANetState.Socket);
end; end;

46
Server/URadarMap.pas
View File

@ -60,7 +60,7 @@ type
implementation implementation
uses uses
UPacket, UPackets, UPacketHandlers, UCEDServer, crc; UPacket, UPackets, UPacketHandlers, UCEDServer, crc, UStatics;
type type
TMulIndex = packed record TMulIndex = packed record
@ -72,6 +72,13 @@ type
TileID: Word; TileID: Word;
Altitude: ShortInt; Altitude: ShortInt;
end; end;
TOldStaticItem = packed record
Unknown: Cardinal;
TileID: Word;
X, Y: Byte;
Z: ShortInt;
Hue: Word;
end;
TStaticItem = packed record TStaticItem = packed record
TileID: Word; TileID: Word;
X, Y: Byte; X, Y: Byte;
@ -138,6 +145,7 @@ var
radarcol: TFileStream; radarcol: TFileStream;
count, i, item, highestZ: Integer; count, i, item, highestZ: Integer;
staticsItems: array of TStaticItem; staticsItems: array of TStaticItem;
oldStaticsItems: array of TOldStaticItem;
mapCell: TMapCell; mapCell: TMapCell;
index: TMulIndex; index: TMulIndex;
begin begin
@ -161,21 +169,39 @@ begin
AMap.Seek(193, soFromCurrent); AMap.Seek(193, soFromCurrent);
FRadarMap[i] := FRadarColors[mapCell.TileID]; FRadarMap[i] := FRadarColors[mapCell.TileID];
AStaIdx.Read(index, SizeOf(TMulIndex)); AStaIdx.Read(index, SizeOf(TMulIndex));
if (index.Position < $FFFFFFFF) and (index.Size > 0) then if (index.Position < $FFFFFFFF) and (index.Size > 0)
and (index.Position + index.Size < AStatics.Size) then
begin begin
AStatics.Position := index.Position; AStatics.Position := index.Position;
SetLength(staticsItems, index.Size div 7); if not UseStaticsOldFormat then
AStatics.Read(staticsItems[0], index.Size);
highestZ := mapCell.Altitude;
for item := Low(staticsItems) to High(staticsItems) do
begin begin
if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and SetLength(staticsItems, index.Size div 7);
(staticsItems[item].Z >= highestZ) then AStatics.Read(staticsItems[0], index.Size);
highestZ := mapCell.Altitude;
for item := Low(staticsItems) to High(staticsItems) do
begin begin
highestZ := staticsItems[item].Z; if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and
FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000]; (staticsItems[item].Z >= highestZ) then
begin
highestZ := staticsItems[item].Z;
FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000];
end;
end;
end else begin
SetLength(oldStaticsItems, index.Size div 11);
AStatics.Read(oldStaticsItems[0], index.Size);
highestZ := mapCell.Altitude;
for item := Low(oldStaticsItems) to High(oldStaticsItems) do
begin
if (oldStaticsItems[item].X = 0) and (oldStaticsItems[item].Y = 0) and
(oldStaticsItems[item].Z >= highestZ) then
begin
highestZ := oldStaticsItems[item].Z;
FRadarMap[i] := FRadarColors[oldStaticsItems[item].TileID + $4000];
end;
end; end;
end; end;
end; end;
end; end;

60
Server/cedserver.lpi
View File

@ -1,29 +1,30 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="7"/> <Version Value="9"/>
<General> <General>
<Flags> <Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/> <MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<LRSInOutputDirectory Value="False"/> <LRSInOutputDirectory Value="False"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<TargetFileExt Value=".exe"/> <UseAppBundle Value="False"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General> </General>
<VersionInfo> <VersionInfo>
<UseVersionInfo Value="True"/> <UseVersionInfo Value="True"/>
<CurrentMajorRevNr Value="6"/> <AutoIncrementBuild Value="True"/>
<CurrentMinorRevNr Value="1"/> <MinorVersionNr Value="7"/>
<CurrentBuildNr Value="209"/> <RevisionNr Value="7"/>
<ProjectVersion Value="0.6.1.209"/> <BuildNr Value="261"/>
<CompanyName Value="AKS DataBasis"/> <StringTable CompanyName="www.uoquint.ru" FileDescription="UO CentrED+ Server" InternalName="CentrED+ Server" LegalCopyright="StaticZ" OriginalFilename="cedserver.exe" ProductName="CentrED+ Server" ProductVersion=""/>
<FileDescription Value="CentrED Server"/>
<InternalName Value="CentrED Server"/>
<LegalCopyright Value="Andreas Schneider"/>
<OriginalFilename Value="cedserver.exe"/>
<ProductName Value="CentrED"/>
</VersionInfo> </VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@ -43,7 +44,7 @@
<PackageName Value="lnetbase"/> <PackageName Value="lnetbase"/>
</Item2> </Item2>
</RequiredPackages> </RequiredPackages>
<Units Count="16"> <Units Count="17">
<Unit0> <Unit0>
<Filename Value="cedserver.lpr"/> <Filename Value="cedserver.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -124,40 +125,41 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="UMap"/> <UnitName Value="UMap"/>
</Unit15> </Unit15>
<Unit16>
<Filename Value="language.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Language"/>
</Unit16>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="8"/> <Version Value="9"/>
<Target> <Target>
<Filename Value="../bin/cedserver"/> <Filename Value="../bin/PEBinaries/cedserver.exe"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="../;../Imaging/"/> <IncludeFiles Value="..;../obj;../Imaging"/>
<OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/> <OtherUnitFiles Value="..;../UOLib;../Server;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;../Client"/>
<UnitOutputDirectory Value="../obj"/> <UnitOutputDirectory Value="../obj"/>
<SrcPath Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>
<SyntaxOptions> <SyntaxOptions>
<CStyleOperator Value="False"/> <UseAnsiStrings Value="False"/>
</SyntaxOptions> </SyntaxOptions>
</Parsing> </Parsing>
<CodeGeneration> <CodeGeneration>
<SmartLinkUnit Value="True"/> <TargetProcessor Value="pentium4"/>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
<Optimizations> <Optimizations>
<OptimizationLevel Value="3"/> <OptimizationLevel Value="3"/>
</Optimizations> </Optimizations>
</CodeGeneration> </CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other> <Other>
<CustomOptions Value="-FE../bin/ <CompilerMessages>
-dNoLogging"/> <UseMsgFile Value="True"/>
</CompilerMessages>
<CustomOptions Value="-dWindows"/>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>

29
Server/cedserver.lpr
View File

@ -31,44 +31,53 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads} {$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
SysUtils, UConfig, UCEDServer; SysUtils, UConfig, UCEDServer, LConvEncoding, vinfo, Language;
{$I version.inc} {$I version.inc}
{$IFDEF WINDOWS}{$R cedserver.rc}{$ENDIF} //{$IFDEF WINDOWS}{$R cedserver.rc}{$ENDIF}
{$R *.res}
begin begin
Writeln(''); Writeln('');
Writeln('CentrED Server Version ', ProductVersion); Writeln(Format('======= CentrED+ Server [Version: %s Build: %d] =======',
Writeln('Copyright ', Copyright); [VersionInfo.GetFileVersionString, VersionInfo.Build]));
Writeln('Copyright: ', Original);
Writeln(' : ', '"CentrED+" version (c) ', Copyright, ' (uoquint.ru)');
//Writeln(' : ', '!!! pre-release (not stable version) !!!');
//Writeln('Modified by StaticZ (uoquint.ru)');
//Writeln('================================'); //Writeln('================================');
Writeln('');
{$IFDEF Windows} {$IFDEF Windows}
if FileExists(ConfigFile) then if FileExists(ConfigFile) then
Config := TConfig.Create(ConfigFile) Config := TConfig.Create(ConfigFile)
else else
Config := TConfig.Init(ConfigFile); Config := TConfig.Init(ConfigFile);
LanguageLoad(Config.Language);
{$ELSE} {$ELSE}
if ParamStr(1) = '--init' then if ParamStr(1) = '--init' then
Config := TConfig.Init(ConfigFile) Config := TConfig.Init(ConfigFile)
else if FileExists(ConfigFile) then else if FileExists(ConfigFile) then
Config := TConfig.Create(ConfigFile) Config := TConfig.Create(ConfigFile)
else begin else begin
Writeln('No valid config file was found. Use --init to create one.'); Writeln(UTF8ToCP866('Файл конфигурации не был найден. Запустите програму с параметром --init чтобы создать новый файл конфигурации.'));
Halt; Halt;
end; end;
LanguageLoad(Config.Language);
{$ENDIF} {$ENDIF}
Writeln(TimeStamp, 'Initialization started'); Writeln(TimeStamp, GetText('xmLoaded') + ' "' + ExtractFileName(ConfigFile) + '"');
Writeln(TimeStamp, GetText('dfStRead'));
Randomize; Randomize;
CEDServerInstance := TCEDServer.Create; CEDServerInstance := TCEDServer.Create;
Writeln(TimeStamp, 'Initialization done'); Writeln(TimeStamp, GetText('dfInited'));
CEDServerInstance.Run; CEDServerInstance.Run;
Write(TimeStamp, 'Shutting down ... '); Write(TimeStamp, GetText('Quieting'));
FreeAndNil(CEDServerInstance); FreeAndNil(CEDServerInstance);
Config.Flush; Config.Flush;
FreeAndNil(Config); FreeAndNil(Config);
Writeln('done'); Writeln(GetText('SucsDone'));
end. end.

120
Server/language.pas Normal file
View File

@ -0,0 +1,120 @@
(*
* CDDL HEADER START
*
* gfgfgfg
*)
unit Language;
{$mode objfpc}{$H+}
interface
procedure LanguageLoad(path: string);
function TranslateText(text: string) : string;
function TranslateTextA(text: string) : string;
function GetText(section : string; key: string) : string;
function GetText(key: string) : string;
implementation
uses SysUtils, Classes, IniFiles, LConvEncoding, UConfig;
var
LangPath : string;
LangFile : TIniFile;
CodePage : Integer;
WinIsoCP : Integer;
LangAbbr : string;
LangName : string;
procedure LanguageLoad(path: string);
begin
if (Copy(path, 2, 1) = ':')
then LangPath := path
else LangPath := ExtractFilePath(ParamStr(0)) + path;
if not FileExists(LangPath) then begin
Writeln(TranslateText('Language files doesn''t exists: "' + LangPath + '"'));
Halt;
end;
LangFile := TIniFile.Create(LangPath);
LangAbbr := LangFile.ReadString( 'info', 'LangAbbr', '');
WinIsoCP := LangFile.ReadInteger(' info', 'CodePage', 1250);
CodePage := LangFile.ReadInteger('Server', 'CodePage', 850);
LangName := LangFile.ReadString('info', 'Language', '');
Writeln(TimeStamp, GetText('iLangUse') + ' ', TranslateText(LangName));
end;
function LanguageGetName() : string;
begin
Result := LangName;
end;
function TranslateText(text: string) : string;
begin
case CodePage of
437 : Result := UTF8ToCP437(text);
850 : Result := UTF8ToCP850(text);
866 : Result := UTF8ToCP866(text);
874 : Result := UTF8ToCP874(text);
932 : Result := UTF8ToCP932(text);
936 : Result := UTF8ToCP936(text);
949 : Result := UTF8ToCP949(text);
950 : Result := UTF8ToCP950(text);
1250 : Result := UTF8ToCP1250(text);
1251 : Result := UTF8ToCP1251(text);
1252 : Result := UTF8ToCP1252(text);
1253 : Result := UTF8ToCP1253(text);
1254 : Result := UTF8ToCP1254(text);
1255 : Result := UTF8ToCP1255(text);
1256 : Result := UTF8ToCP1256(text);
1257 : Result := UTF8ToCP1257(text);
1258 : Result := UTF8ToCP1258(text);
else Result := UTF8ToCP1250(text);
end;
end;
function TranslateTextA(text: string) : string;
begin
case WinIsoCP of
437 : Result := TranslateText(CP437ToUTF8(text));
850 : Result := TranslateText(CP850ToUTF8(text));
866 : Result := TranslateText(CP866ToUTF8(text));
874 : Result := TranslateText(CP874ToUTF8(text));
932 : Result := TranslateText(CP932ToUTF8(text));
936 : Result := TranslateText(CP936ToUTF8(text));
949 : Result := TranslateText(CP949ToUTF8(text));
950 : Result := TranslateText(CP950ToUTF8(text));
1250 : Result := TranslateText(CP1250ToUTF8(text));
1251 : Result := TranslateText(CP1251ToUTF8(text));
1252 : Result := TranslateText(CP1252ToUTF8(text));
1253 : Result := TranslateText(CP1253ToUTF8(text));
1254 : Result := TranslateText(CP1254ToUTF8(text));
1255 : Result := TranslateText(CP1255ToUTF8(text));
1256 : Result := TranslateText(CP1256ToUTF8(text));
1257 : Result := TranslateText(CP1257ToUTF8(text));
1258 : Result := TranslateText(CP1258ToUTF8(text));
else Result := TranslateText(CP1250ToUTF8(text));
end;
end;
function GetText(section : string; key: string) : string;
var text : string;
begin
text := LangFile.ReadString(section, key, '');
if (text <> '')
then result := TranslateText(text)
else result := Format('%%%%[%s]%s%%%%', [section, key]);
end;
function GetText(key: string) : string;
begin
Result := GetText('Server', key);
end;
end.

1
UEnums.pas
View File

@ -43,6 +43,7 @@ type
TAccessLevel = (alNone = 0, TAccessLevel = (alNone = 0,
alView = 1, alView = 1,
alNormal = 2, alNormal = 2,
alDeveloper = 3,
alAdministrator = 255); alAdministrator = 255);
TModifyUserStatus = (muInvalidUsername = 0, TModifyUserStatus = (muInvalidUsername = 0,

71
UOLib/UArt.pas
View File

@ -36,9 +36,9 @@ uses
type type
TArtType = (atLand, atStatic, atLandFlat); TArtType = (atLand, atStatic, atLandFlat);
TArt = class(TMulBlock) TArt = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); overload; constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; OldFormat: Boolean = False); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); overload; constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean; OldFormat: Boolean = False); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload; constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean; OldFormat: Boolean = False); overload;
destructor Destroy; override; destructor Destroy; override;
function Clone: TArt; override; function Clone: TArt; override;
function GetSize: Integer; override; function GetSize: Integer; override;
@ -60,19 +60,19 @@ implementation
type type
PWordArray = ^TWordArray; PWordArray = ^TWordArray;
TWordArray = array[0..16383] of Word; TWordArray = array[0..(MaxInt div SizeOf(Word) - 1)] of Word; // а не перебор ли?
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; OldFormat: Boolean = False);
begin begin
Create(AData, AIndex, AArtType, 0, nil, False); Create(AData, AIndex, AArtType, 0, nil, False, OldFormat);
end; end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean; OldFormat: Boolean = False);
begin begin
Create(AData, AIndex, AArtType, 0, AHue, APartialHue); Create(AData, AIndex, AArtType, 0, AHue, APartialHue, OldFormat);
end; end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean; OldFormat: Boolean = False);
var var
i, x, y, start: Integer; i, x, y, start: Integer;
iCurrentHeight, iCurrentWidth: Integer; iCurrentHeight, iCurrentWidth: Integer;
@ -95,7 +95,7 @@ begin
block.Position := 0; block.Position := 0;
if AArtType = atLand then if AArtType = atLand then
begin begin // Lands
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
FillWord(FGraphic.Bits^, 44 * 44, AArtColor); FillWord(FGraphic.Bits^, 44 * 44, AArtColor);
for y := 0 to 21 do for y := 0 to 21 do
@ -111,7 +111,7 @@ begin
for i := 0 to 44 * 44 - 1 do for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atLandFlat then end else if AArtType = atLandFlat then
begin begin // Lands
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
for i := 1 to 22 do for i := 1 to 22 do
begin begin
@ -138,7 +138,7 @@ begin
for i := 0 to 44 * 44 - 1 do for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atStatic then end else if AArtType = atStatic then
begin begin // Items
block.Read(FHeader, SizeOf(LongInt)); block.Read(FHeader, SizeOf(LongInt));
block.Read(width, SizeOf(SmallInt)); block.Read(width, SizeOf(SmallInt));
block.Read(height, SizeOf(SmallInt)); block.Read(height, SizeOf(SmallInt));
@ -151,22 +151,43 @@ begin
block.Read(offset, SizeOf(Word)); block.Read(offset, SizeOf(Word));
lookup[i] := start + (offset * 2); lookup[i] := start + (offset * 2);
end; end;
for iCurrentHeight := 0 to height - 1 do if not OldFormat then begin // General Clients
begin for iCurrentHeight := 0 to height - 1 do
block.Position := lookup[iCurrentHeight];
iCurrentWidth := 0;
P := FGraphic.Bits + iCurrentHeight * width * 2;
while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and
(block.Read(run, SizeOf(Word)) = SizeOf(Word)) and
(offset + run <> 0) do
begin begin
inc(iCurrentWidth, offset); block.Position := lookup[iCurrentHeight];
for i := 0 to run - 1 do iCurrentWidth := 0;
P := FGraphic.Bits + iCurrentHeight * width * 2;
while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and
(block.Read(run, SizeOf(Word)) = SizeOf(Word)) and
(offset + run <> 0) do
begin begin
block.Read(color, SizeOf(Word)); inc(iCurrentWidth, offset);
P^[iCurrentWidth + i] := color; for i := 0 to run - 1 do
begin
block.Read(color, SizeOf(Word));
P^[iCurrentWidth + i] := color;
end;
inc(iCurrentWidth, run);
end;
end;
end else begin // OldFormat (Pre-Alpha Client)
for iCurrentHeight := 0 to height - 1 do
begin
block.Position := lookup[iCurrentHeight];
iCurrentWidth := 0;
P := FGraphic.Bits + iCurrentHeight * width * 2;
if (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and
(block.Read(run, SizeOf(Word)) = SizeOf(Word)) then
begin
inc(iCurrentWidth, offset);
for i := 0 to run - 1 do
begin
block.Read(color, SizeOf(Word));
if color <> $0000 then
P^[iCurrentWidth + i] := color;
end;
inc(iCurrentWidth, run);
end; end;
inc(iCurrentWidth, run);
end; end;
end; end;

4
UOLib/ULight.pas
View File

@ -76,8 +76,8 @@ begin
for y := 0 to Height - 1 do for y := 0 to Height - 1 do
for x := 0 to Width - 1 do for x := 0 to Width - 1 do
begin begin
buffer.Read(color, SizeOf(byte)); buffer.Read(color, SizeOf(Byte));
color32.R := color * 8; color32.R := Byte(color * 8);
color32.G := color32.R; color32.G := color32.R;
color32.B := color32.R; color32.B := color32.R;
if color > 0 then if color > 0 then

8
UOLib/UMap.pas
View File

@ -46,14 +46,14 @@ type
protected protected
FIsGhost: Boolean; FIsGhost: Boolean;
FGhostZ: ShortInt; FGhostZ: ShortInt;
FGhostID: Word; FGhostID: LongWord;
function GetTileID: Word; override; function GetTileID: LongWord; override;
function GetZ: ShortInt; override; function GetZ: ShortInt; override;
public public
property Altitude: ShortInt read GetZ write SetZ; property Altitude: ShortInt read GetZ write SetZ;
property IsGhost: Boolean read FIsGhost write FIsGhost; property IsGhost: Boolean read FIsGhost write FIsGhost;
property GhostZ: ShortInt read FGhostZ write FGhostZ; property GhostZ: ShortInt read FGhostZ write FGhostZ;
property GhostID: Word write FGhostID; property GhostID: LongWord write FGhostID;
function Clone: TMapCell; override; function Clone: TMapCell; override;
function GetSize: Integer; override; function GetSize: Integer; override;
@ -114,7 +114,7 @@ begin
Create(AOwner, AData, 0, 0); Create(AOwner, AData, 0, 0);
end; end;
function TMapCell.GetTileID: Word; function TMapCell.GetTileID: LongWord;
begin begin
if FIsGhost then if FIsGhost then
Result := FGhostID Result := FGhostID

28
UOLib/UStatics.pas
View File

@ -42,6 +42,7 @@ type
protected protected
{ Members } { Members }
FHue: Word; FHue: Word;
FUnknown: Cardinal; // for old pre-alpha clients only
{ Methods } { Methods }
procedure SetHue(AValue: Word); procedure SetHue(AValue: Word);
@ -82,6 +83,11 @@ type
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer; function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
var
UseStaticsOldFormat: Boolean; // Использование старого формата pre-Alpha
// Очень не красивое и плозое решение, но делать по уму слишком сложно, так
// как это требует переписывание большой части кода на работу с интерфейсами.
implementation implementation
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer; function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
@ -100,6 +106,8 @@ begin
if AData <> nil then if AData <> nil then
begin begin
if UseStaticsOldFormat
then AData.Read(FUnknown, SizeOf(Cardinal));;
AData.Read(FTileID, SizeOf(SmallInt)); AData.Read(FTileID, SizeOf(SmallInt));
AData.Read(iX, SizeOf(Byte)); AData.Read(iX, SizeOf(Byte));
AData.Read(iY, SizeOf(Byte)); AData.Read(iY, SizeOf(Byte));
@ -128,6 +136,7 @@ end;
function TStaticItem.Clone: TStaticItem; function TStaticItem.Clone: TStaticItem;
begin begin
Result := TStaticItem.Create(nil, nil); Result := TStaticItem.Create(nil, nil);
Result.FUnknown:= FUnknown;
Result.FTileID := FTileID; Result.FTileID := FTileID;
Result.FX := FX; Result.FX := FX;
Result.FY := FY; Result.FY := FY;
@ -137,7 +146,9 @@ end;
function TStaticItem.GetSize: Integer; function TStaticItem.GetSize: Integer;
begin begin
Result := 7; if not UseStaticsOldFormat
then Result := 7
else Result := 11;
end; end;
procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata; procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata;
@ -159,6 +170,8 @@ begin
iX := FX mod 8; iX := FX mod 8;
iY := FY mod 8; iY := FY mod 8;
if UseStaticsOldFormat
then AData.Write(FUnknown, SizeOf(Cardinal));;
AData.Write(FTileID, SizeOf(SmallInt)); AData.Write(FTileID, SizeOf(SmallInt));
AData.Write(iX, SizeOf(Byte)); AData.Write(iX, SizeOf(Byte));
AData.Write(iY, SizeOf(Byte)); AData.Write(iY, SizeOf(Byte));
@ -171,7 +184,7 @@ end;
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
AX, AY: Word); AX, AY: Word);
var var
i: Integer; i, size: Integer;
block: TMemoryStream; block: TMemoryStream;
begin begin
inherited Create; inherited Create;
@ -179,13 +192,16 @@ begin
FY := AY; FY := AY;
FItems := TStaticItemList.Create(True); FItems := TStaticItemList.Create(True);
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then if (AData <> nil) and (AIndex.Lookup >= 0) and (AIndex.Size > 0) then
begin begin
AData.Position := AIndex.Lookup; AData.Position := AIndex.Lookup;
block := TMemoryStream.Create; block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size); block.CopyFrom(AData, AIndex.Size);
block.Position := 0; block.Position := 0;
for i := 1 to (AIndex.Size div 7) do if not UseStaticsOldFormat
then size := 7
else size := 11;
for i := 1 to (AIndex.Size div size) do
FItems.Add(TStaticItem.Create(Self, block, AX, AY)); FItems.Add(TStaticItem.Create(Self, block, AX, AY));
block.Free; block.Free;
end; end;
@ -214,7 +230,9 @@ end;
function TStaticBlock.GetSize: Integer; function TStaticBlock.GetSize: Integer;
begin begin
Result := FItems.Count * 7; if not UseStaticsOldFormat
then Result := FItems.Count * 7
else Result := FItems.Count * 11;
end; end;
procedure TStaticBlock.ReverseWrite(AData: TStream); procedure TStaticBlock.ReverseWrite(AData: TStream);

38
UOLib/UTexture.pas
View File

@ -30,7 +30,7 @@ unit UTexture;
interface interface
uses uses
Classes, Imaging, ImagingTypes, ImagingClasses, UMulBlock, UGenericIndex; Classes, Imaging, ImagingTypes, ImagingClasses, UMulBlock, UArt, UGenericIndex;
type type
TTexture = class(TMulBlock) TTexture = class(TMulBlock)
@ -51,8 +51,19 @@ type
property Extra: Integer read FExtra write FExtra; property Extra: Integer read FExtra write FExtra;
end; end;
TOldTexture = class(TTexture)
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
constructor Create(AExtra: Integer); overload;
constructor Create(AId: Cardinal);
private
FArtTile: TArt;
end;
implementation implementation
uses
UGameResources;//, Logging;
constructor TTexture.Create(AData: TStream; AIndex: TGenericIndex); constructor TTexture.Create(AData: TStream; AIndex: TGenericIndex);
var var
size: Integer; size: Integer;
@ -132,5 +143,30 @@ begin
argbGraphic.Free; argbGraphic.Free;
end; end;
// TOldTexture - перегрузка класса, для работы с текстурами пре альфа клиента
constructor TOldTexture.Create(AId: Cardinal);
var
extradata: Integer;
begin
FArtTile := ResMan.Art.GetArt($4000 + AId, 0, nil, False);
if (FArtTile.Graphic.Width <= 64) then extradata := 0 else extradata := 1;
inherited Create(extradata); // Клиент использует не правильные текстуры
FArtTile.Graphic.StretchTo(0,0,FArtTile.Graphic.Width,FArtTile.Graphic.Height,
FGraphic, 0,0,FGraphic.Width,FGraphic.Height, rfBilinear );
//FArtTile.Destroy; // Надо ли удалять тайл?
end;
constructor TOldTexture.Create(AData: TStream; AIndex: TGenericIndex);
begin
inherited Create(0);
end;
constructor TOldTexture.Create(AExtra: Integer);
begin
inherited Create(AExtra);
end;
end. end.

293
UOLib/UTiledata.pas
View File

@ -33,9 +33,14 @@ uses
Classes, SysUtils, UMulBlock; Classes, SysUtils, UMulBlock;
const const
LandTileDataSize = 26; LandOldTileDataSize = 26;
LandOldTileGroupSize = 4 + 32 * LandOldTileDataSize;
StaticOldTileDataSize = 37;
StaticOldTileGroupSize = 4 + 32 * StaticOldTileDataSize;
LandTileDataSize = 30;
LandTileGroupSize = 4 + 32 * LandTileDataSize; LandTileGroupSize = 4 + 32 * LandTileDataSize;
StaticTileDataSize = 37; StaticTileDataSize = 41;
StaticTileGroupSize = 4 + 32 * StaticTileDataSize; StaticTileGroupSize = 4 + 32 * StaticTileDataSize;
type type
@ -54,6 +59,7 @@ type
TTiledata = class(TMulBlock) TTiledata = class(TMulBlock)
protected protected
FFlags: TTileDataFlags; FFlags: TTileDataFlags;
FFlags2 : LongWord;
FTileName: string; FTileName: string;
public public
property Flags: TTileDataFlags read FFlags write FFlags; property Flags: TTileDataFlags read FFlags write FFlags;
@ -63,7 +69,7 @@ type
{ TLandTiledata } { TLandTiledata }
TLandTiledata = class(TTiledata) TLandTiledata = class(TTiledata)
constructor Create(AData: TStream); constructor Create(AData: TStream); virtual;
destructor Destroy; override; destructor Destroy; override;
function Clone: TLandTiledata; override; function Clone: TLandTiledata; override;
function GetSize: Integer; override; function GetSize: Integer; override;
@ -74,10 +80,20 @@ type
property TextureID: Word read FTextureID write FTextureID; property TextureID: Word read FTextureID write FTextureID;
end; end;
{ TLandOldTiledata }
TLandOldTiledata = class(TLandTiledata)
constructor Create(AData: TStream); overload; override;
destructor Destroy; overload; override;
function Clone: TLandTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
{ TStaticTiledata } { TStaticTiledata }
TStaticTiledata = class(TTiledata) TStaticTiledata = class(TTiledata)
constructor Create(AData: TStream); constructor Create(AData: TStream); virtual;
destructor Destroy; override; destructor Destroy; override;
function Clone: TStaticTiledata; override; function Clone: TStaticTiledata; override;
function GetSize: Integer; override; function GetSize: Integer; override;
@ -106,10 +122,19 @@ type
property Height: Byte read FHeight write FHeight; property Height: Byte read FHeight write FHeight;
end; end;
{ TStaticOldTiledata }
TStaticOldTiledata = class(TStaticTiledata)
constructor Create(AData: TStream); overload; override;
destructor Destroy; overload; override;
function Clone: TStaticTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
{ TLandTileGroup } { TLandTileGroup }
TLandTileGroup = class(TMulBlock) TLandTileGroup = class(TMulBlock)
constructor Create(AData: TStream); constructor Create(AData: TStream); virtual;
destructor Destroy; override; destructor Destroy; override;
function Clone: TLandTileGroup; override; function Clone: TLandTileGroup; override;
function GetSize: Integer; override; function GetSize: Integer; override;
@ -121,10 +146,19 @@ type
property Unknown: LongInt read FUnknown write FUnknown; property Unknown: LongInt read FUnknown write FUnknown;
end; end;
{ TLandOldTileGroup }
TLandOldTileGroup = class(TLandTileGroup)
constructor Create(AData: TStream); overload; override;
destructor Destroy; overload; override;
function Clone: TLandTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
{ TStaticTileGroup } { TStaticTileGroup }
TStaticTileGroup = class(TMulBlock) TStaticTileGroup = class(TMulBlock)
constructor Create(AData: TStream); constructor Create(AData: TStream); virtual;
destructor Destroy; override; destructor Destroy; override;
function Clone: TStaticTileGroup; override; function Clone: TStaticTileGroup; override;
function GetSize: Integer; override; function GetSize: Integer; override;
@ -136,11 +170,22 @@ type
property Unknown: LongInt read FUnknown write FUnknown; property Unknown: LongInt read FUnknown write FUnknown;
end; end;
function GetTileDataOffset(ABlock: Integer): Integer; { TStaticOldTileGroup }
TStaticOldTileGroup = class(TStaticTileGroup)
constructor Create(AData: TStream); overload; override;
destructor Destroy; overload; override;
function Clone: TStaticTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
end;
function GetTileDataOffset(ABlock: Integer; OldFormat: Boolean = False): Integer;
implementation implementation
function GetTileDataOffset(ABlock: Integer): Integer; function GetTileDataOffset(ABlock: Integer; OldFormat: Boolean = False): Integer;
var var
group, tile: Integer; group, tile: Integer;
begin begin
@ -150,14 +195,19 @@ begin
group := ABlock div 32; group := ABlock div 32;
tile := ABlock mod 32; tile := ABlock mod 32;
Result := 512 * LandTileGroupSize + group * StaticTileGroupSize + 4 if OldFormat
+ tile * StaticTileDataSize; then Result := 512 * LandOldTileGroupSize + group * StaticOldTileGroupSize
+ 4 + tile * StaticOldTileDataSize
else Result := 512 * LandTileGroupSize + group * StaticTileGroupSize
+ 4 + tile * StaticTileDataSize;
end else end else
begin begin
group := ABlock div 32; group := ABlock div 32;
tile := ABlock mod 32; tile := ABlock mod 32;
Result := group * LandTileGroupSize + 4 + tile * LandTileDataSize; if OldFormat
then Result := group * LandOldTileGroupSize + 4 + tile * LandOldTileDataSize
else Result := group * LandTileGroupSize + 4 + tile * LandTileDataSize;
end; end;
end; end;
@ -169,6 +219,7 @@ begin
if assigned(AData) then if assigned(AData) then
begin begin
AData.Read(FFlags, SizeOf(LongWord)); AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FFlags2, SizeOf(LongWord));
AData.Read(FTextureID, SizeOf(Word)); AData.Read(FTextureID, SizeOf(Word));
AData.Read(PChar(FTileName)^, 20); AData.Read(PChar(FTileName)^, 20);
end; end;
@ -185,6 +236,7 @@ function TLandTiledata.Clone: TLandTiledata;
begin begin
Result := TLandTiledata.Create(nil); Result := TLandTiledata.Create(nil);
Result.FFlags := FFlags; Result.FFlags := FFlags;
Result.FFlags2:= FFlags2;
Result.FTextureID := FTextureID; Result.FTextureID := FTextureID;
Result.FTileName := FTileName; Result.FTileName := FTileName;
end; end;
@ -197,6 +249,7 @@ begin
for i := Length(FTileName) to 20 do for i := Length(FTileName) to 20 do
FTileName := FTileName + #0; FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord)); AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FFlags2, SizeOf(LongWord));
AData.Write(FTextureID, SizeOf(Word)); AData.Write(FTextureID, SizeOf(Word));
AData.Write(PChar(FTileName)^, 20); AData.Write(PChar(FTileName)^, 20);
end; end;
@ -206,6 +259,53 @@ begin
GetSize := LandTileDataSize; GetSize := LandTileDataSize;
end; end;
{ TLandOldTiledata }
constructor TLandOldTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if assigned(AData) then
begin
AData.Read(FFlags, SizeOf(LongWord));
FFlags2 := 0;
AData.Read(FTextureID, SizeOf(Word));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TLandOldTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TLandOldTiledata.Clone: TLandTiledata;
begin
Result := TLandOldTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FFlags2:= FFlags2;
Result.FTextureID := FTextureID;
Result.FTileName := FTileName;
end;
procedure TLandOldTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FTextureID, SizeOf(Word));
AData.Write(PChar(FTileName)^, 20);
end;
function TLandOldTiledata.GetSize: Integer;
begin
GetSize := LandOldTileDataSize;
end;
{ TStaticTiledata} { TStaticTiledata}
constructor TStaticTiledata.Create(AData: TStream); constructor TStaticTiledata.Create(AData: TStream);
@ -214,6 +314,7 @@ begin
if AData <> nil then if AData <> nil then
begin begin
AData.Read(FFlags, SizeOf(LongWord)); AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FFlags2, SizeOf(LongWord));
AData.Read(FWeight, SizeOf(Byte)); AData.Read(FWeight, SizeOf(Byte));
AData.Read(FQuality, SizeOf(Byte)); AData.Read(FQuality, SizeOf(Byte));
AData.Read(FUnknown1, SizeOf(Word)); AData.Read(FUnknown1, SizeOf(Word));
@ -239,6 +340,7 @@ function TStaticTiledata.Clone: TStaticTiledata;
begin begin
Result := TStaticTiledata.Create(nil); Result := TStaticTiledata.Create(nil);
Result.FFlags := FFlags; Result.FFlags := FFlags;
Result.FFlags2:= FFlags2;
Result.FWeight := FWeight; Result.FWeight := FWeight;
Result.FQuality := FQuality; Result.FQuality := FQuality;
Result.FUnknown1 := FUnknown1; Result.FUnknown1 := FUnknown1;
@ -260,6 +362,7 @@ begin
for i := Length(FTileName) to 20 do for i := Length(FTileName) to 20 do
FTileName := FTileName + #0; FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord)); AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FFlags2, SizeOf(LongWord));
AData.Write(FWeight, SizeOf(Byte)); AData.Write(FWeight, SizeOf(Byte));
AData.Write(FQuality, SizeOf(Byte)); AData.Write(FQuality, SizeOf(Byte));
AData.Write(FUnknown1, SizeOf(Word)); AData.Write(FUnknown1, SizeOf(Word));
@ -278,6 +381,80 @@ begin
GetSize := StaticTileDataSize; GetSize := StaticTileDataSize;
end; end;
{ TStaticOldTiledata }
constructor TStaticOldTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if AData <> nil then
begin
AData.Read(FFlags, SizeOf(LongWord));
FFlags2 := 0;
AData.Read(FWeight, SizeOf(Byte));
AData.Read(FQuality, SizeOf(Byte));
AData.Read(FUnknown1, SizeOf(Word));
AData.Read(FUnknown2, SizeOf(Byte));
AData.Read(FQuantity, SizeOf(Byte));
AData.Read(FAnimID, SizeOf(Word));
AData.Read(FUnknown3, SizeOf(Byte));
AData.Read(FHue, SizeOf(Byte));
AData.Read(FUnknown4, SizeOf(Word));
AData.Read(FHeight, SizeOf(Byte));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TStaticOldTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TStaticOldTiledata.Clone: TStaticTiledata;
begin
Result := TStaticOldTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FFlags2:= FFlags2;
Result.FWeight := FWeight;
Result.FQuality := FQuality;
Result.FUnknown1 := FUnknown1;
Result.FUnknown2 := FUnknown2;
Result.FQuantity := FQuantity;
Result.FAnimID := FAnimID;
Result.FUnknown3 := FUnknown3;
Result.FHue := FHue;
Result.FUnknown4 := FUnknown4;
Result.FHeight := FHeight;
Result.FTileName := FTileName;
end;
procedure TStaticOldTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FWeight, SizeOf(Byte));
AData.Write(FQuality, SizeOf(Byte));
AData.Write(FUnknown1, SizeOf(Word));
AData.Write(FUnknown2, SizeOf(Byte));
AData.Write(FQuantity, SizeOf(Byte));
AData.Write(FAnimID, SizeOf(Word));
AData.Write(FUnknown3, SizeOf(Byte));
AData.Write(FHue, SizeOf(Byte));
AData.Write(FUnknown4, SizeOf(Word));
AData.Write(FHeight, SizeOf(Byte));
AData.Write(PChar(FTileName)^, 20);
end;
function TStaticOldTiledata.GetSize: Integer;
begin
GetSize := StaticOldTileDataSize;
end;
{ TLandTileGroup } { TLandTileGroup }
constructor TLandTileGroup.Create(AData: TStream); constructor TLandTileGroup.Create(AData: TStream);
@ -325,6 +502,53 @@ begin
GetSize := LandTileGroupSize; GetSize := LandTileGroupSize;
end; end;
{ TLandOldTileGroup }
constructor TLandOldTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
LandTileData[i] := TLandOldTiledata.Create(AData);
end;
destructor TLandOldTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
LandTileData[i].Free;
inherited;
end;
function TLandOldTileGroup.Clone: TLandTileGroup;
var
i: Integer;
begin
Result := TLandOldTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.LandTileData[i] := LandTileData[i].Clone;
end;
procedure TLandOldTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
LandTileData[i].Write(AData);
end;
function TLandOldTileGroup.GetSize: Integer;
begin
GetSize := LandOldTileGroupSize;
end;
{ TStaticTileGroup } { TStaticTileGroup }
constructor TStaticTileGroup.Create(AData: TStream); constructor TStaticTileGroup.Create(AData: TStream);
@ -372,5 +596,52 @@ begin
GetSize := StaticTileGroupSize; GetSize := StaticTileGroupSize;
end; end;
{ TStaticOldTileGroup }
constructor TStaticOldTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
StaticTileData[i] := TStaticOldTiledata.Create(AData);
end;
destructor TStaticOldTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
StaticTileData[i].Free;
inherited;
end;
function TStaticOldTileGroup.Clone: TStaticTileGroup;
var
i: Integer;
begin
Result := TStaticOldTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.StaticTileData[i] := StaticTileData[i].Clone;
end;
procedure TStaticOldTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
StaticTileData[i].Write(AData);
end;
function TStaticOldTileGroup.GetSize: Integer;
begin
GetSize := StaticOldTileGroupSize;
end;
end. end.

103
UOLib/UUopFile.pas Normal file
View File

@ -0,0 +1,103 @@
(*
* CentrEd+ (c) 2013 by StaticZ <uoquint.ru>
* Base on Wyatt algoritm published on www.ruosi.org
*)
unit UUopFile;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, Graphics, UMulBlock;
function HashFileName(string s) : QWord;
function UopContainer()
type
TUopHeader = packed record;
Format: DWord;
Version: DWord;
Signature: DWord;
Offset: QWord;
Capacity: DWord;
Count: DWord;
end;
TUopIndex = packed record;
Offset: DWord;
Length: DWord;
Uncomp: DWord;
Append: DWord;
end;
implementation
{ THue }
function HashFileName(string s) : QWord;
var
i, stl, eax, ecx, edx, ebx, esi, edi : DWord;
begin
i := 0; stl := Length(s);
eax := 0; ebx := $DEADBEEF + stl;
ecx := 0; edi := $DEADBEEF + stl;
edx := 0; esi := $DEADBEEF + stl;
while i < stl do begin
edi := (uint)((ord(s[i+ 7])shl 24)or(ord(s[i+ 6])shl 16)or(ord(s[i+ 5])shl 8)or ord(s[i+ 4]))+edi;
esi := (uint)((ord(s[i+11])shl 24)or(ord(s[i+10])shl 16)or(ord(s[i+ 9])shl 8)or ord(s[i+ 8]))+esi;
edx := (uint)((ord(s[i+ 3])shl 24)or(ord(s[i+ 2])shl 16)or(ord(s[i+ 1])shl 8)or ord(s[i ]))-esi;
edx := (edx + ebx)xor(esi shr 28)xor(esi shl 4);
inc(esi, edi);
edi := (edi - edx)xor(edx shr 26)xor(edx shl 6);
inc(edx, esi);
esi := (esi - edi)xor(edi shr 24)xor(edi shl 8);
inc(edi, edx);
ebx := (edx - esi)xor(esi shr 16)xor(esi shl 16);
inc(esi, edi);
edi := (edi - ebx)xor(ebx shr 13)xor(ebx shl 19);
inc(ebx, esi);
esi := (esi - edi)xor(edi shr 28)xor(edi shl 4);
inc(edi, ebx);
inc(i, 12);
end;
if (stl - i) > 0 then begin
if (stl - i) <= 12 then inc(esi, DWord(ord(s[i+11])shl 24));
if (stl - i) <= 11 then inc(esi, DWord(ord(s[i+10])shl 16));
if (stl - i) <= 10 then inc(esi, DWord(ord(s[i+ 9])shl 8));
if (stl - i) <= 9 then inc(esi, DWord(ord(s[i+ 8]) ));
if (stl - i) <= 8 then inc(edi, DWord(ord(s[i+ 7])shl 24));
if (stl - i) <= 7 then inc(edi, DWord(ord(s[i+ 6])shl 16));
if (stl - i) <= 6 then inc(edi, DWord(ord(s[i+ 5])shl 8));
if (stl - i) <= 5 then inc(edi, DWord(ord(s[i+ 4]) ));
if (stl - i) <= 4 then inc(ebx, DWord(ord(s[i+ 3])shl 24));
if (stl - i) <= 3 then inc(ebx, DWord(ord(s[i+ 2])shl 16));
if (stl - i) <= 2 then inc(ebx, DWord(ord(s[i+ 1])shl 8));
if (stl - i) <= 1 then inc(ebx, DWord(ord(s[i+ 0]) ));
esi := (esi xor edi) - ((edi shr 18)xor(edi shl 14));
ecx := (esi xor ebx) - ((esi shr 21)xor(esi shl 11));
edi := (edi xor ecx) - ((ecx shr 7)xor(ecx shl 25));
esi := (esi xor edi) - ((edi shr 16)xor(edi shl 16));
edx := (esi xor ecx) - ((esi shr 28)xor(esi shl 4));
edi := (edi xor edx) - ((edx shr 18)xor(edx shl 14));
eax := (esi xor edi) - ((edi shr 8)xor(edi shl 24));
Result := (QWord(edi) shl 32) or eax;
end else begin
Result := (QWord(esi) shl 32) or eax;
end;
end;
end.

14
UOLib/UWorldItem.pas
View File

@ -41,7 +41,7 @@ type
constructor Create(AOwner: TWorldBlock); constructor Create(AOwner: TWorldBlock);
protected protected
FOwner: TWorldBlock; FOwner: TWorldBlock;
FTileID: Word; FTileID: LongWord;
FX: Word; FX: Word;
FY: Word; FY: Word;
FZ: ShortInt; FZ: ShortInt;
@ -52,12 +52,12 @@ type
FPriorityBonus: ShortInt; FPriorityBonus: ShortInt;
FPrioritySolver: Integer; FPrioritySolver: Integer;
procedure DoChanged; procedure DoChanged;
function GetTileID: Word; virtual; function GetTileID: LongWord; virtual;
function GetZ: ShortInt; virtual; function GetZ: ShortInt; virtual;
procedure SetLocked(ALocked: Boolean); procedure SetLocked(ALocked: Boolean);
procedure SetOwner(AOwner: TWorldBlock); procedure SetOwner(AOwner: TWorldBlock);
procedure SetSelected(ASelected: Boolean); procedure SetSelected(ASelected: Boolean);
procedure SetTileID(AValue: Word); procedure SetTileID(AValue: LongWord);
procedure SetX(AValue: Word); procedure SetX(AValue: Word);
procedure SetY(AValue: Word); procedure SetY(AValue: Word);
procedure SetZ(AValue: ShortInt); procedure SetZ(AValue: ShortInt);
@ -66,7 +66,7 @@ type
procedure Delete; procedure Delete;
property Owner: TWorldBlock read FOwner write SetOwner; property Owner: TWorldBlock read FOwner write SetOwner;
property TileID: Word read GetTileID write SetTileID; property TileID: LongWord read GetTileID write SetTileID;
property X: Word read FX write SetX; property X: Word read FX write SetX;
property Y: Word read FY write SetY; property Y: Word read FY write SetY;
property Z: ShortInt read GetZ write SetZ; property Z: ShortInt read GetZ write SetZ;
@ -77,7 +77,7 @@ type
property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus; property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus;
property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver; property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver;
property RawTileID: Word read FTileID; property RawTileID: LongWord read FTileID;
property RawZ: ShortInt read FZ; property RawZ: ShortInt read FZ;
end; end;
@ -151,7 +151,7 @@ begin
FOwner.Changed := True; FOwner.Changed := True;
end; end;
function TWorldItem.GetTileID: Word; function TWorldItem.GetTileID: LongWord;
begin begin
Result := FTileID; Result := FTileID;
end; end;
@ -211,7 +211,7 @@ begin
FSelected := ASelected; FSelected := ASelected;
end; end;
procedure TWorldItem.SetTileID(AValue: Word); procedure TWorldItem.SetTileID(AValue: LongWord);
begin begin
if FTileID = AValue then if FTileID = AValue then
Exit; Exit;

648
version.inc
View File

@ -1,5 +1,645 @@
const const
ProductVersion = '0.6.1'; //ProductVersion = '0.7.2';
ProtocolVersion = 6; ProtocolVersion = 8;
Revision = '209'; Revision = '58';
Copyright = '2009 Andreas Schneider'; Copyright = '2013 StaticZ';
Original = '"UO CentrED" ver 0.6.1 (c) 2009 Andreas Schneider';
baner_u: array[0..3141] of byte = ( //*.bmp 256 rle
$42, $4D, $46, $0C, $00, $00, $00, $00, $00, $00, $76, $00, $00, $00, $28, $00,
$00, $00, $89, $00, $00, $00, $2A, $00, $00, $00, $01, $00, $04, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $62, $03, $00, $00, $62, $03, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $04, $04, $04, $00, $83, $84, $84, $00, $C8, $C8,
$C8, $00, $47, $48, $48, $00, $65, $66, $65, $00, $A8, $A8, $A8, $00, $EA, $E9,
$EA, $00, $96, $97, $96, $00, $5A, $59, $5A, $00, $2C, $2E, $2C, $00, $D8, $D8,
$D8, $00, $77, $78, $78, $00, $B7, $B8, $B8, $00, $F5, $F4, $F5, $00, $3B, $3D,
$3C, $00, $8C, $8C, $8C, $00, $D6, $D6, $DD, $D6, $DD, $DD, $6D, $6D, $DD, $6D,
$D6, $DD, $D6, $DD, $D6, $DD, $66, $6D, $D6, $D6, $D6, $AD, $66, $A6, $D6, $C6,
$6D, $6A, $DD, $66, $66, $66, $A6, $D6, $66, $6D, $A2, $6D, $6D, $D6, $66, $DD,
$A6, $DD, $6A, $D6, $DD, $6D, $66, $D6, $66, $6D, $66, $6D, $66, $66, $DA, $C6,
$DD, $A6, $DD, $66, $6D, $DA, $DD, $6D, $6D, $6D, $60, $00, $6A, $FF, $D6, $DD,
$6D, $6D, $D6, $D6, $D6, $D6, $D6, $D6, $6A, $C7, $BB, $F5, $26, $66, $C2, $AD,
$6C, $A6, $DC, $26, $D6, $C6, $D6, $22, $DD, $DC, $66, $6C, $CD, $D6, $C6, $D6,
$2C, $DD, $C2, $2D, $D6, $DC, $62, $66, $C5, $D6, $22, $AD, $6D, $D2, $AA, $D6,
$CC, $DD, $C2, $2D, $62, $CD, $62, $2A, $6A, $22, $D6, $22, $2D, $6C, $D6, $DA,
$2D, $DD, $C0, $00, $6A, $FF, $6D, $D6, $D6, $DD, $6D, $6D, $6D, $6D, $6D, $D6,
$54, $44, $44, $44, $41, $AD, $2C, $2D, $6C, $C6, $DC, $C2, $DD, $52, $DD, $CA,
$2D, $65, $AD, $DC, $C6, $D6, $CD, $6D, $5C, $6D, $22, $CD, $6D, $DA, $C2, $DD,
$25, $DD, $A5, $2D, $D6, $DA, $2C, $DD, $CC, $D6, $D5, $2D, $65, $CD, $62, $2C,
$66, $5C, $6D, $C2, $26, $DD, $6D, $DD, $6D, $6D, $60, $00, $6A, $FF, $DD, $6D,
$6D, $D6, $D6, $DD, $6D, $DD, $D6, $AB, $44, $44, $44, $44, $44, $4C, $6D, $6D,
$6D, $D6, $D6, $D6, $D6, $66, $D6, $D6, $DD, $6A, $D6, $DC, $DD, $6D, $26, $D6,
$D6, $D6, $D6, $D6, $DD, $66, $2D, $6D, $DD, $6D, $D6, $DD, $6D, $66, $66, $6D,
$CD, $6D, $66, $D6, $DD, $6D, $6D, $6D, $6D, $66, $DD, $6D, $26, $DD, $6D, $66,
$D6, $D6, $D0, $00, $6A, $FF, $D6, $D6, $D6, $D6, $DD, $6D, $DD, $DD, $DA, $B4,
$44, $4B, $F1, $44, $44, $44, $56, $66, $D6, $66, $6D, $66, $66, $66, $6D, $6D,
$D6, $66, $66, $DD, $D6, $66, $66, $66, $66, $66, $DD, $A2, $2A, $DD, $6D, $6D,
$A2, $22, $66, $D6, $D6, $66, $66, $66, $66, $6D, $66, $66, $D6, $66, $66, $6D,
$D6, $DD, $DA, $22, $6D, $66, $66, $66, $66, $66, $D0, $00, $6A, $FF, $D6, $DD,
$6D, $6D, $6D, $DD, $DD, $DD, $DF, $44, $47, $6D, $DD, $DC, $44, $4F, $D7, $93,
$DB, $99, $ED, $A9, $99, $99, $9D, $6D, $6B, $99, $97, $D6, $DA, $99, $99, $99,
$99, $92, $B9, $99, $99, $91, $6D, $C3, $99, $99, $98, $2D, $68, $99, $99, $99,
$99, $FC, $99, $92, $D3, $99, $99, $9C, $D6, $DF, $E9, $99, $9F, $59, $99, $99,
$99, $99, $D0, $00, $6A, $FF, $6D, $D6, $D6, $DD, $DD, $DD, $DD, $DD, $24, $44,
$5D, $DD, $DD, $DD, $DB, $4B, $DD, $9E, $67, $99, $96, $C9, $99, $99, $96, $6D,
$DF, $99, $91, $DD, $66, $99, $99, $99, $99, $95, $49, $99, $99, $99, $E6, $59,
$99, $99, $99, $95, $D4, $99, $99, $99, $99, $B2, $99, $9C, $69, $99, $99, $95,
$D6, $89, $99, $99, $9B, $C9, $99, $99, $99, $99, $60, $00, $6A, $FF, $DD, $6D,
$6D, $DD, $DD, $DD, $D6, $C5, $44, $44, $DD, $DD, $DD, $DD, $DA, $44, $DD, $59,
$65, $99, $9A, $59, $99, $99, $9A, $DD, $67, $99, $9B, $6D, $6D, $E9, $99, $9E,
$EE, $E5, $B9, $93, $39, $99, $97, $29, $93, $8E, $99, $93, $DB, $99, $99, $EE,
$EE, $B6, $99, $97, $69, $99, $99, $97, $D7, $99, $99, $99, $98, $29, $99, $9E,
$EE, $EE, $A0, $00, $6A, $FF, $D6, $DD, $DD, $DD, $DD, $D7, $E9, $9E, $44, $4B,
$DD, $DD, $57, $DD, $DD, $B4, $DD, $69, $AC, $99, $92, $F9, $99, $99, $9C, $D6,
$DC, $99, $98, $DD, $D6, $89, $99, $26, $DD, $DD, $C2, $6D, $DC, $99, $93, $A5,
$66, $D6, $E9, $99, $2F, $99, $91, $DD, $6D, $6D, $99, $9F, $29, $99, $99, $91,
$6E, $99, $99, $5A, $25, $A9, $99, $9D, $DD, $6D, $D0, $00, $6A, $FF, $D6, $D6,
$DD, $DD, $D5, $FC, $AD, $65, $44, $41, $DD, $DD, $44, $AD, $DD, $54, $AD, $DE,
$C2, $99, $95, $49, $98, $99, $95, $D6, $D2, $99, $93, $D6, $D6, $49, $99, $7A,
$A2, $A6, $66, $D6, $78, $99, $9E, $6D, $6D, $CB, $99, $99, $C7, $99, $94, $2A,
$A2, $6D, $39, $9B, $59, $99, $39, $9B, $69, $99, $97, $D6, $D6, $69, $99, $92,
$A2, $AA, $60, $00, $6A, $FF, $D6, $DD, $DD, $DD, $6D, $DD, $DD, $D5, $44, $4B,
$DD, $DD, $44, $2D, $DD, $C4, $AD, $D4, $56, $99, $95, $89, $9B, $99, $97, $DD,
$DA, $99, $99, $DD, $6D, $B9, $99, $99, $99, $95, $66, $B9, $99, $99, $98, $DD,
$5E, $99, $99, $99, $AC, $99, $99, $99, $99, $B6, $89, $94, $79, $93, $89, $98,
$A9, $99, $9C, $D6, $DD, $DE, $99, $99, $99, $99, $A0, $00, $6A, $FF, $6D, $DD,
$DD, $DD, $DD, $DD, $DD, $D1, $44, $44, $DD, $DD, $B4, $5D, $DD, $24, $2D, $D7,
$76, $99, $9F, $E9, $95, $99, $91, $6D, $66, $99, $99, $66, $D6, $F9, $99, $99,
$99, $9F, $D4, $99, $99, $99, $9C, $D5, $99, $99, $99, $9B, $62, $99, $99, $99,
$99, $86, $49, $93, $B9, $94, $B9, $93, $69, $99, $92, $6D, $D6, $D3, $99, $99,
$99, $99, $20, $00, $6A, $FF, $DD, $DD, $DD, $DD, $DD, $67, $48, $34, $44, $44,
$DD, $DD, $14, $7D, $DD, $A4, $CD, $D7, $1D, $E9, $9B, $99, $9C, $39, $9B, $D6,
$DD, $E9, $99, $AD, $DD, $79, $99, $E4, $44, $85, $69, $99, $99, $EB, $2D, $64,
$99, $99, $94, $56, $DA, $99, $99, $44, $84, $BD, $19, $9E, $49, $91, $19, $99,
$D3, $99, $94, $DD, $6D, $D4, $99, $93, $44, $44, $20, $00, $6A, $FF, $6D, $DD,
$DD, $DD, $A4, $99, $9E, $98, $44, $44, $6D, $DD, $74, $FD, $DD, $64, $5D, $D4,
$B6, $89, $9E, $99, $9A, $89, $94, $A2, $2C, $E9, $99, $7C, $22, $59, $99, $46,
$D6, $DD, $A9, $99, $9C, $D6, $DD, $D4, $99, $9B, $66, $DD, $D6, $99, $99, $66,
$D6, $DD, $79, $99, $E9, $97, $79, $99, $61, $99, $99, $C6, $D6, $6B, $99, $97,
$6D, $6D, $D0, $00, $6A, $FF, $DD, $DD, $DD, $D7, $99, $45, $AD, $D5, $44, $44,
$AD, $DD, $54, $1D, $DD, $D4, $7D, $DE, $4D, $49, $99, $99, $96, $B9, $93, $C9,
$99, $99, $99, $99, $9E, $29, $99, $E7, $F7, $F7, $6E, $99, $9B, $55, $18, $6F,
$99, $93, $55, $F4, $CD, $E9, $99, $1F, $7F, $72, $59, $99, $99, $95, $59, $99,
$AA, $E9, $99, $93, $B4, $51, $99, $98, $F7, $F7, $50, $00, $6A, $FF, $DD, $DD,
$DD, $F9, $97, $DD, $DD, $DA, $44, $44, $2D, $DD, $54, $4D, $DD, $D4, $1D, $69,
$36, $B9, $99, $99, $ED, $B9, $9E, $29, $99, $99, $99, $99, $99, $A9, $99, $99,
$99, $99, $A7, $99, $99, $99, $99, $DA, $E9, $99, $99, $99, $56, $39, $99, $99,
$99, $95, $C9, $99, $99, $92, $29, $99, $CD, $59, $99, $99, $99, $15, $99, $99,
$99, $99, $30, $00, $6A, $FF, $DD, $DD, $D7, $9E, $AD, $DD, $DD, $DD, $B4, $44,
$CD, $DD, $24, $4D, $DD, $DB, $BD, $79, $ED, $F9, $99, $99, $8D, $79, $99, $A9,
$99, $99, $99, $99, $99, $A9, $99, $99, $99, $99, $2D, $79, $99, $99, $99, $AD,
$C8, $99, $99, $99, $7D, $49, $99, $99, $99, $9F, $29, $99, $99, $9A, $A9, $99,
$5D, $62, $39, $99, $99, $BC, $99, $99, $99, $99, $E0, $00, $6A, $FF, $DD, $DD,
$A9, $3D, $DD, $D5, $89, $93, $F4, $44, $1C, $5C, $74, $45, $C5, $CB, $42, $77,
$76, $2F, $7F, $77, $C6, $27, $7F, $67, $77, $77, $77, $77, $F7, $67, $F7, $7F,
$77, $77, $A6, $DA, $51, $4B, $15, $6D, $6D, $57, $B4, $B7, $A6, $C7, $77, $77,
$77, $7C, $67, $77, $77, $7D, $67, $77, $2D, $DD, $6C, $7B, $B1, $CA, $77, $77,
$77, $7F, $70, $00, $6A, $FF, $DD, $DD, $89, $2D, $DD, $B9, $93, $BC, $21, $44,
$44, $44, $44, $44, $44, $44, $46, $DD, $6D, $DD, $DD, $6D, $6D, $D6, $DD, $6D,
$D6, $DD, $6D, $D6, $DD, $6D, $DD, $6D, $D6, $D6, $DD, $6D, $D6, $DD, $6D, $D6,
$D6, $D6, $D6, $DD, $6D, $6D, $D6, $DD, $6D, $6D, $D6, $DD, $6D, $D6, $DD, $6D,
$D6, $D6, $DD, $6D, $D6, $DD, $6D, $D6, $DD, $6D, $D0, $00, $6A, $FF, $DD, $D5,
$94, $DD, $D3, $9E, $CD, $DD, $DD, $B4, $44, $44, $44, $44, $44, $44, $CD, $DD,
$D6, $D6, $D6, $D6, $DD, $6D, $D6, $DD, $6D, $D6, $DD, $6D, $D6, $D6, $D6, $DD,
$6D, $6D, $D6, $DD, $6D, $D6, $DD, $6D, $DD, $DD, $DD, $D6, $DD, $DD, $6D, $D6,
$D6, $DD, $6D, $D6, $DD, $6D, $D6, $DD, $6D, $6D, $D6, $DD, $6D, $D6, $DD, $6D,
$D6, $DD, $60, $00, $6A, $FF, $DD, $D8, $96, $DD, $F9, $36, $DD, $DD, $DD, $D7,
$44, $44, $44, $44, $44, $BE, $2D, $DD, $D6, $DD, $6D, $88, $88, $88, $88, $88,
$88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88,
$8E, $99, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88, $88,
$88, $88, $88, $88, $88, $88, $88, $88, $88, $8C, $D0, $00, $6A, $FF, $DD, $A9,
$FD, $D6, $9E, $6D, $DD, $DD, $DD, $DD, $24, $44, $44, $44, $47, $6E, $CD, $DD,
$D6, $D6, $DD, $6D, $D6, $DD, $6D, $66, $D6, $D6, $D6, $D6, $DD, $6D, $DD, $D6,
$D6, $DD, $D6, $D6, $DD, $D6, $DD, $6D, $6D, $C2, $DD, $6D, $D6, $D6, $D6, $D6,
$DD, $D6, $D6, $D6, $DD, $6D, $6D, $D6, $DD, $DD, $6D, $D6, $D6, $D6, $D6, $DD,
$D6, $D6, $D0, $00, $6A, $FF, $DD, $59, $2D, $DB, $97, $DD, $DD, $DD, $D6, $DD,
$DD, $B5, $71, $88, $DD, $D9, $CD, $DD, $6D, $D6, $D6, $DD, $6D, $D6, $DD, $DD,
$DD, $6D, $DD, $DD, $6D, $DD, $6A, $D6, $DD, $DA, $6D, $6D, $D6, $A6, $D6, $DD,
$D6, $C2, $D6, $DA, $6D, $6D, $DD, $DD, $6D, $6D, $DD, $6D, $D6, $D6, $AD, $6D,
$6D, $A6, $DD, $6D, $DD, $D6, $DD, $DA, $6D, $DD, $60, $00, $6A, $FF, $DD, $1E,
$DD, $DE, $3D, $DD, $2D, $DD, $DD, $6D, $DD, $CD, $D6, $9B, $DD, $29, $2D, $DD,
$DD, $6D, $DD, $65, $56, $ED, $D6, $8A, $C1, $D6, $63, $DB, $26, $D6, $70, $DD,
$D6, $F5, $B8, $CD, $2B, $5F, $C6, $DF, $BB, $72, $DD, $F5, $B8, $C6, $25, $45,
$CD, $A4, $CD, $55, $6D, $C7, $51, $2D, $6A, $0C, $D6, $65, $15, $CD, $D6, $F5,
$B8, $5D, $D0, $00, $6A, $FF, $DD, $B4, $DD, $69, $FD, $D5, $CD, $DD, $DD, $DD,
$DD, $DD, $DB, $95, $DD, $79, $6D, $DD, $66, $D6, $D6, $D5, $F2, $1A, $DD, $75,
$75, $6D, $2B, $A7, $5D, $6D, $A7, $D6, $D6, $C6, $D1, $6D, $FD, $6D, $7D, $C2,
$D6, $12, $D6, $C6, $D1, $6D, $D6, $7D, $6D, $DF, $DD, $22, $DD, $FD, $6D, $6D,
$D6, $F6, $6D, $D6, $C6, $D6, $D6, $C6, $D1, $DD, $60, $00, $6A, $FF, $DD, $4B,
$DD, $29, $5D, $D4, $2D, $DD, $DD, $DD, $DD, $DD, $29, $3D, $DD, $83, $DD, $DD,
$DD, $D6, $D6, $D7, $51, $AC, $DA, $C7, $75, $DD, $76, $BC, $56, $DD, $6D, $6D,
$6D, $C6, $DF, $DD, $5D, $D6, $C6, $C6, $D6, $C2, $DD, $C6, $DF, $DD, $6D, $FD,
$6D, $67, $6D, $2A, $D6, $76, $DD, $6D, $6D, $D6, $D6, $D6, $C6, $DD, $6D, $C6,
$DF, $D6, $D0, $00, $6A, $FF, $DD, $B1, $DD, $59, $AD, $DE, $FD, $DD, $DD, $DD,
$DD, $DA, $39, $CD, $DC, $9F, $DD, $DD, $6D, $6D, $DD, $D7, $AF, $D7, $DC, $25,
$CC, $2D, $7D, $BD, $7D, $D6, $D6, $DD, $DD, $5D, $DF, $6D, $7D, $DD, $FD, $76,
$DD, $52, $DD, $5D, $DF, $6D, $6D, $FD, $DD, $DF, $DD, $22, $DD, $FD, $D6, $DD,
$6D, $6D, $6D, $D6, $B6, $D6, $DD, $5D, $DF, $6D, $D0, $00, $6A, $FF, $DD, $7F,
$DD, $59, $6D, $DE, $8D, $DD, $DD, $DD, $DD, $5E, $94, $DD, $D3, $9A, $DD, $DD,
$D6, $DD, $6D, $51, $6D, $24, $64, $26, $D5, $FA, $4A, $6A, $B2, $D6, $DD, $6D,
$6C, $5D, $24, $DD, $C5, $AC, $7D, $A1, $A2, $85, $6C, $5D, $24, $DD, $65, $B6,
$D6, $A4, $1A, $B6, $6A, $45, $C2, $D6, $DD, $D6, $DD, $6C, $5B, $27, $DC, $5D,
$24, $DD, $60, $00, $6A, $FF, $DD, $21, $DD, $C9, $CD, $D4, $9A, $DD, $D6, $DA,
$78, $99, $BD, $DD, $79, $BD, $DD, $DD, $6D, $D6, $D6, $6A, $D6, $6A, $6A, $AD,
$DA, $A6, $A6, $D6, $AA, $DD, $D6, $DD, $DA, $66, $6A, $D6, $DA, $52, $D6, $D6,
$C2, $6A, $DA, $66, $6A, $D6, $6A, $AD, $DD, $6A, $6C, $6D, $66, $BA, $AA, $DD,
$D6, $D6, $D6, $DA, $66, $A6, $DA, $66, $6A, $6D, $60, $00, $6A, $FF, $DD, $D4,
$DD, $69, $FD, $D5, $93, $DD, $D2, $39, $99, $E5, $DD, $D6, $93, $DD, $DD, $DD,
$6D, $6D, $DD, $6D, $6D, $6D, $6D, $DD, $6D, $6D, $6D, $6D, $DD, $6D, $6D, $6D,
$6D, $DD, $6D, $6D, $6D, $6D, $DD, $6D, $6D, $6D, $6D, $DD, $6D, $6D, $6D, $56,
$D6, $DD, $D6, $DD, $6D, $7D, $6D, $6D, $6D, $6D, $DD, $6D, $6D, $6D, $6D, $DD,
$6D, $D6, $D0, $00, $6A, $FF, $DD, $D1, $DD, $D3, $8D, $DD, $89, $7D, $DD, $D6,
$CA, $DD, $DD, $2E, $9C, $DD, $DD, $D6, $DD, $D6, $D6, $D6, $DD, $D6, $D6, $D6,
$D6, $DD, $D6, $D6, $D6, $D6, $DD, $D6, $D6, $D6, $D6, $DD, $D6, $D6, $D6, $D6,
$DD, $D6, $D6, $D6, $D6, $DD, $D6, $B6, $DD, $6D, $6D, $D6, $D6, $D6, $D6, $DD,
$D6, $D6, $D6, $D6, $DD, $D6, $D6, $D6, $D6, $DD, $60, $00, $6A, $FF, $6D, $DA,
$AD, $D1, $92, $DD, $A9, $9B, $DD, $DD, $DD, $DD, $D7, $99, $5D, $DD, $DD, $DD,
$6D, $6D, $D6, $DD, $6D, $6D, $DD, $D6, $DD, $6D, $6D, $DD, $D6, $DD, $6D, $6D,
$DD, $D6, $DD, $6D, $6D, $DD, $D6, $DD, $6D, $6D, $DD, $D6, $DD, $6D, $6D, $DD,
$D6, $DD, $6D, $6D, $DD, $D6, $DD, $6D, $6D, $DD, $D6, $DD, $6D, $6D, $DD, $D6,
$D6, $D6, $D0, $00, $6A, $FF, $DD, $DD, $AD, $D6, $9E, $DD, $D5, $99, $EC, $DD,
$DD, $DC, $49, $95, $DD, $DD, $DD, $D6, $D6, $DD, $6D, $D6, $DD, $6D, $6D, $6D,
$D6, $DD, $6D, $6D, $6D, $D6, $DD, $6D, $6D, $6D, $D6, $DD, $6D, $6D, $6D, $D6,
$DD, $6D, $6D, $6D, $D6, $DD, $6D, $6D, $6D, $D6, $DD, $6D, $6D, $6D, $D6, $DD,
$6D, $6D, $6D, $D6, $DD, $6D, $6D, $6D, $DD, $D6, $D0, $00, $6A, $FF, $D6, $DD,
$DD, $DD, $19, $BD, $DD, $68, $99, $93, $B3, $99, $98, $AD, $DD, $DD, $DD, $6D,
$DD, $D6, $DD, $6D, $D6, $DD, $D6, $DD, $6D, $D6, $DD, $D6, $DD, $6D, $D6, $DD,
$D6, $DD, $6D, $D6, $DD, $D6, $DD, $6D, $D6, $DD, $D6, $DD, $6D, $D6, $DD, $D6,
$DD, $6D, $D6, $DD, $D6, $DD, $6D, $D6, $DD, $D6, $DD, $6D, $D6, $DD, $D6, $DD,
$6D, $6D, $D0, $00, $6A, $FF, $6D, $DD, $DD, $DD, $D3, $95, $DD, $DD, $CB, $89,
$99, $31, $2D, $DD, $DD, $DD, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6,
$D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6,
$DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD,
$6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $60, $00, $6A, $FF, $DD, $6D,
$DD, $DD, $D6, $E9, $46, $DD, $DD, $DD, $DD, $DD, $DD, $DD, $DD, $DD, $D6, $D6,
$DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD,
$6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D,
$6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D,
$D6, $D6, $D0, $00, $6A, $FF, $D6, $D6, $DD, $DD, $DD, $63, $9E, $5D, $DD, $DD,
$DD, $DD, $DD, $DD, $DD, $DD, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D,
$6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D,
$D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6,
$D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D0, $00, $6A, $FF, $D6, $DD,
$6D, $DD, $DD, $DD, $19, $98, $7A, $DD, $DD, $DA, $55, $DD, $DD, $DD, $6D, $6D,
$D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6,
$D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6,
$DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD,
$6D, $6D, $60, $00, $6A, $FF, $6D, $D6, $D6, $DD, $DD, $DD, $D2, $49, $99, $EE,
$33, $EB, $6D, $DD, $DD, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D,
$6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D,
$6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D,
$6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $6D, $D0, $00, $6A, $FF, $DD, $6D,
$D6, $DD, $DD, $DD, $DD, $DD, $57, $1B, $52, $DD, $DD, $DD, $6D, $D6, $DD, $DD,
$6D, $DD, $D6, $DD, $DD, $6D, $DD, $D6, $DD, $DD, $6D, $DD, $D6, $DD, $DD, $6D,
$DD, $D6, $DD, $DD, $6D, $DD, $D6, $DD, $DD, $6D, $DD, $D6, $DD, $DD, $6D, $DD,
$D6, $DD, $DD, $6D, $DD, $D6, $DD, $DD, $6D, $DD, $D6, $DD, $DD, $6D, $DD, $D6,
$DD, $DD, $60, $00, $6A, $FF, $D6, $DD, $6D, $D6, $DD, $DD, $DD, $DD, $DD, $DD,
$DD, $DD, $DD, $6D, $DD, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D,
$D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6,
$D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6,
$DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $D0, $00, $6A, $FF, $D6, $D6,
$DD, $6D, $6D, $DD, $DD, $DD, $DD, $DD, $DD, $DD, $6D, $D6, $D6, $DD, $6D, $6D,
$D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6,
$D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6,
$DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD, $6D, $6D, $D6, $D6, $DD,
$6D, $6D, $D0, $00, $6A, $FF
);
baner_h: array[0..6957] of byte = ( //*.bmp 256 rle
$42, $4D, $2E, $1B, $00, $00, $00, $00, $00, $00, $36, $04, $00, $00, $28, $00,
$00, $00, $89, $00, $00, $00, $2A, $00, $00, $00, $01, $00, $08, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $62, $03, $00, $00, $62, $03, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $04, $04, $04, $00, $CC, $88, $55, $00, $8F, $98,
$A8, $00, $DA, $CC, $C4, $00, $B9, $C7, $DE, $00, $3B, $5B, $88, $00, $44, $8E,
$FC, $00, $EC, $B6, $2C, $00, $EA, $E9, $E8, $00, $D4, $57, $06, $00, $5C, $59,
$5B, $00, $C2, $B4, $AA, $00, $BC, $8D, $6D, $00, $F3, $E6, $BB, $00, $CC, $A4,
$8A, $00, $B5, $B9, $BE, $00, $F4, $F2, $F4, $00, $2D, $7E, $FB, $00, $AD, $74,
$4F, $00, $E4, $C8, $70, $00, $37, $36, $37, $00, $7F, $AF, $F9, $00, $D8, $74,
$2E, $00, $24, $46, $7C, $00, $5E, $76, $9A, $00, $72, $71, $71, $00, $93, $8F,
$8E, $00, $A4, $5B, $2D, $00, $D6, $A0, $2C, $00, $FC, $D7, $34, $00, $DC, $DA,
$DA, $00, $FB, $DF, $76, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
$00, $00, $00, $00, $00, $00, $10, $10, $10, $10, $10, $10, $10, $10, $08, $10,
$10, $10, $10, $10, $08, $10, $10, $10, $10, $08, $08, $08, $10, $10, $10, $10,
$10, $08, $10, $08, $08, $08, $10, $10, $08, $10, $08, $10, $10, $08, $08, $10,
$10, $08, $10, $10, $08, $1E, $0F, $10, $10, $08, $10, $1E, $10, $10, $08, $10,
$08, $10, $10, $08, $08, $10, $08, $10, $08, $10, $10, $08, $08, $0F, $08, $10,
$08, $10, $10, $08, $10, $08, $10, $10, $08, $08, $10, $10, $10, $08, $08, $10,
$10, $10, $10, $10, $10, $08, $08, $10, $10, $10, $08, $10, $08, $10, $08, $10,
$10, $08, $10, $08, $10, $10, $08, $03, $04, $10, $10, $08, $08, $08, $10, $10,
$08, $08, $10, $10, $10, $08, $08, $10, $08, $08, $08, $10, $10, $10, $08, $FF,
$A4, $FF, $10, $10, $08, $10, $08, $10, $08, $10, $10, $10, $08, $10, $08, $10,
$10, $10, $08, $08, $03, $0B, $0C, $12, $12, $0C, $0B, $0D, $08, $10, $10, $0F,
$03, $08, $08, $10, $0F, $1E, $10, $10, $0F, $1E, $1E, $10, $08, $0B, $1E, $10,
$10, $08, $02, $10, $08, $10, $03, $1E, $08, $10, $03, $1E, $0F, $10, $08, $1E,
$0B, $08, $10, $08, $0F, $0F, $10, $10, $03, $03, $03, $10, $08, $10, $10, $1E,
$03, $0F, $08, $10, $0F, $03, $03, $10, $08, $0F, $0B, $10, $10, $08, $10, $10,
$0F, $03, $08, $08, $08, $0F, $0F, $10, $10, $0F, $03, $0F, $10, $10, $0F, $0F,
$10, $08, $1E, $03, $0F, $10, $08, $0F, $03, $08, $10, $1E, $03, $0B, $08, $10,
$10, $0B, $10, $10, $10, $03, $1E, $08, $10, $10, $0B, $FF, $A4, $FF, $10, $08,
$10, $10, $10, $10, $10, $10, $08, $10, $10, $10, $10, $10, $08, $10, $1E, $12,
$1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0C, $08, $08, $0B, $0B, $03, $10, $08,
$0F, $0F, $08, $10, $0B, $0B, $0F, $10, $10, $0F, $03, $08, $10, $1E, $1E, $0F,
$10, $10, $0F, $1E, $10, $08, $10, $0B, $0F, $10, $10, $08, $03, $10, $08, $10,
$0B, $0F, $10, $08, $03, $1E, $0B, $08, $10, $10, $10, $10, $0B, $03, $10, $10,
$1E, $0F, $03, $10, $10, $0B, $0F, $08, $10, $10, $08, $10, $03, $1E, $03, $10,
$08, $0B, $0F, $10, $10, $08, $0B, $0F, $10, $08, $0B, $0F, $08, $10, $1E, $03,
$0B, $10, $10, $0B, $0B, $0F, $10, $1E, $0F, $0B, $10, $08, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $FF, $A4, $FF, $10, $10, $10, $08, $10, $10,
$08, $10, $10, $10, $08, $10, $10, $08, $10, $0B, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $1B, $1B, $1B, $12, $03, $08, $1E, $08, $10, $08, $08, $08, $08, $10,
$08, $1E, $08, $10, $08, $08, $1E, $10, $08, $08, $08, $08, $08, $10, $03, $1E,
$10, $08, $10, $0B, $08, $10, $10, $08, $03, $10, $10, $10, $08, $1E, $10, $10,
$10, $1E, $08, $10, $10, $08, $10, $08, $0F, $1E, $10, $08, $10, $1E, $08, $10,
$10, $08, $1E, $10, $08, $10, $10, $10, $10, $1E, $08, $10, $10, $0F, $1E, $10,
$10, $08, $1E, $10, $10, $10, $08, $1E, $10, $10, $10, $1E, $08, $08, $10, $10,
$1E, $10, $10, $10, $08, $0F, $08, $10, $10, $10, $08, $10, $10, $10, $10, $10,
$08, $10, $10, $FF, $A4, $FF, $10, $08, $10, $10, $08, $10, $10, $10, $08, $10,
$08, $10, $08, $10, $0E, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $1B, $03, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $08, $10, $10, $10, $10, $10, $08, $10, $10, $08,
$10, $08, $10, $10, $08, $08, $10, $08, $10, $08, $10, $10, $10, $08, $10, $08,
$10, $10, $10, $10, $08, $10, $10, $10, $10, $08, $08, $10, $08, $10, $10, $10,
$10, $10, $08, $10, $08, $10, $08, $08, $08, $08, $08, $10, $10, $10, $08, $10,
$08, $10, $10, $08, $10, $08, $08, $10, $10, $10, $08, $10, $10, $08, $10, $10,
$10, $10, $10, $08, $10, $08, $10, $08, $10, $08, $08, $08, $10, $10, $08, $FF,
$A4, $FF, $10, $10, $08, $10, $10, $08, $10, $08, $10, $10, $10, $10, $10, $03,
$1B, $1B, $1B, $1B, $0C, $08, $10, $10, $10, $03, $12, $1B, $1B, $1B, $0C, $08,
$0C, $12, $0C, $10, $0E, $12, $12, $12, $10, $10, $12, $12, $12, $12, $12, $12,
$03, $10, $10, $08, $0D, $12, $12, $12, $12, $10, $10, $08, $10, $03, $12, $12,
$12, $12, $12, $12, $12, $12, $12, $1E, $0B, $01, $12, $1B, $1B, $1B, $01, $0E,
$08, $10, $08, $0E, $12, $12, $1B, $1B, $12, $01, $0B, $10, $08, $1E, $12, $12,
$12, $12, $12, $12, $12, $12, $12, $0B, $03, $12, $12, $12, $03, $08, $0E, $12,
$12, $12, $12, $12, $0E, $10, $08, $10, $1E, $0E, $12, $1B, $1B, $1B, $0C, $0D,
$0E, $12, $12, $12, $12, $12, $12, $12, $12, $01, $10, $FF, $A4, $FF, $08, $10,
$10, $10, $08, $10, $10, $10, $10, $08, $10, $10, $08, $12, $1B, $1B, $1B, $03,
$10, $10, $10, $10, $10, $10, $10, $0B, $1B, $1B, $0C, $10, $1E, $1B, $16, $08,
$0E, $1B, $1B, $1B, $1E, $08, $1B, $1B, $1B, $1B, $1B, $1B, $0B, $10, $10, $10,
$08, $1B, $1B, $1B, $1B, $1E, $10, $10, $10, $0B, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $1B, $0B, $0C, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $12, $03, $10, $1B,
$1B, $1B, $1B, $1B, $1B, $1B, $1B, $0C, $10, $08, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $1B, $0E, $03, $1B, $1B, $1B, $0B, $08, $12, $1B, $1B, $1B, $1B, $1B,
$0C, $10, $10, $03, $12, $1B, $1B, $1B, $1B, $1B, $1B, $03, $0C, $1B, $1B, $1B,
$1B, $1B, $1B, $1B, $1B, $1B, $08, $FF, $A4, $FF, $10, $10, $10, $08, $10, $10,
$08, $10, $10, $10, $10, $10, $0B, $1B, $1B, $1B, $0C, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $0C, $1B, $12, $10, $10, $0C, $1B, $10, $0E, $1B, $1B, $1B,
$03, $03, $1B, $1B, $1B, $1B, $1B, $1B, $0E, $10, $08, $10, $08, $1B, $1B, $1B,
$1B, $03, $10, $10, $10, $03, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0B,
$0C, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0C, $10, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $1B, $1B, $0B, $10, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0C,
$08, $1B, $1B, $1B, $0E, $10, $12, $1B, $1B, $1B, $1B, $1B, $12, $10, $08, $12,
$1B, $1B, $1B, $1B, $1B, $1B, $1B, $0B, $0E, $1B, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $08, $FF, $A4, $FF, $10, $08, $10, $10, $10, $10, $10, $10, $10, $08,
$04, $06, $1B, $1B, $1B, $1B, $0B, $10, $10, $10, $10, $0B, $08, $10, $10, $10,
$08, $1B, $1B, $10, $10, $1E, $1B, $08, $03, $1B, $1B, $1B, $0B, $03, $1B, $1B,
$1B, $1B, $1B, $1B, $0E, $10, $10, $10, $10, $12, $1B, $1B, $1B, $0B, $10, $10,
$10, $1E, $1B, $1B, $1B, $1B, $0B, $03, $03, $03, $03, $1E, $0B, $0C, $03, $03,
$1E, $0B, $1B, $1B, $1B, $1B, $08, $0C, $0E, $03, $0D, $03, $0C, $1B, $1B, $1B,
$01, $10, $12, $1B, $1B, $1B, $0E, $03, $03, $03, $03, $03, $10, $1B, $1B, $1B,
$0C, $08, $1B, $1B, $1B, $1B, $1B, $1B, $12, $08, $0B, $1B, $1B, $1B, $1B, $1B,
$0C, $0E, $0C, $0B, $0B, $1B, $1B, $1B, $12, $03, $03, $03, $03, $03, $08, $FF,
$A4, $FF, $10, $10, $10, $08, $10, $08, $10, $10, $15, $15, $15, $15, $1B, $1B,
$1B, $1B, $03, $10, $10, $10, $0B, $1B, $12, $10, $10, $10, $10, $12, $1B, $10,
$10, $10, $1B, $1E, $03, $1B, $1B, $1B, $0B, $0E, $1B, $1B, $1B, $1B, $1B, $1B,
$0C, $10, $08, $10, $10, $12, $1B, $1B, $1B, $0B, $10, $08, $10, $08, $1B, $1B,
$1B, $1B, $1E, $08, $10, $10, $10, $10, $08, $10, $08, $10, $08, $03, $1B, $1B,
$1B, $1B, $0B, $10, $10, $10, $08, $08, $0E, $1B, $1B, $1B, $1B, $08, $12, $1B,
$1B, $1B, $0B, $08, $10, $10, $10, $08, $10, $12, $1B, $1B, $01, $1E, $1B, $1B,
$1B, $12, $1B, $1B, $1B, $10, $0C, $1B, $1B, $1B, $1B, $03, $10, $10, $08, $10,
$0B, $1B, $1B, $1B, $12, $10, $10, $10, $10, $08, $10, $FF, $A4, $FF, $08, $10,
$10, $10, $10, $10, $08, $15, $1E, $08, $0D, $13, $1B, $1B, $1B, $1B, $0B, $10,
$10, $10, $0B, $1B, $1B, $10, $10, $10, $10, $0C, $1B, $08, $10, $10, $1B, $03,
$1E, $1B, $1B, $1B, $0E, $0E, $1B, $1B, $12, $12, $1B, $1B, $01, $08, $10, $10,
$08, $0C, $1B, $1B, $1B, $0E, $10, $10, $08, $10, $1B, $1B, $1B, $1B, $12, $01,
$12, $0C, $12, $03, $10, $08, $1E, $0E, $1B, $1B, $1B, $1B, $1B, $1B, $1E, $10,
$10, $03, $0C, $1B, $1B, $1B, $1B, $1B, $12, $10, $0C, $1B, $1B, $1B, $12, $01,
$12, $01, $12, $0B, $08, $12, $1B, $1B, $12, $03, $1B, $1B, $1B, $0C, $1B, $1B,
$1B, $08, $0C, $1B, $1B, $1B, $12, $08, $10, $08, $10, $10, $03, $1B, $1B, $1B,
$1B, $01, $01, $12, $0C, $01, $08, $FF, $A4, $FF, $10, $10, $08, $10, $10, $08,
$08, $0D, $1D, $1D, $07, $1C, $1B, $1B, $1B, $1B, $0B, $10, $10, $10, $03, $1B,
$1B, $1E, $10, $10, $10, $0C, $1B, $1E, $10, $10, $0C, $0B, $10, $1B, $1B, $1B,
$0C, $0C, $1B, $1B, $01, $12, $1B, $1B, $12, $10, $08, $10, $10, $0E, $1B, $1B,
$1B, $0C, $10, $10, $10, $10, $12, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0E,
$10, $03, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $10, $10, $0C, $1B, $1B, $1B,
$1B, $1B, $1B, $1B, $0C, $10, $0E, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0C,
$10, $0C, $1B, $1B, $12, $0B, $1B, $1B, $1B, $0E, $1B, $1B, $1B, $1E, $01, $1B,
$1B, $1B, $0C, $08, $10, $10, $10, $10, $0D, $1B, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $1E, $FF, $A4, $FF, $10, $08, $10, $08, $08, $08, $1D, $1D, $1D, $1D,
$1D, $1C, $1B, $1B, $1B, $1B, $0E, $10, $10, $10, $03, $1B, $1B, $0D, $10, $10,
$10, $0E, $1B, $0D, $10, $10, $0E, $0E, $10, $12, $1B, $1B, $0C, $12, $1B, $1B,
$0E, $0C, $1B, $1B, $1B, $10, $10, $10, $10, $0E, $1B, $1B, $1B, $0C, $08, $10,
$10, $08, $0C, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0E, $08, $12, $1B, $1B,
$1B, $1B, $1B, $1B, $12, $1E, $10, $03, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0C,
$08, $10, $0E, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $12, $10, $0C, $1B, $1B,
$1B, $0E, $1B, $1B, $12, $0B, $1B, $1B, $1B, $03, $0E, $1B, $1B, $1B, $1B, $08,
$10, $10, $08, $10, $08, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $03, $FF,
$A4, $FF, $10, $10, $10, $10, $0D, $1D, $1D, $1D, $1D, $1D, $1D, $1C, $1B, $1B,
$1B, $1B, $0C, $10, $10, $10, $08, $1B, $1B, $0B, $10, $10, $10, $0B, $1B, $0B,
$10, $10, $0C, $0C, $10, $12, $1B, $1B, $12, $1B, $1B, $1B, $0B, $0E, $1B, $1B,
$1B, $08, $10, $10, $10, $0B, $1B, $1B, $1B, $12, $10, $10, $10, $10, $0C, $1B,
$1B, $1B, $0C, $03, $03, $03, $03, $1E, $08, $1B, $1B, $1B, $1B, $12, $0E, $03,
$10, $08, $10, $03, $1B, $1B, $1B, $1B, $01, $0B, $1E, $10, $10, $10, $0B, $1B,
$1B, $1B, $12, $03, $03, $03, $03, $03, $10, $0E, $1B, $1B, $1B, $01, $1B, $1B,
$01, $03, $1B, $1B, $1B, $0B, $03, $1B, $1B, $1B, $1B, $0B, $10, $10, $10, $10,
$08, $1B, $1B, $1B, $1B, $0E, $03, $03, $03, $03, $1E, $FF, $A4, $FF, $08, $10,
$10, $0D, $1D, $1D, $07, $1D, $1D, $1D, $1D, $1F, $1B, $1B, $1B, $1B, $0C, $10,
$10, $10, $10, $1B, $1B, $0B, $10, $10, $10, $03, $1B, $0E, $10, $10, $12, $0C,
$10, $01, $1B, $1B, $1B, $1B, $1B, $1B, $0B, $0B, $1B, $1B, $1B, $1E, $0C, $0C,
$0C, $12, $1B, $1B, $1B, $1B, $0C, $0C, $0C, $0B, $0E, $1B, $1B, $1B, $0C, $10,
$10, $08, $08, $10, $08, $1B, $1B, $1B, $1B, $0B, $10, $10, $10, $1E, $1E, $03,
$1B, $1B, $1B, $1B, $08, $08, $10, $10, $03, $10, $03, $1B, $1B, $1B, $1B, $10,
$08, $10, $10, $10, $10, $0E, $1B, $1B, $1B, $1B, $1B, $1B, $0C, $08, $1B, $1B,
$1B, $0E, $08, $12, $1B, $1B, $1B, $1B, $0B, $10, $08, $03, $10, $12, $1B, $1B,
$1B, $03, $10, $10, $08, $10, $10, $FF, $A4, $FF, $10, $08, $0D, $1D, $1D, $1D,
$1D, $1D, $1F, $0D, $0F, $18, $1B, $1B, $1B, $1B, $12, $10, $10, $10, $10, $1B,
$1B, $0E, $10, $10, $10, $1E, $1B, $0E, $10, $10, $1B, $12, $10, $0C, $1B, $1B,
$1B, $1B, $1B, $1B, $1E, $0B, $1B, $1B, $1B, $03, $12, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $1B, $1B, $1B, $0C, $0B, $1B, $1B, $1B, $1B, $12, $1B, $12, $12, $12,
$1E, $0C, $1B, $1B, $1B, $1B, $01, $12, $12, $1B, $03, $08, $1B, $1B, $1B, $1B,
$1B, $0C, $12, $1B, $1B, $10, $03, $1B, $1B, $1B, $1B, $12, $12, $1B, $12, $1B,
$03, $03, $1B, $1B, $1B, $1B, $1B, $1B, $0E, $08, $1B, $1B, $1B, $0E, $08, $0B,
$1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1E, $0C, $1B, $1B, $1B, $1B, $12, $1B,
$12, $12, $0C, $FF, $A4, $FF, $10, $10, $1F, $1D, $1D, $1D, $1D, $0D, $02, $05,
$17, $17, $1B, $1B, $1B, $1B, $1B, $10, $10, $10, $10, $12, $1B, $0C, $10, $10,
$10, $08, $1B, $0C, $10, $03, $1B, $12, $08, $0E, $1B, $1B, $1B, $1B, $1B, $1B,
$08, $03, $1B, $1B, $1B, $0B, $01, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $12, $0B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $03, $1E, $1B, $1B,
$1B, $1B, $1B, $1B, $1B, $1B, $0B, $10, $0B, $1B, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $08, $08, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0B, $03, $1B, $1B,
$1B, $1B, $1B, $1B, $0B, $10, $1B, $1B, $1B, $0C, $10, $10, $0E, $1B, $1B, $1B,
$1B, $1B, $1B, $1B, $03, $0C, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $12, $FF,
$A4, $FF, $10, $0D, $1D, $1D, $1D, $1D, $08, $02, $17, $17, $17, $17, $14, $1B,
$1B, $1B, $1B, $08, $10, $10, $10, $01, $1B, $12, $10, $10, $10, $10, $1B, $12,
$10, $0C, $1B, $1B, $10, $0B, $1B, $1B, $1B, $1B, $1B, $1B, $10, $1E, $1B, $1B,
$1B, $0B, $0C, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $12, $03, $1B,
$1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $03, $10, $0D, $0C, $1B, $1B, $1B, $1B,
$1B, $1B, $0E, $10, $08, $03, $12, $1B, $1B, $1B, $1B, $1B, $1B, $1E, $10, $1B,
$1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0E, $1E, $1B, $1B, $1B, $1B, $1B, $1B,
$03, $08, $12, $1B, $1B, $0C, $08, $10, $08, $03, $12, $1B, $1B, $1B, $1B, $1B,
$0B, $0E, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $FF, $A4, $FF, $10, $1D,
$1D, $1D, $1D, $1E, $02, $17, $17, $17, $17, $17, $17, $1B, $1B, $1B, $1B, $12,
$12, $12, $12, $1B, $1B, $1B, $12, $12, $12, $12, $1B, $1B, $0E, $01, $1E, $03,
$10, $08, $03, $0D, $03, $0D, $03, $0D, $10, $10, $03, $0D, $03, $08, $0D, $1E,
$03, $0D, $03, $0D, $03, $0D, $03, $03, $03, $0D, $08, $03, $0D, $03, $0D, $03,
$0D, $03, $0D, $03, $08, $10, $08, $10, $0D, $03, $0B, $0B, $0B, $0D, $08, $10,
$10, $10, $08, $0D, $03, $0B, $0B, $03, $1E, $08, $10, $03, $0D, $03, $03, $03,
$03, $0D, $03, $03, $08, $08, $03, $0D, $03, $03, $0D, $03, $08, $10, $0D, $03,
$03, $0D, $08, $10, $10, $10, $08, $08, $03, $0E, $0B, $0D, $08, $1E, $03, $03,
$03, $03, $0D, $03, $03, $03, $0D, $FF, $A4, $FF, $0D, $1D, $1D, $1D, $0D, $02,
$17, $17, $17, $17, $17, $02, $03, $0F, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $03, $09, $10, $10, $08, $10, $10, $08,
$10, $10, $08, $10, $08, $10, $10, $08, $10, $08, $10, $10, $08, $10, $10, $08,
$10, $10, $08, $10, $10, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $08,
$10, $10, $10, $10, $10, $10, $10, $10, $08, $10, $10, $10, $10, $08, $10, $10,
$08, $10, $10, $10, $08, $10, $10, $08, $10, $10, $10, $10, $10, $10, $10, $10,
$08, $10, $10, $08, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$08, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $08, $FF, $A4, $FF, $0D, $1D, $1D, $1F, $03, $17, $17, $17, $17, $02,
$03, $0E, $09, $09, $16, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B,
$1B, $1B, $1B, $11, $0D, $09, $1E, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,
$0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,
$0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $14, $14, $14, $0A, $0A,
$0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,
$0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,
$0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0B, $10, $FF,
$A4, $FF, $1F, $1D, $1D, $1E, $05, $17, $17, $17, $02, $0B, $09, $09, $09, $09,
$0B, $03, $16, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $0A, $11, $11,
$08, $09, $13, $10, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $08, $10, $10, $08, $10, $10, $10, $10, $10, $08, $10,
$10, $10, $08, $10, $10, $08, $10, $10, $10, $10, $08, $10, $10, $10, $10, $10,
$10, $10, $08, $10, $10, $10, $10, $10, $0B, $03, $10, $10, $10, $10, $10, $10,
$08, $10, $10, $10, $08, $10, $10, $10, $10, $10, $08, $10, $10, $08, $10, $08,
$10, $08, $10, $08, $10, $10, $10, $10, $10, $10, $10, $08, $10, $10, $08, $10,
$10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $10, $FF, $A4, $FF, $1D, $1D,
$1F, $0F, $17, $17, $17, $18, $0B, $09, $09, $09, $09, $03, $10, $10, $1E, $0C,
$1B, $1B, $1B, $1B, $1B, $1B, $1B, $1B, $19, $11, $11, $11, $1E, $09, $0E, $08,
$10, $08, $10, $10, $10, $10, $08, $10, $10, $08, $10, $10, $10, $10, $08, $10,
$10, $10, $10, $08, $10, $10, $10, $10, $10, $08, $10, $10, $08, $10, $10, $08,
$08, $10, $10, $10, $08, $1E, $08, $10, $08, $10, $10, $08, $1E, $08, $10, $10,
$10, $10, $10, $10, $0B, $1E, $08, $10, $08, $1E, $08, $10, $10, $08, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $10, $10, $10, $10, $10, $10, $08, $1E, $08,
$10, $08, $10, $10, $1E, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10,
$08, $1E, $10, $10, $10, $08, $10, $FF, $A4, $FF, $1D, $1D, $0D, $1A, $17, $17,
$17, $0F, $16, $09, $09, $09, $0B, $10, $10, $08, $10, $10, $08, $0B, $19, $16,
$16, $1C, $07, $0D, $11, $11, $11, $06, $03, $09, $01, $10, $10, $10, $10, $08,
$10, $08, $10, $10, $08, $0B, $02, $10, $14, $10, $10, $10, $0A, $1E, $0F, $1A,
$10, $08, $08, $14, $10, $1A, $0F, $10, $10, $10, $1A, $00, $10, $10, $08, $10,
$1A, $0B, $19, $0A, $0B, $10, $03, $19, $0B, $1A, $0B, $10, $08, $1A, $19, $19,
$1A, $03, $10, $10, $1A, $0B, $19, $0A, $0B, $10, $03, $0B, $0A, $0B, $0B, $10,
$1E, $0A, $03, $10, $02, $0E, $10, $10, $0F, $1A, $0B, $1A, $03, $08, $10, $03,
$00, $0B, $10, $10, $08, $0B, $19, $0B, $0F, $10, $10, $08, $1A, $0B, $19, $0A,
$0F, $10, $10, $FF, $A4, $FF, $1D, $1D, $1E, $05, $17, $17, $05, $0B, $09, $09,
$09, $16, $1E, $10, $10, $10, $10, $10, $08, $08, $03, $1D, $1D, $1D, $1D, $0D,
$11, $11, $11, $15, $0B, $09, $01, $10, $10, $10, $08, $10, $10, $10, $10, $08,
$10, $0B, $1A, $0F, $1A, $1E, $10, $10, $02, $0E, $02, $0B, $08, $10, $03, $1A,
$1E, $1A, $0B, $08, $10, $10, $03, $02, $10, $08, $10, $10, $0B, $10, $10, $1A,
$08, $10, $1A, $08, $10, $08, $1A, $10, $0F, $03, $08, $10, $1A, $03, $10, $10,
$0B, $10, $08, $1A, $08, $10, $08, $10, $1A, $10, $10, $10, $10, $1A, $10, $10,
$03, $1E, $08, $10, $1A, $10, $10, $10, $08, $10, $10, $08, $1A, $1E, $10, $10,
$10, $10, $0B, $10, $08, $10, $08, $10, $0B, $10, $10, $19, $10, $10, $10, $FF,
$A4, $FF, $1D, $1D, $1E, $17, $17, $17, $02, $01, $09, $09, $09, $0E, $15, $08,
$08, $10, $08, $10, $10, $10, $0D, $1D, $1D, $1D, $13, $04, $11, $11, $11, $15,
$0C, $09, $01, $10, $10, $10, $10, $08, $10, $10, $08, $10, $10, $02, $0E, $1A,
$1E, $0F, $10, $1E, $0B, $02, $1A, $02, $10, $10, $0E, $1E, $19, $03, $02, $10,
$10, $10, $08, $10, $08, $10, $10, $10, $0B, $10, $08, $1A, $10, $10, $0B, $10,
$10, $10, $0B, $10, $0B, $10, $10, $10, $0B, $03, $10, $10, $0B, $10, $10, $1A,
$10, $10, $10, $10, $1A, $10, $08, $10, $08, $1A, $10, $10, $03, $1E, $10, $10,
$1A, $10, $10, $10, $10, $10, $10, $10, $10, $10, $08, $10, $08, $10, $0B, $10,
$10, $10, $10, $10, $0B, $08, $10, $1A, $10, $08, $10, $FF, $A4, $FF, $1D, $1D,
$04, $17, $17, $17, $02, $01, $09, $09, $09, $0B, $06, $08, $10, $10, $10, $10,
$10, $0D, $1D, $1D, $1D, $1D, $0D, $06, $11, $11, $11, $08, $16, $09, $0C, $10,
$10, $10, $08, $10, $10, $08, $10, $10, $10, $1A, $1E, $1A, $08, $1A, $10, $0B,
$03, $0B, $0F, $0F, $1E, $08, $02, $10, $19, $08, $1A, $10, $10, $08, $10, $10,
$10, $10, $10, $08, $0F, $10, $10, $1A, $10, $10, $02, $10, $08, $10, $1A, $10,
$1A, $10, $08, $10, $02, $0D, $08, $10, $0B, $10, $10, $1A, $10, $10, $08, $10,
$1A, $10, $10, $10, $10, $1A, $08, $10, $03, $03, $10, $10, $1A, $10, $08, $10,
$08, $10, $08, $10, $10, $08, $10, $10, $10, $10, $19, $08, $10, $10, $10, $10,
$0B, $10, $10, $1A, $10, $10, $10, $FF, $A4, $FF, $1F, $1F, $0F, $17, $17, $17,
$02, $01, $09, $09, $09, $03, $11, $06, $08, $10, $08, $08, $0D, $1D, $1D, $1D,
$1D, $0D, $15, $11, $11, $11, $06, $03, $09, $09, $0E, $10, $10, $10, $10, $10,
$08, $10, $10, $10, $0B, $1A, $08, $10, $03, $19, $1E, $19, $0F, $10, $08, $0E,
$1A, $1E, $19, $03, $10, $08, $19, $03, $10, $10, $10, $10, $08, $10, $08, $03,
$0E, $10, $03, $0A, $10, $10, $0B, $0B, $1E, $0F, $1A, $10, $1E, $1A, $1E, $03,
$0A, $02, $10, $0F, $0B, $08, $03, $0A, $10, $10, $08, $0B, $19, $10, $10, $08,
$08, $0A, $1A, $1E, $19, $08, $08, $03, $0A, $0B, $0B, $03, $10, $10, $10, $10,
$08, $10, $10, $10, $08, $0F, $0E, $19, $03, $1A, $10, $0F, $0B, $08, $03, $0A,
$10, $10, $08, $FF, $A4, $FF, $1F, $1D, $04, $17, $17, $17, $02, $16, $09, $09,
$09, $03, $11, $11, $15, $10, $0D, $1F, $1D, $1D, $1D, $1D, $0D, $15, $11, $11,
$11, $11, $04, $16, $09, $09, $0D, $08, $08, $10, $10, $08, $10, $10, $10, $08,
$1E, $1E, $10, $08, $08, $1E, $08, $1E, $1E, $10, $10, $1E, $1E, $08, $1E, $08,
$08, $08, $1E, $08, $08, $10, $10, $08, $10, $10, $10, $1E, $08, $08, $08, $1E,
$08, $10, $10, $1E, $0B, $03, $10, $10, $08, $08, $0B, $03, $08, $1E, $10, $1E,
$08, $08, $08, $1E, $08, $10, $08, $1E, $1E, $10, $10, $10, $08, $1E, $08, $0F,
$08, $10, $10, $08, $1A, $03, $1E, $08, $08, $10, $10, $08, $10, $10, $10, $08,
$10, $1E, $08, $08, $1E, $08, $10, $1E, $08, $08, $08, $1E, $10, $10, $10, $FF,
$A4, $FF, $0D, $1D, $1E, $17, $17, $17, $02, $01, $09, $09, $09, $0E, $06, $11,
$11, $06, $04, $08, $0D, $0D, $08, $04, $06, $11, $11, $11, $11, $15, $03, $09,
$09, $09, $10, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10,
$10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10,
$10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10,
$10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10,
$10, $10, $08, $10, $0E, $10, $10, $08, $10, $10, $08, $10, $10, $10, $08, $10,
$1A, $10, $10, $08, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10,
$10, $10, $08, $10, $10, $10, $08, $10, $08, $10, $08, $FF, $A4, $FF, $08, $1D,
$08, $17, $17, $17, $05, $03, $09, $09, $09, $16, $04, $11, $11, $11, $11, $11,
$11, $06, $11, $11, $11, $11, $11, $11, $06, $1E, $09, $09, $09, $01, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$19, $10, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $10, $10, $FF, $A4, $FF, $10, $1F, $0D, $18, $17, $17,
$17, $0F, $09, $09, $09, $09, $03, $06, $11, $11, $11, $11, $11, $11, $11, $11,
$11, $11, $11, $15, $1E, $16, $09, $09, $09, $1E, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $08, $10, $FF, $A4, $FF, $10, $08, $1F, $0F, $17, $17, $17, $02, $01, $09,
$09, $09, $09, $03, $06, $11, $11, $11, $11, $11, $11, $11, $11, $11, $15, $1E,
$16, $09, $09, $09, $01, $10, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $10, $10, $FF,
$A4, $FF, $10, $08, $1F, $1E, $17, $17, $17, $05, $1E, $16, $09, $09, $09, $16,
$03, $15, $06, $11, $11, $11, $11, $06, $15, $1E, $0E, $09, $09, $09, $09, $09,
$08, $08, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $08, $FF, $A4, $FF, $10, $10,
$08, $0D, $02, $17, $17, $17, $18, $03, $09, $09, $09, $09, $09, $01, $03, $1E,
$04, $04, $08, $0F, $01, $09, $09, $09, $09, $09, $09, $0D, $08, $10, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $FF, $A4, $FF, $10, $08, $10, $08, $1E, $17,
$17, $17, $17, $0F, $0B, $09, $09, $09, $09, $09, $09, $09, $09, $09, $09, $09,
$09, $09, $09, $09, $09, $09, $0B, $10, $08, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08,
$10, $10, $10, $FF, $A4, $FF, $10, $10, $10, $10, $08, $0F, $17, $17, $17, $17,
$0F, $0B, $09, $09, $09, $09, $09, $09, $09, $09, $09, $09, $09, $09, $09, $09,
$16, $03, $08, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10,
$10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $10, $10, $08, $10, $FF,
$A4, $FF, $10, $08, $10, $08, $10, $08, $02, $17, $17, $17, $17, $02, $1E, $16,
$09, $09, $09, $09, $09, $09, $09, $09, $09, $09, $09, $0E, $08, $10, $10, $08,
$10, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $10, $FF, $A4, $FF, $10, $10,
$10, $10, $10, $10, $08, $02, $17, $17, $17, $17, $18, $04, $1E, $0C, $16, $09,
$09, $09, $09, $09, $01, $0B, $08, $04, $08, $08, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $08, $FF, $A4, $FF, $10, $08, $10, $08, $10, $08,
$10, $08, $0F, $05, $17, $17, $17, $17, $18, $0F, $04, $08, $1E, $1E, $08, $1E,
$04, $02, $02, $10, $10, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10, $08, $10,
$08, $10, $10, $FF, $A4, $FF, $10, $10, $10, $10, $10, $10, $10, $10, $10, $08,
$02, $05, $17, $17, $17, $17, $17, $17, $05, $05, $17, $05, $02, $08, $10, $10,
$08, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10,
$10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $10, $FF,
$A4, $FF, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $08, $04, $02,
$18, $18, $18, $18, $18, $0F, $04, $08, $08, $10, $10, $08, $10, $10, $08, $10,
$10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10,
$08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08,
$10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10,
$10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10,
$08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08,
$10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $10,
$10, $08, $10, $10, $08, $10, $10, $08, $10, $10, $08, $FF, $A4, $FF
);

128
vinfo.pas Normal file
View File

@ -0,0 +1,128 @@
unit vinfo;
{$mode objfpc}
interface
uses
Classes, SysUtils, resource, versiontypes, versionresource;
type
TVersionPrecision = 1..4;
{ TVersionInfo }
TVersionInfo = class
private
FVersResource: TVersionResource;
function GetBuild: Integer;
function GetFixedInfo: TVersionFixedInfo;
function GetStringFileInfo: TVersionStringFileInfo;
function GetVarFileInfo: TVersionVarFileInfo;
public
constructor Create;
destructor Destroy; override;
procedure Load(Instance: THandle);
property FixedInfo: TVersionFixedInfo read GetFixedInfo;
property StringFileInfo: TVersionStringFileInfo read GetStringFileInfo;
property VarFileInfo: TVersionVarFileInfo read GetVarFileInfo;
property Build: Integer read GetBuild;
//Helper functions
function GetFileVersionString: String;
function GetProductVersionString(AMinPrecision: TVersionPrecision = 2): String;
end;
var
VersionInfo: TVersionInfo;
implementation
{ TVersionInfo }
function TVersionInfo.GetBuild: Integer;
begin
Result := Integer(FixedInfo.FileVersion[3]);
end;
function TVersionInfo.GetFixedInfo: TVersionFixedInfo;
begin
Result := FVersResource.FixedInfo;
end;
function TVersionInfo.GetStringFileInfo: TVersionStringFileInfo;
begin
Result := FVersResource.StringFileInfo;
end;
function TVersionInfo.GetVarFileInfo: TVersionVarFileInfo;
begin
Result := FVersResource.VarFileInfo;
end;
constructor TVersionInfo.Create;
begin
inherited Create;
FVersResource := TVersionResource.Create;
end;
destructor TVersionInfo.Destroy;
begin
FVersResource.Free;
inherited Destroy;
end;
procedure TVersionInfo.Load(Instance: THandle);
var
Stream: TResourceStream;
begin
Stream := TResourceStream.CreateFromID(Instance, 1, PChar(RT_VERSION));
try
FVersResource.SetCustomRawDataStream(Stream);
// access some property to load from the stream
FVersResource.FixedInfo;
// clear the stream
FVersResource.SetCustomRawDataStream(nil);
finally
Stream.Free;
end;
end;
function TVersionInfo.GetProductVersionString(AMinPrecision: TVersionPrecision = 2): String;
var
productVersion: TFileProductVersion;
lastVersion, i: Integer;
begin
productVersion := FixedInfo.ProductVersion;
lastVersion := 3;
while (lastVersion >= AMinPrecision) and (productVersion[lastVersion] = 0) do
dec(lastVersion);
Result := '';
for i := 0 to lastVersion do
begin
Result := Result + IntToStr(productVersion[i]);
if i < lastVersion then
Result := Result + '.';
end;
end;
function TVersionInfo.GetFileVersionString: String;
var
fileVersion: TFileProductVersion;
begin
fileVersion := FixedInfo.FileVersion;
Result := Format('%d.%d.%d', [fileVersion[0], fileVersion[1], fileVersion[2]]);
end;
initialization
VersionInfo := TVersionInfo.Create;
VersionInfo.Load(HINSTANCE);
finalization
VersionInfo.Free;
end.