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

* Fixed compilation with FPC 3.1.1 and Lazarus 1.5

This commit is contained in:
Andreas Schneider 2015-05-01 12:48:35 +02:00
parent fe6b65844f
commit 58b24b35ec
6 changed files with 408 additions and 452 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Client/CentrED.lpr
View File

@ -36,7 +36,7 @@ uses
Forms, Dialogs, Windows, UdmNetwork, UResourceManager; Forms, Dialogs, Windows, UdmNetwork, UResourceManager;
{$R CentrED.res} {$R CentrED.res}
{$R CentrED.manifest.rc} //{$R CentrED.manifest.rc}
function GetApplicationName: String; function GetApplicationName: String;
begin begin

444
Client/GUI/AeroGlass.pas
View File

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

8
Client/GUI/VirtualList.pas
View File

@ -28,6 +28,8 @@ type
Selected: Boolean; Selected: Boolean;
end; end;
{ TVirtualList }
TVirtualList = class(TVirtualDrawTree) TVirtualList = class(TVirtualDrawTree)
private private
@ -75,7 +77,7 @@ type
procedure HandleMouseDblClick(var Message: TLMMouse; const HitInfo: THitInfo); override; procedure HandleMouseDblClick(var Message: TLMMouse; const HitInfo: THitInfo); override;
procedure HandleMouseDown(var Message: TLMMouse; var HitInfo: THitInfo); override; procedure HandleMouseDown(var Message: TLMMouse; var HitInfo: THitInfo); override;
procedure HandleMouseUp(var Message: TLMMouse; const HitInfo: THitInfo); override; procedure HandleMouseUp(Keys: PtrUInt; const HitInfo: THitInfo); override;
property SelectedCount: Dword read FSelectionCount; property SelectedCount: Dword read FSelectionCount;
property TilesCount: Dword read FTilesCount; property TilesCount: Dword read FTilesCount;
@ -690,10 +692,10 @@ begin
end; end;
procedure TVirtualList.HandleMouseUp(var Message: TLMMouse; const HitInfo: THitInfo); procedure TVirtualList.HandleMouseUp(Keys: PtrUInt; const HitInfo: THitInfo);
begin begin
//Logger.Send([lcClient, lcDebug], 'TVirtualTree.HandleMouseUp %s', ['Start']); //Logger.Send([lcClient, lcDebug], 'TVirtualTree.HandleMouseUp %s', ['Start']);
inherited HandleMouseUp(Message, HitInfo); inherited HandleMouseUp(Keys, HitInfo);
end; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------

132
Client/UfrmMain.lfm
View File

