Added: moving, dragging and copying of map selection
Added: test application for moving logic
This commit is contained in:
parent
f82b8bdcf8
commit
cbd10a0961
|
|
@ -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.
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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<TBindingExpression>;
|
||||
TPageMenuMap = TDictionary<TTabSheet, TX2MenuBarItem>;
|
||||
|
|
@ -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<TGameMap>;
|
||||
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<TGameMap>.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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,11 @@
|
|||
program MultiselectMoveTest;
|
||||
|
||||
uses
|
||||
GUITestRunner,
|
||||
MultiselectMoveTestCase in 'MultiselectMoveTestCase.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RunRegisteredTests;
|
||||
end.
|
||||
|
|
@ -0,0 +1,139 @@
|
|||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{EFFF3F42-880C-43A5-BDB6-ED22365C2CEB}</ProjectGuid>
|
||||
<ProjectVersion>13.4</ProjectVersion>
|
||||
<FrameworkType>VCL</FrameworkType>
|
||||
<MainSource>MultiselectMoveTest.dpr</MainSource>
|
||||
<Base>True</Base>
|
||||
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||
<TargetedPlatforms>1</TargetedPlatforms>
|
||||
<AppType>Console</AppType>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
|
||||
<Base_Win64>true</Base_Win64>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||
<Base_Win32>true</Base_Win32>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
|
||||
<Cfg_1_Win32>true</Cfg_1_Win32>
|
||||
<CfgParent>Cfg_1</CfgParent>
|
||||
<Cfg_1>true</Cfg_1>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
|
||||
<Cfg_2>true</Cfg_2>
|
||||
<CfgParent>Base</CfgParent>
|
||||
<Base>true</Base>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base)'!=''">
|
||||
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
|
||||
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
|
||||
<DCC_UsePackage>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)</DCC_UsePackage>
|
||||
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
|
||||
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Win64)'!=''">
|
||||
<DCC_UsePackage>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)</DCC_UsePackage>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||
<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)</DCC_UsePackage>
|
||||
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
|
||||
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||
<DCC_Optimize>false</DCC_Optimize>
|
||||
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
|
||||
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
|
||||
<DCC_RemoteDebug>true</DCC_RemoteDebug>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<DelphiCompile Include="$(MainSource)">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="MultiselectMoveTestCase.pas"/>
|
||||
<BuildConfiguration Include="Release">
|
||||
<Key>Cfg_2</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
<BuildConfiguration Include="Debug">
|
||||
<Key>Cfg_1</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
</BuildConfiguration>
|
||||
</ItemGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType/>
|
||||
<BorlandProject>
|
||||
<Delphi.Personality>
|
||||
<VersionInfo>
|
||||
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
|
||||
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||
<VersionInfo Name="Release">0</VersionInfo>
|
||||
<VersionInfo Name="Build">0</VersionInfo>
|
||||
<VersionInfo Name="Debug">False</VersionInfo>
|
||||
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||
<VersionInfo Name="Special">False</VersionInfo>
|
||||
<VersionInfo Name="Private">False</VersionInfo>
|
||||
<VersionInfo Name="DLL">False</VersionInfo>
|
||||
<VersionInfo Name="Locale">1043</VersionInfo>
|
||||
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||
</VersionInfo>
|
||||
<VersionInfoKeys>
|
||||
<VersionInfoKeys Name="CompanyName"/>
|
||||
<VersionInfoKeys Name="FileDescription"/>
|
||||
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="InternalName"/>
|
||||
<VersionInfoKeys Name="LegalCopyright"/>
|
||||
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||
<VersionInfoKeys Name="OriginalFilename"/>
|
||||
<VersionInfoKeys Name="ProductName"/>
|
||||
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||
<VersionInfoKeys Name="Comments"/>
|
||||
</VersionInfoKeys>
|
||||
<Source>
|
||||
<Source Name="MainSource">MultiselectMoveTest.dpr</Source>
|
||||
</Source>
|
||||
</Delphi.Personality>
|
||||
<Deployment/>
|
||||
<Platforms>
|
||||
<Platform value="Win64">False</Platform>
|
||||
<Platform value="Win32">True</Platform>
|
||||
</Platforms>
|
||||
</BorlandProject>
|
||||
<ProjectFileVersion>12</ProjectFileVersion>
|
||||
</ProjectExtensions>
|
||||
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
|
||||
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
|
||||
</Project>
|
||||
Binary file not shown.
|
|
@ -0,0 +1,225 @@
|
|||
unit MultiselectMoveTestCase;
|
||||
|
||||
interface
|
||||
uses
|
||||
System.Generics.Collections,
|
||||
TestFramework;
|
||||
|
||||
|
||||
type
|
||||
TMultiselectMoveTest = class(TTestCase)
|
||||
private
|
||||
FList: TList<Integer>;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
|
||||
procedure CheckList(AExpected: array of Integer);
|
||||
procedure Move(ASelection: array of Integer; ATargetIndex: Integer);
|
||||
|
||||
property List: TList<Integer> 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<Integer>.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.
|
||||
Loading…
Reference in New Issue