* Fixed memory corruption in frmMain (caused by heContrns)

* Added range selection to frmBoundaries
This commit is contained in:
Andreas Schneider 2015-05-13 19:02:33 +02:00
parent 609ff53253
commit d334728b6c
6 changed files with 255 additions and 88 deletions

View File

@ -18,7 +18,7 @@
<UseVersionInfo Value="True"/> <UseVersionInfo Value="True"/>
<AutoIncrementBuild Value="True"/> <AutoIncrementBuild Value="True"/>
<MinorVersionNr Value="7"/> <MinorVersionNr Value="7"/>
<BuildNr Value="260"/> <BuildNr Value="262"/>
<StringTable CompanyName="AKS DataBasis" FileDescription="UO CentrED" InternalName="CentrED" LegalCopyright="(c) 2015 Andreas Schneider and StaticZ" OriginalFilename="CentrED.exe" ProductName="CentrED" ProductVersion="0.7.0"/> <StringTable CompanyName="AKS DataBasis" FileDescription="UO CentrED" InternalName="CentrED" LegalCopyright="(c) 2015 Andreas Schneider and StaticZ" OriginalFilename="CentrED.exe" ProductName="CentrED" ProductVersion="0.7.0"/>
</VersionInfo> </VersionInfo>
<BuildModes Count="7"> <BuildModes Count="7">
@ -316,7 +316,7 @@
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/> <MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
</Item6> </Item6>
</RequiredPackages> </RequiredPackages>
<Units Count="49"> <Units Count="50">
<Unit0> <Unit0>
<Filename Value="CentrED.lpr"/> <Filename Value="CentrED.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -422,6 +422,7 @@
<Filename Value="UfrmLargeScaleCommand.pas"/> <Filename Value="UfrmLargeScaleCommand.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="frmLargeScaleCommand"/> <ComponentName Value="frmLargeScaleCommand"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
</Unit17> </Unit17>
<Unit18> <Unit18>
@ -563,6 +564,10 @@
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
</Unit48> </Unit48>
<Unit49>
<Filename Value="USelectionHelper.pas"/>
<IsPartOfProject Value="True"/>
</Unit49>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -597,6 +602,7 @@
<CompilerMessages> <CompilerMessages>
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/> <IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
</CompilerMessages> </CompilerMessages>
<CustomOptions Value="-B"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
</CONFIG> </CONFIG>

View File

