Changeset 237 for trunk

Timestamp:

Sep 20, 2018, 4:39:37 PM (6 years ago)

Author:

chronos

Message:

• Modified: Drawing parts split to separate methods.
• Fixed: Draw correctly unit move arrows across map boundaries in cyclic mode.

Location:

trunk

Files:

• Forms/UFormClient.pas (modified) (1 diff)
• UClientGUI.pas (modified) (4 diffs)

trunk/Forms/UFormClient.pas

@@ -217 +217 @@
           end;
         end;
+        for Y := 0 to CountP.Y do begin
+          for X := 0 to CountP.X do begin
+            TempView.Assign(View);
+            TempView.DestRect := TRect.Create(
+              TPoint.Create(
+                -StartP.X + R.Size.X * X,
+                -StartP.Y + R.Size.Y * Y
+              ),
+              TPoint.Create(
+                -StartP.X + R.Size.X * X + View.DestRect.Size.X,
+                -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
+              )
+            );
+            Client.DrawArrows(PaintBox1.Canvas, TempView);
+          end;
+        end;
         TempView.Free;
       end else
       Client.Paint(PaintBox1.Canvas, View);
+      Client.DrawArrows(PaintBox1.Canvas, View);
     end;
   end;

trunk/UClientGUI.pas

@@ -50 +50 @@
     procedure PaintMapCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
       Cell: TCell);
+    procedure DrawArrows(Canvas: TCanvas; View: TView);
+    procedure DrawCells(Canvas: TCanvas; View: TView);
+    procedure DrawCellLinks(Canvas: TCanvas; View: TView);
+    procedure DrawNeighborLinks(Canvas: TCanvas; View: TView);
     procedure Paint(Canvas: TCanvas; View: TView);
     constructor Create; override;
@@ -64 +68 @@
 
 procedure TClientGUI.Paint(Canvas: TCanvas; View: TView);
+begin
+  DrawCellLinks(Canvas, View);
+  DrawCells(Canvas, View);
+  if TGame(Game).DevelMode then DrawNeighborLinks(Canvas, View);
+  //DrawArrows(Canvas, View);
+end;
+
+constructor TClientGUI.Create;
+begin
+  inherited;
+  View := TView.Create;
+end;
+
+destructor TClientGUI.Destroy;
+begin
+  FreeAndNil(View);
+  inherited Destroy;
+end;
+
+procedure TClientGUI.SetGame(AValue: TGame);
+begin
+  inherited;
+  View.Game := AValue;
+end;
+
+procedure TClientGUI.PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string;
+  View: TView; Cell: TPlayerCell);
 var
   I: Integer;