@ -1,10 +1,10 @@
object frmMain: TfrmMain object frmMain: TfrmMain
Left = 294 Left = 290
Height = 680 Height = 680
Top = 123 Top = 123
Width = 982 Width = 982
Caption = 'UO CentrED+' Caption = 'UO CentrED+'
ClientHeight = 660 ClientHeight = 659
ClientWidth = 982 ClientWidth = 982
Constraints.MinHeight = 680 Constraints.MinHeight = 680
Constraints.MinWidth = 980 Constraints.MinWidth = 980
@ -18,24 +18,23 @@ object frmMain: TfrmMain
OnShow = FormShow OnShow = FormShow
OnWindowStateChange = FormWindowStateChange OnWindowStateChange = FormWindowStateChange
SessionProperties = 'acFlat.Checked;acLightlevel.Tag;acNoDraw.Checked;acStatics.Checked;acTerrain.Checked;acWalkable.Checked;cbStatics.Checked;cbTerrain.Checked;Height;Left;mnuAutoHideGroupList.Checked;mnuAutoHideGroupList.Tag;mnuAutoHideRandomList.Checked;mnuAutoHideRandomList.Tag;mnuAutoShowFilterWindow.Checked;mnuCompactHueSettings.Checked;mnuFlatShowHeight.Checked;mnuMiscTileListCentre.Checked;mnuMiscTileListClip.Checked;mnuMiscTileListDrawInfo.Checked;mnuMiscTileListLarge.Checked;mnuMiscTileListMidle.Checked;mnuMiscTileListSmall.Checked;mnuMiscTileListStretch.Checked;mnuMiscTileListTable.Checked;mnuSecurityQuestion.Checked;mnuShowAnimations.Checked;mnuShowBlocks.Checked;mnuShowBridges.Checked;mnuShowFoliage.Checked;mnuShowGrid.Checked;mnuShowLightSource.Checked;mnuShowNoDrawTiles.Checked;mnuShowRoofs.Checked;mnuShowSurfaces.Checked;mnuShowWalls.Checked;mnuShowWater.Checked;mnuTileListCentre.Checked;mnuTileListClip.Checked;mnuTileListDrawInfo.Checked;mnuTileListLarge.Checked;mnuTileListMidle.Checked;mnuTileListSmall.Checked;mnuTileListStretch.Checked;mnuTileListTable.Checked;mnuWhiteBackground.Checked;mnuWindowedMode.Checked;mnuWindowedMode.Tag;pcLeft.TabIndex;spGroupList.Top;spTileList.Top;Tag;Top;Width;WindowState;mnuMiscTileListDrawInfo.Enabled;mnuTileListDrawInfo.Enabled' SessionProperties = 'acFlat.Checked;acLightlevel.Tag;acNoDraw.Checked;acStatics.Checked;acTerrain.Checked;acWalkable.Checked;cbStatics.Checked;cbTerrain.Checked;Height;Left;mnuAutoHideGroupList.Checked;mnuAutoHideGroupList.Tag;mnuAutoHideRandomList.Checked;mnuAutoHideRandomList.Tag;mnuAutoShowFilterWindow.Checked;mnuCompactHueSettings.Checked;mnuFlatShowHeight.Checked;mnuMiscTileListCentre.Checked;mnuMiscTileListClip.Checked;mnuMiscTileListDrawInfo.Checked;mnuMiscTileListLarge.Checked;mnuMiscTileListMidle.Checked;mnuMiscTileListSmall.Checked;mnuMiscTileListStretch.Checked;mnuMiscTileListTable.Checked;mnuSecurityQuestion.Checked;mnuShowAnimations.Checked;mnuShowBlocks.Checked;mnuShowBridges.Checked;mnuShowFoliage.Checked;mnuShowGrid.Checked;mnuShowLightSource.Checked;mnuShowNoDrawTiles.Checked;mnuShowRoofs.Checked;mnuShowSurfaces.Checked;mnuShowWalls.Checked;mnuShowWater.Checked;mnuTileListCentre.Checked;mnuTileListClip.Checked;mnuTileListDrawInfo.Checked;mnuTileListLarge.Checked;mnuTileListMidle.Checked;mnuTileListSmall.Checked;mnuTileListStretch.Checked;mnuTileListTable.Checked;mnuWhiteBackground.Checked;mnuWindowedMode.Checked;mnuWindowedMode.Tag;pcLeft.TabIndex;spGroupList.Top;spTileList.Top;Tag;Top;Width;WindowState;mnuMiscTileListDrawInfo.Enabled;mnuTileListDrawInfo.Enabled'
LCLVersion = '0.9.30.2' LCLVersion = '1.5'
WindowState = wsMaximized WindowState = wsMaximized
object pcLeft: TPageControl object pcLeft: TPageControl
Cursor = crArrow Cursor = crArrow
Left = 0 Left = 0
Height = 660 Height = 659
Top = 0 Top = 0
Width = 224 Width = 224
ActivePage = tsTiles ActivePage = tsTiles
Align = alLeft Align = alLeft
TabIndex = 0 TabIndex = 0
TabOrder = 0 TabOrder = 0
OnChange = pcLeftChange
OnResize = pcLeftResize OnResize = pcLeftResize
object tsTiles: TTabSheet object tsTiles: TTabSheet
Caption = ' Тайлы ' Caption = ' Тайлы '
ClientHeight = 634 ClientHeight = 632
ClientWidth = 216 ClientWidth = 220
object vdtTiles: TVirtualDrawTree object vdtTiles: TVirtualDrawTree
Tag = -1 Tag = -1
AnchorSideLeft.Control = tsTiles AnchorSideLeft.Control = tsTiles
@ -47,8 +46,8 @@ object frmMain: TfrmMain
Left = 0 Left = 0
Height = 64 Height = 64
Hint = '-' Hint = '-'
Top = 295 Top = 293
Width = 213 Width = 217
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 1 BorderSpacing.Top = 1
BorderSpacing.Right = 3 BorderSpacing.Right = 3
@ -193,7 +192,7 @@ object frmMain: TfrmMain
Left = 0 Left = 0
Height = 5 Height = 5
Top = 290 Top = 290
Width = 216 Width = 220
Align = alNone Align = alNone
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
OnMoved = spTileListMoved OnMoved = spTileListMoved
@ -204,10 +203,10 @@ object frmMain: TfrmMain
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = tsTiles AnchorSideTop.Control = tsTiles
Cursor = crArrow Cursor = crArrow
Left = 79 Left = 92
Height = 14 Height = 13
Top = 0 Top = 0
Width = 85 Width = 97
BorderSpacing.Left = 16 BorderSpacing.Left = 16
Caption = 'Фильтр / Поиск:' Caption = 'Фильтр / Поиск:'
ParentColor = False ParentColor = False
@ -220,15 +219,15 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = tsTiles AnchorSideBottom.Control = tsTiles
Cursor = crArrow Cursor = crArrow
Left = 0 Left = 0
Height = 339 Height = 337
Top = 295 Top = 295
Width = 216 Width = 220
Align = alBottom Align = alBottom
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BidiMode = bdRightToLeft BidiMode = bdRightToLeft
Caption = 'Набор случайных тайлов' Caption = 'Набор случайных тайлов'
ClientHeight = 321 ClientHeight = 323
ClientWidth = 212 ClientWidth = 218
Constraints.MinHeight = 1 Constraints.MinHeight = 1
ParentBidiMode = False ParentBidiMode = False
ParentColor = False ParentColor = False
@ -279,7 +278,6 @@ object frmMain: TfrmMain
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnAddRandomClick OnClick = btnAddRandomClick
ShowCaption = False ShowCaption = False
ShowHint = True ShowHint = True
@ -333,7 +331,6 @@ object frmMain: TfrmMain
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnDeleteRandomClick OnClick = btnDeleteRandomClick
ShowCaption = False ShowCaption = False
ShowHint = True ShowHint = True
@ -388,7 +385,6 @@ object frmMain: TfrmMain
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnClearRandomClick OnClick = btnClearRandomClick
ShowCaption = False ShowCaption = False
ShowHint = True ShowHint = True
@ -399,10 +395,10 @@ object frmMain: TfrmMain
AnchorSideTop.Control = cbRandomPreset AnchorSideTop.Control = cbRandomPreset
AnchorSideRight.Control = btnRandomPresetDelete AnchorSideRight.Control = btnRandomPresetDelete
Cursor = crArrow Cursor = crArrow
Left = 162 Left = 168
Height = 22 Height = 22
Hint = 'Сохранить набор' Hint = 'Сохранить набор'
Top = 296 Top = 294
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -442,7 +438,6 @@ object frmMain: TfrmMain
4DFFC88C4FFFC88C4FFFC88C4FFFC88D4FFFC98C4FFFC78B4FFFC5894BFFC476 4DFFC88C4FFFC88C4FFFC88C4FFFC88D4FFFC98C4FFFC78B4FFFC5894BFFC476
3BFF000000000000000000000000000000000000000000000000 3BFF000000000000000000000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnRandomPresetSaveClick OnClick = btnRandomPresetSaveClick
ShowCaption = False ShowCaption = False
ShowHint = True ShowHint = True
@ -454,10 +449,10 @@ object frmMain: TfrmMain
AnchorSideRight.Control = vdtRandom AnchorSideRight.Control = vdtRandom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Cursor = crArrow Cursor = crArrow
Left = 188 Left = 194
Height = 22 Height = 22
Hint = 'Удалить набор' Hint = 'Удалить набор'
Top = 296 Top = 294
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
Glyph.Data = { Glyph.Data = {
@ -496,7 +491,6 @@ object frmMain: TfrmMain
0000C88B4DFFC88C4FFFC88C4FFFC88C4FFFC88C4FFFC88D4FFFC98C4FFFC78B 0000C88B4DFFC88C4FFFC88C4FFFC88C4FFFC88C4FFFC88D4FFFC98C4FFFC78B
4FFFC5894BFFC4763BFF00000000000000000000000000000000 4FFFC5894BFFC4763BFF00000000000000000000000000000000
} }
NumGlyphs = 0
OnClick = btnRandomPresetDeleteClick OnClick = btnRandomPresetDeleteClick
ShowCaption = False ShowCaption = False
ShowHint = True ShowHint = True
@ -513,9 +507,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = cbRandomPreset AnchorSideBottom.Control = cbRandomPreset
Cursor = 63 Cursor = 63
Left = 2 Left = 2
Height = 272 Height = 270
Top = 20 Top = 20
Width = 208 Width = 214
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 2 BorderSpacing.Left = 2
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -628,7 +622,7 @@ object frmMain: TfrmMain
ScrollBarOptions.ScrollBars = ssVertical ScrollBarOptions.ScrollBars = ssVertical
TabOrder = 0 TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes] TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning] TreeOptions.MiscOptions = [toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toStaticBackground] TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages, toStaticBackground]
TreeOptions.SelectionOptions = [toFullRowSelect] TreeOptions.SelectionOptions = [toFullRowSelect]
OnClick = vdtRandomClick OnClick = vdtRandomClick
@ -647,13 +641,13 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Cursor = crArrow Cursor = crArrow
Left = 2 Left = 2
Height = 21 Height = 25
Top = 296 Top = 294
Width = 156 Width = 162
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
ItemHeight = 13 ItemHeight = 0
OnChange = cbRandomPresetChange OnChange = cbRandomPresetChange
ParentBidiMode = False ParentBidiMode = False
Sorted = True Sorted = True
@ -666,9 +660,9 @@ object frmMain: TfrmMain
AnchorSideTop.Control = cbTerrain AnchorSideTop.Control = cbTerrain
Cursor = crArrow Cursor = crArrow
Left = 4 Left = 4
Height = 19 Height = 24
Top = 18 Top = 18
Width = 62 Width = 76
BorderSpacing.Top = 16 BorderSpacing.Top = 16
Caption = 'Статика' Caption = 'Статика'
OnChange = cbStaticsChange OnChange = cbStaticsChange
@ -679,9 +673,9 @@ object frmMain: TfrmMain
AnchorSideTop.Control = tsTiles AnchorSideTop.Control = tsTiles
Cursor = crArrow Cursor = crArrow
Left = 4 Left = 4
Height = 19 Height = 24
Top = 2 Top = 2
Width = 59 Width = 72
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Рельеф' Caption = 'Рельеф'
@ -695,10 +689,10 @@ object frmMain: TfrmMain
AnchorSideRight.Control = tsTiles AnchorSideRight.Control = tsTiles
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Cursor = crIBeam Cursor = crIBeam
Left = 79 Left = 92
Height = 21 Height = 19
Top = 14 Top = 13
Width = 121 Width = 112
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 16 BorderSpacing.Right = 16
OnEditingDone = edFilterEditingDone OnEditingDone = edFilterEditingDone
@ -711,8 +705,8 @@ object frmMain: TfrmMain
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 289 Top = 287
Width = 216 Width = 220
Align = alNone Align = alNone
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
OnMoved = spGroupListMoved OnMoved = spGroupListMoved
@ -723,8 +717,8 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = vdtTiles AnchorSideBottom.Control = vdtTiles
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 97 Left = 101
Height = 21 Height = 19
Hint = 'Append S or T to restrict the search to Statics or Terrain.' Hint = 'Append S or T to restrict the search to Statics or Terrain.'
Top = 330 Top = 330
Width = 96 Width = 96
@ -748,9 +742,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = spGroupList AnchorSideBottom.Control = spGroupList
Cursor = crArrow Cursor = crArrow
Left = 0 Left = 0
Height = 251 Height = 244
Top = 38 Top = 43
Width = 213 Width = 217
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 1 BorderSpacing.Top = 1
BorderSpacing.Right = 3 BorderSpacing.Right = 3
@ -777,7 +771,7 @@ object frmMain: TfrmMain
SelectionCurveRadius = 8 SelectionCurveRadius = 8
TabOrder = 8 TabOrder = 8
TextMargin = 0 TextMargin = 0
TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toToggleOnDblClick, toWheelPanning] TreeOptions.MiscOptions = [toFullRepaintOnResize, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowRoot, toShowTreeLines] TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowRoot, toShowTreeLines]
TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect] TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
TreeOptions.StringOptions = [] TreeOptions.StringOptions = []
@ -796,9 +790,8 @@ object frmMain: TfrmMain
end end
object tsNavigation: TTabSheet object tsNavigation: TTabSheet
Caption = 'Навигация' Caption = 'Навигация'
ClientHeight = 634 ClientHeight = 632
ClientWidth = 216 ClientWidth = 220
OnContextPopup = tsNavigationContextPopup
object gbGoTo: TGroupBox object gbGoTo: TGroupBox
AnchorSideLeft.Control = tsNavigation AnchorSideLeft.Control = tsNavigation
AnchorSideTop.Control = btnDeleteLocation AnchorSideTop.Control = btnDeleteLocation
@ -816,8 +809,8 @@ object frmMain: TfrmMain
BidiMode = bdRightToLeft BidiMode = bdRightToLeft
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
Caption = 'Быстрый переход' Caption = 'Быстрый переход'
ClientHeight = 34 ClientHeight = 38
ClientWidth = 212 ClientWidth = 214
ParentBidiMode = False ParentBidiMode = False
ParentColor = False ParentColor = False
TabOrder = 1 TabOrder = 1
@ -946,7 +939,6 @@ object frmMain: TfrmMain
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnAddLocationClick OnClick = btnAddLocationClick
ShowCaption = False ShowCaption = False
ShowHint = True ShowHint = True
@ -1000,7 +992,6 @@ object frmMain: TfrmMain
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnDeleteLocationClick OnClick = btnDeleteLocationClick
ShowCaption = False ShowCaption = False
ShowHint = True ShowHint = True
@ -1054,7 +1045,6 @@ object frmMain: TfrmMain
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
} }
NumGlyphs = 0
OnClick = btnClearLocationsClick OnClick = btnClearLocationsClick
ShowCaption = False ShowCaption = False
ShowHint = True ShowHint = True
@ -1239,6 +1229,7 @@ object frmMain: TfrmMain
object tbSeparator1: TToolButton object tbSeparator1: TToolButton
Cursor = crArrow Cursor = crArrow
Left = 24 Left = 24
Height = 22
Top = 2 Top = 2
Width = 4 Width = 4
Style = tbsDivider Style = tbsDivider
@ -1373,6 +1364,7 @@ object frmMain: TfrmMain
object tbSeparator3: TToolButton object tbSeparator3: TToolButton
Cursor = crArrow Cursor = crArrow
Left = 124 Left = 124
Height = 22
Top = 2 Top = 2
Width = 4 Width = 4
Caption = 'tbSeparator3' Caption = 'tbSeparator3'
@ -1391,6 +1383,7 @@ object frmMain: TfrmMain
object tbSeparator4: TToolButton object tbSeparator4: TToolButton
Cursor = crArrow Cursor = crArrow
Left = 583 Left = 583
Height = 22
Top = 2 Top = 2
Width = 4 Width = 4
Caption = 'tbSeparator4' Caption = 'tbSeparator4'
@ -1415,6 +1408,7 @@ object frmMain: TfrmMain
object tbSeparator5: TToolButton object tbSeparator5: TToolButton
Cursor = crArrow Cursor = crArrow
Left = 645 Left = 645
Height = 22
Top = 2 Top = 2
Width = 4 Width = 4
Caption = 'tbSeparator5' Caption = 'tbSeparator5'
@ -1472,6 +1466,7 @@ object frmMain: TfrmMain
object tbSeparator2: TToolButton object tbSeparator2: TToolButton
Cursor = crArrow Cursor = crArrow
Left = 293 Left = 293
Height = 22
Top = 2 Top = 2
Width = 4 Width = 4
Caption = 'tbSeparator2' Caption = 'tbSeparator2'
@ -1524,6 +1519,7 @@ object frmMain: TfrmMain
object tbSeparator6: TToolButton object tbSeparator6: TToolButton
Cursor = crArrow Cursor = crArrow
Left = 197 Left = 197
Height = 22
Top = 2 Top = 2
Width = 4 Width = 4
Caption = 'tbSeparator2' Caption = 'tbSeparator2'
@ -1533,6 +1529,7 @@ object frmMain: TfrmMain
object tbSeparator7: TToolButton object tbSeparator7: TToolButton
Cursor = crArrow Cursor = crArrow
Left = 51 Left = 51
Height = 22
Top = 2 Top = 2
Width = 4 Width = 4
Caption = 'tbSeparator2' Caption = 'tbSeparator2'
@ -1541,6 +1538,7 @@ object frmMain: TfrmMain
object tbSeparator8: TToolButton object tbSeparator8: TToolButton
Cursor = crArrow Cursor = crArrow
Left = 521 Left = 521
Height = 22
Top = 2 Top = 2
Width = 4 Width = 4
Caption = 'tbSeparator2' Caption = 'tbSeparator2'
@ -1549,6 +1547,7 @@ object frmMain: TfrmMain
object tbSeparator9: TToolButton object tbSeparator9: TToolButton
Cursor = crArrow Cursor = crArrow
Left = 343 Left = 343
Height = 22
Top = 2 Top = 2
Width = 4 Width = 4
Caption = 'tbSeparator2' Caption = 'tbSeparator2'
@ -1564,7 +1563,7 @@ object frmMain: TfrmMain
Cursor = crArrow Cursor = crArrow
Left = 224 Left = 224
Height = 20 Height = 20
Top = 495 Top = 494
Width = 758 Width = 758
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised BevelInner = bvRaised
@ -1577,7 +1576,7 @@ object frmMain: TfrmMain
Left = 10 Left = 10
Height = 16 Height = 16
Top = 2 Top = 2
Width = 95 Width = 106
Align = alLeft Align = alLeft
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Caption = 'Чат и Сообщения' Caption = 'Чат и Сообщения'
@ -1907,7 +1906,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 224 Left = 224
Height = 140 Height = 140
Top = 520 Top = 519
Width = 758 Width = 758
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone BevelOuter = bvNone
@ -1918,7 +1917,7 @@ object frmMain: TfrmMain
object vstChat: TVirtualStringTree object vstChat: TVirtualStringTree
Cursor = 63 Cursor = 63
Left = 0 Left = 0
Height = 119 Height = 121
Top = 0 Top = 0
Width = 758 Width = 758
Align = alClient Align = alClient
@ -1948,7 +1947,7 @@ object frmMain: TfrmMain
item item
Position = 2 Position = 2
Text = 'Сообщение' Text = 'Сообщение'
Width = 604 Width = 606
end> end>
Header.DefaultHeight = 17 Header.DefaultHeight = 17
Header.MainColumn = 2 Header.MainColumn = 2
@ -1967,8 +1966,8 @@ object frmMain: TfrmMain
object edChat: TEdit object edChat: TEdit
Cursor = crIBeam Cursor = crIBeam
Left = 0 Left = 0
Height = 21 Height = 19
Top = 119 Top = 121
Width = 758 Width = 758
Align = alBottom Align = alBottom
Anchors = [akLeft, akRight] Anchors = [akLeft, akRight]
@ -1982,7 +1981,7 @@ object frmMain: TfrmMain
Cursor = crVSplit Cursor = crVSplit
Left = 222 Left = 222
Height = 5 Height = 5
Top = 515 Top = 514
Width = 760 Width = 760
Align = alCustom Align = alCustom
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
@ -2001,11 +2000,10 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pnlChatHeader AnchorSideBottom.Control = pnlChatHeader
Left = 224 Left = 224
Height = 471 Height = 470
Top = 24 Top = 24
Width = 758 Width = 758
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
OnClick = oglGameWindowClick
OnDblClick = oglGameWindowDblClick OnDblClick = oglGameWindowDblClick
OnKeyDown = oglGameWindowKeyDown OnKeyDown = oglGameWindowKeyDown
OnMouseDown = oglGameWindowMouseDown OnMouseDown = oglGameWindowMouseDown