@ -1,7 +1,7 @@
inherited frmBoundaries: TfrmBoundaries inherited frmBoundaries: TfrmBoundaries
Left = 1831 Left = 445
Height = 164 Height = 164
Top = 239 Top = 332
Width = 402 Width = 402
Caption = 'Boundaries' Caption = 'Boundaries'
ClientHeight = 164 ClientHeight = 164
@ -17,7 +17,7 @@ inherited frmBoundaries: TfrmBoundaries
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Caption = 'Restrict Height' Caption = 'Restrict Height'
ClientHeight = 141 ClientHeight = 139
ClientWidth = 192 ClientWidth = 192
TabOrder = 0 TabOrder = 0
object lblMinZ: TLabel object lblMinZ: TLabel
@ -25,9 +25,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Control = seMinZ AnchorSideTop.Control = seMinZ
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 13 Height = 15
Top = 8 Top = 10
Width = 68 Width = 77
Caption = 'Minimum Z:' Caption = 'Minimum Z:'
Layout = tlCenter Layout = tlCenter
ParentColor = False ParentColor = False
@ -37,7 +37,7 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = gbZRestriction AnchorSideRight.Control = gbZRestriction
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 136 Left = 136
Height = 21 Height = 27
Top = 4 Top = 4
Width = 52 Width = 52
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
@ -56,8 +56,8 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = gbZRestriction AnchorSideRight.Control = gbZRestriction
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 4 Left = 4
Height = 36 Height = 37
Top = 29 Top = 35
Width = 184 Width = 184
Frequency = 10 Frequency = 10
Max = 127 Max = 127
@ -74,9 +74,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Control = seMaxZ AnchorSideTop.Control = seMaxZ
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 13 Height = 15
Top = 73 Top = 82
Width = 71 Width = 81
Caption = 'Maximum Z:' Caption = 'Maximum Z:'
Layout = tlCenter Layout = tlCenter
ParentColor = False ParentColor = False
@ -87,8 +87,8 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = seMinZ AnchorSideRight.Control = seMinZ
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 136 Left = 136
Height = 21 Height = 27
Top = 69 Top = 76
Width = 52 Width = 52
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
MaxValue = 127 MaxValue = 127
@ -104,8 +104,8 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = gbZRestriction AnchorSideRight.Control = gbZRestriction
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 4 Left = 4
Height = 36 Height = 37
Top = 94 Top = 107
Width = 184 Width = 184
Frequency = 10 Frequency = 10
Max = 127 Max = 127
@ -133,15 +133,15 @@ inherited frmBoundaries: TfrmBoundaries
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
Caption = 'Restrict View Range' Caption = 'Restrict View Range'
ClientHeight = 141 ClientHeight = 139
ClientWidth = 190 ClientWidth = 190
TabOrder = 1 TabOrder = 1
object seMinX: TSpinEdit object seMinX: TSpinEdit
AnchorSideLeft.Control = lblX AnchorSideLeft.Control = lblX
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seMaxX AnchorSideTop.Control = seMaxX
Left = 19 Left = 20
Height = 21 Height = 27
Top = 4 Top = 4
Width = 74 Width = 74
BorderSpacing.Left = 4 BorderSpacing.Left = 4
@ -153,7 +153,7 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = gbViewRestriction AnchorSideRight.Control = gbViewRestriction
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 112 Left = 112
Height = 21 Height = 27
Top = 4 Top = 4
Width = 74 Width = 74
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
@ -168,9 +168,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = seMinX AnchorSideRight.Control = seMinX
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 19 Left = 20
Height = 21 Height = 27
Top = 33 Top = 39
Width = 74 Width = 74
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8 BorderSpacing.Top = 8
@ -183,8 +183,8 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideRight.Control = seMaxX AnchorSideRight.Control = seMaxX
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 112 Left = 112
Height = 21 Height = 27
Top = 33 Top = 39
Width = 74 Width = 74
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
OnChange = seMaxYChange OnChange = seMaxYChange
@ -195,9 +195,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Control = seMinX AnchorSideTop.Control = seMinX
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 13 Height = 15
Top = 8 Top = 10
Width = 11 Width = 12
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Caption = 'X:' Caption = 'X:'
ParentColor = False ParentColor = False
@ -207,9 +207,9 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideTop.Control = seMinY AnchorSideTop.Control = seMinY
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 4 Left = 4
Height = 13 Height = 15
Top = 37 Top = 45
Width = 10 Width = 9
Caption = 'Y:' Caption = 'Y:'
ParentColor = False ParentColor = False
end end
@ -218,10 +218,10 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = seMaxX AnchorSideTop.Control = seMaxX
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 97 Left = 98
Height = 13 Height = 15
Top = 8 Top = 10
Width = 11 Width = 13
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Caption = '—' Caption = '—'
ParentColor = False ParentColor = False
@ -230,13 +230,31 @@ inherited frmBoundaries: TfrmBoundaries
AnchorSideLeft.Control = lblXSep AnchorSideLeft.Control = lblXSep
AnchorSideTop.Control = seMinY AnchorSideTop.Control = seMinY
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 97 Left = 98
Height = 13 Height = 15
Top = 37 Top = 45
Width = 11 Width = 13
Caption = '—' Caption = '—'
ParentColor = False ParentColor = False
end end
object btnSelectArea: TButton
Left = 74
Height = 25
Top = 76
Width = 112
Caption = 'Select Area'
OnClick = btnSelectAreaClick
TabOrder = 4
end
object btnClear: TButton
Left = 111
Height = 25
Top = 107
Width = 75
Caption = 'Clear'
OnClick = btnClearClick
TabOrder = 5
end
end end
inherited tmClose: TTimer[2] inherited tmClose: TTimer[2]
end end

View File