-  Cell: TPlayerCell;
-  MapCell: TCell;
+  TextPos: TPoint;
+  Points: array of Classes.TPoint;
+  TextSize: TSize;
+begin
+  if Cell.MapCell.Extra = etObjectiveTarget then begin
+    Text := Text + '!';
+  end;
+  with Canvas do begin
+    if Assigned(View.FocusedCell) and (View.FocusedCell = Cell) then begin
+      Pen.Color := clYellow;
+      Pen.Style := psSolid;
+      Pen.Width := 1;
+    end else
+    if Cell.MapCell.Terrain = ttCity then begin
+      // Cannot set clear border as it will display shifted on gtk2
+      //Pen.Style := psClear;
+      Pen.Color := clBlack;
+      Pen.Style := psSolid;
+      Pen.Width := 3;
+    end else begin
+      // Cannot set clear border as it will display shifted on gtk2
+      //Pen.Style := psClear;
+      Pen.Color := Brush.Color;
+      Pen.Style := psSolid;
+      Pen.Width := 0;
+    end;
+    // Transform view
+    SetLength(Points, Length(Cell.MapCell.Polygon.Points));
+    for I := 0 to Length(Points) - 1 do
+      Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.Polygon.Points[I]));
+    Brush.Style := bsSolid;
+    //Polygon(Points, False, 0, Length(Points));
+    TCanvasEx.PolygonEx(Canvas, Points, False);
+    //MoveTo(Points[0].X, Points[0].Y);
+    //LineTo(Points[1].X, Points[1].Y);
+
+    // Show cell text
+    if (Cell.GetAvialPower <> 0) or (Cell.MapCell.Extra = etObjectiveTarget) then begin
+      Pen.Style := psSolid;
+      Font.Color := clWhite;
+      Brush.Style := bsClear;
+      Font.Size := Trunc(42 * View.Zoom);
+      TextPos := View.CellToCanvasPos(Pos);
+      TextSize := TextExtent(Text);
+      TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
+        Round(TextPos.Y) - TextSize.cy div 2, Text, False);
+    end;
+  end;
+end;
+
+procedure TClientGUI.PaintMapCell(Canvas: TCanvas; Pos: TPoint; Text: string;
+  View: TView; Cell: TCell);
+var
+  I: Integer;
+  TextPos: TPoint;
+  Points: array of Classes.TPoint;
+  TextSize: TSize;
+begin
+  if Cell.Extra = etObjectiveTarget then begin
+    Text := Text + '!';
+  end;
+  with Canvas do begin
+    if Assigned(View.FocusedCell) and (View.FocusedCell.MapCell = Cell) then begin
+      Pen.Color := clYellow;
+      Pen.Style := psSolid;
+      Pen.Width := 1;
+    end else
+    if Cell.Terrain = ttCity then begin
+      // Cannot set clear border as it will display shifted on gtk2
+      //Pen.Style := psClear;
+      Pen.Color := clBlack;
+      Pen.Style := psSolid;
+      Pen.Width := 3;
+    end else begin
+      // Cannot set clear border as it will display shifted on gtk2
+      //Pen.Style := psClear;
+      Pen.Color := Brush.Color;
+      Pen.Style := psSolid;
+      Pen.Width := 0;
+    end;
+    // Transform view
+    SetLength(Points, Length(Cell.Polygon.Points));
+    for I := 0 to Length(Points) - 1 do
+      Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.Polygon.Points[I]));
+    Brush.Style := bsSolid;
+    //Polygon(Points, False, 0, Length(Points));
+    TCanvasEx.PolygonEx(Canvas, Points, False);
+    //MoveTo(Points[0].X, Points[0].Y);
+    //LineTo(Points[1].X, Points[1].Y);
+
+    // Show cell text
+    if (Cell.Power <> 0) or (Cell.Extra = etObjectiveTarget) then begin
+      Pen.Style := psSolid;
+      Font.Color := clWhite;
+      Brush.Style := bsClear;
+      Font.Size := Trunc(42 * View.Zoom);
+      TextPos := View.CellToCanvasPos(Pos);
+      TextSize := TextExtent(Text);
+      TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
+        Round(TextPos.Y) - TextSize.cy div 2, Text, False);
+    end;
+  end;
+end;
+
+procedure TClientGUI.DrawArrows(Canvas: TCanvas; View: TView);
+var
   PosFrom, PosTo: TPoint;
   Angle: Double;
   ArrowCenter: TPoint;
   Move: TUnitMove;
+  P: TPoint;
+begin
+  with Canvas, View do begin
+    Pen.Color := clCream;
+    if Assigned(ControlPlayer) then
+    for Move in ControlPlayer.Moves do begin
+      PosFrom := TGame(Game).Map.CellToPos(Move.CellFrom.MapCell);
+      PosTo := TGame(Game).Map.CellToPos(Move.CellTo.MapCell);
+      if TGame(Game).Map.Cyclic then begin
+        P := TPoint.Create(PosTo.X + TGame(Game).Map.PixelRect.Size.X,
+          PosTo.Y);
+        if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
+          PosTo := TPoint.Create(P.X, PosTo.Y);
+        P := TPoint.Create(PosTo.X, PosTo.Y + TGame(Game).Map.PixelRect.Size.Y);
+        if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
+          PosTo := TPoint.Create(PosTo.X, P.Y);
+        P := TPoint.Create(PosTo.X - TGame(Game).Map.PixelRect.Size.X,
+          PosTo.Y);
+        if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
+          PosTo := TPoint.Create(P.X, PosTo.Y);
+        P := TPoint.Create(PosTo.X, PosTo.Y - TGame(Game).Map.PixelRect.Size.Y);
+        if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
+          PosTo := TPoint.Create(PosTo.X, P.Y);
+      end;
+      // In Fog of war mode show only
+      if TGame(Game).FogOfWar and not ControlPlayer.PlayerMap.Cells.SearchCell(Move.CellFrom.MapCell).InVisibleRange and
+        not ControlPlayer.PlayerMap.Cells.SearchCell(Move.CellTo.MapCell).InVisibleRange then
+        Continue;
+      if Move.CountRepeat > 0 then Pen.Width := 2
+        else Pen.Width := 1;
+      Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
+      if (Angle > +Pi) or (Angle < -Pi) then
+        raise Exception.Create(Format(SWrongArrowAngle, [FloatToStr(Angle)]));
+
+      if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
+      ArrowCenter := View.CellToCanvasPos(TPoint.Create(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
+        Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2)));
+      TGame(Game).Map.DrawArrow(Canvas, ArrowCenter,
+        Angle, IntToStr(Move.CountOnce), View.Zoom);
+    end;
+  end;
+end;
+
+procedure TClientGUI.DrawCells(Canvas: TCanvas; View: TView);
+var
+  Cell: TPlayerCell;
+  MapCell: TCell;
   CellText: string;
