From d334728b6c3528890dedb28fa8d94edeed107273 Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Wed, 13 May 2015 19:02:33 +0200 Subject: [PATCH] * Fixed memory corruption in frmMain (caused by heContrns) * Added range selection to frmBoundaries --- Client/CentrED.lpi | 10 ++- Client/Tools/UfrmBoundaries.lfm | 96 ++++++++++++++++----------- Client/Tools/UfrmBoundaries.pas | 31 ++++++++- Client/USelectionHelper.pas | 113 ++++++++++++++++++++++++++++++++ Client/UfrmMain.lfm | 60 ++++++++--------- Client/UfrmMain.pas | 33 +++++----- 6 files changed, 255 insertions(+), 88 deletions(-) create mode 100644 Client/USelectionHelper.pas diff --git a/Client/CentrED.lpi b/Client/CentrED.lpi index d9f91e0..daef122 100644 --- a/Client/CentrED.lpi +++ b/Client/CentrED.lpi @@ -18,7 +18,7 @@ - + @@ -316,7 +316,7 @@ - + @@ -422,6 +422,7 @@ + @@ -563,6 +564,10 @@ + + + + @@ -597,6 +602,7 @@ + diff --git a/Client/Tools/UfrmBoundaries.lfm b/Client/Tools/UfrmBoundaries.lfm index 9913d5b..5fb1fb4 100644 --- a/Client/Tools/UfrmBoundaries.lfm +++ b/Client/Tools/UfrmBoundaries.lfm @@ -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 diff --git a/Client/Tools/UfrmBoundaries.pas b/Client/Tools/UfrmBoundaries.pas index ecf7ea5..65752b4 100644 --- a/Client/Tools/UfrmBoundaries.pas +++ b/Client/Tools/UfrmBoundaries.pas @@ -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} diff --git a/Client/USelectionHelper.pas b/Client/USelectionHelper.pas new file mode 100644 index 0000000..5b81ee1 --- /dev/null +++ b/Client/USelectionHelper.pas @@ -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. + diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm index 2198c11..daf4206 100644 --- a/Client/UfrmMain.lfm +++ b/Client/UfrmMain.lfm @@ -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 diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas index d4b4515..85c7b20 100644 --- a/Client/UfrmMain.pas +++ b/Client/UfrmMain.pas @@ -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; + TBlockInfoList = specialize TFPGList; TGhostTile = class(TStaticItem); - TPacketList = specialize TheObjectVector; - TAccessChangedListeners = specialize TPointerVectorSet; - TSelectionListeners = specialize TPointerVectorSet; + TPacketList = specialize TFPGObjectList; + TAccessChangedListeners = specialize TFPGList; + TSelectionListeners = specialize TFPGList; TTileHintInfo = record Name: String; @@ -713,8 +712,10 @@ 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 @@ -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