Changeset 23 for trunk/UGame.pas
- Timestamp:
- Mar 2, 2014, 11:27:14 PM (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UGame.pas
r22 r23 10 10 const 11 11 DefaultPlayerStartUnits = 5; 12 CellMulX = 1.12; 13 CellMulY = 1.292; 12 14 13 15 type … … 44 46 end; 45 47 48 { TView } 49 50 TView = class 51 private 52 FDestRect: TRect; 53 FZoom: Double; 54 procedure SetDestRect(AValue: TRect); 55 procedure SetZoom(AValue: Double); 56 public 57 SourceRect: TRect; 58 constructor Create; 59 destructor Destroy; override; 60 function CanvasToCellPos(Pos: TPoint): TPoint; 61 function CellToCanvasPos(Pos: TPoint): TPoint; 62 function CanvasToCellRect(Pos: TRect): TRect; 63 function CellToCanvasRect(Pos: TRect): TRect; 64 property DestRect: TRect read FDestRect write SetDestRect; 65 property Zoom: Double read FZoom write SetZoom; 66 end; 67 46 68 { THexMap } 47 69 … … 55 77 DefaultCellSize: TPoint; 56 78 Cells: array of array of TCell; 57 function PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TCell;58 function CellToPos(Cell: TCell; Rect: TRect; Zoom: Double): TPoint;79 function PosToCell(Pos: TPoint; View: TView): TCell; 80 function CellToPos(Cell: TCell; View: TView): TPoint; 59 81 function GetHexagonPolygon(Pos: TPoint; HexSize: TPoint): TPointArray; 60 procedure Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TCell);82 procedure Paint(Canvas: TCanvas; View: TView; SelectedCell: TCell; FocusedCell: TCell); 61 83 constructor Create; 62 84 destructor Destroy; override; … … 68 90 end; 69 91 92 70 93 TPlayerMode = (pmHuman, pmComputer); 71 94 … … 75 98 Game: TGame; 76 99 Name: string; 77 CellPos: TPoint;78 ViewSize: TPoint;79 100 Color: TColor; 80 View Zoom: Double;101 View: TView; 81 102 SelectedCell: TCell; 103 FocusedCell: TCell; 82 104 Mode: TPlayerMode; 83 105 TotalUnits: Integer; 84 106 TotalCells: Integer; 85 107 StartUnits: Integer; 86 function CanvasToCellPos(Pos: TPoint): TPoint;87 function CellToCanvasPos(Pos: TPoint): TPoint;88 function CanvasToCellRect(Pos: TRect): TRect;89 function CellToCanvasRect(Pos: TRect): TRect;90 108 procedure ComputerTurn; 91 109 procedure SelectCell(Pos: TPoint); 92 110 procedure Paint(PaintBox: TPaintBox); 93 111 constructor Create; 112 destructor Destroy; override; 94 113 procedure Assign(Source: TPlayer); 95 114 end; … … 108 127 { TGame } 109 128 110 TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer) of object; 129 TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer; 130 Update: Boolean) of object; 111 131 TWinEvent = procedure(Player: TPlayer) of object; 112 132 … … 153 173 end; 154 174 175 function RectEquals(A, B: TRect): Boolean; 176 begin 177 Result := (A.Left = B.Left) and (A.Top = B.Top) and 178 (A.Right = B.Right) and (A.Bottom = B.Bottom); 179 end; 180 155 181 function PtInPoly(const Points: array of TPoint; Pos: TPoint): Boolean; 156 182 var … … 193 219 end; 194 220 221 { TView } 222 223 procedure TView.SetZoom(AValue: Double); 224 begin 225 if FZoom = AValue then Exit; 226 FZoom := AValue; 227 SourceRect := Bounds(SourceRect.Left, SourceRect.Top, 228 Trunc((DestRect.Right - DestRect.Left) / Zoom), 229 Trunc((DestRect.Bottom - DestRect.Top) / Zoom)); 230 end; 231 232 procedure TView.SetDestRect(AValue: TRect); 233 begin 234 if RectEquals(FDestRect, AValue) then Exit; 235 FDestRect := AValue; 236 SourceRect := Bounds(SourceRect.Left, SourceRect.Top, 237 Trunc((DestRect.Right - DestRect.Left) / Zoom), 238 Trunc((DestRect.Bottom - DestRect.Top) / Zoom)); 239 end; 240 241 constructor TView.Create; 242 begin 243 Zoom := 1; 244 end; 245 246 destructor TView.Destroy; 247 begin 248 inherited Destroy; 249 end; 250 195 251 { TCell } 196 252 … … 228 284 { TPlayer } 229 285 230 function T Player.CanvasToCellPos(Pos: TPoint): TPoint;231 begin 232 Result := Point(Trunc(Pos.X / ViewZoom + CellPos.X),233 Trunc(Pos.Y / ViewZoom + CellPos.Y));234 end; 235 236 function T Player.CellToCanvasPos(Pos: TPoint): TPoint;237 begin 238 Result := Point(Trunc((Pos.X - CellPos.X) * ViewZoom),239 Trunc((Pos.Y - CellPos.Y) * ViewZoom));240 end; 241 242 function T Player.CanvasToCellRect(Pos: TRect): TRect;286 function TView.CanvasToCellPos(Pos: TPoint): TPoint; 287 begin 288 Result := Point(Trunc(Pos.X / Zoom + SourceRect.Left), 289 Trunc(Pos.Y / Zoom + SourceRect.Top)); 290 end; 291 292 function TView.CellToCanvasPos(Pos: TPoint): TPoint; 293 begin 294 Result := Point(Trunc((Pos.X - SourceRect.Left) * Zoom), 295 Trunc((Pos.Y - SourceRect.Top) * Zoom)); 296 end; 297 298 function TView.CanvasToCellRect(Pos: TRect): TRect; 243 299 begin 244 300 Result.TopLeft := CanvasToCellPos(Pos.TopLeft); … … 246 302 end; 247 303 248 function T Player.CellToCanvasRect(Pos: TRect): TRect;304 function TView.CellToCanvasRect(Pos: TRect): TRect; 249 305 begin 250 306 Result.TopLeft := CellToCanvasPos(Pos.TopLeft); … … 263 319 BottomRight: TPoint; 264 320 begin 265 NewSelectedCell := Game.Map.PosToCell( CanvasToCellPos(Pos), CanvasToCellRect(Bounds(0, 0, ViewSize.X, ViewSize.Y)), ViewZoom);321 NewSelectedCell := Game.Map.PosToCell(View.CanvasToCellPos(Pos), View); 266 322 if Assigned(NewSelectedCell) then begin 267 323 if Assigned(SelectedCell) and IsCellsNeighbor(NewSelectedCell, SelectedCell) then begin … … 279 335 procedure TPlayer.Paint(PaintBox: TPaintBox); 280 336 begin 281 Game.Map.Paint(PaintBox.Canvas, CanvasToCellRect(Bounds(0, 0, ViewSize.X, ViewSize.Y)), ViewZoom, SelectedCell);337 Game.Map.Paint(PaintBox.Canvas, View, SelectedCell, FocusedCell); 282 338 end; 283 339 284 340 constructor TPlayer.Create; 285 341 begin 286 View Zoom := 1;342 View := TView.Create; 287 343 SelectedCell := nil; 344 FocusedCell := nil; 288 345 StartUnits := DefaultPlayerStartUnits; 346 end; 347 348 destructor TPlayer.Destroy; 349 begin 350 FreeAndNil(View); 351 inherited Destroy; 289 352 end; 290 353 … … 299 362 StartUnits := Source.StartUnits; 300 363 SelectedCell := Source.SelectedCell; 301 View Zoom := Source.ViewZoom;364 View.Zoom := Source.View.Zoom; 302 365 end; 303 366 … … 352 415 CountOnce := TMove(Moves[I]).CountOnce; 353 416 CountRepeat := TMove(Moves[I]).CountRepeat; 417 if Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True); 354 418 end else begin 355 419 CountOnce := CellFrom.Power; 356 420 CountRepeat := 0; 357 end;358 if Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat);421 if Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False); 422 end; 359 423 if I < Moves.Count then begin 360 424 // Already have such move … … 362 426 else begin 363 427 TMove(Moves[I]).CountOnce := CountOnce; 364 TMove(Moves[I]).Count Once := CountOnce;428 TMove(Moves[I]).CountRepeat := CountRepeat; 365 429 end; 366 430 end else begin … … 451 515 Map := THexMap.Create; 452 516 Map.Game := Self; 453 Map.Size := Point(2 , 2);517 Map.Size := Point(20, 20); 454 518 Moves := TObjectList.Create; 455 519 end; … … 490 554 StartCell.Power := TPlayer(Players[I]).StartUnits; 491 555 end; 492 View Zoom := 1;556 View.Zoom := 1; 493 557 // Center board 494 CellPos := Point(Trunc(Map.GetPixelSize.X div 2 - ViewSize.X div 2 / ViewZoom),495 Trunc(Map.GetPixelSize.Y div 2 - ViewSize.Y div 2 / ViewZoom));558 View.SourceRect.TopLeft := Point(Trunc(Map.GetPixelSize.X div 2 - (View.SourceRect.Right - View.SourceRect.Left) div 2 / View.Zoom), 559 Trunc(Map.GetPixelSize.Y div 2 - (View.SourceRect.Bottom - View.SourceRect.Top) div 2 / View.Zoom)); 496 560 end; 497 561 CurrentPlayer := TPlayer(Players[0]); … … 538 602 end; 539 603 540 function THexMap.PosToCell(Pos: TPoint; Rect: TRect; Zoom: Double): TCell;604 function THexMap.PosToCell(Pos: TPoint; View: TView): TCell; 541 605 var 542 606 CX, CY: Integer; … … 546 610 Points: array of TPoint; 547 611 begin 548 // TODO: This is implemented as simple sequence lookup. It needs some faster algorithm612 // TODO: This is implemented as simple sequence lookup. Needs some faster algorithm 549 613 Result := nil; 550 CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom); 551 HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom); 552 for CY := Trunc(Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) + 1 do 553 for CX := Trunc(Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) + 1 do begin 554 X := CX - Trunc(Rect.Left / CellSize.X); 555 Y := CY - Trunc(Rect.Top / CellSize.Y); 614 CellSize := FloatPoint(DefaultCellSize.X / CellMulX, DefaultCellSize.Y / CellMulY); 615 HexSize := FloatPoint(DefaultCellSize.X, DefaultCellSize.Y); 616 with View do 617 for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do 618 for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin 619 X := CX; 620 Y := CY; 556 621 if (CY and 1) = 1 then begin 557 622 X := X + 0.5; … … 560 625 if (CX >= 0) and (CY >= 0) and (CY < Size.Y) and (CX < Size.X) then 561 626 if Cells[CY, CX].Terrain = ttNormal then begin 562 Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X), 563 Trunc(Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y))); 627 Points := GetHexagonPolygon(Point(Trunc(X * CellSize.X - Frac(SourceRect.Left / CellSize.X) * CellSize.X), 628 Trunc(Y * CellSize.Y - Frac(SourceRect.Top / CellSize.Y) * CellSize.Y)), 629 Point(Trunc(HexSize.X), Trunc(HexSize.Y))); 564 630 if PtInPoly(Points, Pos) then begin 565 631 Result := Cells[CY, CX]; … … 570 636 end; 571 637 572 function THexMap.CellToPos(Cell: TCell; Rect: TRect; Zoom: Double): TPoint;638 function THexMap.CellToPos(Cell: TCell; View: TView): TPoint; 573 639 var 574 640 CX, CY: Integer; … … 578 644 Points: array of TPoint; 579 645 begin 580 CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom); 581 HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom); 582 X := Cell.Pos.X - Trunc(Rect.Left / CellSize.X); 583 Y := Cell.Pos.Y - Trunc(Rect.Top / CellSize.Y); 646 with View do begin 647 CellSize := FloatPoint(DefaultCellSize.X / CellMulX * View.Zoom, DefaultCellSize.Y / CellMulY * View.Zoom); 648 HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom); 649 X := Cell.Pos.X - Trunc(SourceRect.Left / CellSize.X); 650 Y := Cell.Pos.Y - Trunc(SourceRect.Top / CellSize.Y); 584 651 if (Cell.Pos.Y and 1) = 1 then begin 585 652 X := X + 0.5; … … 587 654 end; 588 655 589 Result.X := Trunc(X * CellSize.X - Frac(Rect.Left / CellSize.X) * CellSize.X); 590 Result.Y := Trunc(Y * CellSize.Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y); 591 end; 592 593 594 procedure THexMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double; SelectedCell: TCell); 656 Result.X := Trunc(X * CellSize.X - Frac(SourceRect.Left / CellSize.X) * CellSize.X); 657 Result.Y := Trunc(Y * CellSize.Y - Frac(SourceRect.Top / CellSize.Y) * CellSize.Y); 658 end; 659 end; 660 661 662 procedure THexMap.Paint(Canvas: TCanvas; View: TView; SelectedCell: TCell; FocusedCell: TCell); 595 663 var 596 664 CX, CY: Integer; 597 665 X, Y: Double; 666 CellSizeZoomed: TFloatPoint; 667 CellSize: TFloatPoint; 598 668 HexSize: TFloatPoint; 599 CellSize: TFloatPoint;600 669 I: Integer; 601 670 Points: array of TPoint; … … 608 677 begin 609 678 with Canvas do begin 679 if Assigned(FocusedCell) and (FocusedCell = TCell(Cells[CY, CX])) then begin 680 Pen.Color := clYellow; 681 Pen.Style := psSolid; 682 end else begin 683 Pen.Color := clBlack; 684 Pen.Style := psClear; 685 end; 610 686 Points := GetHexagonPolygon(Point(Trunc(X), Trunc(Y)), Point(Trunc(HexSize.X), Trunc(HexSize.Y))); 611 687 Polygon(Points); 688 Pen.Style := psSolid; 612 689 Font.Color := clWhite; 613 Font.Size := Trunc(12 * Zoom);690 Font.Size := Trunc(12 * View.Zoom); 614 691 TextOut(Round(X) - TextWidth(Text) div 2, Round(Y) - TextHeight(Text) div 2, Text); 615 692 end; … … 617 694 618 695 begin 619 CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom); 620 HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom); 621 with Canvas do try 696 CellSize := FloatPoint(DefaultCellSize.X / CellMulX, DefaultCellSize.Y / CellMulY); 697 HexSize := FloatPoint(DefaultCellSize.X * View.Zoom, DefaultCellSize.Y * View.Zoom); 698 CellSizeZoomed := FloatPoint(CellSize.X * View.Zoom, CellSize.Y * View.Zoom); 699 with Canvas, View do try 622 700 Lock; 623 701 ClearCellMoves; … … 629 707 end; 630 708 631 for CY := Trunc( Rect.Top / CellSize.Y) to Trunc(Rect.Bottom / CellSize.Y) + 1 do632 for CX := Trunc( Rect.Left / CellSize.X) to Trunc(Rect.Right / CellSize.X) + 1 do begin633 X := CX - Trunc( Rect.Left / CellSize.X);634 Y := CY - Trunc( Rect.Top / CellSize.Y);709 for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do 710 for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin 711 X := CX - Trunc(SourceRect.Left / CellSize.X); 712 Y := CY - Trunc(SourceRect.Top / CellSize.Y); 635 713 if (CY and 1) = 1 then begin 636 714 X := X + 0.5; … … 644 722 else Brush.Color := Cell.GetColor; 645 723 Pen.Color := clBlack; 646 PaintHexagon(X * CellSize .X - Frac(Rect.Left / CellSize.X) * CellSize.X,647 Y * CellSize .Y - Frac(Rect.Top / CellSize.Y) * CellSize.Y, IntToStr(Cell.GetAvialPower));724 PaintHexagon(X * CellSizeZoomed.X - Frac(SourceRect.Left / CellSize.X) * CellSizeZoomed.X, 725 Y * CellSizeZoomed.Y - Frac(SourceRect.Top / CellSize.Y) * CellSizeZoomed.Y, IntToStr(Cell.GetAvialPower)); 648 726 // Draw arrows 649 727 Pen.Color := clCream; 650 728 for I := 0 to Cell.MovesFrom.Count - 1 do begin 651 PosFrom := CellToPos(Cell, Rect, Zoom);652 PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo, Rect, Zoom);729 PosFrom := CellToPos(Cell, View); 730 PosTo := CellToPos(TMove(Cell.MovesFrom[I]).CellTo, View); 653 731 Line(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 4), 654 732 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 4),
Note:
See TracChangeset
for help on using the changeset viewer.