Changeset 7

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:

• UFormMain.lfm (modified) (1 diff)
• UFormMain.pas (modified) (8 diffs)
• UGame.pas (modified) (8 diffs)

trunk/UFormMain.lfm

@@ -72 +72 @@
     end
   end
+  object Timer1: TTimer
+    Interval = 20
+    OnTimer = Timer1Timer
+    left = 154
+    top = 263
+  end
 end

trunk/UFormMain.pas

@@ -32 +32 @@
     MenuItem7: TMenuItem;
     PaintBox1: TPaintBox;
+    Timer1: TTimer;
     procedure AExitExecute(Sender: TObject);
     procedure AGameNewExecute(Sender: TObject);
@@ -50 +51 @@
     procedure PaintBox1Paint(Sender: TObject);
     procedure EraseBackground(DC: HDC); override;
+    procedure Timer1Timer(Sender: TObject);
   private
     StartMousePoint: TPoint;
     StartViewPoint: TPoint;
     MoveActive: Boolean;
+    RedrawPending: Boolean;
   public
     Game: TGame;
+    procedure Redraw;
   end;
 
@@ -72 +76 @@
 procedure TFormMain.PaintBox1Paint(Sender: TObject);
 begin
-  TPlayer(Game.Players[0]).Paint(PaintBox1);
+  with TPlayer(Game.Players[0]) do begin
+    View := Bounds(View.Left, View.Top, PaintBox1.Width,
+      PaintBox1.Height);
+    Paint(PaintBox1);
+  end;
 end;
 
 procedure TFormMain.EraseBackground(DC: HDC);
 begin
+end;
+
+procedure TFormMain.Timer1Timer(Sender: TObject);
+begin
+  if RedrawPending then begin
+    RedrawPending := False;
+    PaintBox1.Repaint;
+  end;
+end;
+
+procedure TFormMain.Redraw;
+begin
+  RedrawPending := True;
 end;
 
@@ -95 +116 @@
     FormNew.Save(Game);
     Game.New;
-    PaintBox1.Repaint;
+    Redraw;
   end;
 end;
@@ -116 +137 @@
     StartViewPoint := Point(TPlayer(Game.Players[0]).View.Left, TPlayer(Game.Players[0]).View.Top);
     MoveActive := True;
+    TPlayer(Game.Players[0]).SelectCell(Point(X, Y));
+    Redraw;
   end;
 end;
@@ -133 +156 @@
       TPlayer(Game.Players[0]).View.Bottom - TPlayer(Game.Players[0]).View.Top);
     TPlayer(Game.Players[0]).SelectCell(Point(X, Y));
-    PaintBox1.Repaint;
+    Redraw;
   end;
 end;
@@ -148 +171 @@
   with TPlayer(Game.Players[0]) do
     ViewZoom := ViewZoom / ZoomFactor;
-  PaintBox1.Repaint;
+  Redraw;
 end;
 
@@ -156 +179 @@
   with TPlayer(Game.Players[0]) do
     ViewZoom := ViewZoom * ZoomFactor;
-  PaintBox1.Repaint;
+  Redraw;
 end;
 

trunk/UGame.pas

@@ -15 +15 @@
     X, Y: Double;
   end;
+
+  TPointArray = array of TPoint;
 
   TTerrainType = (ttVoid, ttNormal);
@@ -30 +32 @@
 
   TMap = class
+  private
+  public
     DefaultCellSize: TPoint;
     Cells: array of array of TCell;
-    procedure Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double);
+    function PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double
+      ): TPoint;
+    function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
+    procedure Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
     constructor Create;
     destructor Destroy; override;
@@ -72 +79 @@
 end;
 
+function PtInPoly(const Points: array of TPoint; Pos: TPoint): Boolean;
+var
+  Count, K, J : Integer;
+begin
+  Result := False;
+  Count := Length(Points) ;
+  J := Count - 1;
+  for K := 0 to Count-1 do begin
+  if ((Points[K].Y <= Pos.Y) and (Pos.Y < Points[J].Y)) or
+    ((Points[J].Y <= Pos.Y) and (Pos.Y < Points[K].Y)) then
+    begin
+    if (Pos.X < (Points[j].X - Points[K].X) *
+       (Pos.Y - Points[K].Y) /
+       (Points[j].Y - Points[K].Y) + Points[K].X) then
+        Result := not Result;
+    end;
+    J := K;
+  end;
+end;
+
 { TCell }
 
@@ -84 +111 @@
 procedure TPlayer.SelectCell(Pos: TPoint);
 begin
-
+  SelectedCell := Game.Map.PosToCell(Pos, View, ViewZoom);
 end;
 
 procedure TPlayer.Paint(PaintBox: TPaintBox);
 begin
-  View := Bounds(View.Left, View.Top, PaintBox.Width,
-    PaintBox.Height);
-  Game.Map.Paint(PaintBox.Canvas, View, ViewZoom);
+  Game.Map.Paint(PaintBox.Canvas, View, ViewZoom, SelectedCell);
 end;
 
