Changeset 35


Ignore:
Timestamp:
Mar 7, 2014, 11:03:30 PM (11 years ago)
Author:
chronos
Message:
  • Added: Zoom all action to show entire map.
  • Added: Actions Zoom in and Zoom out which keep view center.
  • Fixed: Form resize now keep view center.
  • Modified: Attacking is now using mutiple dice rolls system.
Location:
trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r34 r35  
    108108      end
    109109    end
     110    object MenuItem10: TMenuItem
     111      Caption = 'View'
     112      object MenuItem11: TMenuItem
     113        Action = AZoomAll
     114      end
     115      object MenuItem12: TMenuItem
     116        Action = AZoomIn
     117      end
     118      object MenuItem13: TMenuItem
     119        Action = AZoomOut
     120      end
     121    end
    110122    object MenuItem8: TMenuItem
    111123      Caption = 'Tools'
    … …  
    121133    top = 263
    122134  end
     135  object ActionList1: TActionList
     136    Images = Core.ImageListSmall
     137    left = 280
     138    top = 152
     139    object AZoomIn: TAction
     140      Caption = 'Zoom in'
     141      OnExecute = AZoomInExecute
     142      ShortCut = 16491
     143    end
     144    object AZoomOut: TAction
     145      Caption = 'Zoom out'
     146      OnExecute = AZoomOutExecute
     147      ShortCut = 16493
     148    end
     149    object AZoomAll: TAction
     150      Caption = 'Zoom all'
     151      OnExecute = AZoomAllExecute
     152      ShortCut = 16449
     153    end
     154  end
    123155end

  • trunk/Forms/UFormMain.lrt

    r34 r35  
    22TFORMMAIN.MENUITEM1.CAPTION=Game
    33TFORMMAIN.MENUITEM5.CAPTION=-
     4TFORMMAIN.MENUITEM10.CAPTION=View
    45TFORMMAIN.MENUITEM8.CAPTION=Tools
     6TFORMMAIN.AZOOMIN.CAPTION=Zoom in
     7TFORMMAIN.AZOOMOUT.CAPTION=Zoom out
     8TFORMMAIN.AZOOMALL.CAPTION=Zoom all

  • trunk/Forms/UFormMain.pas

    r34 r35  
    1717
    1818  TFormMain = class(TForm)
     19    AZoomIn: TAction;
     20    AZoomAll: TAction;
     21    AZoomOut: TAction;
     22    ActionList1: TActionList;
    1923    MainMenu1: TMainMenu;
    2024    MenuItem1: TMenuItem;
     25    MenuItem10: TMenuItem;
     26    MenuItem11: TMenuItem;
     27    MenuItem12: TMenuItem;
     28    MenuItem13: TMenuItem;
    2129    MenuItem2: TMenuItem;
    2230    MenuItem3: TMenuItem;
    … …  
    3644    ToolButton4: TToolButton;
    3745    ToolButton5: TToolButton;
     46    procedure AZoomAllExecute(Sender: TObject);
     47    procedure AZoomInExecute(Sender: TObject);
     48    procedure AZoomOutExecute(Sender: TObject);
    3849    procedure FormActivate(Sender: TObject);
    3950    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    … …  
    136147end;
    137148
     149procedure TFormMain.AZoomAllExecute(Sender: TObject);
     150var
     151  Factor: TFloatPoint;
     152  MapRect: TRect;
     153begin
     154  with Core.Game, CurrentPlayer, View do begin
     155    MapRect := Map.GetPixelRect;
     156    Factor := FloatPoint((DestRect.Right - DestRect.Left) / (MapRect.Right - MapRect.Left),
     157      (DestRect.Bottom - DestRect.Top) / (MapRect.Bottom - MapRect.Top));
     158    if Factor.X < Factor.Y then Zoom := Factor.X
     159      else Zoom := Factor.Y;
     160    CenterMap;
     161  end;
     162  Redraw;
     163end;
     164
     165procedure TFormMain.AZoomInExecute(Sender: TObject);
     166begin
     167  with Core.Game.CurrentPlayer do begin
     168    View.Zoom := View.Zoom * ZoomFactor;
     169  end;
     170  Redraw;
     171end;
     172
     173procedure TFormMain.AZoomOutExecute(Sender: TObject);
     174var
     175  D: TPoint;
     176begin
     177  with Core.Game.CurrentPlayer do begin
     178    //D := Point(Trunc(MousePos.X - View.Left / ViewZoom),
     179    //  Trunc(MousePos.Y - View.Top / ViewZoom));
     180    View.Zoom := View.Zoom / ZoomFactor;
     181    //View := Bounds(Trunc((D.X - MousePos.X) * ViewZoom),
     182    //  Trunc((D.Y - MousePos.Y) * ViewZoom),
     183    //  View.Right - View.Left,
     184    //  View.Bottom - View.Top);
     185  end;
     186  Redraw;
     187end;
     188
    138189procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
    139190begin
    … …  
    172223  Cell: TCell;
    173224  OldCell: TCell;
     225  CellPos: TPoint;
    174226begin
    175227  if Assigned(Core.Game.CurrentPlayer) then begin
    … …  
    195247      StatusBar1.Panels[0].Text := '';
    196248    end;
     249    CellPos := Core.Game.CurrentPlayer.View.CanvasToCellPos(Point(X, Y));
     250    StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y);
    197251    if Cell <> OldCell then Redraw;
    198252  end else StatusBar1.Panels[0].Text := '';
    … …  
    213267procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
    214268  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    215 var
    216   D: TPoint;
    217 begin
    218   with Core.Game.CurrentPlayer do begin
    219     //D := Point(Trunc(MousePos.X - View.Left / ViewZoom),
    220     //  Trunc(MousePos.Y - View.Top / ViewZoom));
    221     View.Zoom := View.Zoom / ZoomFactor;
    222     //View := Bounds(Trunc((D.X - MousePos.X) * ViewZoom),
    223     //  Trunc((D.Y - MousePos.Y) * ViewZoom),
    224     //  View.Right - View.Left,
    225     //  View.Bottom - View.Top);
    226   end;
    227   Redraw;
     269begin
     270  AZoomOut.Execute;
    228271end;
    229272
    … …  
    231274  MousePos: TPoint; var Handled: Boolean);
    232275begin
    233   with Core.Game.CurrentPlayer do
    234     View.Zoom := View.Zoom * ZoomFactor;
    235   Redraw;
     276  AZoomIn.Execute;
    236277end;
    237278

  • trunk/Languages/xtactics.cs.po

    r34 r35  
    6666msgstr ""
    6767
     68#: tformmain.azoomall.caption
     69msgid "Zoom all"
     70msgstr ""
     71
     72#: tformmain.azoomin.caption
     73msgid "Zoom in"
     74msgstr ""
     75
     76#: tformmain.azoomout.caption
     77msgid "Zoom out"
     78msgstr ""
     79
    6880#: tformmain.caption
    6981msgid "xTactics"
    … …  
    7385msgid "Game"
    7486msgstr "Hra"
     87
     88#: tformmain.menuitem10.caption
     89msgid "View"
     90msgstr ""
    7591
    7692#: tformmain.menuitem5.caption

  • trunk/Languages/xtactics.po

    r34 r35  
    5757msgstr ""
    5858
     59#: tformmain.azoomall.caption
     60msgid "Zoom all"
     61msgstr ""
     62
     63#: tformmain.azoomin.caption
     64msgid "Zoom in"
     65msgstr ""
     66
     67#: tformmain.azoomout.caption
     68msgid "Zoom out"
     69msgstr ""
     70
    5971#: tformmain.caption
    6072msgid "xTactics"
    … …  
    6375#: tformmain.menuitem1.caption
    6476msgid "Game"
     77msgstr ""
     78
     79#: tformmain.menuitem10.caption
     80msgid "View"
    6581msgstr ""
    6682

  • trunk/UGame.pas

    r33 r35  
    6666    destructor Destroy; override;
    6767    procedure SelectCell(Pos: TPoint; Player: TPlayer);
     68    procedure CenterMap;
    6869    function CanvasToCellPos(Pos: TPoint): TPoint;
    6970    function CellToCanvasPos(Pos: TPoint): TPoint;
    … …  
    9697    procedure Grow(APlayer: TPlayer);
    9798    procedure ComputePlayerStats;
    98     function GetPixelSize: TPoint;
     99    function GetPixelRect: TRect;
    99100    property Size: TPoint read FSize write SetSize;
    100101  end;
    … …  
    137138    FCellFrom: TCell;
    138139    FCellTo: TCell;
     140    FDestroying: Boolean;
    139141    procedure SetCellFrom(AValue: TCell);
    140142    procedure SetCellTo(AValue: TCell);
    … …  
    160162    FOnWin: TWinEvent;
    161163    FRunning: Boolean;
     164    procedure Attack(var AttackPower, DefendPower: Integer);
    162165    procedure MoveAll(Player: TPlayer);
    163166    procedure ClearMovesFromCell(Cell: TCell);
    … …  
    195198
    196199procedure InitStrings;
     200function FloatPoint(AX, AY: Double): TFloatPoint;
    197201
    198202
    … …  
    295299
    296300destructor TMove.Destroy;
     301var
     302  LastState: Boolean;
    297303begin
    298304  CellFrom := nil;
    299305  CellTo := nil;
    300   if Assigned(List) then
    301     List.Remove(Self);
     306  if Assigned(List) then begin
     307    // To remove itself from list we need disable owning to not be called twice
     308    try
     309      LastState := List.OwnsObjects;
     310      List.OwnsObjects := False;
     311      List.Remove(Self);
     312    finally
     313      List.OwnsObjects := LastState;
     314    end;
     315  end;
    302316  inherited Destroy;
    303317end;
    … …  
    306320
    307321procedure TView.SetZoom(AValue: Double);
     322var
     323  OldSourceRect: TRect;
    308324begin
    309325  if FZoom = AValue then Exit;
    310326  FZoom := AValue;
    311   SourceRect := Bounds(SourceRect.Left, SourceRect.Top,
     327  SourceRect := Bounds(Trunc(SourceRect.Left + (SourceRect.Right - SourceRect.Left) div 2 - (DestRect.Right - DestRect.Left) / Zoom / 2),
     328    Trunc(SourceRect.Top +  (SourceRect.Bottom - SourceRect.Top) div 2 - (DestRect.Bottom - DestRect.Top) / Zoom / 2),
    312329    Trunc((DestRect.Right - DestRect.Left) / Zoom),
    313330    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
    … …  
    321338
    322339procedure TView.SetDestRect(AValue: TRect);
     340var
     341  Diff: TPoint;
    323342begin
    324343  if RectEquals(FDestRect, AValue) then Exit;
     344  Diff := Point(Trunc((DestRect.Right - DestRect.Left) / Zoom - (AValue.Right - AValue.Left) / Zoom) div 2,
     345    Trunc((DestRect.Bottom - DestRect.Top) / Zoom - (AValue.Bottom - AValue.Top) / Zoom) div 2);
    325346  FDestRect := AValue;
    326   SourceRect := Bounds(SourceRect.Left, SourceRect.Top,
     347  SourceRect := Bounds(SourceRect.Left + Diff.X, SourceRect.Top + Diff.Y,
    327348    Trunc((DestRect.Right - DestRect.Left) / Zoom),
    328349    Trunc((DestRect.Bottom - DestRect.Top) / Zoom));
    … …  
    360381constructor TCell.Create;
    361382begin
     383  Player := nil;
    362384  MovesFrom := TObjectList.Create;
    363385  MovesFrom.OwnsObjects := False;
    … …  
    499521end;
    500522
     523procedure TView.CenterMap;
     524var
     525  MapRect: TRect;
     526begin
     527  MapRect := Game.Map.GetPixelRect;
     528  SourceRect := Bounds(MapRect.Left + (MapRect.Right - MapRect.Left) div 2 - (SourceRect.Right - SourceRect.Left) div 2,
     529    MapRect.Top + (MapRect.Bottom - MapRect.Top) div 2 - (SourceRect.Bottom - SourceRect.Top) div 2,
     530    SourceRect.Right - SourceRect.Left,
     531    SourceRect.Bottom - SourceRect.Top);
     532end;
     533
    501534procedure TPlayer.Paint(PaintBox: TPaintBox);
    502535begin
    … …  
    530563{ TGame }
    531564
     565procedure TGame.Attack(var AttackPower, DefendPower: Integer);
     566var
     567  AttackerRoll: Integer;
     568  DefenderRoll: Integer;
     569begin
     570  while (AttackPower > 0) and (DefendPower > 0) do begin
     571    // Earch side do dice roll and compare result. Defender wins tie
     572    AttackerRoll := Random(6);
     573    DefenderRoll := Random(6);
     574    if AttackerRoll > DefenderRoll then Dec(DefendPower)
     575      else Dec(AttackPower);
     576  end;
     577end;
     578
    532579procedure TGame.MoveAll(Player: TPlayer);
    533580var
    534581  I: Integer;
     582  Remain: Integer;
     583  AttackerPower: Integer;
     584  DefenderPower: Integer;
    535585begin
    536586  I := 0;
    … …  
    542592        CellTo.Power := CellTo.Power + CountOnce;
    543593      end else begin
    544         // Fight
    545         //NewPower := CellTo.Power - Trunc(CountOnce / CellTo.Power);
    546         if CellTo.Power > CountOnce then begin
    547           // Defender wins
    548           CellTo.Power := CellTo.Power - CountOnce;
    549         end else begin
    550           // Attacker wins
    551           CellTo.Power := CountOnce - CellTo.Power;
     594        AttackerPower := CountOnce;
     595        DefenderPower := CellTo.Power;
     596        Attack(AttackerPower, DefenderPower);
     597        if DefenderPower = 0 then begin
     598          // Attacker wins with possible loses
     599          ClearMovesFromCell(CellTo);
    552600          CellTo.Player := Player;
    553           ClearMovesFromCell(CellTo);
    554         end;
     601          CellTo.Power := AttackerPower;
     602        end else
     603        if AttackerPower = 0 then begin
     604          // Defender wins with possible loses
     605          CellTo.Power := DefenderPower;
     606        end else
     607          raise Exception.Create('Unfinished battle');
    555608      end;
    556609      CellFrom.Power := CellFrom.Power - CountOnce;
    … …  
    764817    end;
    765818    View.Zoom := 1;
    766     // Center board
    767     View.SourceRect.TopLeft := Point(Trunc(Map.GetPixelSize.X div 2 - (View.SourceRect.Right - View.SourceRect.Left) div 2 / View.Zoom),
    768       Trunc(Map.GetPixelSize.Y div 2 - (View.SourceRect.Bottom - View.SourceRect.Top) div 2 / View.Zoom));
     819    View.CenterMap;
    769820  end;
    770821  CurrentPlayer := TPlayer(Players[0]);
    … …  
    873924  Points: array of TPoint;
    874925begin
    875   with View do begin
    876926  CellSize := FloatPoint(DefaultCellSize.X / CellMulX, DefaultCellSize.Y / CellMulY);
    877927  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
    … …  
    885935  Result.X := Trunc(X * CellSize.X);
    886936  Result.Y := Trunc(Y * CellSize.Y);
    887   end;
    888937end;
    889938
    … …  
    10081057      Player.TotalCells := Player.TotalCells + 1;
    10091058      Player.TotalUnits := Player.TotalUnits + Power;
    1010 
    1011     end;
    1012   end;
    1013 end;
    1014 
    1015 function THexMap.GetPixelSize: TPoint;
    1016 begin
    1017   Result := Point(Size.X * DefaultCellSize.X, Size.Y * DefaultCellSize.Y);
     1059    end;
     1060  end;
     1061end;
     1062
     1063function THexMap.GetPixelRect: TRect;
     1064begin
     1065  Result := Bounds(Trunc(-0.5 * DefaultCellSize.X),
     1066    Trunc(-0.5 * DefaultCellSize.Y),
     1067    Trunc((Size.X + 0.5) * DefaultCellSize.X),
     1068    Trunc(((Size.Y + 0.5) * 0.78) * DefaultCellSize.Y));
    10181069end;
    10191070
Note: See TracChangeset for help on using the changeset viewer.