unit Forms.Map; interface uses System.Classes, Vcl.Controls, Vcl.ExtCtrls, Vcl.Forms, Vcl.Graphics, Vcl.StdCtrls, VirtualTrees, Frame.MapPreview, Game.Base, Game.Intf; type TMapForm = class(TForm) btnCancel: TButton; btnOK: TButton; edtMapName: TEdit; lblMapName: TLabel; pnlButtons: TPanel; pnlMapName: TPanel; vstMap: TVirtualStringTree; pnlFilter: TPanel; lblFilter: TLabel; edtFilter: TEdit; frmMapPreview: TMapPreviewFrame; pnlMapPreview: TPanel; procedure btnOKClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure vstMapGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure vstMapPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure vstMapFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); procedure vstMapFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure vstMapCollapsing(Sender: TBaseVirtualTree; Node: PVirtualNode; var Allowed: Boolean); procedure vstMapCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); procedure edtMapNameChange(Sender: TObject); procedure edtFilterChange(Sender: TObject); private FLockMapChange: Boolean; function GetMapName: string; procedure SetMapName(const Value: string); protected procedure LoadPredefinedMapList(AGame: IGameMapList); function CreateMap: TGameMap; function FindMapNode(const AMapName: string): PVirtualNode; property MapName: string read GetMapName write SetMapName; public class function Insert(AOwner: TComponent; AGame: IGameMapList; out AMap: TGameMap): Boolean; end; implementation uses System.Generics.Collections, System.StrUtils, System.SysUtils, Winapi.Windows; type PGameMap = ^TGameMap; const EmptyCategory = 'Other'; {$R *.dfm} { TMapForm } class function TMapForm.Insert(AOwner: TComponent; AGame: IGameMapList; out AMap: TGameMap): Boolean; begin with Self.Create(AOwner) do try LoadPredefinedMapList(AGame); Result := (ShowModal = mrOk); if Result then AMap := CreateMap; finally Free; end; end; procedure TMapForm.FormCreate(Sender: TObject); begin vstMap.NodeDataSize := SizeOf(PGameMap); end; procedure TMapForm.LoadPredefinedMapList(AGame: IGameMapList); var map: TGameMap; categoryNodes: TDictionary; parentNode: PVirtualNode; node: PVirtualNode; begin vstMap.BeginUpdate; try vstMap.Clear; categoryNodes := TDictionary.Create; try for map in AGame.PredefinedMapList do begin if categoryNodes.ContainsKey(map.Category) then parentNode := categoryNodes[map.Category] else begin parentNode := vstMap.AddChild(nil, map); categoryNodes.Add(map.Category, parentNode); end; vstMap.AddChild(parentNode, map); end; finally FreeAndNil(categoryNodes); end; finally vstMap.FullExpand; vstMap.EndUpdate; node := vstMap.GetFirstLevel(1); if Assigned(node) then begin vstMap.FocusedNode := node; vstMap.Selected[node] := True; end; end; end; function TMapForm.CreateMap: TGameMap; var node: PVirtualNode; nodeData: PGameMap; begin node := FindMapNode(MapName); if Assigned(node) then begin nodeData := vstMap.GetNodeData(node); Result := TGameMap.Create(nodeData^); end else Result := TGameMap.Create(MapName, '', ''); end; function TMapForm.GetMapName: string; begin Result := Trim(edtMapName.Text); end; procedure TMapForm.SetMapName(const Value: string); begin edtMapName.Text := Value; end; function TMapForm.FindMapNode(const AMapName: string): PVirtualNode; begin Result := vstMap.IterateSubtree(nil, procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean) var nodeData: PGameMap; begin nodeData := Sender.GetNodeData(Node); Abort := (Sender.GetNodeLevel(Node) > 0) and SameText(nodeData^.Name, AMapName); end, nil); end; procedure TMapForm.btnOKClick(Sender: TObject); begin if Length(MapName) = 0 then begin MessageBox(Self.Handle, 'Please enter a map name', 'Error', MB_OK or MB_ICONERROR); ActiveControl := edtMapName; exit; end; ModalResult := mrOk; end; procedure TMapForm.vstMapGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var nodeData: PGameMap; begin nodeData := Sender.GetNodeData(Node); if Sender.GetNodeLevel(Node) = 0 then begin if Length(nodeData^.Category) > 0 then CellText := nodeData^.Category else CellText := EmptyCategory; end else CellText := nodeData^.DisplayName; end; procedure TMapForm.vstMapPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); begin if (TextType = ttNormal) and (Sender.GetNodeLevel(Node) = 0) then TargetCanvas.Font.Style := [fsBold]; end; procedure TMapForm.vstMapFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); var sibling: PVirtualNode; begin Allowed := True; if not Assigned(NewNode) then exit; { Prevent selection of categories while being keyboard-friendly } if Sender.GetNodeLevel(NewNode) = 0 then begin if Assigned(OldNode) then begin if Sender.AbsoluteIndex(OldNode) < Sender.AbsoluteIndex(NewNode) then begin { Moving forwards } Sender.FocusedNode := Sender.GetFirstChild(NewNode); end else begin { Moving backwards } sibling := Sender.GetPreviousSibling(NewNode); if Assigned(sibling) then Sender.FocusedNode := Sender.GetLastChild(sibling); end; end; Allowed := False; end; end; procedure TMapForm.vstMapFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); var nodeData: PGameMap; begin if FLockMapChange then exit; if Assigned(Node) then begin nodeData := Sender.GetNodeData(Node); frmMapPreview.Load(nodeData^.Name); FLockMapChange := True; try edtMapName.Text := nodeData^.Name; finally FLockMapChange := False; end; end else frmMapPreview.Clear; end; procedure TMapForm.vstMapCollapsing(Sender: TBaseVirtualTree; Node: PVirtualNode; var Allowed: Boolean); begin Allowed := False; end; procedure TMapForm.vstMapCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); var nodeData1: PGameMap; nodeData2: PGameMap; begin nodeData1 := Sender.GetNodeData(Node1); nodeData2 := Sender.GetNodeData(Node2); if Sender.GetNodeLevel(Node1) = 0 then Result := CompareText(nodeData1^.Category, nodeData2^.Category) else Result := CompareText(nodeData1^.DisplayName, nodeData2^.DisplayName); end; procedure TMapForm.edtFilterChange(Sender: TObject); var node: PVirtualNode; begin vstMap.BeginUpdate; try { First run; set visibility of map nodes } vstMap.IterateSubtree(nil, procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean) var nodeData: PGameMap; begin if Sender.GetNodeLevel(Node) > 0 then begin nodeData := Sender.GetNodeData(Node); Sender.IsFiltered[Node] := (Length(edtFilter.Text) > 0) and (not ContainsText(nodeData^.DisplayName, edtFilter.Text)); end; end, nil); { Second run; hide empty categories } node := vstMap.GetFirst; while Assigned(node) do begin vstMap.IsFiltered[Node] := not Assigned(vstMap.IterateSubtree(node, procedure(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean) begin Abort := not Sender.IsFiltered[Node]; end, nil, [], False, True)); node := vstMap.GetNextSibling(node); end; finally vstMap.EndUpdate; end; end; procedure TMapForm.edtMapNameChange(Sender: TObject); var node: PVirtualNode; begin if FLockMapChange then exit; node := FindMapNode(MapName); FLockMapChange := True; try vstMap.FocusedNode := node; finally FLockMapChange := False; end; if Assigned(node) then begin vstMap.Selected[node] := True; frmMapPreview.Load(MapName); end else begin vstMap.ClearSelection; frmMapPreview.Clear; end; end; end.