-  CellLink: TCellLink;
-  NeighCell: TCell;
-begin
-  with Canvas, View do
-  try
-    Lock;
-    // Draw cell links
-    Pen.Color := clBlack;
-    Pen.Style := psSolid;
-    Pen.Width := 3;
-    for CellLink in TGame(Game).Map.CellLinks do
-    with CellLink do begin
-      if Length(Points) >= 2 then begin
-        MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));
-        for I := 1 to Length(Points) - 1 do
-          LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));
-      end;
-    end;
-
-    // Draw cells
+begin
+  with Canvas, View do begin
     if Assigned(ControlPlayer) then begin
       for Cell in ControlPlayer.PlayerMap.Cells do begin
@@ -132 +296 @@
       end;
     end;
-
-    // Draw links to neighbors
-    if TGame(Game).DevelMode then
+  end;
+end;
+
+procedure TClientGUI.DrawCellLinks(Canvas: TCanvas; View: TView);
+var
+  I: Integer;
+  CellLink: TCellLink;
+begin
+  with Canvas, View do begin
+    Pen.Color := clBlack;
+    Pen.Style := psSolid;
+    Pen.Width := 3;
+    for CellLink in TGame(Game).Map.CellLinks do
+    with CellLink do begin
+      if Length(Points) >= 2 then begin
+        MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));
+        for I := 1 to Length(Points) - 1 do
+          LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));
+      end;
+    end;
+  end;
+end;
+
+procedure TClientGUI.DrawNeighborLinks(Canvas: TCanvas; View: TView);
+var
+  Cell: TPlayerCell;
+  C: TCell;
+begin
+  with Canvas, View do begin
     for Cell in ControlPlayer.PlayerMap.Cells do begin
-      for NeighCell in Cell.MapCell.Neighbors do begin
+      for C in Cell.MapCell.Neighbors do begin
         Pen.Color := clYellow;
         MoveTo(PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.PosPx)));
-        LineTo(PointToStdPoint(View.CellToCanvasPos(NeighCell.PosPx)));
+        LineTo(PointToStdPoint(View.CellToCanvasPos(C.PosPx)));
       end;
 
@@ -146 +336 @@
       TextOut(View.CellToCanvasPos(Cell.MapCell.PosPx).X,
         View.CellToCanvasPos(Cell.MapCell.PosPx).Y, IntToStr(Cell.MapCell.Id));
