diff --git a/source/model/Game.Map.pas b/source/model/Game.Map.pas deleted file mode 100644 index 24be1ef..0000000 --- a/source/model/Game.Map.pas +++ /dev/null @@ -1,57 +0,0 @@ -unit Game.Map; - -interface -uses - Game.Intf; - - -type - TGameMap = class(TInterfacedObject, IGameMap) - private - FCategory: string; - FName: string; - FDisplayName: string; - public - constructor Create(const AName: string; const ADisplayName, ACategory: string); - - { IGameMap } - function GetCategory: string; - function GetName: string; - function GetDisplayName: string; - end; - - -implementation -uses - System.StrUtils; - - -{ TGameMap } -constructor TGameMap.Create(const AName, ADisplayName, ACategory: string); -begin - inherited Create; - - FName := AName; - FDisplayName := IfThen(Length(ADisplayName) > 0, ADisplayName, AName); - FCategory := ACategory; -end; - - -function TGameMap.GetCategory: string; -begin - Result := FCategory; -end; - - -function TGameMap.GetName: string; -begin - Result := FName; -end; - - -function TGameMap.GetDisplayName: string; -begin - Result := FDisplayName; -end; - -end. diff --git a/source/view/Forms.Main.dfm b/source/view/Forms.Main.dfm index caf1dcb..1d257f3 100644 --- a/source/view/Forms.Main.dfm +++ b/source/view/Forms.Main.dfm @@ -83,6 +83,7 @@ object MainForm: TMainForm Margins.Right = 8 Margins.Bottom = 8 Align = alClient + DragMode = dmAutomatic Header.AutoSizeIndex = 0 Header.Font.Charset = DEFAULT_CHARSET Header.Font.Color = clWindowText @@ -91,9 +92,13 @@ object MainForm: TMainForm Header.Font.Style = [] Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible] TabOrder = 0 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoChangeScale] TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toWheelPanning, toEditOnClick] TreeOptions.PaintOptions = [toHideFocusRect, toShowDropmark, toThemeAware, toUseBlendedImages] TreeOptions.SelectionOptions = [toFullRowSelect, toMiddleClickSelect, toMultiSelect, toRightClickSelect] + OnChange = vstMapListChange + OnDragOver = vstMapListDragOver + OnDragDrop = vstMapListDragDrop OnGetText = vstMapListGetText Columns = < item @@ -107,7 +112,7 @@ object MainForm: TMainForm WideText = 'Category' end> end - object ToolBar1: TToolBar + object tbMapList: TToolBar AlignWithMargins = True Left = 8 Top = 8 @@ -2264,39 +2269,8 @@ object MainForm: TMainForm end object alMain: TActionList Images = glToolbar - Left = 44 - Top = 276 - object actGameAdd: TAction - Caption = '&Add game' - ImageIndex = 0 - OnExecute = actGameAddExecute - end - object actGameRemove: TAction - Caption = '&Remove game' - Enabled = False - ImageIndex = 1 - OnExecute = actGameRemoveExecute - end - object actMapAdd: TAction - Caption = '&Add map' - ImageIndex = 0 - OnExecute = actMapAddExecute - end - object actMapRemove: TAction - Caption = '&Remove map' - Enabled = False - ImageIndex = 1 - end - object actMapUp: TAction - Caption = 'Move &up' - Enabled = False - ImageIndex = 2 - end - object actMapDown: TAction - Caption = 'Move &down' - Enabled = False - ImageIndex = 3 - end + Left = 212 + Top = 440 object actLaunch: TAction Caption = '&Launch server' end @@ -2318,4 +2292,54 @@ object MainForm: TMainForm Action = actCopyCmdLine end end + object alMapList: TActionList + Images = glToolbar + Left = 356 + Top = 440 + object actMapAdd: TAction + Caption = '&Add map' + ImageIndex = 0 + ShortCut = 16462 + OnExecute = actMapAddExecute + end + object actMapRemove: TAction + Caption = '&Remove map' + Enabled = False + ImageIndex = 1 + ShortCut = 16430 + OnExecute = actMapRemoveExecute + end + object actMapUp: TAction + Caption = 'Move &up' + Enabled = False + ImageIndex = 2 + ShortCut = 16422 + OnExecute = actMapUpExecute + end + object actMapDown: TAction + Caption = 'Move &down' + Enabled = False + ImageIndex = 3 + ShortCut = 16424 + OnExecute = actMapDownExecute + end + end + object alGames: TActionList + Images = glToolbar + Left = 284 + Top = 440 + object actGameAdd: TAction + Caption = '&Add game' + ImageIndex = 0 + ShortCut = 16462 + OnExecute = actGameAddExecute + end + object actGameRemove: TAction + Caption = '&Remove game' + Enabled = False + ImageIndex = 1 + ShortCut = 16430 + OnExecute = actGameRemoveExecute + end + end end diff --git a/source/view/Forms.Main.pas b/source/view/Forms.Main.pas index c853c31..8184152 100644 --- a/source/view/Forms.Main.pas +++ b/source/view/Forms.Main.pas @@ -5,6 +5,7 @@ uses System.Bindings.Expression, System.Classes, System.Generics.Collections, + System.Types, Vcl.ActnList, Vcl.ComCtrls, Vcl.Controls, @@ -16,6 +17,7 @@ uses Vcl.Menus, Vcl.StdCtrls, Vcl.ToolWin, + Winapi.ActiveX, JvExControls, JvExMask, @@ -33,8 +35,6 @@ uses type TMainForm = class(TForm) - actGameAdd: TAction; - actGameRemove: TAction; actMapAdd: TAction; actMapDown: TAction; actMapRemove: TAction; @@ -105,7 +105,7 @@ type tbMapRemove: TToolButton; tbMapSep1: TToolButton; tbMapUp: TToolButton; - ToolBar1: TToolBar; + tbMapList: TToolBar; tsAbout: TTabSheet; tsConfiguration: TTabSheet; tsGames: TTabSheet; @@ -117,6 +117,10 @@ type actCopyCmdLine: TAction; actSave: TAction; actClose: TAction; + alMapList: TActionList; + alGames: TActionList; + actGameAdd: TAction; + actGameRemove: TAction; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -125,13 +129,19 @@ type procedure llLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType); procedure SpinEditChange(Sender: TObject); procedure EditChange(Sender: TObject); + procedure actCloseExecute(Sender: TObject); procedure actGameAddExecute(Sender: TObject); procedure actGameRemoveExecute(Sender: TObject); procedure vstGamesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure vstGamesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure vstMapListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + procedure vstMapListChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + procedure vstMapListDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean); + procedure vstMapListDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); procedure actMapAddExecute(Sender: TObject); - procedure actCloseExecute(Sender: TObject); + procedure actMapRemoveExecute(Sender: TObject); + procedure actMapUpExecute(Sender: TObject); + procedure actMapDownExecute(Sender: TObject); private type TBindingExpressionList = TList; TPageMenuMap = TDictionary; @@ -142,6 +152,7 @@ type procedure SetActiveGame(const Value: TCustomGame); protected + procedure EnablePageActions; procedure ActiveGameChanged; procedure ClearUIBindings; @@ -153,6 +164,12 @@ type procedure UpdateGameList; procedure UpdateMapList; + function FindMapNode(AMap: TGameMap): PVirtualNode; + + procedure HandleMapSelection(ANodes: TNodeArray; ATargetIndex: Integer; ACopy: Boolean); + procedure MoveMapSelection(ANodes: TNodeArray; ATargetIndex: Integer); + procedure CopyMapSelection(ANodes: TNodeArray; ATargetIndex: Integer); + property ActiveGame: TCustomGame read FActiveGame write SetActiveGame; property PageMenuMap: TPageMenuMap read FPageMenuMap; property UIBindings: TBindingExpressionList read FUIBindings; @@ -165,7 +182,6 @@ uses System.Math, System.StrUtils, System.SysUtils, - System.Types, Vcl.Graphics, Vcl.GraphUtil, Vcl.Themes, @@ -278,6 +294,17 @@ begin end; +procedure TMainForm.EnablePageActions; +const + ActionListState: array[Boolean] of TActionListState = (asSuspended, asNormal); + +begin + { Prevent shortcuts from triggering on invisible pages } + alMapList.State := ActionListState[pcMain.ActivePage = tsMapList]; + alGames.State := ActionListState[pcMain.ActivePage = tsGames]; +end; + + procedure TMainForm.ActiveGameChanged; begin ClearUIBindings; @@ -377,14 +404,129 @@ end; procedure TMainForm.UpdateMapList; +var + gameMapList: IGameMapList; + begin - if Assigned(ActiveGame) then - vstMapList.RootNodeCount := (ActiveGame as IGameMapList).GetMapList.Count + if Supports(ActiveGame, IGameMapList, gameMapList) then + vstMapList.RootNodeCount := gameMapList.GetMapList.Count else vstMapList.Clear; end; +function TMainForm.FindMapNode(AMap: TGameMap): PVirtualNode; +var + gameMapList: IGameMapList; + +begin + Result := nil; + if not Supports(ActiveGame, IGameMapList, gameMapList) then + exit; + + Result := vstMapList.IterateSubtree(nil, + procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean) + begin + Abort := (gameMapList.GetMapList[Node^.Index] = AMap); + end, + nil); +end; + + +procedure TMainForm.HandleMapSelection(ANodes: TNodeArray; ATargetIndex: Integer; ACopy: Boolean); +var + gameMapList: IGameMapList; + node: PVirtualNode; + targetIndex: Integer; + sourceShift: Integer; + sourceIndex: Integer; + newIndex: Integer; + newNode: PVirtualNode; + selectedMaps: TList; + map: TGameMap; + +begin + if (ATargetIndex < 0) or (ATargetIndex > vstMapList.RootNodeCount) then + exit; + + if not Supports(ActiveGame, IGameMapList, gameMapList) then + exit; + + targetIndex := ATargetIndex; + sourceShift := 0; + + vstMapList.BeginUpdate; + try + selectedMaps := TList.Create; + try + for node in ANodes do + begin + sourceIndex := node^.Index; + + if ACopy then + begin + { Copy map nodes } + Inc(sourceIndex, sourceShift); + + map := TGameMap.Create(gameMapList.GetMapList[sourceIndex]); + gameMapList.GetMapList.Insert(targetIndex, map); + selectedMaps.Add(map); + + Inc(targetIndex); + + if sourceIndex > ATargetIndex then + Inc(sourceShift); + end else + begin + { Move map nodes } + if sourceIndex < ATargetIndex then + Inc(sourceIndex, sourceShift); + + if targetIndex > sourceIndex then + begin + newIndex := Pred(targetIndex); + Dec(sourceShift); + end else + begin + newIndex := targetIndex; + Inc(targetIndex); + end; + + selectedMaps.Add(gameMapList.GetMapList[sourceIndex]); + gameMapList.GetMapList.Move(sourceIndex, newIndex); + end; + end; + + + vstMapList.ClearSelection; + vstMapList.IterateSubtree(nil, + procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean) + begin + if selectedMaps.Contains(gameMapList.GetMapList[Node^.Index]) then + Sender.Selected[Node] := True; + end, + nil); + finally + FreeAndNil(selectedMaps); + end; + finally + vstMapList.EndUpdate; + end; +end; + + +procedure TMainForm.MoveMapSelection(ANodes: TNodeArray; ATargetIndex: Integer); +begin + HandleMapSelection(ANodes, ATargetIndex, False); +end; + + +procedure TMainForm.CopyMapSelection(ANodes: TNodeArray; ATargetIndex: Integer); +begin + HandleMapSelection(ANodes, ATargetIndex, True); +end; + + procedure TMainForm.SetActiveGame(const Value: TCustomGame); begin if Value <> FActiveGame then @@ -404,6 +546,7 @@ end; procedure TMainForm.mbMenuSelectedChanged(Sender: TObject; Item: TX2CustomMenuBarItem); begin pcMain.ActivePageIndex := Item.Tag; + EnablePageActions; end; @@ -425,6 +568,12 @@ begin end; +procedure TMainForm.actCloseExecute(Sender: TObject); +begin + Close; +end; + + procedure TMainForm.actGameAddExecute(Sender: TObject); var game: TCustomGame; @@ -505,13 +654,14 @@ end; procedure TMainForm.vstMapListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var + gameMapList: IGameMapList; map: TGameMap; begin - if not Assigned(ActiveGame) then + if not Supports(ActiveGame, IGameMapList, gameMapList) then exit; - map := (ActiveGame as IGameMapList).GetMapList[Node^.Index]; + map := gameMapList.GetMapList[Node^.Index]; case Column of MapColumnName: @@ -523,28 +673,152 @@ begin end; -procedure TMainForm.actMapAddExecute(Sender: TObject); +procedure TMainForm.vstMapListChange(Sender: TBaseVirtualTree; Node: PVirtualNode); var - mapList: IGameMapList; - map: TGameMap; + hasSelection: Boolean; begin - mapList := ActiveGame as IGameMapList; + hasSelection := (Sender.SelectedCount > 0); - if TMapForm.Insert(Self, mapList, map) then + actMapRemove.Enabled := hasSelection; + actMapUp.Enabled := hasSelection; + actMapDown.Enabled := hasSelection; +end; + + +procedure TMainForm.vstMapListDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; + Mode: TDropMode; var Effect: Integer; var Accept: Boolean); +begin + Accept := (Source = Sender); +end; + + +procedure TMainForm.vstMapListDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject; Formats: TFormatArray; + Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode); +var + sourceTree: TBaseVirtualTree; + selectedNodes: TNodeArray; + targetIndex: Integer; + lastNode: PVirtualNode; + +begin + sourceTree := (Source as TBaseVirtualTree); + targetIndex := 0; + + case Mode of + dmNowhere: + begin + lastNode := Sender.GetLast; + if Assigned(lastNode) then + targetIndex := Succ(lastNode^.Index); + end; + + dmAbove, + dmOnNode: + targetIndex := Sender.DropTargetNode^.Index; + + dmBelow: + targetIndex := Succ(Sender.DropTargetNode^.Index); + end; + + selectedNodes := sourceTree.GetSortedSelection(True); + + if Effect = DROPEFFECT_COPY then + CopyMapSelection(selectedNodes, targetIndex) + else + MoveMapSelection(selectedNodes, targetIndex); +end; + + +procedure TMainForm.actMapAddExecute(Sender: TObject); +var + gameMapList: IGameMapList; + map: TGameMap; + node: PVirtualNode; + +begin + if not Supports(ActiveGame, IGameMapList, gameMapList) then + exit; + + if TMapForm.Insert(Self, gameMapList, map) then begin - mapList.GetMapList.Add(map); + gameMapList.GetMapList.Add(map); UpdateMapList; + + node := FindMapNode(map); + if Assigned(node) then + begin + vstMapList.ClearSelection; + vstMapList.FocusedNode := node; + vstMapList.Selected[node] := True; + end; end; end; -procedure TMainForm.actCloseExecute(Sender: TObject); +procedure TMainForm.actMapRemoveExecute(Sender: TObject); +var + gameMapList: IGameMapList; + selectedNodes: TNodeArray; + nodeIndex: Integer; + begin - Close; + if not Supports(ActiveGame, IGameMapList, gameMapList) then + exit; + + if vstMapList.SelectedCount = 0 then + exit; + + if MessageBox(Self.Handle, 'Do you want to remove the selected map(s)?', 'Remove', MB_YESNO or MB_ICONQUESTION) = ID_YES then + begin + vstMapList.BeginUpdate; + try + selectedNodes := vstMapList.GetSortedSelection(True); + + for nodeIndex := High(selectedNodes) downto Low(selectedNodes) do + gameMapList.GetMapList.Delete(selectedNodes[nodeIndex]^.Index); + + UpdateMapList; + finally + vstMapList.ClearSelection; + vstMapList.EndUpdate; + end; + end; end; +procedure TMainForm.actMapUpExecute(Sender: TObject); +var + selectedNodes: TNodeArray; + targetIndex: Integer; + +begin + selectedNodes := vstMapList.GetSortedSelection(True); + if Length(selectedNodes) = 0 then + exit; + + targetIndex := Pred(selectedNodes[0]^.Index); + if targetIndex < 0 then + targetIndex := 0; + + MoveMapSelection(selectedNodes, targetIndex); +end; + + +procedure TMainForm.actMapDownExecute(Sender: TObject); +var + selectedNodes: TNodeArray; + targetIndex: Integer; + +begin + selectedNodes := vstMapList.GetSortedSelection(True); + if Length(selectedNodes) = 0 then + exit; + + targetIndex := Succ(selectedNodes[High(selectedNodes)]^.Index) + 1; + MoveMapSelection(selectedNodes, targetIndex); +end; + { TINIHintWindow } function TINIHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect; diff --git a/source/view/Forms.Map.pas b/source/view/Forms.Map.pas index 7ae18fc..c8492cb 100644 --- a/source/view/Forms.Map.pas +++ b/source/view/Forms.Map.pas @@ -350,10 +350,8 @@ begin vstMap.FocusedNode := node; if Assigned(node) then - begin - vstMap.Selected[node] := True; - vstMap.ScrollIntoView(node, True); - end else + vstMap.Selected[node] := True + else vstMap.ClearSelection; end; diff --git a/test/MultiselectMove/MultiselectMoveTest.dpr b/test/MultiselectMove/MultiselectMoveTest.dpr new file mode 100644 index 0000000..b0a047b --- /dev/null +++ b/test/MultiselectMove/MultiselectMoveTest.dpr @@ -0,0 +1,11 @@ +program MultiselectMoveTest; + +uses + GUITestRunner, + MultiselectMoveTestCase in 'MultiselectMoveTestCase.pas'; + +{$R *.res} + +begin + RunRegisteredTests; +end. diff --git a/test/MultiselectMove/MultiselectMoveTest.dproj b/test/MultiselectMove/MultiselectMoveTest.dproj new file mode 100644 index 0000000..f741eb8 --- /dev/null +++ b/test/MultiselectMove/MultiselectMoveTest.dproj @@ -0,0 +1,139 @@ + + + {EFFF3F42-880C-43A5-BDB6-ED22365C2CEB} + 13.4 + VCL + MultiselectMoveTest.dpr + True + Debug + Win32 + 1 + Console + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + fmx;IndySystem;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DataSnapServer;DataSnapProviderClient;DbxCommonDriver;dbxcds;DBXOracleDriver;CustomIPTransport;dsnap;fmxase;IndyCore;inetdbxpress;IPIndyImpl;bindcompfmx;rtl;dbrtl;DbxClientDriver;bindcomp;inetdb;xmlrtl;ibxpress;IndyProtocols;DBXMySQLDriver;soaprtl;bindengine;DBXInformixDriver;DBXFirebirdDriver;inet;fmxobj;DBXSybaseASADriver;fmxdae;dbexpress;DataSnapIndy10ServerTransport;$(DCC_UsePackage) + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + + + cxLibraryRS16;dxLayoutControlRS16;dxCoreRS16;cxExportRS16;dxBarRS16;TeeDB;vclib;dxPSCoreRS16;cxPageControlRS16;DBXSybaseASEDriver;vclimg;dxComnRS16;vcldb;vcldsnap;X2CLGL;DBXDb2Driver;vcl;DBXMSSQLDriver;cxDataRS16;webdsnap;X2CLMB;dxPSTeeChartRS16;adortl;dxPSdxLCLnkRS16;dxorgcRS16;dxWizardControlRS16;Tee;DBXOdbcDriver;dxmdsRS16;cxGridRS16;cxEditorsRS16;TeeUI;vclactnband;dxServerModeRS16;bindcompvcl;cxPivotGridRS16;vclie;cxSchedulerRS16;vcltouch;websnap;VclSmp;DataSnapConnectors;dsnapcon;dxThemeRS16;vclx;VirtualTreesR;dxGDIPlusRS16;$(DCC_UsePackage) + + + JvGlobus;JvMM;cxLibraryRS16;dxLayoutControlRS16;JvManagedThreads;dxCoreRS16;cxExportRS16;dxBarRS16;JvDlgs;JvCrypt;TeeDB;rbDIDE1516;vclib;inetdbbde;dxPSCoreRS16;rbTCUI1516;JvNet;cxPageControlRS16;JvDotNetCtrls;DBXSybaseASEDriver;vclimg;rbTC1516;fmi;rbDAD1516;dxComnRS16;JvXPCtrls;rbRCL1516;vcldb;vcldsnap;X2CLGL;rbIBE1516;DBXDb2Driver;dclRBBDE1516;rbDB1516;JvCore;dclRBIBE1516;dclRBADO1516;vcl;CloudService;DBXMSSQLDriver;CodeSiteExpressPkg;FmxTeeUI;cxDataRS16;rbRAP1516;JvAppFrm;JvDB;JvRuntimeDesign;webdsnap;X2CLMB;OmniThreadLibraryRuntimeXE2;JclDeveloperTools;rbRIDE1516;dxPSTeeChartRS16;adortl;dxPSdxLCLnkRS16;JvDocking;JvWizards;rbADO1516;madBasic_;dxorgcRS16;JvHMI;dxWizardControlRS16;JvBands;vcldbx;rbDBDE1516;dclRBE1516;rbIDE1516;JvPluginSystem;Tee;rbUSERDesign1516;DBXOdbcDriver;JvCmp;madDisAsm_;JvSystem;svnui;JvTimeFramework;JvControls;dxmdsRS16;cxGridRS16;cxEditorsRS16;FMXTee;TeeUI;vclactnband;dxServerModeRS16;bindcompvcl;cxPivotGridRS16;JvStdCtrls;Jcl;vclie;JvCustom;JvJans;cxSchedulerRS16;madExcept_;JvPageComps;vcltouch;JvPrintPreview;rbBDE1516;websnap;rbUSER1516;dclRBDBE1516;VclSmp;DataSnapConnectors;dsnapcon;dxThemeRS16;JclVcl;JvPascalInterpreter;vclx;rbCIDE1516;svn;rbDBE1516;bdertl;VirtualTreesR;dxGDIPlusRS16;JvBDE;$(DCC_UsePackage) + true + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + 1033 + $(BDS)\bin\default_app.manifest + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + + + DEBUG;$(DCC_Define) + false + true + true + true + + + false + + + false + RELEASE;$(DCC_Define) + 0 + false + + + + MainSource + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1043 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + MultiselectMoveTest.dpr + + + + + False + True + + + 12 + + + + diff --git a/test/MultiselectMove/MultiselectMoveTest.res b/test/MultiselectMove/MultiselectMoveTest.res new file mode 100644 index 0000000..c287ee9 Binary files /dev/null and b/test/MultiselectMove/MultiselectMoveTest.res differ diff --git a/test/MultiselectMove/MultiselectMoveTestCase.pas b/test/MultiselectMove/MultiselectMoveTestCase.pas new file mode 100644 index 0000000..4fd2f74 --- /dev/null +++ b/test/MultiselectMove/MultiselectMoveTestCase.pas @@ -0,0 +1,225 @@ +unit MultiselectMoveTestCase; + +interface +uses + System.Generics.Collections, + TestFramework; + + +type + TMultiselectMoveTest = class(TTestCase) + private + FList: TList; + protected + procedure SetUp; override; + procedure TearDown; override; + + procedure CheckList(AExpected: array of Integer); + procedure Move(ASelection: array of Integer; ATargetIndex: Integer); + + property List: TList read FList; + published + procedure TestSetUp; + + procedure TestSingleDown; + procedure TestSingleUp; + procedure TestSingleMin; + procedure TestSingleMax; + + procedure TestMultipleDown; + procedure TestMultipleUp; + procedure TestMultipleMin; + procedure TestMultipleMax; + + procedure TestGapDown; + procedure TestGapUp; + procedure TestGapMiddle; + procedure TestGapMin; + procedure TestGapMax; + end; + + +implementation +uses + System.SysUtils; + + +{ TMultiselectMoveTest } +procedure TMultiselectMoveTest.SetUp; +var + value: Integer; + +begin + inherited SetUp; + + FList := TList.Create; + for value := 0 to 9 do + FList.Add(value); +end; + + +procedure TMultiselectMoveTest.TearDown; +begin + FreeAndNil(FList); + + inherited TearDown; +end; + + +procedure TMultiselectMoveTest.CheckList(AExpected: array of Integer); +var + listValues: TStringBuilder; + expectedValues: TStringBuilder; + value: Integer; + +begin + listValues := nil; + expectedValues := nil; + try + listValues := TStringBuilder.Create; + for value in List do + listValues.Append(value).Append(','); + + expectedValues := TStringBuilder.Create; + for value in AExpected do + expectedValues.Append(value).Append(','); + + CheckEquals(expectedValues.ToString, listValues.ToString); + finally + FreeAndNil(expectedValues); + FreeAndNil(listValues); + end; +end; + + +procedure TMultiselectMoveTest.Move(ASelection: array of Integer; ATargetIndex: Integer); +var + targetIndex: Integer; + sourceShift: Integer; + index: Integer; + sourceIndex: Integer; + +begin + targetIndex := ATargetIndex; + sourceShift := 0; + + for index in ASelection do + begin + sourceIndex := index; + if index < ATargetIndex then + Inc(sourceIndex, sourceShift); + + if targetIndex > sourceIndex then + begin + List.Move(sourceIndex, Pred(targetIndex)); + Dec(sourceShift); + end else if targetIndex < sourceIndex then + begin + List.Move(sourceIndex, targetIndex); + Inc(targetIndex); + end; + end; +end; + + +procedure TMultiselectMoveTest.TestSetUp; +begin + CheckList([0,1,2,3,4,5,6,7,8,9]); +end; + + +procedure TMultiselectMoveTest.TestSingleDown; +begin + Move([1], 5); + CheckList([0,2,3,4,1,5,6,7,8,9]); +end; + + +procedure TMultiselectMoveTest.TestSingleMin; +begin + Move([5], 0); + CheckList([5,0,1,2,3,4,6,7,8,9]); +end; + + +procedure TMultiselectMoveTest.TestSingleMax; +begin + Move([5], 10); + CheckList([0,1,2,3,4,6,7,8,9,5]); +end; + + +procedure TMultiselectMoveTest.TestSingleUp; +begin + Move([8], 5); + CheckList([0,1,2,3,4,8,5,6,7,9]); +end; + + +procedure TMultiselectMoveTest.TestMultipleDown; +begin + Move([1,2], 5); + CheckList([0,3,4,1,2,5,6,7,8,9]); +end; + + +procedure TMultiselectMoveTest.TestMultipleUp; +begin + Move([5,6], 1); + CheckList([0,5,6,1,2,3,4,7,8,9]); +end; + + +procedure TMultiselectMoveTest.TestMultipleMin; +begin + Move([5,6,7], 0); + CheckList([5,6,7,0,1,2,3,4,8,9]); +end; + + +procedure TMultiselectMoveTest.TestMultipleMax; +begin + Move([3,4,5], 10); + CheckList([0,1,2,6,7,8,9,3,4,5]); +end; + + +procedure TMultiselectMoveTest.TestGapDown; +begin + Move([3,5], 6); + CheckList([0,1,2,4,3,5,6,7,8,9]); +end; + + +procedure TMultiselectMoveTest.TestGapUp; +begin + Move([7,9], 3); + CheckList([0,1,2,7,9,3,4,5,6,8]); +end; + + +procedure TMultiselectMoveTest.TestGapMiddle; +begin + Move([3,8], 5); + CheckList([0,1,2,4,3,8,5,6,7,9]); +end; + + +procedure TMultiselectMoveTest.TestGapMin; +begin + Move([3,5,8], 0); + CheckList([3,5,8,0,1,2,4,6,7,9]); +end; + + +procedure TMultiselectMoveTest.TestGapMax; +begin + Move([4,6,9], 10); + CheckList([0,1,2,3,5,7,8,4,6,9]); +end; + + +initialization + RegisterTest(TMultiselectMoveTest.Suite); + +end.