@ -32,13 +32,15 @@ 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, UfrmToolWindow, USelectionHelper;
type type
{ TfrmBoundaries } { TfrmBoundaries }
TfrmBoundaries = class(TfrmToolWindow) TfrmBoundaries = class(TfrmToolWindow)
btnSelectArea: TButton;
btnClear: TButton;
gbZRestriction: TGroupBox; gbZRestriction: TGroupBox;
gbViewRestriction: TGroupBox; gbViewRestriction: TGroupBox;
lblYSep: TLabel; lblYSep: TLabel;
@ -55,6 +57,8 @@ type
seMaxY: TSpinEdit; seMaxY: TSpinEdit;
tbMaxZ: TTrackBar; tbMaxZ: TTrackBar;
tbMinZ: TTrackBar; tbMinZ: TTrackBar;
procedure btnSelectAreaClick(Sender: TObject);
procedure btnClearClick(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure seMaxXChange(Sender: TObject); procedure seMaxXChange(Sender: TObject);
procedure seMaxYChange(Sender: TObject); procedure seMaxYChange(Sender: TObject);
@ -64,6 +68,8 @@ type
procedure seMinZChange(Sender: TObject); procedure seMinZChange(Sender: TObject);
procedure tbMaxZChange(Sender: TObject); procedure tbMaxZChange(Sender: TObject);
procedure tbMinZChange(Sender: TObject); procedure tbMinZChange(Sender: TObject);
protected
procedure RangeSelected(AX1, AY1, AX2, AY2: Word);
public public
{ public declarations } { public declarations }
end; end;
@ -89,6 +95,20 @@ begin
seMaxY.Value := seMaxX.MaxValue; seMaxY.Value := seMaxX.MaxValue;
end; end;
procedure TfrmBoundaries.btnSelectAreaClick(Sender: TObject);
begin
SelectRange(@RangeSelected);
end;
procedure TfrmBoundaries.btnClearClick(Sender: TObject);
begin
seMinX.Value := 0;
seMinY.Value := 0;
seMaxX.Value := seMaxX.MaxValue;
seMaxY.Value := seMaxY.MaxValue;
frmMain.InvalidateFilter;
end;
procedure TfrmBoundaries.seMaxXChange(Sender: TObject); procedure TfrmBoundaries.seMaxXChange(Sender: TObject);
begin begin
frmMain.InvalidateFilter; frmMain.InvalidateFilter;
@ -133,6 +153,15 @@ begin
frmMain.InvalidateFilter; frmMain.InvalidateFilter;
end; end;
procedure TfrmBoundaries.RangeSelected(AX1, AY1, AX2, AY2: Word);
begin
seMinX.Value := AX1;
seMinY.Value := AY1;
seMaxX.Value := AX2;
seMaxY.Value := AY2;
frmBoundaries.Show;
end;
initialization initialization
{$I UfrmBoundaries.lrs} {$I UfrmBoundaries.lrs}

113
Client/USelectionHelper.pas Normal file
View File

@ -0,0 +1,113 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2015 Andreas Schneider
*)
unit USelectionHelper;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
TSelectedRangeCallback = procedure(AX1, AY1, AX2, AY2: Word) of object;
procedure SelectRange(ACallback: TSelectedRangeCallback);
implementation
uses
UfrmMain, UWorldItem, math;
type
{ TRangeSelectionHelper }
TRangeSelectionHelper = class
constructor Create(ACallback: TSelectedRangeCallback);
protected
FCallback: TSelectedRangeCallback;
FItem1: TWorldItem;
FItem2: TWorldItem;
procedure TileSelected(AWorldItem: TWorldItem);
procedure Finish;
public
procedure Run;
end;
procedure SelectRange(ACallback: TSelectedRangeCallback);
var
helper: TRangeSelectionHelper;
begin
helper := TRangeSelectionHelper.Create(ACallback);
helper.Run;
//Cleanup will follow asynchroneously
end;
{ TRangeSelectionHelper }
constructor TRangeSelectionHelper.Create(ACallback: TSelectedRangeCallback);
begin
FCallback := ACallback;
FItem1 := nil;
FItem2 := nil;
end;
procedure TRangeSelectionHelper.TileSelected(AWorldItem: TWorldItem);
begin
if FItem1 = nil then
FItem1 := AWorldItem
else if FItem2 = nil then
begin
FItem2 := AWorldItem;
Finish;
end;
end;
procedure TRangeSelectionHelper.Finish;
var
minX, minY: Word;
maxX, maxY: Word;
begin
frmMain.UnregisterSelectionListener(@TileSelected);
minX := Min(FItem1.X, FItem2.X);
minY := Min(FItem1.Y, FItem2.Y);
maxX := Max(FItem1.X, FItem2.X);
maxY := Max(FItem1.Y, FItem2.Y);
FCallback(minX, minY, maxX, maxY);
Free; //We use this class only once, so it can cleanup after itself
end;
procedure TRangeSelectionHelper.Run;
begin
//TODO show indicator and option to cancel
//TODO keep track of instance (global variable maybe?)
frmMain.RegisterSelectionListener(@TileSelected);
frmMain.SwitchToSelection;
end;
end.

View File