270
Client/UfrmMain.pas
View File

@ -469,7 +469,6 @@ type
procedure acUndoExecute(Sender: TObject); procedure acUndoExecute(Sender: TObject);
procedure acVirtualLayerExecute(Sender: TObject); procedure acVirtualLayerExecute(Sender: TObject);
procedure acWalkableExecute(Sender: TObject); procedure acWalkableExecute(Sender: TObject);
procedure acGridExecute(Sender: TObject);
procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean); procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
procedure ApplicationProperties1ShowHint(var HintStr: string; procedure ApplicationProperties1ShowHint(var HintStr: string;
var CanShow: Boolean; var HintInfo: THintInfo); var CanShow: Boolean; var HintInfo: THintInfo);
@ -504,8 +503,6 @@ type
procedure mnuAccountControlClick(Sender: TObject); procedure mnuAccountControlClick(Sender: TObject);
procedure mnuAutoHideGroupListClick(Sender: TObject); procedure mnuAutoHideGroupListClick(Sender: TObject);
procedure mnuAutoHideRandomListClick(Sender: TObject); procedure mnuAutoHideRandomListClick(Sender: TObject);
procedure mnuAutoShowFilterWindowClick(Sender: TObject);
procedure mnuCompactHueSettingsClick(Sender: TObject);
procedure mnuDisconnectClick(Sender: TObject); procedure mnuDisconnectClick(Sender: TObject);
procedure mnuDocsClick(Sender: TObject); procedure mnuDocsClick(Sender: TObject);
procedure mnuEng2ComClick(Sender: TObject); procedure mnuEng2ComClick(Sender: TObject);
@ -528,7 +525,6 @@ type
procedure mnuSetLanguageClick(Sender: TObject); procedure mnuSetLanguageClick(Sender: TObject);
procedure mnuShowAnimationsClick(Sender: TObject); procedure mnuShowAnimationsClick(Sender: TObject);
procedure mnuShowBlocksClick(Sender: TObject); procedure mnuShowBlocksClick(Sender: TObject);
procedure mnuShowBridgesClick(Sender: TObject);
procedure mnuShowGridClick(Sender: TObject); procedure mnuShowGridClick(Sender: TObject);
procedure mnuShowLightSourceClick(Sender: TObject); procedure mnuShowLightSourceClick(Sender: TObject);
procedure mnuShowNoDrawTilesClick(Sender: TObject); procedure mnuShowNoDrawTilesClick(Sender: TObject);
@ -539,7 +535,6 @@ type
procedure mnuWhiteBackgroundClick(Sender: TObject); procedure mnuWhiteBackgroundClick(Sender: TObject);
procedure mnuWindowedModeClick(Sender: TObject); procedure mnuWindowedModeClick(Sender: TObject);
procedure mnuZoomClick(Sender: TObject); procedure mnuZoomClick(Sender: TObject);
procedure oglGameWindowClick(Sender: TObject);
procedure oglGameWindowDblClick(Sender: TObject); procedure oglGameWindowDblClick(Sender: TObject);
procedure oglGameWindowKeyDown(Sender: TObject; var Key: Word; procedure oglGameWindowKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); Shift: TShiftState);
@ -558,7 +553,6 @@ type
procedure pbRadarMouseDown(Sender: TObject; Button: TMouseButton; procedure pbRadarMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); Shift: TShiftState; X, Y: Integer);
procedure pbRadarPaint(Sender: TObject); procedure pbRadarPaint(Sender: TObject);
procedure pcLeftChange(Sender: TObject);
procedure pcLeftResize(Sender: TObject); procedure pcLeftResize(Sender: TObject);
procedure pmGrabTileInfoPopup(Sender: TObject); procedure pmGrabTileInfoPopup(Sender: TObject);
procedure DropedownMenusClose(Sender: TObject); procedure DropedownMenusClose(Sender: TObject);
@ -573,8 +567,6 @@ type
procedure tmMovementTimer(Sender: TObject); procedure tmMovementTimer(Sender: TObject);
procedure tmSelectNodeTimer(Sender: TObject); procedure tmSelectNodeTimer(Sender: TObject);
procedure tmSettingsCloseTimer(Sender: TObject); procedure tmSettingsCloseTimer(Sender: TObject);
procedure tsNavigationContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure tvGroupFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure tvGroupFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure tvGroupsChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure tvGroupsChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure tvGroupsDrawText(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; procedure tvGroupsDrawText(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
@ -1073,11 +1065,6 @@ begin
RebuildScreenBuffer; RebuildScreenBuffer;
end; end;
procedure TfrmMain.mnuShowBridgesClick(Sender: TObject);
begin
end;
procedure TfrmMain.mnuShutdownClick(Sender: TObject); procedure TfrmMain.mnuShutdownClick(Sender: TObject);
begin begin
dmNetwork.Send(TQuitServerPacket.Create('')); dmNetwork.Send(TQuitServerPacket.Create(''));
@ -1164,11 +1151,6 @@ begin
RebuildScreenBuffer; RebuildScreenBuffer;
end; end;
procedure TfrmMain.oglGameWindowClick(Sender: TObject);
begin
end;
procedure TfrmMain.oglGameWindowDblClick(Sender: TObject); procedure TfrmMain.oglGameWindowDblClick(Sender: TObject);
begin begin
if (acSelect.Checked) and (CurrentTile <> nil) then if (acSelect.Checked) and (CurrentTile <> nil) then
@ -1299,7 +1281,7 @@ var
blockInfo: PBlockInfo; blockInfo: PBlockInfo;
targetRect: TRect; targetRect: TRect;
offsetX, offsetY: Integer; offsetX, offsetY: Integer;
tile: TWorldItem; item: TWorldItem;
tileX, tileY, newX, newY: Word; tileX, tileY, newX, newY: Word;
targetBlocks: TBlockInfoList; //а в чем разница с targetTiles: TWorldItemList; ? targetBlocks: TBlockInfoList; //а в чем разница с targetTiles: TWorldItemList; ?
targetTile: TWorldItem; targetTile: TWorldItem;
@ -1357,11 +1339,11 @@ begin
Logger.Send([lcClient, lcDebug], 'Virtual tiles', FVirtualTiles.Count); Logger.Send([lcClient, lcDebug], 'Virtual tiles', FVirtualTiles.Count);
for i := 0 to FVirtualTiles.Count - 1 do for i := 0 to FVirtualTiles.Count - 1 do
begin begin
tile := FVirtualTiles[i]; item := FVirtualTiles[i];
if tile is TGhostTile then if item is TGhostTile then
begin begin
dmNetwork.Send(TInsertStaticPacket.Create(tile.X, tile.Y, tile.Z, tile.TileID, TGhostTile(tile).Hue)); dmNetwork.Send(TInsertStaticPacket.Create(item.X, item.Y, item.Z, item.TileID, TGhostTile(item).Hue));
FUndoList^.Add(TDeleteStaticPacket.Create(TGhostTile(tile))); FUndoList^.Add(TDeleteStaticPacket.Create(TGhostTile(item)));
end; end;
end; end;
end else if (SelectedTile <> targetTile) or targetTile.CanBeEdited then end else if (SelectedTile <> targetTile) or targetTile.CanBeEdited then
@ -1395,7 +1377,7 @@ begin
end; end;
end; end;
if acMove.Checked then //***** Move tile *****// if acMove.Checked then //***** Move item *****//
begin begin
offsetX := frmMoveSettings.GetOffsetX; offsetX := frmMoveSettings.GetOffsetX;
offsetY := frmMoveSettings.GetOffsetY; offsetY := frmMoveSettings.GetOffsetY;
@ -1423,81 +1405,81 @@ begin
begin begin
if frmMoveSettings.cbLand.Checked and (((offsetY > 0) or (offsetX > 0)) and not ((offsetY > 0) and (offsetX < 0))) if frmMoveSettings.cbLand.Checked and (((offsetY > 0) or (offsetX > 0)) and not ((offsetY > 0) and (offsetX < 0)))
then tileY := abs(i - targetBlocks.Count + 1) else tileY := i; then tileY := abs(i - targetBlocks.Count + 1) else tileY := i;
tile := targetBlocks.Items[tileY]^.Item; item := targetBlocks.Items[tileY]^.Item;
if (frmMoveSettings.cbItem.Checked) and (tile is TStaticItem) then begin if (frmMoveSettings.cbItem.Checked) and (item is TStaticItem) then begin
newX := EnsureRange(tile.X + offsetX, 0, FLandscape.CellWidth - 1); newX := EnsureRange(item.X + offsetX, 0, FLandscape.CellWidth - 1);
newY := EnsureRange(tile.Y + offsetY, 0, FLandscape.CellHeight - 1); newY := EnsureRange(item.Y + offsetY, 0, FLandscape.CellHeight - 1);
FUndoList^.Add(TMoveStaticPacket.Create(newX, newY, tile.Z, tile.TileID, TStaticItem(tile).Hue, tile.X, tile.Y)); FUndoList^.Add(TMoveStaticPacket.Create(newX, newY, item.Z, item.TileID, TStaticItem(item).Hue, item.X, item.Y));
dmNetwork.Send(TMoveStaticPacket.Create(TStaticItem(tile), newX, newY)); dmNetwork.Send(TMoveStaticPacket.Create(TStaticItem(item), newX, newY));
end; end;
if (frmMoveSettings.cbLand.Checked) and (tile is TMapCell) then begin if (frmMoveSettings.cbLand.Checked) and (item is TMapCell) then begin
newX := EnsureRange(tile.X + offsetX, 0, FLandscape.CellWidth - 1); newX := EnsureRange(item.X + offsetX, 0, FLandscape.CellWidth - 1);
newY := EnsureRange(tile.Y + offsetY, 0, FLandscape.CellHeight - 1); newY := EnsureRange(item.Y + offsetY, 0, FLandscape.CellHeight - 1);
map := FLandscape.MapCell[newX, newY]; map := FLandscape.MapCell[newX, newY];
// Это не очень хорошо, для оптимизации следует ввести специальный пакет TMoveMapPacket // Это не очень хорошо, для оптимизации следует ввести специальный пакет TMoveMapPacket
FUndoList^.Add(TDrawMapPacket.Create(tile.X, tile.Y, tile.Z, tile.TileID)); FUndoList^.Add(TDrawMapPacket.Create(item.X, item.Y, item.Z, item.TileID));
FUndoList^.Add(TDrawMapPacket.Create(newX, newY, map.RawZ, map.TileID)); FUndoList^.Add(TDrawMapPacket.Create(newX, newY, map.RawZ, map.TileID));
dmNetwork.Send(TDrawMapPacket.Create(tile.X, tile.Y, z, $0001)); dmNetwork.Send(TDrawMapPacket.Create(item.X, item.Y, z, $0001));
dmNetwork.Send(TDrawMapPacket.Create(newX, newY, tile.Z, tile.TileID)); dmNetwork.Send(TDrawMapPacket.Create(newX, newY, item.Z, item.TileID));
end; end;
end; end;
end else if acElevate.Checked then //***** Elevate tile *****// end else if acElevate.Checked then //***** Elevate item *****//
begin begin
for i := 0 to targetBlocks.Count - 1 do for i := 0 to targetBlocks.Count - 1 do
begin begin
tile := targetBlocks.Items[i]^.Item; item := targetBlocks.Items[i]^.Item;
z := frmElevateSettings.seZ.Value; z := frmElevateSettings.seZ.Value;
if frmElevateSettings.rbRaise.Checked then if frmElevateSettings.rbRaise.Checked then
z := EnsureRange(tile.Z + z, -128, 127) z := EnsureRange(item.Z + z, -128, 127)
else if frmElevateSettings.rbLower.Checked then else if frmElevateSettings.rbLower.Checked then
z := EnsureRange(tile.Z - z, -128, 127); z := EnsureRange(item.Z - z, -128, 127);
if tile is TMapCell then if item is TMapCell then
begin begin
if frmElevateSettings.cbRandomHeight.Checked then if frmElevateSettings.cbRandomHeight.Checked then
Inc(z, Random(frmElevateSettings.seRandomHeight.Value)); Inc(z, Random(frmElevateSettings.seRandomHeight.Value));
FUndoList^.Add(TDrawMapPacket.Create(tile.X, tile.Y, tile.Z, FUndoList^.Add(TDrawMapPacket.Create(item.X, item.Y, item.Z,
tile.TileID)); item.TileID));
dmNetwork.Send(TDrawMapPacket.Create(tile.X, tile.Y, z, dmNetwork.Send(TDrawMapPacket.Create(item.X, item.Y, z,
tile.TileID)); item.TileID));
end else end else
begin begin
FUndoList^.Add(TElevateStaticPacket.Create(tile.X, tile.Y, FUndoList^.Add(TElevateStaticPacket.Create(item.X, item.Y,
z, tile.TileID, TStaticItem(tile).Hue, tile.Z)); z, item.TileID, TStaticItem(item).Hue, item.Z));
dmNetwork.Send(TElevateStaticPacket.Create(TStaticItem(tile), z)); dmNetwork.Send(TElevateStaticPacket.Create(TStaticItem(item), z));
end; end;
end; end;
end else if acDelete.Checked then //***** Delete tile *****// end else if acDelete.Checked then //***** Delete item *****//
begin begin
Logger.Send([lcClient, lcDebug], 'targetBlocks.Count', targetBlocks.Count); Logger.Send([lcClient, lcDebug], 'targetBlocks.Count', targetBlocks.Count);
for i := 0 to targetBlocks.Count - 1 do for i := 0 to targetBlocks.Count - 1 do
begin begin
tile := targetBlocks.Items[i]^.Item; item := targetBlocks.Items[i]^.Item;
if tile is TStaticItem then if item is TStaticItem then
begin begin
FUndoList^.Add(TInsertStaticPacket.Create(tile.X, tile.Y, FUndoList^.Add(TInsertStaticPacket.Create(item.X, item.Y,
tile.Z, tile.TileID, TStaticItem(tile).Hue)); item.Z, item.TileID, TStaticItem(item).Hue));
dmNetwork.Send(TDeleteStaticPacket.Create(TStaticItem(tile))); dmNetwork.Send(TDeleteStaticPacket.Create(TStaticItem(item)));
end; end;
end; end;
end else if acHue.Checked then //***** Hue tile *****// end else if acHue.Checked then //***** Hue item *****//
begin begin
for i := 0 to targetBlocks.Count - 1 do for i := 0 to targetBlocks.Count - 1 do
begin begin
blockInfo := targetBlocks.Items[i]; blockInfo := targetBlocks.Items[i];
tile := blockInfo^.Item; item := blockInfo^.Item;
if blockInfo^.HueOverride and (tile is TStaticItem) then if blockInfo^.HueOverride and (item is TStaticItem) then
begin begin
if TStaticItem(tile).Hue <> blockInfo^.Hue then if TStaticItem(item).Hue <> blockInfo^.Hue then
begin begin
FUndoList^.Add(THueStaticPacket.Create(tile.X, tile.Y, tile.Z, FUndoList^.Add(THueStaticPacket.Create(item.X, item.Y, item.Z,
tile.TileID, blockInfo^.Hue, TStaticItem(tile).Hue)); item.TileID, blockInfo^.Hue, TStaticItem(item).Hue));
dmNetwork.Send(THueStaticPacket.Create(TStaticItem(tile), dmNetwork.Send(THueStaticPacket.Create(TStaticItem(item),
blockInfo^.Hue)); blockInfo^.Hue));
end; end;
end; end;
@ -1823,7 +1805,7 @@ procedure TfrmMain.btnRandomPresetSaveClick(Sender: TObject);
var var
presetName: string; presetName: string;
i: Integer; i: Integer;
preset, tile: TDOMElement; presetElement, tileElement: TDOMElement;
children: TDOMNodeList; children: TDOMNodeList;
tileNode: PVirtualItem; tileNode: PVirtualItem;
tileInfo: PTileInfo; tileInfo: PTileInfo;
@ -1831,31 +1813,31 @@ begin
presetName := cbRandomPreset.Text; presetName := cbRandomPreset.Text;
if InputQuery(lbDlgSaveRandPrsCaption, lbDlgSaveRandPrs, presetName) then if InputQuery(lbDlgSaveRandPrsCaption, lbDlgSaveRandPrs, presetName) then
begin begin
preset := FindRandomPreset(presetName); presetElement := FindRandomPreset(presetName);
if preset = nil then if presetElement = nil then
begin begin
preset := FRandomPresetsDoc.CreateElement('Preset'); presetElement := FRandomPresetsDoc.CreateElement('PresetElement');
preset.AttribStrings['Name'] := UTF8ToCP1251(presetName); presetElement.AttribStrings['Name'] := UTF8ToCP1251(presetName);
FRandomPresetsDoc.DocumentElement.AppendChild(preset); FRandomPresetsDoc.DocumentElement.AppendChild(presetElement);
cbRandomPreset.Items.AddObject(presetName, preset); cbRandomPreset.Items.AddObject(presetName, presetElement);
end else end else
begin begin
children := preset.ChildNodes; children := presetElement.ChildNodes;
for i := children.Count - 1 downto 0 do for i := children.Count - 1 downto 0 do
preset.RemoveChild(children[i]); presetElement.RemoveChild(children[i]);
end; end;
tileNode := vdlRandom.GetFirst; tileNode := vdlRandom.GetFirst;
while tileNode <> nil do while tileNode <> nil do
begin begin
tileInfo := vdlRandom.GetNodeData(tileNode); tileInfo := vdlRandom.GetNodeData(tileNode);
tile := FRandomPresetsDoc.CreateElement('Tile'); tileElement := FRandomPresetsDoc.CreateElement('TileElement');
tile.AttribStrings['ID'] := IntToStr(tileInfo^.ID); tileElement.AttribStrings['ID'] := IntToStr(tileInfo^.ID);
preset.AppendChild(tile); presetElement.AppendChild(tileElement);
tileNode := vdlRandom.GetNext(tileNode); tileNode := vdlRandom.GetNext(tileNode);
end; end;
cbRandomPreset.ItemIndex := cbRandomPreset.Items.IndexOfObject(preset); cbRandomPreset.ItemIndex := cbRandomPreset.Items.IndexOfObject(presetElement);
SaveRandomPresets; SaveRandomPresets;
end; end;
@ -1863,7 +1845,7 @@ end;
procedure TfrmMain.cbRandomPresetChange(Sender: TObject); procedure TfrmMain.cbRandomPresetChange(Sender: TObject);
var var
preset, tile: TDOMElement; presetElement, tileElement: TDOMElement;
tiles: TDOMNodeList; tiles: TDOMNodeList;
tileNode: PVirtualItem; tileNode: PVirtualItem;
tileInfo: PTileInfo; tileInfo: PTileInfo;
@ -1872,13 +1854,13 @@ begin
if cbRandomPreset.ItemIndex > -1 then if cbRandomPreset.ItemIndex > -1 then
begin begin
vdlRandom.Clear; vdlRandom.Clear;
preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]); presetElement := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]);
tiles := preset.ChildNodes; tiles := presetElement.ChildNodes;
for i := 0 to tiles.Count - 1 do for i := 0 to tiles.Count - 1 do
begin begin
tile := TDOMElement(tiles[i]); tileElement := TDOMElement(tiles[i]);
if (tile.NodeName = 'Tile') and if (tileElement.NodeName = 'TileElement') and
TryStrToInt(tile.AttribStrings['ID'], id) and TryStrToInt(tileElement.AttribStrings['ID'], id) and
(id < FLandscape.MaxStaticID + $4000) then (id < FLandscape.MaxStaticID + $4000) then
begin begin
tileNode := vdlRandom.AddItem(nil); tileNode := vdlRandom.AddItem(nil);
@ -2054,11 +2036,6 @@ begin
FRepaintNeeded := True; FRepaintNeeded := True;
end; end;
procedure TfrmMain.acGridExecute(Sender: TObject);
begin
end;
procedure TfrmMain.acDrawExecute(Sender: TObject); procedure TfrmMain.acDrawExecute(Sender: TObject);
begin begin
acDraw.Checked := True; acDraw.Checked := True;
@ -2852,16 +2829,6 @@ begin
spTileListMoved(Sender); spTileListMoved(Sender);
end; end;
procedure TfrmMain.mnuAutoShowFilterWindowClick(Sender: TObject);
begin
end;
procedure TfrmMain.mnuCompactHueSettingsClick(Sender: TObject);
begin
end;
procedure TfrmMain.spGroupListMoved(Sender: TObject); procedure TfrmMain.spGroupListMoved(Sender: TObject);
var var
anchor: integer; anchor: integer;
@ -3032,11 +2999,6 @@ begin
pbRadar.Canvas.Line(posX-scrW-1, posY+scrH+1, posX-scrW-1, posY-scrH-1); pbRadar.Canvas.Line(posX-scrW-1, posY+scrH+1, posX-scrW-1, posY-scrH-1);
end; end;
procedure TfrmMain.pcLeftChange(Sender: TObject);
begin
end;
procedure TfrmMain.pmGrabTileInfoPopup(Sender: TObject); procedure TfrmMain.pmGrabTileInfoPopup(Sender: TObject);
var var
isStatic: Boolean; isStatic: Boolean;
@ -3085,12 +3047,6 @@ begin
tbFlat.Down := acFlat.Checked; tbFlat.Down := acFlat.Checked;
end; end;
procedure TfrmMain.tsNavigationContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
begin
end;
procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin begin
if Sender is TWinControl then if Sender is TWinControl then
@ -5613,7 +5569,7 @@ var
z, b, t, a, e, value: Integer; z, b, t, a, e, value: Integer;
uu, ur, ll, ul, dl, dr : Word; uu, ur, ll, ul, dl, dr : Word;
valueF : Single; valueF : Single;
tile: TBrushTile; brushTile: TBrushTile;
// Создание миниатюр // Создание миниатюр
id : Integer; id : Integer;
destColor, hue : Word; destColor, hue : Word;
@ -5681,7 +5637,7 @@ begin
FBrushList.Brush[b]^.ECount := 0; FBrushList.Brush[b]^.ECount := 0;
while tNode <> nil do begin while tNode <> nil do begin
s := LowerCase(tNode.NodeName); s := LowerCase(tNode.NodeName);
if (s = 'tile') or (s = 'land') then if (s = 'brushTile') or (s = 'land') then
inc(FBrushList.Brush[b]^.Count) inc(FBrushList.Brush[b]^.Count)
else if (s = 'edge') then else if (s = 'edge') then
inc(FBrushList.Brush[b]^.ECount); inc(FBrushList.Brush[b]^.ECount);
@ -5703,37 +5659,37 @@ begin
while tNode <> nil do while tNode <> nil do
begin begin
s := LowerCase(tNode.NodeName); s := LowerCase(tNode.NodeName);
if (s = 'tile') or (s = 'land') then begin if (s = 'brushTile') or (s = 'land') then begin
//Logger.Send([lcInfo], 'Brush: %d - Land: %d / %d', [b+1, t+1, FBrushList.Brush[b]^.Count]); //Logger.Send([lcInfo], 'Brush: %d - Land: %d / %d', [b+1, t+1, FBrushList.Brush[b]^.Count]);
tile.ID := $FFFF; brushTile.ID := $FFFF;
tile.Chance := 1.0; brushTile.Chance := 1.0;
for a := tNode.Attributes.Length - 1 downto 0 do begin for a := tNode.Attributes.Length - 1 downto 0 do begin
attribute := LowerCase(tNode.Attributes[a].NodeName); attribute := LowerCase(tNode.Attributes[a].NodeName);
if attribute = 'id' then begin if attribute = 'id' then begin
if TryStrToInt(tNode.Attributes[a].NodeValue, value) if TryStrToInt(tNode.Attributes[a].NodeValue, value)
then tile.ID := value; then brushTile.ID := value;
end else if attribute = 'chance' then begin end else if attribute = 'chance' then begin
if TryStrToFloat(tNode.Attributes[a].NodeValue, valueF) if TryStrToFloat(tNode.Attributes[a].NodeValue, valueF)
then tile.Chance := valueF; then brushTile.Chance := valueF;
end; end;
end; end;
tile.Mask := $0F; brushTile.Mask := $0F;
tile.Brush1 := FBrushList.Brush[b]; brushTile.Brush1 := FBrushList.Brush[b];
tile.Brush2 := FBrushList.Brush[b]; brushTile.Brush2 := FBrushList.Brush[b];
// Тестирование... // Тестирование...
if LoadListError(tile.ID = $FFFF, if LoadListError(brushTile.ID = $FFFF,
fPath, Format(GetParseErText('blTagTileAttrID'), [FBrushList.Brush[b]^.ID])) fPath, Format(GetParseErText('blTagTileAttrID'), [FBrushList.Brush[b]^.ID]))
then begin LoadBrushTilesList; Exit; end; then begin LoadBrushTilesList; Exit; end;
if LoadListError(tile.ID > $3FFF, if LoadListError(brushTile.ID > $3FFF,
fPath, Format(GetParseErText('blTagTileAttrIDOutOfRange'), [tile.ID, tile.ID, FBrushList.Brush[b]^.ID])) fPath, Format(GetParseErText('blTagTileAttrIDOutOfRange'), [brushTile.ID, brushTile.ID, FBrushList.Brush[b]^.ID]))
then begin LoadBrushTilesList; Exit; end; then begin LoadBrushTilesList; Exit; end;
if LoadListError(FBrushList.Tiles[tile.ID].ID = tile.ID, if LoadListError(FBrushList.Tiles[brushTile.ID].ID = brushTile.ID,
fPath, Format(GetParseErText('blTagTileRedeclaration'), [tile.ID, tile.ID, FBrushList.Brush[b]^.ID])) fPath, Format(GetParseErText('blTagTileRedeclaration'), [brushTile.ID, brushTile.ID, FBrushList.Brush[b]^.ID]))
then begin LoadBrushTilesList; Exit; end; then begin LoadBrushTilesList; Exit; end;
FBrushList.Tiles[tile.ID] := tile; FBrushList.Tiles[brushTile.ID] := brushTile;
FBrushList.Brush[b]^.BTile[t] := @FBrushList.Tiles[tile.ID]; FBrushList.Brush[b]^.BTile[t] := @FBrushList.Tiles[brushTile.ID];
inc(t); inc(t);
end else if (s = 'edge') then begin end else if (s = 'edge') then begin
//Logger.Send([lcInfo], 'Brush: %d - Edge: %d / %d', [b+1, e+1, FBrushList.Brush[b]^.ECount]); //Logger.Send([lcInfo], 'Brush: %d - Edge: %d / %d', [b+1, e+1, FBrushList.Brush[b]^.ECount]);
@ -5762,7 +5718,7 @@ begin
FBrushList.Brush[b]^.BEdges[e]^.CountDR := 0; FBrushList.Brush[b]^.BEdges[e]^.CountDR := 0;
while eNode <> nil do begin while eNode <> nil do begin
s := LowerCase(eNode.NodeName); s := LowerCase(eNode.NodeName);
if (s = 'tile') or (s = 'land') then begin if (s = 'brushTile') or (s = 'land') then begin
attribute := ''; attribute := '';
for a := eNode.Attributes.Length - 1 downto 0 do begin for a := eNode.Attributes.Length - 1 downto 0 do begin
attribute := LowerCase(eNode.Attributes[a].NodeName); attribute := LowerCase(eNode.Attributes[a].NodeName);
@ -5779,7 +5735,7 @@ begin
end; end;
if LoadListError((attribute<>'type') or ((s<>'uu')and(s<>'ur')and(s<>'ll')and(s<>'ul')and(s<>'dl')and(s<>'dr')), if LoadListError((attribute<>'type') or ((s<>'uu')and(s<>'ur')and(s<>'ll')and(s<>'ul')and(s<>'dl')and(s<>'dr')),
fPath, Format(GetParseErText('blTagTile2AttrType'), [tile.ID, tile.ID, FBrushList.Brush[b]^.BEdges[e]^.ID, FBrushList.Brush[b]^.ID])) fPath, Format(GetParseErText('blTagTile2AttrType'), [brushTile.ID, brushTile.ID, FBrushList.Brush[b]^.BEdges[e]^.ID, FBrushList.Brush[b]^.ID]))
then begin LoadBrushTilesList; Exit; end; then begin LoadBrushTilesList; Exit; end;
end; end;
eNode := eNode.NextSibling; eNode := eNode.NextSibling;
@ -5795,57 +5751,57 @@ begin
eNode := tNode.FirstChild; eNode := tNode.FirstChild;
while eNode <> nil do begin while eNode <> nil do begin
s := LowerCase(eNode.NodeName); s := LowerCase(eNode.NodeName);
if (s = 'tile') or (s = 'land') then begin if (s = 'brushTile') or (s = 'land') then begin
//Logger.Send([lcInfo], 'Brush: %d - Edge: %d - Land: %d / %d', [b+1, e+1, uu+ur+ll+ul+dl+dr+1, FBrushList.Brush[b]^.BEdges[e]^.CountUU+FBrushList.Brush[b]^.BEdges[e]^.CountUR+FBrushList.Brush[b]^.BEdges[e]^.CountLL+FBrushList.Brush[b]^.BEdges[e]^.CountUL+FBrushList.Brush[b]^.BEdges[e]^.CountDL+FBrushList.Brush[b]^.BEdges[e]^.CountDR]); //Logger.Send([lcInfo], 'Brush: %d - Edge: %d - Land: %d / %d', [b+1, e+1, uu+ur+ll+ul+dl+dr+1, FBrushList.Brush[b]^.BEdges[e]^.CountUU+FBrushList.Brush[b]^.BEdges[e]^.CountUR+FBrushList.Brush[b]^.BEdges[e]^.CountLL+FBrushList.Brush[b]^.BEdges[e]^.CountUL+FBrushList.Brush[b]^.BEdges[e]^.CountDL+FBrushList.Brush[b]^.BEdges[e]^.CountDR]);
tile.ID := $FFFF; brushTile.ID := $FFFF;
tile.Chance := 1.0; brushTile.Chance := 1.0;
for a := eNode.Attributes.Length - 1 downto 0 do begin for a := eNode.Attributes.Length - 1 downto 0 do begin
attribute := LowerCase(eNode.Attributes[a].NodeName); attribute := LowerCase(eNode.Attributes[a].NodeName);
if attribute = 'type' then begin if attribute = 'type' then begin
s := LowerCase(CP1251ToUTF8(eNode.Attributes[a].NodeValue)); s := LowerCase(CP1251ToUTF8(eNode.Attributes[a].NodeValue));
if s = 'uu' then tile.Mask := $03 if s = 'uu' then brushTile.Mask := $03
else if s = 'ur' then tile.Mask := $07 else if s = 'ur' then brushTile.Mask := $07
else if s = 'll' then tile.Mask := $09 else if s = 'll' then brushTile.Mask := $09
else if s = 'ul' then tile.Mask := $0B else if s = 'ul' then brushTile.Mask := $0B
else if s = 'dl' then tile.Mask := $0D else if s = 'dl' then brushTile.Mask := $0D
else if s = 'dr' then tile.Mask := $0E; else if s = 'dr' then brushTile.Mask := $0E;
end else if attribute = 'id' then begin end else if attribute = 'id' then begin
if TryStrToInt(eNode.Attributes[a].NodeValue, value) if TryStrToInt(eNode.Attributes[a].NodeValue, value)
then tile.ID := value; then brushTile.ID := value;
end else if attribute = 'chance' then begin end else if attribute = 'chance' then begin
if TryStrToFloat(eNode.Attributes[a].NodeValue, valueF) if TryStrToFloat(eNode.Attributes[a].NodeValue, valueF)
then tile.Chance := valueF; then brushTile.Chance := valueF;
end; end;
end; end;
// Тестирование... // Тестирование...
if LoadListError(tile.ID = $FFFF, if LoadListError(brushTile.ID = $FFFF,
fPath, Format(GetParseErText('blTagTile2AttrID'), [FBrushList.Brush[b]^.ID])) fPath, Format(GetParseErText('blTagTile2AttrID'), [FBrushList.Brush[b]^.ID]))
then begin LoadBrushTilesList; Exit; end; then begin LoadBrushTilesList; Exit; end;
if LoadListError(tile.ID > $3FFF, if LoadListError(brushTile.ID > $3FFF,
fPath, Format(GetParseErText('blTagTile2AttrIDOutOfRange'), [tile.ID, tile.ID, FBrushList.Brush[b]^.ID])) fPath, Format(GetParseErText('blTagTile2AttrIDOutOfRange'), [brushTile.ID, brushTile.ID, FBrushList.Brush[b]^.ID]))
then begin LoadBrushTilesList; Exit; end; then begin LoadBrushTilesList; Exit; end;
if LoadListError(FBrushList.Tiles[tile.ID].ID = tile.ID, if LoadListError(FBrushList.Tiles[brushTile.ID].ID = brushTile.ID,
fPath, Format(GetParseErText('blTagTile2Redeclaration'), [tile.ID, tile.ID, FBrushList.Brush[b]^.ID])) fPath, Format(GetParseErText('blTagTile2Redeclaration'), [brushTile.ID, brushTile.ID, FBrushList.Brush[b]^.ID]))
then begin LoadBrushTilesList; Exit; end; then begin LoadBrushTilesList; Exit; end;
tile.Brush1 := FBrushList.Brush[b]; brushTile.Brush1 := FBrushList.Brush[b];
tile.Brush2 := nil; brushTile.Brush2 := nil;
FBrushList.Tiles[tile.ID] := tile; FBrushList.Tiles[brushTile.ID] := brushTile;
if tile.Mask = $03 then begin if brushTile.Mask = $03 then begin
FBrushList.Brush[b]^.BEdges[e]^.BTileUU[uu] := @FBrushList.Tiles[tile.ID]; inc(uu); FBrushList.Brush[b]^.BEdges[e]^.BTileUU[uu] := @FBrushList.Tiles[brushTile.ID]; inc(uu);
end else if tile.Mask = $07 then begin end else if brushTile.Mask = $07 then begin
FBrushList.Brush[b]^.BEdges[e]^.BTileUR[ur] := @FBrushList.Tiles[tile.ID]; inc(ur); FBrushList.Brush[b]^.BEdges[e]^.BTileUR[ur] := @FBrushList.Tiles[brushTile.ID]; inc(ur);
end else if tile.Mask = $09 then begin end else if brushTile.Mask = $09 then begin
FBrushList.Brush[b]^.BEdges[e]^.BTileLL[ll] := @FBrushList.Tiles[tile.ID]; inc(ll); FBrushList.Brush[b]^.BEdges[e]^.BTileLL[ll] := @FBrushList.Tiles[brushTile.ID]; inc(ll);
end else if tile.Mask = $0B then begin end else if brushTile.Mask = $0B then begin
FBrushList.Brush[b]^.BEdges[e]^.BTileUL[ul] := @FBrushList.Tiles[tile.ID]; inc(ul); FBrushList.Brush[b]^.BEdges[e]^.BTileUL[ul] := @FBrushList.Tiles[brushTile.ID]; inc(ul);
end else if tile.Mask = $0D then begin end else if brushTile.Mask = $0D then begin
FBrushList.Brush[b]^.BEdges[e]^.BTileDL[dl] := @FBrushList.Tiles[tile.ID]; inc(dl); FBrushList.Brush[b]^.BEdges[e]^.BTileDL[dl] := @FBrushList.Tiles[brushTile.ID]; inc(dl);
end else if tile.Mask = $0E then begin end else if brushTile.Mask = $0E then begin
FBrushList.Brush[b]^.BEdges[e]^.BTileDR[dr] := @FBrushList.Tiles[tile.ID]; inc(dr); FBrushList.Brush[b]^.BEdges[e]^.BTileDR[dr] := @FBrushList.Tiles[brushTile.ID]; inc(dr);
end; end;
FBrushList.Tiles[tile.ID].ID := FBrushList.Brush[b]^.BEdges[e]^.ID; // Временно запоминаем ID перехода (позже востанавливаем ID тайла) FBrushList.Tiles[brushTile.ID].ID := FBrushList.Brush[b]^.BEdges[e]^.ID; // Временно запоминаем ID перехода (позже востанавливаем ID тайла)
end; end;
eNode := eNode.NextSibling; eNode := eNode.NextSibling;
end; end;

4
UCacheManager.pas
View File

@ -43,7 +43,7 @@ type
{ TCacheManager } { TCacheManager }
generic TCacheManager<T> = class generic TCacheManager<T> = class
type public public type
{ Types } { Types }
TRemoveObjectEvent = procedure(AObject: T) of object; TRemoveObjectEvent = procedure(AObject: T) of object;
@ -53,7 +53,7 @@ type
Obj: T; Obj: T;
Next: PCacheEntry; Next: PCacheEntry;
end; end;
var protected protected
{ Members } { Members }
FSize: Integer; FSize: Integer;
FFirst: PCacheEntry; FFirst: PCacheEntry;