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

* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Client/CentrED.lpi
View File

@ -18,7 +18,7 @@
<UseVersionInfo Value="True"/>
<AutoIncrementBuild Value="True"/>
<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"/>
</VersionInfo>
<BuildModes Count="7">
@ -316,7 +316,7 @@
<MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
</Item6>
</RequiredPackages>
<Units Count="49">
<Units Count="50">
<Unit0>
<Filename Value="CentrED.lpr"/>
<IsPartOfProject Value="True"/>
@ -422,6 +422,7 @@
<Filename Value="UfrmLargeScaleCommand.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmLargeScaleCommand"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit17>
<Unit18>
@ -563,6 +564,10 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit48>
<Unit49>
<Filename Value="USelectionHelper.pas"/>
<IsPartOfProject Value="True"/>
</Unit49>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -597,6 +602,7 @@
<CompilerMessages>
<IgnoredMessages idx5028="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True"/>
</CompilerMessages>
<CustomOptions Value="-B"/>
</Other>
</CompilerOptions>
</CONFIG>

96
Client/Tools/UfrmBoundaries.lfm
View File

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

31
Client/Tools/UfrmBoundaries.pas
View File

@ -32,13 +32,15 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ComCtrls, Spin, ExtCtrls, UfrmToolWindow;
ComCtrls, Spin, ExtCtrls, UfrmToolWindow, USelectionHelper;
type
{ TfrmBoundaries }
TfrmBoundaries = class(TfrmToolWindow)
btnSelectArea: TButton;
btnClear: TButton;
gbZRestriction: TGroupBox;
gbViewRestriction: TGroupBox;
lblYSep: TLabel;
@ -55,6 +57,8 @@ type
seMaxY: TSpinEdit;
tbMaxZ: TTrackBar;
tbMinZ: TTrackBar;
procedure btnSelectAreaClick(Sender: TObject);
procedure btnClearClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure seMaxXChange(Sender: TObject);
procedure seMaxYChange(Sender: TObject);
@ -64,6 +68,8 @@ type
procedure seMinZChange(Sender: TObject);
procedure tbMaxZChange(Sender: TObject);
procedure tbMinZChange(Sender: TObject);
protected
procedure RangeSelected(AX1, AY1, AX2, AY2: Word);
public
{ public declarations }
end;
@ -89,6 +95,20 @@ begin
seMaxY.Value := seMaxX.MaxValue;
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);
begin
frmMain.InvalidateFilter;
@ -133,6 +153,15 @@ begin
frmMain.InvalidateFilter;
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
{$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.

60
Client/UfrmMain.lfm
View File

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

33
Client/UfrmMain.pas
View File

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