@@ -150 +175 @@
 { TMap }
 
-procedure TMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double);
+function TMap.GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray;
+var
+  HexShift: TFloatPoint;
+begin
+  HexShift := FloatPoint(0.5 * cos(30 / 180 * Pi), 0.5 * sin(30 / 180 * Pi));
+  SetLength(Result, 6);
+  Result[0] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y - 0.5 * HexSize.Y));
+  Result[1] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
+  Result[2] := Point(Round(Pos.X + HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
+  Result[3] := Point(Round(Pos.X + 0 * HexSize.X), Round(Pos.Y + 0.5 * HexSize.Y));
+  Result[4] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y + HexShift.Y * HexSize.Y));
+  Result[5] := Point(Round(Pos.X - HexShift.X * HexSize.X), Round(Pos.Y - HexShift.Y * HexSize.Y));
+end;
+
+function TMap.PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TPoint;
 var
   CX, CY: Integer;
   X, Y: Double;
-  HexShift: TFloatPoint;
   HexSize: TFloatPoint;
   CellSize: TFloatPoint;
+  Points: array of TPoint;
+begin
+  CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
+  HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
+    for CY := Trunc(Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) + 1 do
+    for CX := Trunc(Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) + 1 do begin
+      X := CX - Trunc(Rect.Left / CellSize.X);
+      Y := CY - Trunc(Rect.Top / CellSize.Y);
+      if (CY and 1) = 1 then begin
+        X := X + 0.5;
+        //Y := Y + 0.5;
+      end;
+      if (CX >= 0) and (CY >= 0) and (CY < Length(Cells)) and (CX < Length(Cells[0])) then
+      if Cells[CY, CX].Terrain = ttNormal then begin
+        Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X),
+          Trunc(Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
+        if PtInPoly(Points, Pos) then begin
+          Result := Point(CX, CY);
+          Exit;
+        end;
+      end;
+    end;
+end;
+
+
+procedure TMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TPoint);
+var
+  CX, CY: Integer;
+  X, Y: Double;
+  HexSize: TFloatPoint;
+  CellSize: TFloatPoint;
 
 procedure PaintHexagon(X, Y: Double; Text: string);
@@ -163 +232 @@
 begin
   with Canvas do begin
-    SetLength(Points, 6);
-    Points[0] := Point(Round(X + 0 * HexSize.X), Round(Y - 0.5 * HexSize.Y));
-    Points[1] := Point(Round(X + HexShift.X * HexSize.X), Round(Y - HexShift.Y * HexSize.Y));
-    Points[2] := Point(Round(X + HexShift.X * HexSize.X), Round(Y + HexShift.Y * HexSize.Y));
-    Points[3] := Point(Round(X + 0 * HexSize.X), Round(Y + 0.5 * HexSize.Y));
-    Points[4] := Point(Round(X - HexShift.X * HexSize.X), Round(Y + HexShift.Y * HexSize.Y));
-    Points[5] := Point(Round(X - HexShift.X * HexSize.X), Round(Y - HexShift.Y * HexSize.Y));
+    Points := GetHexagonPolygon(Point(Trunc(X), Trunc(Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y)));
     Polygon(Points);
-
-  (*
-    MoveTo(Round(X + 0 * HexSize.X), Round(Y - 0.5 * HexSize.Y));
-    LineTo(Round(X + HexShift.X * HexSize.X), Round(Y - HexShift.Y * HexSize.Y));
-    LineTo(Round(X + HexShift.X * HexSize.X), Round(Y + HexShift.Y * HexSize.Y));
-    LineTo(Round(X + 0 * HexSize.X), Round(Y + 0.5 * HexSize.Y));
-    LineTo(Round(X - HexShift.X * HexSize.X), Round(Y + HexShift.Y * HexSize.Y));
-    LineTo(Round(X - HexShift.X * HexSize.X), Round(Y - HexShift.Y * HexSize.Y));
-    LineTo(Round(X + 0 * HexSize.X), Round(Y - 0.5 * HexSize.Y));
-  *)
     Font.Color := clWhite;
     Font.Size := Trunc(12 * Zoom);
@@ -189 +242 @@
 begin
   CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
-  HexShift := FloatPoint(0.5 * cos(30 / 180 * Pi),
-    0.5 * sin(30 / 180 * Pi));
   HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
   with Canvas do try
@@ -204 +255 @@
       if (CX >= 0) and (CY >= 0) and (CY < Length(Cells)) and (CX < Length(Cells[0])) then
       if Cells[CY, CX].Terrain = ttNormal then begin
-        Brush.Color := Cells[CY, CX].GetColor;
+        if (SelectedCell.X = CX) and (SelectedCell.Y = CY) then Brush.Color := clGreen
+          else Brush.Color := Cells[CY, CX].GetColor;
         PaintHexagon(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X,
           Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, IntToStr(Cells[CY, CX].Power));