-    end;
-
-    // Draw arrows
-    Pen.Color := clCream;
-    if Assigned(ControlPlayer) then
-    for Move in ControlPlayer.Moves do begin
-      PosFrom := TGame(Game).Map.CellToPos(Move.CellFrom.MapCell);
-      PosTo := TGame(Game).Map.CellToPos(Move.CellTo.MapCell);
-      // In Fog of war mode show only
-      if TGame(Game).FogOfWar and not ControlPlayer.PlayerMap.Cells.SearchCell(Move.CellFrom.MapCell).InVisibleRange and
-        not ControlPlayer.PlayerMap.Cells.SearchCell(Move.CellTo.MapCell).InVisibleRange then
-        Continue;
-      if Move.CountRepeat > 0 then Pen.Width := 2
-        else Pen.Width := 1;
-      Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
-      if (Angle > +Pi) or (Angle < -Pi) then
-        raise Exception.Create(Format(SWrongArrowAngle, [FloatToStr(Angle)]));
-
-      if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
-      ArrowCenter := View.CellToCanvasPos(TPoint.Create(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
-        Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2)));
-      TGame(Game).Map.DrawArrow(Canvas, ArrowCenter,
-        Angle, IntToStr(Move.CountOnce), View.Zoom);
-    end;
-  finally
-    Unlock;
-  end;
-end;
-
-constructor TClientGUI.Create;
-begin
-  inherited;
-  View := TView.Create;
-end;
-
-destructor TClientGUI.Destroy;
-begin
-  FreeAndNil(View);
-  inherited Destroy;
-end;
-
-procedure TClientGUI.SetGame(AValue: TGame);
-begin
-  inherited;
-  View.Game := AValue;
-end;
-
-procedure TClientGUI.PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string;
-  View: TView; Cell: TPlayerCell);
-var
-  I: Integer;
-  TextPos: TPoint;
-  Points: array of Classes.TPoint;
-  TextSize: TSize;
-begin
-  if Cell.MapCell.Extra = etObjectiveTarget then begin
-    Text := Text + '!';
-  end;
-  with Canvas do begin
-    if Assigned(View.FocusedCell) and (View.FocusedCell = Cell) then begin
-      Pen.Color := clYellow;
-      Pen.Style := psSolid;
-      Pen.Width := 1;
-    end else
-    if Cell.MapCell.Terrain = ttCity then begin
-      // Cannot set clear border as it will display shifted on gtk2
-      //Pen.Style := psClear;
-      Pen.Color := clBlack;
-      Pen.Style := psSolid;
-      Pen.Width := 3;
-    end else begin
-      // Cannot set clear border as it will display shifted on gtk2
-      //Pen.Style := psClear;
-      Pen.Color := Brush.Color;
-      Pen.Style := psSolid;
-      Pen.Width := 0;
-    end;
-    // Transform view
-    SetLength(Points, Length(Cell.MapCell.Polygon.Points));
-    for I := 0 to Length(Points) - 1 do
-      Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.Polygon.Points[I]));
-    Brush.Style := bsSolid;
-    //Polygon(Points, False, 0, Length(Points));
-    TCanvasEx.PolygonEx(Canvas, Points, False);
-    //MoveTo(Points[0].X, Points[0].Y);
-    //LineTo(Points[1].X, Points[1].Y);
-
-    // Show cell text
-    if (Cell.GetAvialPower <> 0) or (Cell.MapCell.Extra = etObjectiveTarget) then begin
-      Pen.Style := psSolid;
-      Font.Color := clWhite;
-      Brush.Style := bsClear;
-      Font.Size := Trunc(42 * View.Zoom);
-      TextPos := View.CellToCanvasPos(Pos);
-      TextSize := TextExtent(Text);
-      TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
-        Round(TextPos.Y) - TextSize.cy div 2, Text, False);
-    end;
-  end;
-end;
-
-procedure TClientGUI.PaintMapCell(Canvas: TCanvas; Pos: TPoint; Text: string;
-  View: TView; Cell: TCell);
-var
-  I: Integer;
-  TextPos: TPoint;
-  Points: array of Classes.TPoint;
-  TextSize: TSize;
-begin
-  if Cell.Extra = etObjectiveTarget then begin
-    Text := Text + '!';
-  end;
-  with Canvas do begin
-    if Assigned(View.FocusedCell) and (View.FocusedCell.MapCell = Cell) then begin
-      Pen.Color := clYellow;
-      Pen.Style := psSolid;
-      Pen.Width := 1;
-    end else
-    if Cell.Terrain = ttCity then begin
-      // Cannot set clear border as it will display shifted on gtk2
-      //Pen.Style := psClear;
-      Pen.Color := clBlack;
-      Pen.Style := psSolid;
-      Pen.Width := 3;
-    end else begin
-      // Cannot set clear border as it will display shifted on gtk2
-      //Pen.Style := psClear;
-      Pen.Color := Brush.Color;
-      Pen.Style := psSolid;
-      Pen.Width := 0;
-    end;
-    // Transform view
-    SetLength(Points, Length(Cell.Polygon.Points));
-    for I := 0 to Length(Points) - 1 do
-      Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.Polygon.Points[I]));
-    Brush.Style := bsSolid;
-    //Polygon(Points, False, 0, Length(Points));
-    TCanvasEx.PolygonEx(Canvas, Points, False);
-    //MoveTo(Points[0].X, Points[0].Y);
-    //LineTo(Points[1].X, Points[1].Y);
-
-    // Show cell text
-    if (Cell.Power <> 0) or (Cell.Extra = etObjectiveTarget) then begin
-      Pen.Style := psSolid;
-      Font.Color := clWhite;
-      Brush.Style := bsClear;
-      Font.Size := Trunc(42 * View.Zoom);
-      TextPos := View.CellToCanvasPos(Pos);
-      TextSize := TextExtent(Text);
-      TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
-        Round(TextPos.Y) - TextSize.cy div 2, Text, False);
     end;
   end;