@ -81,7 +81,7 @@ object frmMain: TfrmMain
end end
object edX: TSpinEdit object edX: TSpinEdit
Left = 24 Left = 24
Height = 21 Height = 25
Top = 3 Top = 3
Width = 55 Width = 55
MaxValue = 100000 MaxValue = 100000
@ -89,7 +89,7 @@ object frmMain: TfrmMain
end end
object edY: TSpinEdit object edY: TSpinEdit
Left = 104 Left = 104
Height = 21 Height = 25
Top = 3 Top = 3
Width = 52 Width = 52
MaxValue = 100000 MaxValue = 100000
@ -118,12 +118,12 @@ object frmMain: TfrmMain
object tsTiles: TTabSheet object tsTiles: TTabSheet
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 476 ClientHeight = 476
ClientWidth = 220 ClientWidth = 214
object lblFilter: TLabel object lblFilter: TLabel
AnchorSideLeft.Control = cbTerrain AnchorSideLeft.Control = cbTerrain
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbTerrain AnchorSideTop.Control = cbTerrain
Left = 85 Left = 91
Height = 13 Height = 13
Top = 8 Top = 8
Width = 31 Width = 31
@ -140,10 +140,10 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = spTileList AnchorSideBottom.Control = spTileList
Left = 4 Left = 4
Height = 228 Height = 224
Hint = '-' Hint = '-'
Top = 60 Top = 64
Width = 212 Width = 206
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -201,11 +201,11 @@ object frmMain: TfrmMain
Left = 0 Left = 0
Height = 183 Height = 183
Top = 293 Top = 293
Width = 220 Width = 214
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'Random pool' Caption = 'Random pool'
ClientHeight = 168 ClientHeight = 168
ClientWidth = 216 ClientWidth = 210
TabOrder = 1 TabOrder = 1
object btnAddRandom: TSpeedButton object btnAddRandom: TSpeedButton
AnchorSideLeft.Control = gbRandom AnchorSideLeft.Control = gbRandom
@ -359,10 +359,10 @@ object frmMain: TfrmMain
object btnRandomPresetSave: TSpeedButton object btnRandomPresetSave: TSpeedButton
AnchorSideTop.Control = cbRandomPreset AnchorSideTop.Control = cbRandomPreset
AnchorSideRight.Control = btnRandomPresetDelete AnchorSideRight.Control = btnRandomPresetDelete
Left = 164 Left = 158
Height = 22 Height = 22
Hint = 'Save Preset' Hint = 'Save Preset'
Top = 139 Top = 137
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -411,10 +411,10 @@ object frmMain: TfrmMain
AnchorSideTop.Control = btnRandomPresetSave AnchorSideTop.Control = btnRandomPresetSave
AnchorSideRight.Control = gbRandom AnchorSideRight.Control = gbRandom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 190 Left = 184
Height = 22 Height = 22
Hint = 'Delete Preset' Hint = 'Delete Preset'
Top = 139 Top = 137
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -469,9 +469,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = cbRandomPreset AnchorSideBottom.Control = cbRandomPreset
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 111 Height = 109
Top = 24 Top = 24
Width = 208 Width = 202
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -517,9 +517,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = gbRandom AnchorSideBottom.Control = gbRandom
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 4 Left = 4
Height = 25 Height = 27
Top = 139 Top = 137
Width = 156 Width = 150
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -539,7 +539,7 @@ object frmMain: TfrmMain
Left = 0 Left = 0
Height = 5 Height = 5
Top = 288 Top = 288
Width = 220 Width = 214
Align = alNone Align = alNone
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
ResizeAnchor = akBottom ResizeAnchor = akBottom
@ -549,7 +549,7 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = vdtTiles AnchorSideBottom.Control = vdtTiles
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 112 Left = 106
Height = 23 Height = 23
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 = 257 Top = 257
@ -571,10 +571,10 @@ object frmMain: TfrmMain
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = tsTiles AnchorSideRight.Control = tsTiles
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 85 Left = 91
Height = 23 Height = 23
Top = 21 Top = 21
Width = 119 Width = 107
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 16 BorderSpacing.Right = 16
OnEditingDone = edFilterEditingDone OnEditingDone = edFilterEditingDone
@ -585,10 +585,10 @@ object frmMain: TfrmMain
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = cbTerrain AnchorSideTop.Control = cbTerrain
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 4 Left = 3
Height = 24 Height = 26
Top = 32 Top = 34
Width = 65 Width = 73
Caption = 'Statics' Caption = 'Statics'
Checked = True Checked = True
OnChange = cbStaticsChange OnChange = cbStaticsChange
@ -599,9 +599,9 @@ object frmMain: TfrmMain
AnchorSideLeft.Control = tsTiles AnchorSideLeft.Control = tsTiles
AnchorSideTop.Control = tsTiles AnchorSideTop.Control = tsTiles
Left = 4 Left = 4
Height = 24 Height = 26
Top = 8 Top = 8
Width = 65 Width = 71
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = 'Terrain' Caption = 'Terrain'
@ -614,7 +614,7 @@ object frmMain: TfrmMain
object tsClients: TTabSheet object tsClients: TTabSheet
Caption = 'Clients' Caption = 'Clients'
ClientHeight = 476 ClientHeight = 476
ClientWidth = 220 ClientWidth = 214
object lbClients: TListBox object lbClients: TListBox
Left = 0 Left = 0
Height = 478 Height = 478
@ -633,7 +633,7 @@ object frmMain: TfrmMain
object tsLocations: TTabSheet object tsLocations: TTabSheet
Caption = 'Locations' Caption = 'Locations'
ClientHeight = 476 ClientHeight = 476
ClientWidth = 220 ClientWidth = 214
object btnClearLocations: TSpeedButton object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation AnchorSideLeft.Control = btnDeleteLocation
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom

View File

@ -36,8 +36,7 @@ uses
StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math, StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket, XMLPropStorage, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket,
UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, heContnrs, UGLFont, DOM, XMLRead, XMLWrite, strutils, ULightManager, fgl, UTiledata;
UContnrExt, UTiledata, Types;
type type
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object; TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
@ -45,12 +44,12 @@ type
TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered); TScreenBufferState = (sbsValid, sbsIndexed, sbsFiltered);
TScreenBufferStates = set of TScreenBufferState; TScreenBufferStates = set of TScreenBufferState;
TBlockInfoList = specialize TheVector<PBlockInfo>; TBlockInfoList = specialize TFPGList<PBlockInfo>;
TGhostTile = class(TStaticItem); TGhostTile = class(TStaticItem);
TPacketList = specialize TheObjectVector<TPacket>; TPacketList = specialize TFPGObjectList<TPacket>;
TAccessChangedListeners = specialize TPointerVectorSet<TAccessChangedListener>; TAccessChangedListeners = specialize TFPGList<TAccessChangedListener>;
TSelectionListeners = specialize TPointerVectorSet<TSelectionListener>; TSelectionListeners = specialize TFPGList<TSelectionListener>;
TTileHintInfo = record TTileHintInfo = record
Name: String; Name: String;
@ -713,8 +712,10 @@ begin
mnuGrabTileIDClick(nil); mnuGrabTileIDClick(nil);
end; end;
for selectionListener in FSelectionListeners.Reversed do for selectionListener in FSelectionListeners do
begin
selectionListener(CurrentTile); selectionListener(CurrentTile);
end;
end; end;
if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then if (not acSelect.Checked) and (targetTile <> nil) and (SelectedTile <> nil) then
@ -1178,14 +1179,14 @@ end;
procedure TfrmMain.acUndoExecute(Sender: TObject); procedure TfrmMain.acUndoExecute(Sender: TObject);
var var
packet: TPacket; i: Integer;
begin begin
//Send each reversed action in reverse order. //Send each reversed action in reverse order.
for packet in FUndoList.Reversed do for i := FUndoList.Count - 1 downto 0 do
dmNetwork.Send(packet); dmNetwork.Send(FUndoList[i]);
//Cleanup without freeing the objects (this was already done by dmNetwork.Send) //Cleanup without freeing the objects (this was already done by dmNetwork.Send)
FUndoList.Wipe; FUndoList.Clear;
//No Undo packets, nothing to undo. //No Undo packets, nothing to undo.
acUndo.Enabled := False; acUndo.Enabled := False;
@ -1969,23 +1970,23 @@ end;
procedure TfrmMain.RegisterAccessChangedListener( procedure TfrmMain.RegisterAccessChangedListener(
AListener: TAccessChangedListener); AListener: TAccessChangedListener);
begin begin
FAccessChangedListeners.Include(AListener); FAccessChangedListeners.Add(AListener);
end; end;
procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener); procedure TfrmMain.RegisterSelectionListener(AListener: TSelectionListener);
begin begin
FSelectionListeners.Include(AListener); FSelectionListeners.Add(AListener);
end; end;
procedure TfrmMain.UnregisterAccessChangedListener( procedure TfrmMain.UnregisterAccessChangedListener(
AListener: TAccessChangedListener); AListener: TAccessChangedListener);
begin begin
FAccessChangedListeners.Exclude(AListener); FAccessChangedListeners.Remove(AListener);
end; end;
procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener); procedure TfrmMain.UnregisterSelectionListener(AListener: TSelectionListener);
begin begin
FSelectionListeners.Exclude(AListener); FSelectionListeners.Remove(AListener);
end; end;
procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem); procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem);
@ -3172,7 +3173,7 @@ begin
end; end;
end; end;
for accessChangedListener in FAccessChangedListeners.Reversed do for accessChangedListener in FAccessChangedListeners do
accessChangedListener(accessLevel); accessChangedListener(accessLevel);
end; end;
$08: //password change status $08: //password change status