close Warning: Can't synchronize with repository "(default)" (No changeset 184 in the repository). Look in the Trac log for more information.

Changeset 3


Ignore:
Timestamp:
Feb 8, 2014, 11:28:47 PM (10 years ago)
Author:
chronos
Message:
  • Added: Support for multiple players.
  • Added: Each cell have power state.
Location:
trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/UFormMain.lfm

    r2 r3  
    99  OnCreate = FormCreate
    1010  OnDestroy = FormDestroy
     11  OnShow = FormShow
    1112  LCLVersion = '1.3'
    1213  object PaintBox1: TPaintBox
  • trunk/UFormMain.pas

    r2 r3  
    1717    procedure FormCreate(Sender: TObject);
    1818    procedure FormDestroy(Sender: TObject);
     19    procedure FormShow(Sender: TObject);
    1920    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
    2021      Shift: TShiftState; X, Y: Integer);
     
    4546procedure TFormMain.PaintBox1Paint(Sender: TObject);
    4647begin
    47   Game.Player.Paint(PaintBox1);
     48  TPlayer(Game.Players[0]).Paint(PaintBox1);
    4849end;
    4950
     
    6263end;
    6364
     65procedure TFormMain.FormShow(Sender: TObject);
     66begin
     67  Game.New;
     68end;
     69
    6470procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
    6571  Shift: TShiftState; X, Y: Integer);
    6672begin
    6773  StartMousePoint := Point(X, Y);
    68   StartViewPoint := Point(Game.Player.View.Left, Game.Player.View.Top);
     74  StartViewPoint := Point(TPlayer(Game.Players[0]).View.Left, TPlayer(Game.Players[0]).View.Top);
    6975  MoveActive := True;
    7076end;
     
    7985begin
    8086  if MoveActive then begin
    81     Game.Player.View := Bounds(StartViewPoint.X + StartMousePoint.X - X,
     87    TPlayer(Game.Players[0]).View := Bounds(StartViewPoint.X + StartMousePoint.X - X,
    8288      StartViewPoint.Y + StartMousePoint.Y - Y,
    83       Game.Player.View.Right - Game.Player.View.Left,
    84       Game.Player.View.Bottom - Game.Player.View.Top);
     89      TPlayer(Game.Players[0]).View.Right - TPlayer(Game.Players[0]).View.Left,
     90      TPlayer(Game.Players[0]).View.Bottom - TPlayer(Game.Players[0]).View.Top);
    8591    PaintBox1.Repaint;
    8692  end;
    87   Caption := IntToStr(Game.Player.View.Right - Game.Player.View.Left);
     93  Caption := IntToStr(TPlayer(Game.Players[0]).View.Right - TPlayer(Game.Players[0]).View.Left);
    8894end;
    8995
  • trunk/UGame.pas

    r2 r3  
    66
    77uses
    8   Classes, SysUtils, ExtCtrls, Graphics;
     8  Classes, SysUtils, ExtCtrls, Graphics, Contnrs;
    99
    1010type
    1111  TGame = class;
     12  TPlayer = class;
    1213
    1314  TFloatPoint = record
     
    1516  end;
    1617
     18  TTerrainType = (ttVoid, ttNormal);
     19
     20  { TCell }
     21
    1722  TCell = class
    18     Visible: Boolean;
    19     BackgroundColor: TColor;
    20     Name: string;
     23    Terrain: TTerrainType;
     24    Power: Integer;
     25    Player: TPlayer;
     26    function GetColor: TColor;
    2127  end;
    2228
     
    2834    procedure Paint(Canvas: TCanvas; Rect: TRect);
    2935    constructor Create;
     36    procedure Init(Size: TPoint);
    3037  end;
    3138
     
    3643    Name: string;
    3744    View: TRect;
     45    Color: TColor;
    3846    procedure Paint(PaintBox: TPaintBox);
    3947  end;
     
    4250
    4351  TGame = class
    44     Player: TPlayer;
     52    Players: TObjectList;
    4553    Map: TMap;
    4654    constructor Create;
    4755    destructor Destroy; override;
     56    procedure New;
    4857  end;
    4958
     
    5564  Result.X := AX;
    5665  Result.Y := AY;
     66end;
     67
     68{ TCell }
     69
     70function TCell.GetColor: TColor;
     71begin
     72  if Assigned(Player) then Result := Player.Color
     73    else Result := clGray;
    5774end;
    5875
     
    7087constructor TGame.Create;
    7188var
     89  Player: TPlayer;
     90begin
     91  Players := TObjectList.Create;
     92  Player := TPlayer.Create;
     93  Player.Game := Self;
     94  Player.Color := clBlue;
     95  Players.Add(Player);
     96  Player := TPlayer.Create;
     97  Player.Game := Self;
     98  Player.Color := clRed;
     99  Players.Add(Player);
     100
     101  Map := TMap.Create;
     102end;
     103
     104destructor TGame.Destroy;
     105begin
     106  FreeAndNil(Players);
     107  FreeAndNil(Map);
     108  inherited Destroy;
     109end;
     110
     111procedure TGame.New;
     112var
    72113  X, Y: Integer;
    73114  NewCell: TCell;
    74   C: Integer;
    75 begin
    76   Player := TPlayer.Create;
    77   Player.Game := Self;
    78   Map := TMap.Create;
    79   SetLength(Map.Cells, 100, 100);
    80   C := 0;
     115  I: Integer;
     116  StartCell: TCell;
     117begin
     118  Map.Init(Point(20, 20));
    81119  for Y := 0 to Length(Map.Cells) - 1 do
    82   for X := 0 to Length(Map.Cells[0]) - 1 do begin
    83     NewCell := TCell.Create;
    84     NewCell.Visible := Boolean(Random(2));
    85     NewCell.Name := IntToStr(C);
    86     Map.Cells[Y, X] := NewCell;
    87     //Map.Cells[Y, X].Color := Boolean(Random(2));
    88     Inc(C);
    89   end;
    90 end;
    91 
    92 destructor TGame.Destroy;
    93 begin
    94   FreeAndNil(Player);
    95   FreeAndNil(Map);
    96   inherited Destroy;
     120  for X := 0 to Length(Map.Cells[0]) - 1 do
     121  with Map.Cells[Y, X] do begin
     122    if Random(2) = 0 then Terrain := ttVoid
     123      else Terrain := ttNormal;
     124    Power := Random(4);
     125  end;
     126  for I := 0 to Players.Count - 1 do
     127  with TPlayer(Players[I]) do begin
     128    StartCell := Map.Cells[Random(Length(Map.Cells)), Random(Length(Map.Cells[0]))];
     129    StartCell.Terrain := ttNormal;
     130    StartCell.Player := TPlayer(Players[I]);
     131  end;
    97132end;
    98133
     
    129164    LineTo(Round(X + 0 * HexSize.X), Round(Y - 0.5 * HexSize.Y));
    130165  *)
     166    Font.Color := clWhite;
    131167    TextOut(Round(X) - TextWidth(Text) div 2, Round(Y) - TextHeight(Text) div 2, Text);
    132168  end;
     
    139175  with Canvas do try
    140176    Lock;
    141     for CY := Trunc(Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) do
    142     for CX := Trunc(Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) do begin
     177    for CY := Trunc(Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) + 1 do
     178    for CX := Trunc(Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) + 1 do begin
    143179      X := CX - Trunc(Rect.Left / CellSize.X);
    144180      Y := CY - Trunc(Rect.Top / CellSize.Y);
     
    148184      end;
    149185      if (CX >= 0) and (CY >= 0) and (CY < Length(Cells)) and (CX < Length(Cells[0])) then
    150       if Cells[CY, CX].Visible then
    151       PaintHexagon(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X,
    152         Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, Cells[CY, CX].Name);
    153       //Break;
     186      if Cells[CY, CX].Terrain = ttNormal then begin
     187        Brush.Color := Cells[CY, CX].GetColor;
     188        PaintHexagon(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X,
     189          Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, IntToStr(Cells[CY, CX].Power));
     190      end;
    154191    end;
    155192  finally
     
    163200end;
    164201
     202procedure TMap.Init(Size: TPoint);
     203var
     204  X, Y: Integer;
     205  NewCell: TCell;
     206  C: Integer;
     207begin
     208  // Free previous
     209  for Y := 0 to Length(Cells) - 1 do
     210  for X := 0 to Length(Cells[0]) - 1 do begin
     211    Cells[Y, X].Destroy;
     212  end;
     213  // Allocate and init new
     214  SetLength(Cells, Size.X, Size.Y);
     215  for Y := 0 to Length(Cells) - 1 do
     216  for X := 0 to Length(Cells[0]) - 1 do begin
     217    NewCell := TCell.Create;
     218    Cells[Y, X] := NewCell;
     219  end;
     220end;
     221
    165222end.
    166223
  • trunk/xtactics.lpi

    r2 r3  
    4343        <IsPartOfProject Value="True"/>
    4444        <ComponentName Value="FormMain"/>
     45        <HasResources Value="True"/>
    4546        <ResourceBaseClass Value="Form"/>
    4647        <UnitName Value="UFormMain"/>
Note: See TracChangeset for help on using the changeset viewer.