Changeset 53
- Timestamp:
- Aug 17, 2014, 3:00:30 PM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UGame.pas
r52 r53 20 20 TGame = class; 21 21 TPlayer = class; 22 TView = class; 22 23 23 24 TFloatPoint = record … … 44 45 Neighbors: TObjectList; // TList<TCell> 45 46 procedure Assign(Source: TCell); 47 function IsVisible(View: TView): Boolean; 46 48 function GetColor: TColor; 47 49 function GetAvialPower: Integer; … … 95 97 Cells: TObjectList; // TList<TCell> 96 98 procedure DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; Angle: Double; 97 Size: TPoint;Text: string);99 Text: string); 98 100 function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual; 99 101 function IsValidIndex(Index: TPoint): Boolean; virtual; … … 129 131 function IsValidIndex(Index: TPoint): Boolean; override; 130 132 function GetPixelRect: TRect; override; 131 procedure Paint(Canvas: TCanvas; View: TView); override;132 133 procedure Generate; override; 133 134 constructor Create; override; … … 143 144 function IsValidIndex(Index: TPoint): Boolean; override; 144 145 function GetPixelRect: TRect; override; 145 procedure Paint(Canvas: TCanvas; View: TView); override;146 146 procedure Generate; override; 147 147 constructor Create; override; … … 322 322 end; 323 323 324 function GetPolygonRect(Polygon: array of TPoint): TRect; 325 var 326 I: Integer; 327 begin 328 Result := Rect(High(Integer), High(Integer), 329 Low(Integer), Low(Integer)); 330 for I := 0 to Length(Polygon) - 1 do 331 with Polygon[I] do begin 332 if X > Result.Right then 333 Result.Right := X; 334 if X < Result.Left then 335 Result.Left := X; 336 if Y > Result.Bottom then 337 Result.Bottom := Y; 338 if Y < Result.Top then 339 Result.Top := Y; 340 end; 341 end; 342 324 343 { TSquareMap } 325 344 … … 382 401 end; 383 402 384 procedure TSquareMap.Paint(Canvas: TCanvas; View: TView);385 var386 CX, CY: Integer;387 X, Y: Double;388 CellSizeZoomed: TFloatPoint;389 CellSize: TFloatPoint;390 HexSize: TFloatPoint;391 I: Integer;392 Points: array of TPoint;393 Cell: TCell;394 PosFrom, PosTo: TPoint;395 Angle: Double;396 begin397 CellSize := FloatPoint(DefaultCellSize.X * SquareCellMulX, DefaultCellSize.Y * SquareCellMulY);398 HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);399 CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);400 with Canvas, View do try401 Lock;402 for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do403 for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin404 X := CX;405 Y := CY;406 if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then begin407 Cell := TCell(Cells[CY * FSize.X + CX]);408 if Cell.Terrain <> ttVoid then begin409 if Assigned(SelectedCell) and (SelectedCell = TCell(Cells[CY * FSize.X + CX])) then Brush.Color := clGreen410 else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, TCell(Cells[CY * FSize.X + CX])) then Brush.Color := clPurple411 else Brush.Color := Cell.GetColor;412 Pen.Color := clBlack;413 PaintCell(Canvas, Point(Trunc(X * CellSize.X),414 Trunc(Y * CellSize.Y)),415 IntToStr(Cell.GetAvialPower), View, TCell(Cells[CY * FSize.X + CX]));416 // Draw arrows417 Pen.Color := clCream;418 for I := 0 to Cell.MovesFrom.Count - 1 do begin419 PosFrom := CellToPos(Cell);420 PosTo := CellToPos(TUnitMove(Cell.MovesFrom[I]).CellTo);421 if TUnitMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2422 else Pen.Width := 1;423 Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));424 if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;425 DrawArrow(Canvas, View, View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3),426 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))),427 Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)),428 IntToStr(TUnitMove(Cell.MovesFrom[I]).CountOnce));429 Pen.Width := 1;430 end;431 end;432 end;433 end;434 finally435 Unlock;436 end;437 end;438 439 403 constructor TSquareMap.Create; 440 404 begin … … 463 427 464 428 procedure TMap.DrawArrow(Canvas: TCanvas; View: TView; Pos: TPoint; 465 Angle: Double; Size: TPoint;Text: string);429 Angle: Double; Text: string); 466 430 var 467 431 Points: array of TPoint; 468 432 FPoints: array of TFloatPoint; 469 433 I: Integer; 434 ArrowSize: TPoint; 470 435 begin 471 436 Canvas.Brush.Color := clWhite; … … 473 438 SetLength(Points, 8); 474 439 SetLength(FPoints, 8); 475 FPoints[0] := FloatPoint(+0.5 * Size.X, +0 * Size.Y); 476 FPoints[1] := FloatPoint(+0 * Size.X, +0.5 * Size.Y); 477 FPoints[2] := FloatPoint(+0 * Size.X, +0.25 * Size.Y); 478 FPoints[3] := FloatPoint(-0.5 * Size.X, +0.25 * Size.Y); 479 FPoints[4] := FloatPoint(-0.5 * Size.X, -0.25 * Size.Y); 480 FPoints[5] := FloatPoint(+0 * Size.X, -0.25 * Size.Y); 481 FPoints[6] := FloatPoint(+0 * Size.X, -0.5 * Size.Y); 482 FPoints[7] := FloatPoint(+0.5 * Size.X, 0 * Size.Y); 440 ArrowSize := Point(Trunc(DefaultCellSize.X / 4 * View.Zoom), 441 Trunc(DefaultCellSize.Y / 4* View.Zoom)); 442 FPoints[0] := FloatPoint(+0.5 * ArrowSize.X, +0 * ArrowSize.Y); 443 FPoints[1] := FloatPoint(+0 * ArrowSize.X, +0.5 * ArrowSize.Y); 444 FPoints[2] := FloatPoint(+0 * ArrowSize.X, +0.25 * ArrowSize.Y); 445 FPoints[3] := FloatPoint(-0.5 * ArrowSize.X, +0.25 * ArrowSize.Y); 446 FPoints[4] := FloatPoint(-0.5 * ArrowSize.X, -0.25 * ArrowSize.Y); 447 FPoints[5] := FloatPoint(+0 * ArrowSize.X, -0.25 * ArrowSize.Y); 448 FPoints[6] := FloatPoint(+0 * ArrowSize.X, -0.5 * ArrowSize.Y); 449 FPoints[7] := FloatPoint(+0.5 * ArrowSize.X, 0 * ArrowSize.Y); 483 450 // Rotate 484 451 for I := 0 to Length(Points) - 1 do 485 FPoints[I] := FloatPoint(FPoints[I].X * cos(Angle) - FPoints[I].Y * sin(Angle),486 FPoints[I].X * sin(Angle) + FPoints[I].Y * cos(Angle));452 FPoints[I] := FloatPoint(FPoints[I].X * Cos(Angle) - FPoints[I].Y * Sin(Angle), 453 FPoints[I].X * Sin(Angle) + FPoints[I].Y * Cos(Angle)); 487 454 // Shift 488 455 for I := 0 to Length(Points) - 1 do … … 520 487 521 488 // Copy all cells 489 (* 522 490 Cells.Count := 0; 523 491 Cells.Count := Source.Cells.Count; … … 526 494 TCell(Cells[I]).Assign(TCell(Source.Cells[I])); 527 495 end; 496 *) 528 497 end; 529 498 … … 679 648 end; 680 649 681 procedure TMap.Paint(Canvas: TCanvas; View: TView);682 begin683 684 end;685 686 650 function TMap.GetPixelRect: TRect; 687 651 var … … 773 737 774 738 procedure TView.SetZoom(AValue: Double); 775 var776 OldSourceRect: TRect;777 739 begin 778 740 if FZoom = AValue then Exit; … … 830 792 Polygon := Source.Polygon; 831 793 // TODO: How to copy neighbours and moves list 794 end; 795 796 function TCell.IsVisible(View: TView): Boolean; 797 var 798 RectA, RectB: TRect; 799 begin 800 RectA := GetPolygonRect(Polygon); 801 RectB := View.SourceRect; 802 Result := ((RectA.Left < RectB.Right) and (RectA.Right > RectB.Left) and 803 (RectA.Top < RectB.Bottom) and (RectA.Bottom > RectB.Top)); 832 804 end; 833 805 … … 1505 1477 end; 1506 1478 1507 procedure THexMap.Paint(Canvas: TCanvas; View: TView); 1508 var 1509 CX, CY: Integer; 1510 X, Y: Double; 1511 CellSizeZoomed: TFloatPoint; 1512 CellSize: TFloatPoint; 1513 HexSize: TFloatPoint; 1514 I: Integer; 1515 Points: array of TPoint; 1479 procedure TMap.Paint(Canvas: TCanvas; View: TView); 1480 var 1481 I: Integer; 1482 C: Integer; 1516 1483 Cell: TCell; 1517 1484 PosFrom, PosTo: TPoint; … … 1519 1486 ArrowCenter: TPoint; 1520 1487 begin 1521 CellSize := FloatPoint(DefaultCellSize.X / HexCellMulX, DefaultCellSize.Y / HexCellMulY);1522 HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom);1523 CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom);1524 1488 with Canvas, View do 1525 1489 try 1526 1490 Lock; 1527 for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do 1528 for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin 1529 X := CX; 1530 Y := CY; 1531 if (CY and 1) = 1 then begin 1532 X := X + 0.5; 1533 //Y := Y + 0.5; 1534 end; 1535 if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then begin 1536 Cell := TCell(Cells[CY * FSize.X + CX]); 1537 if Cell.Terrain <> ttVoid then begin 1538 if Assigned(SelectedCell) and (SelectedCell = TCell(Cells[CY * FSize.X + CX])) then Brush.Color := clGreen 1539 else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, TCell(Cells[CY * FSize.X + CX])) then Brush.Color := clPurple 1540 else Brush.Color := Cell.GetColor; 1541 Pen.Color := clBlack; 1542 PaintCell(Canvas, Point(Trunc(X * CellSize.X), 1543 Trunc(Y * CellSize.Y)), 1544 IntToStr(Cell.GetAvialPower), View, TCell(Cells[CY * FSize.X + CX])); 1545 // Draw arrows 1546 Pen.Color := clCream; 1547 for I := 0 to Cell.MovesFrom.Count - 1 do begin 1548 PosFrom := CellToPos(Cell); 1549 PosTo := CellToPos(TUnitMove(Cell.MovesFrom[I]).CellTo); 1550 if TUnitMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2 1551 else Pen.Width := 1; 1552 Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X)); 1553 if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi; 1554 ArrowCenter := View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3), 1555 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))); 1556 DrawArrow(Canvas, View, ArrowCenter, 1557 Angle, Point(Trunc(HexSize.X / 4), Trunc(HexSize.Y / 4)), 1558 IntToStr(TUnitMove(Cell.MovesFrom[I]).CountOnce)); 1559 end; 1491 for C := 0 to Cells.Count - 1 do begin 1492 Cell := TCell(Cells[C]); 1493 if (Cell.Terrain <> ttVoid) and Cell.IsVisible(View) then begin 1494 if Assigned(SelectedCell) and (SelectedCell = Cell) then 1495 Brush.Color := clGreen 1496 else if Assigned(SelectedCell) and IsCellsNeighbor(SelectedCell, Cell) then 1497 Brush.Color := clPurple 1498 else Brush.Color := Cell.GetColor; 1499 Pen.Color := clBlack; 1500 PaintCell(Canvas, Cell.PosPx, IntToStr(Cell.GetAvialPower), View, Cell); 1501 1502 // Draw arrows 1503 Pen.Color := clCream; 1504 for I := 0 to Cell.MovesFrom.Count - 1 do begin 1505 PosFrom := CellToPos(Cell); 1506 PosTo := CellToPos(TUnitMove(Cell.MovesFrom[I]).CellTo); 1507 if TUnitMove(Cell.MovesFrom[I]).CountRepeat > 0 then Pen.Width := 2 1508 else Pen.Width := 1; 1509 Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X)); 1510 if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi; 1511 ArrowCenter := View.CellToCanvasPos(Point(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 3), 1512 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 3))); 1513 DrawArrow(Canvas, View, ArrowCenter, 1514 Angle, IntToStr(TUnitMove(Cell.MovesFrom[I]).CountOnce)); 1560 1515 end; 1561 1516 end;
Note:
See TracChangeset
for help on using the changeset viewer.