Changeset 18

Timestamp:

Feb 26, 2014, 9:45:23 PM (11 years ago)

Author:

chronos

Message:

• Add: Player start units setting.
• Add: Allow add and remove players in new game dialog.
• Fixed: Do not allow move from to same cell.

Location:

trunk

Files:

• UFormMain.pas (modified) (1 diff)
• UFormNew.lfm (modified) (4 diffs)
• UFormNew.pas (modified) (3 diffs)
• UGame.pas (modified) (7 diffs)

trunk/UFormMain.pas

@@ -200 +200 @@
 begin
   if (Abs(StartMousePoint.X - X) < 5) and (Abs(StartMousePoint.Y - Y) < 5) then begin
-    if Game.CurrentPlayer.Mode = pmHuman then begin
+    if Game.Running and (Game.CurrentPlayer.Mode = pmHuman) then begin
       Game.CurrentPlayer.SelectCell(Point(X, Y));
       Redraw;

trunk/UFormNew.lfm

@@ -1 +1 @@
 object FormNew: TFormNew
-  Left = 593
+  Left = 706
   Height = 516
-  Top = 245
+  Top = 455
   Width = 716
   Caption = 'New game'
   ClientHeight = 516
   ClientWidth = 716
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
+  OnShow = FormShow
   LCLVersion = '1.3'
   object ButtonOk: TButton
@@ -46 +49 @@
       item
         Caption = 'Type'
-        Width = 377
+        Width = 100
+      end    
+      item
+        Caption = 'Color'
+        Width = 100
+      end    
+      item
+        Caption = 'Start units'
+        Width = 177
       end>
+    OwnerData = True
+    ReadOnly = True
+    RowSelect = True
     TabOrder = 3
     ViewStyle = vsReport
+    OnData = ListView1Data
+    OnSelectItem = ListView1SelectItem
   end
   object ButtonPlayerAdd: TButton
@@ -57 +73 @@
     Width = 83
     Caption = 'Add'
+    OnClick = ButtonPlayerAddClick
     TabOrder = 4
   end
@@ -65 +82 @@
     Width = 83
     Caption = 'Remove'
+    OnClick = ButtonPlayerRemoveClick
     TabOrder = 5
   end

trunk/UFormNew.pas

@@ -24 +24 @@
     SpinEditMapSizeX: TSpinEdit;
     SpinEditMapSizeY: TSpinEdit;
+    procedure ButtonPlayerAddClick(Sender: TObject);
+    procedure ButtonPlayerRemoveClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure ListView1Data(Sender: TObject; Item: TListItem);
+    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
+      Selected: Boolean);
   private
-    { private declarations }
+    Players: TPlayers;
   public
+    procedure ReloadView;
     procedure Load(Game: TGame);
     procedure Save(Game: TGame);
@@ -40 +49 @@
 { TFormNew }
 
+procedure TFormNew.ListView1Data(Sender: TObject; Item: TListItem);
+begin
+  if (Item.Index >= 0) and (Item.Index < Players.Count) then
+  with TPlayer(Players[Item.Index]) do begin
+    Item.Caption := Name;
+    Item.Data := Players[Item.Index];
+    Item.SubItems.Add(PlayerModeText[Mode]);
+    Item.SubItems.Add(IntToStr(Color));
+    Item.SubItems.Add(IntToStr(StartUnits));
+  end;
+end;
+
+procedure TFormNew.ListView1SelectItem(Sender: TObject; Item: TListItem;
+  Selected: Boolean);
+begin
+  ReloadView;
+end;
+
+procedure TFormNew.ReloadView;
+begin
+  ListView1.Items.Count := Players.Count;
+  ListView1.Refresh;
+  ButtonPlayerRemove.Enabled := Assigned(ListView1.Selected);
+end;
+
+procedure TFormNew.FormShow(Sender: TObject);
+begin
+  ReloadView;
+end;
+
+procedure TFormNew.FormCreate(Sender: TObject);
+begin
+  Players := TPlayers.Create;
+end;
+
+procedure TFormNew.ButtonPlayerRemoveClick(Sender: TObject);
+begin
+  if Assigned(ListView1.Selected) then
+    Players.Remove(ListView1.Selected.Data);
+  ReloadView;
+end;
+
+procedure TFormNew.ButtonPlayerAddClick(Sender: TObject);
+var
+  NewPlayer: TPlayer;
+begin
+  NewPlayer := TPlayer.Create;
+  NewPlayer.Name := 'Player x';
+  NewPlayer.Color := clYellow;
+  Players.Add(NewPlayer);
+  ReloadView;
+end;
+
+procedure TFormNew.FormDestroy(Sender: TObject);
+begin
+  Players.Free;
+end;
+
 procedure TFormNew.Load(Game: TGame);
 var
@@ -46 +113 @@
 begin
   CheckBoxVoid.Checked := Game.VoidEnabled;
-  ListView1.Items.Clear;
-  for I := 0 to Game.Players.Count - 1 do
-  with TPlayer(Game.Players[I]) do begin
-    NewItem := ListView1.Items.Add;
-    NewItem.Caption := Name;
-    NewItem.SubItems.Add(PlayerModeText[Mode]);
+  for I := 0 to Players.Count - 1 do
+    TPlayer(Players[I]).Free;
+  Players.Count := Game.Players.Count;
+  for I := 0 to Game.Players.Count - 1 do begin
+    Players[I] := TPlayer.Create;
+    TPlayer(Players[I]).Assign(TPlayer(Game.Players[I]));
   end;
   SpinEditMapSizeX.Value := Game.Map.Size.X;

trunk/UGame.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, ExtCtrls, Graphics, Contnrs;
+
+const
+  DefaultPlayerStartUnits = 5;
 
 type
@@ -80 +83 @@
     TotalUnits: Integer;
     TotalCells: Integer;
+    StartUnits: Integer;
     procedure ComputerTurn;
     procedure SelectCell(Pos: TPoint);
     procedure Paint(PaintBox: TPaintBox);
     constructor Create;
+    procedure Assign(Source: TPlayer);
+  end;
+
+  TPlayers = class(TObjectList)
+
   end;
 
@@ -105 +114 @@
     procedure SetMove(CellFrom, CellTo: TCell);
   public
-    Players: TObjectList; // TList<TPlayer>
+    Players: TPlayers;
     Map: THexMap;
     VoidEnabled: Boolean;
@@ -171 +180 @@
     not ((DX = -1) and (DY = -1)) and
     not ((DX = 1) and (DY = 1))));
+  Result := Result and not (Cell1 = Cell2);
 end;
 
@@ -240 +250 @@
   ViewZoom := 1;
   SelectedCell := nil;
+  StartUnits := DefaultPlayerStartUnits;
+end;
+
+procedure TPlayer.Assign(Source: TPlayer);
+begin
+  Name := Source.Name;
+  Color := Source.Color;
+  Mode := Source.Mode;
+  Game := Source.Game;
+  TotalCells := Source.TotalCells;
+  TotalUnits := Source.TotalUnits;
+  StartUnits := Source.StartUnits;
+  SelectedCell := Source.SelectedCell;
+  ViewZoom := Source.ViewZoom;
 end;
 
@@ -365 +389 @@
   Randomize;
 
-  Players := TObjectList.Create;
+  Players := TPlayers.Create;
   Player := TPlayer.Create;
   Player.Name := 'Player 1';
@@ -419 +443 @@
       StartCell.Terrain := ttNormal;
       StartCell.Player := TPlayer(Players[I]);
+      StartCell.Power := TPlayer(Players[I]).StartUnits;
     end;
   end;