Changeset 7


Ignore:
Timestamp:
Feb 11, 2014, 11:53:04 PM (11 years ago)
Author:
chronos
Message:
  • Added: Ability to select cell by mouse click.
  • Added: Delayed scene drawing with limited FPS.
Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/UFormMain.lfm

    r6 r7  
    7272    end
    7373  end
     74  object Timer1: TTimer
     75    Interval = 20
     76    OnTimer = Timer1Timer
     77    left = 154
     78    top = 263
     79  end
    7480end
  • trunk/UFormMain.pas

    r6 r7  
    3232    MenuItem7: TMenuItem;
    3333    PaintBox1: TPaintBox;
     34    Timer1: TTimer;
    3435    procedure AExitExecute(Sender: TObject);
    3536    procedure AGameNewExecute(Sender: TObject);
     
    5051    procedure PaintBox1Paint(Sender: TObject);
    5152    procedure EraseBackground(DC: HDC); override;
     53    procedure Timer1Timer(Sender: TObject);
    5254  private
    5355    StartMousePoint: TPoint;
    5456    StartViewPoint: TPoint;
    5557    MoveActive: Boolean;
     58    RedrawPending: Boolean;
    5659  public
    5760    Game: TGame;
     61    procedure Redraw;
    5862  end;
    5963
     
    7276procedure TFormMain.PaintBox1Paint(Sender: TObject);
    7377begin
    74   TPlayer(Game.Players[0]).Paint(PaintBox1);
     78  with TPlayer(Game.Players[0]) do begin
     79    View := Bounds(View.Left, View.Top, PaintBox1.Width,
     80      PaintBox1.Height);
     81    Paint(PaintBox1);
     82  end;
    7583end;
    7684
    7785procedure TFormMain.EraseBackground(DC: HDC);
    7886begin
     87end;
     88
     89procedure TFormMain.Timer1Timer(Sender: TObject);
     90begin
     91  if RedrawPending then begin
     92    RedrawPending := False;
     93    PaintBox1.Repaint;
     94  end;
     95end;
     96
     97procedure TFormMain.Redraw;
     98begin
     99  RedrawPending := True;
    79100end;
    80101
     
    95116    FormNew.Save(Game);
    96117    Game.New;
    97     PaintBox1.Repaint;
     118    Redraw;
    98119  end;
    99120end;
     
    116137    StartViewPoint := Point(TPlayer(Game.Players[0]).View.Left, TPlayer(Game.Players[0]).View.Top);
    117138    MoveActive := True;
     139    TPlayer(Game.Players[0]).SelectCell(Point(X, Y));
     140    Redraw;
    118141  end;
    119142end;
     
    133156      TPlayer(Game.Players[0]).View.Bottom - TPlayer(Game.Players[0]).View.Top);
    134157    TPlayer(Game.Players[0]).SelectCell(Point(X, Y));
    135     PaintBox1.Repaint;
     158    Redraw;
    136159  end;
    137160end;
     
    148171  with TPlayer(Game.Players[0]) do
    149172    ViewZoom := ViewZoom / ZoomFactor;
    150   PaintBox1.Repaint;
     173  Redraw;
    151174end;
    152175
     
    156179  with TPlayer(Game.Players[0]) do
    157180    ViewZoom := ViewZoom * ZoomFactor;
    158   PaintBox1.Repaint;
     181  Redraw;
    159182end;
    160183
  • trunk/UGame.pas

    r6 r7  
    1515    X, Y: Double;
    1616  end;
     17
     18  TPointArray = array of TPoint;
    1719
    1820  TTerrainType = (ttVoid, ttNormal);
     
    3032
    3133  TMap = class
     34  private
     35  public
    3236    DefaultCellSize: TPoint;
    3337    Cells: array of array of TCell;
    34     procedure Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double);
     38    function PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double
     39      ): TPoint;
     40    function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
     41    procedure Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
    3542    constructor Create;
    3643    destructor Destroy; override;
     
    7279end;
    7380
     81function PtInPoly(const Points: array of TPoint; Pos: TPoint): Boolean;
     82var
     83  Count, K, J : Integer;
     84begin
     85  Result := False;
     86  Count := Length(Points) ;
     87  J := Count - 1;
     88  for K := 0 to Count-1 do begin
     89  if ((Points[K].Y <= Pos.Y) and (Pos.Y < Points[J].Y)) or
     90    ((Points[J].Y <= Pos.Y) and (Pos.Y < Points[K].Y)) then
     91    begin
     92    if (Pos.X < (Points[j].X - Points[K].X) *
     93       (Pos.Y - Points[K].Y) /
     94       (Points[j].Y - Points[K].Y) + Points[K].X) then
     95        Result := not Result;
     96    end;
     97    J := K;
     98  end;
     99end;
     100
    74101{ TCell }
    75102
     
    84111procedure TPlayer.SelectCell(Pos: TPoint);
    85112begin
    86 
     113  SelectedCell := Game.Map.PosToCell(Pos, View, ViewZoom);
    87114end;
    88115
    89116procedure TPlayer.Paint(PaintBox: TPaintBox);
    90117begin
    91   View := Bounds(View.Left, View.Top, PaintBox.Width,
    92     PaintBox.Height);
    93   Game.Map.Paint(PaintBox.Canvas, View, ViewZoom);
     118  Game.Map.Paint(PaintBox.Canvas, View, ViewZoom, SelectedCell);
    94119end;
    95120
     
    150175{ TMap }
    151176
    152 procedure TMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double);
     177function TMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
     178var
     179  HexShift: TFloatPoint;
     180begin
     181  HexShift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
     182  SetLength(Result, 6);
     183  Result[0] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y - 0.5 * HexSize.Y));
     184  Result[1] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
     185  Result[2] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
     186  Result[3] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y + 0.5 * HexSize.Y));
     187  Result[4] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
     188  Result[5] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
     189end;
     190
     191function TMap.PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TPoint;
    153192var
    154193  CX, CY: Integer;
    155194  X, Y: Double;
    156   HexShift: TFloatPoint;
    157195  HexSize: TFloatPoint;
    158196  CellSize: TFloatPoint;
     197  Points: array of TPoint;
     198begin
     199  CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
     200  HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
     201    for CY := Trunc(Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) + 1 do
     202    for CX := Trunc(Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) + 1 do begin
     203      X := CX - Trunc(Rect.Left / CellSize.X);
     204      Y := CY - Trunc(Rect.Top / CellSize.Y);
     205      if (CY and 1) = 1 then begin
     206        X := X + 0.5;
     207        //Y := Y + 0.5;
     208      end;
     209      if (CX >= 0) and (CY >= 0) and (CY < Length(Cells)) and (CX < Length(Cells[0])) then
     210      if Cells[CY, CX].Terrain = ttNormal then begin
     211        Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X),
     212          Trunc(Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
     213        if PtInPoly(Points, Pos) then begin
     214          Result := Point(CX, CY);
     215          Exit;
     216        end;
     217      end;
     218    end;
     219end;
     220
     221
     222procedure TMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
     223var
     224  CX, CY: Integer;
     225  X, Y: Double;
     226  HexSize: TFloatPoint;
     227  CellSize: TFloatPoint;
    159228
    160229procedure PaintHexagon(X, Y: Double; Text: string);
     
    163232begin
    164233  with Canvas do begin
    165     SetLength(Points, 6);
    166     Points[0] := Point(Round(X + 0 * HexSize.X), Round(Y - 0.5 * HexSize.Y));
    167     Points[1] := Point(Round(X + HexShift.X * HexSize.X), Round(Y - HexShift.Y * HexSize.Y));
    168     Points[2] := Point(Round(X + HexShift.X * HexSize.X), Round(Y + HexShift.Y * HexSize.Y));
    169     Points[3] := Point(Round(X + 0 * HexSize.X), Round(Y + 0.5 * HexSize.Y));
    170     Points[4] := Point(Round(X - HexShift.X * HexSize.X), Round(Y + HexShift.Y * HexSize.Y));
    171     Points[5] := Point(Round(X - HexShift.X * HexSize.X), Round(Y - HexShift.Y * HexSize.Y));
     234    Points := GetHexagonPolygon(Point(Trunc(X), Trunc(Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
    172235    Polygon(Points);
    173 
    174   (*
    175     MoveTo(Round(X + 0 * HexSize.X), Round(Y - 0.5 * HexSize.Y));
    176     LineTo(Round(X + HexShift.X * HexSize.X), Round(Y - HexShift.Y * HexSize.Y));
    177     LineTo(Round(X + HexShift.X * HexSize.X), Round(Y + HexShift.Y * HexSize.Y));
    178     LineTo(Round(X + 0 * HexSize.X), Round(Y + 0.5 * HexSize.Y));
    179     LineTo(Round(X - HexShift.X * HexSize.X), Round(Y + HexShift.Y * HexSize.Y));
    180     LineTo(Round(X - HexShift.X * HexSize.X), Round(Y - HexShift.Y * HexSize.Y));
    181     LineTo(Round(X + 0 * HexSize.X), Round(Y - 0.5 * HexSize.Y));
    182   *)
    183236    Font.Color := clWhite;
    184237    Font.Size := Trunc(12 * Zoom);
     
    189242begin
    190243  CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
    191   HexShift := FloatPoint(0.5 * cos(30 / 180 * Pi),
    192     0.5 * sin(30 / 180 * Pi));
    193244  HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
    194245  with Canvas do try
     
    204255      if (CX >= 0) and (CY >= 0) and (CY < Length(Cells)) and (CX < Length(Cells[0])) then
    205256      if Cells[CY, CX].Terrain = ttNormal then begin
    206         Brush.Color := Cells[CY, CX].GetColor;
     257        if (SelectedCell.X = CX) and (SelectedCell.Y = CY) then Brush.Color := clGreen
     258          else Brush.Color := Cells[CY, CX].GetColor;
    207259        PaintHexagon(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X,
    208260          Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, IntToStr(Cells[CY, CX].Power));
Note: See TracChangeset for help on using the changeset viewer.