Changeset 40


Ignore:
Timestamp:
Mar 11, 2014, 9:09:56 AM (11 years ago)
Author:
chronos
Message:
  • Fixed: Save game settings not only on application exit but also on new game confirmation.
  • Modified: Made moves arrows look like arrow now.
Location:
trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMove.lfm

    r34 r40  
    88  ClientHeight = 240
    99  ClientWidth = 320
     10  OnShow = FormShow
    1011  LCLVersion = '1.3'
    1112  object SpinEditOnce: TSpinEdit

  • trunk/Forms/UFormMove.pas

    r34 r40  
    2222    TrackBarOnce: TTrackBar;
    2323    TrackBarRepeat: TTrackBar;
     24    procedure FormShow(Sender: TObject);
    2425    procedure SpinEditOnceChange(Sender: TObject);
    2526    procedure SpinEditRepeatChange(Sender: TObject);
    … …  
    5960end;
    6061
     62procedure TFormMove.FormShow(Sender: TObject);
     63begin
     64  ButtonOk.SetFocus;
     65end;
     66
    6167procedure TFormMove.SpinEditRepeatChange(Sender: TObject);
    6268begin

  • trunk/Forms/UFormNew.pas

    r39 r40  
    194194  SpinEditMapSizeX.Value := Game.Map.Size.X;
    195195  SpinEditMapSizeY.Value := Game.Map.Size.Y;
     196  TrackBarSizeX.Position := Game.Map.Size.X;
     197  TrackBarSizeY.Position := Game.Map.Size.Y;
    196198  RadioGroupGrowAmount.ItemIndex := Integer(Game.GrowAmount);
    197199  RadioGroupGrowCells.ItemIndex := Integer(Game.GrowCells);

  • trunk/Languages/xtactics.cs.po

    r39 r40  
    288288msgid "You need at least two players"
    289289msgstr "Potřebujete alespoň dva hráče"
     290
     291#: ugame.sunfinishedbattle
     292msgid "Unfinished battle"
     293msgstr ""
     294

  • trunk/Languages/xtactics.po

    r39 r40  
    277277msgstr ""
    278278
     279#: ugame.sunfinishedbattle
     280msgid "Unfinished battle"
     281msgstr ""
     282

  • trunk/UCore.pas

    r39 r40  
    161161begin
    162162  FormSettings.Load;
    163   if FormSettings.ShowModal = mrOk then
     163  if FormSettings.ShowModal = mrOk then begin
    164164    FormSettings.Save;
     165    Game.SaveConfig(XMLConfig1, 'Game');
     166  end;
    165167end;
    166168

  • trunk/UGame.pas

    r39 r40  
    77uses
    88  Classes, SysUtils, ExtCtrls, Graphics, Contnrs, XMLConf, XMLRead, XMLWrite,
    9   DOM;
     9  DOM, Math;
    1010
    1111const
    1212  DefaultPlayerStartUnits = 5;
    13   CellMulX = 1.12;
    14   CellMulY = 1.292;
     13  HexCellMulX = 1.12;
     14  HexCellMulY = 1.292;
     15  SquareCellMulX = 1.1;
     16  SquareCellMulY = 1.1;
    1517  MaxPlayerCount = 8;
    1618
    … …  
    8587    MaxPower: Integer;
    8688    DefaultCellSize: TPoint;
     89    procedure DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; Size: TPoint);
    8790    function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual;
    8891    function IsValidIndex(Index: TPoint): Boolean; virtual;
    … …  
    268271  SComputer = 'Computer';
    269272  SCannotSetPlayerStartCells = 'Cannot choose start cell for player';
     273  SUnfinishedBattle = 'Unfinished battle';
    270274
    271275procedure InitStrings;
    … …  
    374378  // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
    375379  Result := nil;
    376   CellSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
     380  CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulX);
    377381  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
    378382  with View do
    … …  
    403407  Points: array of TPoint;
    404408begin
    405   CellSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
     409  CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulX);
    406410  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
    407411  X := Cell.Pos.X;
    … …  
    457461  Cell: TCell;
    458462  PosFrom, PosTo: TPoint;
     463  Angle: Double;
    459464
    460465procedure PaintHexagon(Pos: TPoint; Text: string);
    … …  
    479484      Pen.Width := 0;
    480485    end;
    481     FillRect(Trunc(Pos.X - HexSize.X / 2), Trunc(Pos.Y - HexSize.Y / 2), Trunc(Pos.X + HexSize.X / 2), Trunc(Pos.Y + HexSize.Y / 2));
     486    Rectangle(Trunc(Pos.X - HexSize.X / 2), Trunc(Pos.Y - HexSize.Y / 2), Trunc(Pos.X + HexSize.X / 2), Trunc(Pos.Y + HexSize.Y / 2));
    482487    //Rectangle(Trunc(Pos.X), Trunc(Pos.Y), Trunc(Pos.X + HexSize.X), Trunc(Pos.Y + HexSize.Y));
    483488    Pen.Style := psSolid;
    … …  
    489494
    490495begin
    491   CellSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
     496  CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulY);
    492497  HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);
    493498  CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);
    … …  
    515520            if TMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2
    516521              else Pen.Width := 1;
    517             Line(View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 4),
    518               Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 4))),
    519               View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
    520               Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2))));
     522            Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
     523            if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
     524            DrawArrow(Canvas, View, View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3),
     525              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))),
     526              Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)));
    521527            Pen.Width := 1;
    522528          end;
    … …  
    549555begin
    550556
     557end;
     558
     559procedure TMap.DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; Size: TPoint);
     560var
     561  Points: array of TPoint;
     562  FPoints: array of TFloatPoint;
     563  I: Integer;
     564begin
     565  Canvas.Brush.Color := clWhite;
     566  Canvas.Pen.Color := clBlack;
     567  SetLength(Points, 8);
     568  SetLength(FPoints, 8);
     569  FPoints[0] := FloatPoint(+0.5 * Size.X, +0 * Size.Y);
     570  FPoints[1] := FloatPoint(+0 * Size.X, +0.5 * Size.Y);
     571  FPoints[2] := FloatPoint(+0 * Size.X, +0.25 * Size.Y);
     572  FPoints[3] := FloatPoint(-0.5 * Size.X, +0.25 * Size.Y);
     573  FPoints[4] := FloatPoint(-0.5 * Size.X, -0.25 * Size.Y);
     574  FPoints[5] := FloatPoint(+0 * Size.X, -0.25 * Size.Y);
     575  FPoints[6] := FloatPoint(+0 * Size.X, -0.5 * Size.Y);
     576  FPoints[7] := FloatPoint(+0.5 * Size.X, 0 * Size.Y);
     577  // Rotate
     578  for I := 0 to Length(Points) - 1 do
     579    FPoints[I] := FloatPoint(FPoints[I].X * cos(Angle) - FPoints[I].Y * sin(Angle),
     580      FPoints[I].X * sin(Angle) + FPoints[I].Y * cos(Angle));
     581  // Shift
     582  for I := 0 to Length(Points) - 1 do
     583    Points[I] := Point(Trunc(FPoints[I].X + Pos.X), Trunc(FPoints[I].Y + Pos.Y));
     584  Canvas.Polygon(Points);
    551585end;
    552586
    … …  
    10341068          CellTo.Power := DefenderPower;
    10351069        end else
    1036           raise Exception.Create('Unfinished battle');
     1070          raise Exception.Create(SUnfinishedBattle);
    10371071      end;
    10381072      CellFrom.Power := CellFrom.Power - CountOnce;
    … …  
    14421476  // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm
    14431477  Result := nil;
    1444   CellSize := FloatPoint(DefaultCellSize.X / CellMulX, DefaultCellSize.Y / CellMulY);
     1478  CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);
    14451479  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
    14461480  with View do
    … …  
    14741508  Points: array of TPoint;
    14751509begin
    1476   CellSize := FloatPoint(DefaultCellSize.X / CellMulX, DefaultCellSize.Y / CellMulY);
     1510  CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);
    14771511  HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y);
    14781512  X := Cell.Pos.X;
    … …  
    14981532  Cell: TCell;
    14991533  PosFrom, PosTo: TPoint;
     1534  Angle: Double;
    15001535
    15011536procedure PaintHexagon(Pos: TPoint; Text: string);
    … …  
    15331568
    15341569begin
    1535   CellSize := FloatPoint(DefaultCellSize.X / CellMulX, DefaultCellSize.Y / CellMulY);
     1570  CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);
    15361571  HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);
    15371572  CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);
    1538   with Canvas, View do try
     1573  with Canvas, View do
     1574  try
    15391575    Lock;
    15401576    for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do
    … …  
    15631599            if TMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2
    15641600              else Pen.Width := 1;
    1565             Line(View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 4),
    1566               Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 4))),
    1567               View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
    1568               Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2))));
     1601            Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
     1602            if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
     1603            DrawArrow(Canvas, View, View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3),
     1604              Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))),
     1605              Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)));
    15691606            Pen.Width := 1;
    15701607          end;

  • trunk/xtactics.lpi

    r36 r40  
    130130        <Filename Value="Forms/UFormMove.pas"/>
    131131        <IsPartOfProject Value="True"/>
    132         <HasResources Value="True"/>
     132        <ComponentName Value="FormMove"/>
     133        <HasResources Value="True"/>
     134        <ResourceBaseClass Value="Form"/>
    133135        <UnitName Value="UFormMove"/>
    134136      </Unit6>
Note: See TracChangeset for help on using the changeset viewer.