source: trunk/ClientGUI.pas

Last change on this file was 334, checked in by chronos, 4 months ago
  • Fixed: Recalculate list NewId if necessary.
File size: 23.6 KB
Line 
1unit ClientGUI;
2
3interface
4
5uses
6 Types, Classes, SysUtils, Graphics, GameClient, Player, Map, Game, Geometry,
7 Math;
8
9type
10 { TView }
11
12 TView = class
13 private
14 FDestRect: TRect;
15 FZoom: Double;
16 procedure SetDestRect(AValue: TRect);
17 procedure SetZoom(AValue: Double);
18 public
19 Game: TObject; //TGame;
20 SourceRect: TRect;
21 FocusedCell: TPlayerCell;
22 SelectedCell: TPlayerCell;
23 procedure Clear;
24 function IsCellVisible(Cell: TCell): Boolean;
25 constructor Create;
26 destructor Destroy; override;
27 procedure SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);
28 procedure CenterMap;
29 procedure CenterPlayerCity(Player: TPlayer);
30 procedure ZoomAll;
31 function CanvasToCellPos(Pos: TPoint): TPoint;
32 function CellToCanvasPos(Pos: TPoint): TPoint;
33 function CellToCanvasPosF(Pos: TPointF): TPointF;
34 function CanvasToCellRect(Pos: TRect): TRect;
35 function CellToCanvasRect(Pos: TRect): TRect;
36 function CellToCanvasRectF(Pos: TRectF): TRectF;
37 procedure Assign(Source: TView);
38 property DestRect: TRect read FDestRect write SetDestRect;
39 property Zoom: Double read FZoom write SetZoom;
40 end;
41
42 { TClientGUI }
43
44 TClientGUI = class(TClient)
45 protected
46 procedure SetGame(AValue: TGame); override;
47 public
48 View: TView;
49 CellGridVisible: Boolean;
50 UnitShapeVisible: Boolean;
51 procedure DrawArrow(Canvas: TCanvas; Pos: TPoint; Angle: Double;
52 Text: string; View: TView);
53 procedure PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
54 Cell: TPlayerCell);
55 procedure PaintMapCell(Canvas: TCanvas; Pos: TPoint; Text: string; View: TView;
56 Cell: TCell);
57 procedure DrawArrows(Canvas: TCanvas; View: TView);
58 procedure DrawCells(Canvas: TCanvas; View: TView);
59 procedure DrawCellLinks(Canvas: TCanvas; View: TView);
60 procedure DrawNeighborLinks(Canvas: TCanvas; View: TView);
61 procedure DrawCities(Canvas: TCanvas; View: TView);
62 procedure DrawSelection(Canvas: TCanvas; View: TView);
63 procedure Paint(Canvas: TCanvas; View: TView);
64 constructor Create; override;
65 destructor Destroy; override;
66 end;
67
68
69implementation
70
71uses
72 Building;
73
74resourcestring
75 SZeroZoomNotAlowed = 'Zero zoom not allowed';
76 SWrongArrowAngle = 'Wrong arrow angle %s';
77
78{ TClientGUI }
79
80procedure TClientGUI.Paint(Canvas: TCanvas; View: TView);
81begin
82 DrawCellLinks(Canvas, View);
83 DrawCells(Canvas, View);
84 DrawCities(Canvas, View);
85 DrawSelection(Canvas, View);
86 DrawArrows(Canvas, View);
87 if TGame(Game).DevelMode then DrawNeighborLinks(Canvas, View);
88end;
89
90constructor TClientGUI.Create;
91begin
92 inherited;
93 View := TView.Create;
94end;
95
96destructor TClientGUI.Destroy;
97begin
98 FreeAndNil(View);
99 inherited;
100end;
101
102procedure TClientGUI.SetGame(AValue: TGame);
103begin
104 inherited;
105 View.Game := AValue;
106end;
107
108procedure TClientGUI.PaintCell(Canvas: TCanvas; Pos: TPoint; Text: string;
109 View: TView; Cell: TPlayerCell);
110var
111 I: Integer;
112 TextPos: TPoint;
113 Points: array of Classes.TPoint;
114 TextSize: TSize;
115 R: Integer;
116begin
117 if Cell.MapCell.Extra = etObjectiveTarget then begin
118 Text := Text + '!';
119 end;
120 with Canvas do begin
121 // Cannot set clear border as it will display shifted on gtk2
122 //Pen.Style := psClear;
123 Pen.Style := psSolid;
124 if CellGridVisible then begin
125 Pen.Color := clBlack;
126 Pen.Width := Round(2 * View.Zoom);
127 end else begin
128 Pen.Color := Brush.Color;
129 Pen.Width := 0;
130 end;
131
132 // Transform view
133 SetLength(Points, Length(Cell.MapCell.Polygon.Points));
134 for I := 0 to Length(Points) - 1 do
135 Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.Polygon.Points[I]));
136 Brush.Style := bsSolid;
137 TCanvasEx.PolygonEx(Canvas, Points, False);
138
139 // Show cell text
140 if (Cell.GetAvialPower <> 0) or (Cell.MapCell.Extra = etObjectiveTarget) then begin
141 Pen.Style := psSolid;
142 Font.Color := clWhite;
143 Brush.Style := bsClear;
144 Font.Size := Trunc(42 * View.Zoom);
145 TextPos := View.CellToCanvasPos(Pos);
146 TextSize := TextExtent(Text);
147 TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
148 Round(TextPos.Y) - TextSize.cy div 2, Text, False);
149 end;
150 if UnitShapeVisible and Assigned(Cell.MapCell.OneUnit) then begin
151 TextPos := View.CellToCanvasPos(Pos);
152 R := Trunc(70 * View.Zoom);
153 Pen.Color := clWhite;
154 Pen.Style := psSolid;
155 Pen.Width := Round(10 * View.Zoom);
156 Brush.Style := bsClear;
157 TCanvasEx.EllipseEx(Canvas, TRect.Create(
158 TPoint.Create(TextPos.X - R, TextPos.Y - R),
159 TPoint.Create(TextPos.X + R, TextPos.Y + R)
160 ));
161 end;
162 end;
163end;
164
165procedure TClientGUI.PaintMapCell(Canvas: TCanvas; Pos: TPoint; Text: string;
166 View: TView; Cell: TCell);
167var
168 I: Integer;
169 TextPos: TPoint;
170 Points: array of Classes.TPoint;
171 TextSize: TSize;
172 R: Integer;
173begin
174 if Cell.Extra = etObjectiveTarget then begin
175 Text := Text + '!';
176 end;
177 with Canvas do begin
178 if Assigned(View.FocusedCell) and (View.FocusedCell.MapCell = Cell) then begin
179 Pen.Color := clYellow;
180 Pen.Style := psSolid;
181 Pen.Width := 1;
182 end else
183 if Assigned(Cell.Building) and Assigned(Cell.Building.Kind) and
184 (Cell.Building.Kind.SpecialType = stCity) then begin
185 // Cannot set clear border as it will display shifted on gtk2
186 //Pen.Style := psClear;
187 Pen.Color := clBlack;
188 Pen.Style := psSolid;
189 Pen.Width := Trunc(5 * View.Zoom);
190 end else begin
191 // Cannot set clear border as it will display shifted on gtk2
192 //Pen.Style := psClear;
193 Pen.Color := Brush.Color;
194 Pen.Style := psSolid;
195 Pen.Width := 0;
196 end;
197
198 // Cannot set clear border as it will display shifted on gtk2
199 //Pen.Style := psClear;
200 Pen.Style := psSolid;
201 if CellGridVisible then begin
202 Pen.Color := clBlack;
203 Pen.Width := Round(2 * View.Zoom);
204 end else begin
205 Pen.Color := Brush.Color;
206 Pen.Width := 0;
207 end;
208
209 // Transform view
210 SetLength(Points, Length(Cell.Polygon.Points));
211 for I := 0 to Length(Points) - 1 do
212 Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.Polygon.Points[I]));
213 Brush.Style := bsSolid;
214 //Polygon(Points, False, 0, Length(Points));
215 TCanvasEx.PolygonEx(Canvas, Points, False);
216 //MoveTo(Points[0].X, Points[0].Y);
217 //LineTo(Points[1].X, Points[1].Y);
218
219 // Show cell text
220 if Assigned(Cell.OneUnit) and (Cell.OneUnit.Power <> 0) or
221 (Cell.Extra = etObjectiveTarget) then begin
222 Pen.Style := psSolid;
223 Font.Color := clWhite;
224 Brush.Style := bsClear;
225 Font.Size := Trunc(42 * View.Zoom);
226 TextPos := View.CellToCanvasPos(Pos);
227 TextSize := TextExtent(Text);
228 TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2,
229 Round(TextPos.Y) - TextSize.cy div 2, Text, False);
230 end;
231 if UnitShapeVisible and Assigned(Cell.OneUnit) then begin
232 TextPos := View.CellToCanvasPos(Pos);
233 R := Trunc(70 * View.Zoom);
234 Pen.Color := clWhite;
235 Pen.Style := psSolid;
236 Pen.Width := Round(10 * View.Zoom);
237 Brush.Style := bsClear;
238 TCanvasEx.EllipseEx(Canvas, TRect.Create(
239 TPoint.Create(TextPos.X - R, TextPos.Y - R),
240 TPoint.Create(TextPos.X + R, TextPos.Y + R)
241 ));
242 end;
243 end;
244end;
245
246procedure TClientGUI.DrawArrows(Canvas: TCanvas; View: TView);
247var
248 PosFrom, PosTo: TPoint;
249 Angle: Double;
250 ArrowCenter: TPoint;
251 Move: TUnitMove;
252 P: TPoint;
253begin
254 with Canvas, View do begin
255 Pen.Color := clCream;
256 if Assigned(ControlPlayer) then
257 for Move in ControlPlayer.Moves do begin
258 PosFrom := TGame(Game).Map.CellToPos(Move.CellFrom.MapCell);
259 PosTo := TGame(Game).Map.CellToPos(Move.CellTo.MapCell);
260 if TGame(Game).Map.Cyclic then begin
261 P := TPoint.Create(PosTo.X + TGame(Game).Map.PixelRect.Size.X,
262 PosTo.Y);
263 if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
264 PosTo := TPoint.Create(P.X, PosTo.Y);
265 P := TPoint.Create(PosTo.X, PosTo.Y + TGame(Game).Map.PixelRect.Size.Y);
266 if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
267 PosTo := TPoint.Create(PosTo.X, P.Y);
268 P := TPoint.Create(PosTo.X - TGame(Game).Map.PixelRect.Size.X,
269 PosTo.Y);
270 if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
271 PosTo := TPoint.Create(P.X, PosTo.Y);
272 P := TPoint.Create(PosTo.X, PosTo.Y - TGame(Game).Map.PixelRect.Size.Y);
273 if TLine.Create(PosFrom, PosTo).Distance > TLine.Create(PosFrom, P).Distance then
274 PosTo := TPoint.Create(PosTo.X, P.Y);
275 end;
276 // In Fog of war mode show only
277 if TGame(Game).FogOfWar and not ControlPlayer.PlayerMap.Cells.SearchCell(Move.CellFrom.MapCell).InVisibleRange and
278 not ControlPlayer.PlayerMap.Cells.SearchCell(Move.CellTo.MapCell).InVisibleRange then
279 Continue;
280 if Move.CountRepeat > 0 then Pen.Width := Round(2 * View.Zoom)
281 else Pen.Width := Round(1 * View.Zoom);
282 Angle := ArcTan2(PosTo.Y - PosFrom.Y, PosTo.X - PosFrom.X);
283 if (Angle > +Pi) or (Angle < -Pi) then
284 raise Exception.Create(Format(SWrongArrowAngle, [FloatToStr(Angle)]));
285
286 ArrowCenter := View.CellToCanvasPos(TPoint.Create(
287 Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
288 Trunc(PosFrom.Y + (PosTo.Y - PosFrom.Y) / 2)
289 ));
290 DrawArrow(Canvas, ArrowCenter,
291 Angle, IntToStr(Move.CountOnce), View);
292 end;
293 end;
294end;
295
296procedure TClientGUI.DrawArrow(Canvas: TCanvas; Pos: TPoint;
297 Angle: Double; Text: string; View: TView);
298var
299 Points: array of Classes.TPoint;
300 Arrow: TPolygonF;
301 I: Integer;
302 ArrowSize: TPoint;
303 RectPolygon: TRectF;
304begin
305 SetLength(Arrow.Points, 8);
306 ArrowSize := TPoint.Create(Trunc(TGame(Game).Map.DefaultCellSize.X / 3 * View.Zoom),
307 Trunc(TGame(Game).Map.DefaultCellSize.Y / 3 * View.Zoom));
308 Arrow.Points[0] := TPointF.Create(+0.5 * ArrowSize.X, +0 * ArrowSize.Y);
309 Arrow.Points[1] := TPointF.Create(+0 * ArrowSize.X, +0.5 * ArrowSize.Y);
310 Arrow.Points[2] := TPointF.Create(+0 * ArrowSize.X, +0.25 * ArrowSize.Y);
311 Arrow.Points[3] := TPointF.Create(-0.5 * ArrowSize.X, +0.25 * ArrowSize.Y);
312 Arrow.Points[4] := TPointF.Create(-0.5 * ArrowSize.X, -0.25 * ArrowSize.Y);
313 Arrow.Points[5] := TPointF.Create(+0 * ArrowSize.X, -0.25 * ArrowSize.Y);
314 Arrow.Points[6] := TPointF.Create(+0 * ArrowSize.X, -0.5 * ArrowSize.Y);
315 Arrow.Points[7] := TPointF.Create(+0.5 * ArrowSize.X, 0 * ArrowSize.Y);
316 // Rotate
317 for I := 0 to Length(Arrow.Points) - 1 do begin
318 Arrow.Points[I] := TPointF.Create(
319 Arrow.Points[I].X * Cos(Angle) - Arrow.Points[I].Y * Sin(Angle),
320 Arrow.Points[I].X * Sin(Angle) + Arrow.Points[I].Y * Cos(Angle)
321 );
322 Arrow.Points[I] := Arrow.Points[I] + TPointF.Create(Pos.X, Pos.Y);
323 end;
324
325 RectPolygon := Arrow.GetRect;
326 if (RectPolygon.P1.X < View.DestRect.Size.X) and
327 (RectPolygon.P2.X > 0) and
328 (RectPolygon.P1.Y < View.DestRect.Size.Y) and
329 (RectPolygon.P2.Y > 0) then begin
330
331 // Convert to standard points
332 SetLength(Points, 8);
333 for I := 0 to Length(Points) - 1 do
334 Points[I] := Point(Trunc(Arrow[I].X), Trunc(Arrow[I].Y));
335 with Canvas do begin
336 Pen.Color := clBlack;
337 Brush.Color := clWhite;
338 Brush.Style := bsSolid;
339 Polygon(Points);
340 Brush.Style := bsClear;
341 Font.Color := clBlack;
342 Font.Size := Trunc(18 * View.Zoom);
343 TextOut(Pos.X - TextWidth(Text) div 2, Pos.Y - TextHeight(Text) div 2, Text);
344 Pen.Width := 1;
345 end;
346 end;
347end;
348
349procedure TClientGUI.DrawCells(Canvas: TCanvas; View: TView);
350var
351 Cell: TPlayerCell;
352 MapCell: TCell;
353 CellText: string;
354begin
355 with Canvas, View do begin
356 if Assigned(ControlPlayer) then begin
357 for Cell in ControlPlayer.PlayerMap.Cells do begin
358 if View.IsCellVisible(Cell.MapCell) and (Cell.MapCell.Terrain <> ttVoid) then begin
359 if Cell.MapCell.Player = ControlPlayer then
360 CellText := IntToStr(Cell.GetAvialPower)
361 else begin
362 if Assigned(Cell.MapCell.OneUnit) then
363 CellText := IntToStr(Cell.MapCell.OneUnit.Power)
364 else CellText := '';
365 end;
366 if Assigned(SelectedCell) and (SelectedCell = Cell) then
367 Brush.Color := clGreen
368 else if Assigned(SelectedCell) and ControlPlayer.IsAllowedMoveTarget(SelectedCell, Cell) then
369 Brush.Color := clPurple
370 else if TGame(Game).FogOfWar then begin
371 if Cell.InVisibleRange then begin
372 Brush.Color := Cell.MapCell.GetColor;
373 end else begin
374 if Cell.Explored then begin
375 Brush.Color := $404040;
376 CellText := '';
377 end else begin
378 Brush.Color := clBlack;
379 CellText := '';
380 end;
381 end;
382 end else Brush.Color := Cell.MapCell.GetColor;
383 PaintCell(Canvas, Cell.MapCell.PosPx, CellText, View, Cell);
384 end else
385 if TGame(Game).FogOfWar and (Cell.MapCell.Terrain = ttVoid) then begin
386 Brush.Color := clBlack;
387 PaintCell(Canvas, Cell.MapCell.PosPx, '', View, Cell);
388 end;
389 end;
390 end else begin
391 // Draw cells
392 for MapCell in TGame(Game).Map.Cells do begin
393 if (MapCell.Terrain <> ttVoid) and View.IsCellVisible(MapCell) then begin
394 Brush.Color := MapCell.GetColor;
395 if Assigned(MapCell.OneUnit) then
396 CellText := IntToStr(MapCell.OneUnit.Power)
397 else CellText := '';
398 PaintMapCell(Canvas, MapCell.PosPx, CellText, View, MapCell);
399 end;
400 end;
401 end;
402 end;
403end;
404
405procedure TClientGUI.DrawCellLinks(Canvas: TCanvas; View: TView);
406var
407 I: Integer;
408 CellLink: TCellLink;
409begin
410 with Canvas, View do begin
411 Pen.Color := clBlack;
412 Pen.Style := psSolid;
413 Pen.Width := 3;
414 for CellLink in TGame(Game).Map.CellLinks do
415 with CellLink do begin
416 if Length(Points) >= 2 then begin
417 MoveTo(PointToStdPoint(View.CellToCanvasPos(Points[0])));
418 for I := 1 to Length(Points) - 1 do
419 LineTo(PointToStdPoint(View.CellToCanvasPos(Points[I])));
420 end;
421 end;
422 end;
423end;
424
425procedure TClientGUI.DrawNeighborLinks(Canvas: TCanvas; View: TView);
426var
427 Cell: TPlayerCell;
428 C: TCell;
429begin
430 with Canvas, View do begin
431 for Cell in ControlPlayer.PlayerMap.Cells do begin
432 for C in Cell.MapCell.Neighbors do begin
433 Pen.Color := clYellow;
434 MoveTo(PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.PosPx)));
435 LineTo(PointToStdPoint(View.CellToCanvasPos(C.PosPx)));
436 end;
437
438 Font.Color := clRed;
439 Brush.Style := bsClear;
440 TextOut(View.CellToCanvasPos(Cell.MapCell.PosPx).X,
441 View.CellToCanvasPos(Cell.MapCell.PosPx).Y, IntToStr(Cell.MapCell.Id));
442 end;
443 end;
444end;
445
446procedure TClientGUI.DrawCities(Canvas: TCanvas; View: TView);
447var
448 Cell: TPlayerCell;
449 MapCell: TCell;
450 Points: array of Classes.TPoint;
451 I: Integer;
452begin
453 with Canvas, View do begin
454 if Assigned(ControlPlayer) then begin
455 for Cell in ControlPlayer.PlayerMap.Cells do begin
456 if (Cell.MapCell.Terrain <> ttVoid) and View.IsCellVisible(Cell.MapCell) then begin
457 if Assigned(Cell.MapCell.Building) and Assigned(Cell.MapCell.Building.Kind) and
458 (Cell.MapCell.Building.Kind.SpecialType = stCity) then begin
459 // Cannot set clear border as it will display shifted on gtk2
460 //Pen.Style := psClear;
461 Pen.Color := clBlack;
462 Pen.Style := psSolid;
463 Pen.Width := Round(6 * View.Zoom);
464
465 // Transform view
466 SetLength(Points, Length(Cell.MapCell.Polygon.Points) + 1);
467 for I := 0 to Length(Cell.MapCell.Polygon.Points) - 1 do
468 Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.Polygon.Points[I]));
469 Points[Length(Points) - 1] := Points[0];
470 TCanvasEx.PolyLineEx(Canvas, Points);
471 end;
472 end;
473 end;
474 end else begin
475 for MapCell in TGame(Game).Map.Cells do begin
476 if (MapCell.Terrain <> ttVoid) and View.IsCellVisible(MapCell) then begin
477 if View.IsCellVisible(MapCell) and (MapCell.Terrain <> ttVoid) then begin
478 if Assigned(MapCell.Building) and Assigned(MapCell.Building.Kind) and
479 (MapCell.Building.Kind.SpecialType = stCity) then begin
480 // Cannot set clear border as it will display shifted on gtk2
481 //Pen.Style := psClear;
482 Pen.Color := clBlack;
483 Pen.Style := psSolid;
484 Pen.Width := Round(6 * View.Zoom);
485
486 // Transform view
487 SetLength(Points, Length(MapCell.Polygon.Points) + 1);
488 for I := 0 to Length(MapCell.Polygon.Points) - 1 do
489 Points[I] := PointToStdPoint(View.CellToCanvasPos(MapCell.Polygon.Points[I]));
490 Points[Length(Points) - 1] := Points[0];
491 TCanvasEx.PolyLineEx(Canvas, Points);
492 end;
493 end;
494 end;
495 end;
496 end;
497 end;
498end;
499
500procedure TClientGUI.DrawSelection(Canvas: TCanvas; View: TView);
501var
502 Points: array of Classes.TPoint;
503 I: Integer;
504begin
505 with Canvas, View do begin
506 if Assigned(ControlPlayer) then begin
507 if Assigned(View.FocusedCell) then begin
508 Pen.Color := clYellow;
509 Pen.Style := psSolid;
510 Pen.Width := Round(2 * View.Zoom);
511
512 // Transform view
513 SetLength(Points, Length(View.FocusedCell.MapCell.Polygon.Points) + 1);
514 for I := 0 to Length(View.FocusedCell.MapCell.Polygon.Points) - 1 do
515 Points[I] := PointToStdPoint(View.CellToCanvasPos(View.FocusedCell.MapCell.Polygon.Points[I]));
516 Points[Length(Points) - 1] := Points[0];
517 TCanvasEx.PolyLineEx(Canvas, Points);
518 end;
519 end;
520 end;
521end;
522
523{ TView }
524
525procedure TView.SetZoom(AValue: Double);
526begin
527 if FZoom = AValue then Exit;
528 if AValue = 0 then
529 raise Exception.Create(SZeroZoomNotAlowed);
530 FZoom := AValue;
531 SourceRect := TRect.CreateBounds(TPoint.Create(Trunc(SourceRect.P1.X + SourceRect.Size.X div 2 - DestRect.Size.X / Zoom / 2),
532 Trunc(SourceRect.P1.Y + SourceRect.Size.Y div 2 - DestRect.Size.Y / Zoom / 2)),
533 TPoint.Create(Trunc(DestRect.Size.X / Zoom),
534 Trunc(DestRect.Size.Y / Zoom)));
535end;
536
537procedure TView.Clear;
538begin
539 FocusedCell := nil;
540 SelectedCell := nil;
541end;
542
543procedure TView.SetDestRect(AValue: TRect);
544var
545 Diff: TPoint;
546begin
547 if FDestRect = AValue then Exit;
548 Diff := TPoint.Create(Trunc(DestRect.Size.X / Zoom - AValue.Size.X / Zoom) div 2,
549 Trunc(DestRect.Size.Y / Zoom - AValue.Size.Y / Zoom) div 2);
550 FDestRect := AValue;
551 SourceRect := TRect.CreateBounds(TPoint.Create(SourceRect.P1.X + Diff.X, SourceRect.P1.Y + Diff.Y),
552 TPoint.Create(Trunc(DestRect.Size.X / Zoom),
553 Trunc(DestRect.Size.Y / Zoom)));
554end;
555
556constructor TView.Create;
557begin
558 Zoom := 1.5;
559 Clear;
560end;
561
562destructor TView.Destroy;
563begin
564 inherited;
565end;
566
567function TView.CanvasToCellPos(Pos: TPoint): TPoint;
568begin
569 Result := TPoint.Create(Trunc((Pos.X - DestRect.P1.X) / Zoom + SourceRect.P1.X),
570 Trunc((Pos.Y - DestRect.P1.Y) / Zoom + SourceRect.P1.Y));
571end;
572
573function TView.CellToCanvasPos(Pos: TPoint): TPoint;
574begin
575 Result := TPoint.Create(Trunc((Pos.X - SourceRect.P1.X) * Zoom) + DestRect.P1.X,
576 Trunc((Pos.Y - SourceRect.P1.Y) * Zoom) + DestRect.P1.Y);
577end;
578
579function TView.CellToCanvasPosF(Pos: TPointF): TPointF;
580begin
581 Result := TPointF.Create((Pos.X - SourceRect.P1.X) * Zoom + DestRect.P1.X,
582 (Pos.Y - SourceRect.P1.Y) * Zoom + DestRect.P1.Y);
583end;
584
585function TView.CanvasToCellRect(Pos: TRect): TRect;
586begin
587 Result.P1 := CanvasToCellPos(Pos.P1);
588 Result.P2 := CanvasToCellPos(Pos.P2);
589end;
590
591function TView.CellToCanvasRect(Pos: TRect): TRect;
592begin
593 Result.P1 := CellToCanvasPos(Pos.P1);
594 Result.P2 := CellToCanvasPos(Pos.P2);
595end;
596
597function TView.CellToCanvasRectF(Pos: TRectF): TRectF;
598begin
599 Result.P1 := CellToCanvasPosF(Pos.P1);
600 Result.P2 := CellToCanvasPosF(Pos.P2);
601end;
602
603procedure TView.Assign(Source: TView);
604begin
605 SourceRect := Source.SourceRect;
606 FDestRect := Source.DestRect;
607 FZoom := Source.Zoom;
608 SelectedCell := Source.SelectedCell;
609 FocusedCell := Source.FocusedCell;
610end;
611
612procedure TView.SelectCell(Pos: TPoint; Player: TPlayer; ShiftState: TShiftState);
613var
614 NewSelectedCell: TPlayerCell;
615 UnitMove: TUnitMove;
616 I: Integer;
617 CellPos: TPoint;
618 R: TRect;
619begin
620 if TGame(Game).Map.Cyclic then begin
621 R := CellToCanvasRect(TGame(Game).Map.PixelRect);
622 CellPos := TPoint.Create(
623 ModNeg(Pos.X - R.P1.X, R.Size.X) + R.P1.X,
624 ModNeg(Pos.Y - R.P1.Y, R.Size.Y) + R.P1.Y
625 );
626 NewSelectedCell := Player.PlayerMap.PosToCell(
627 CanvasToCellPos(CellPos));
628 end else begin
629 NewSelectedCell := Player.PlayerMap.PosToCell(
630 CanvasToCellPos(Pos));
631 end;
632 if Assigned(NewSelectedCell) then begin
633 if Assigned(SelectedCell) and (NewSelectedCell <> SelectedCell) and
634 TGame(Game).CurrentPlayer.IsAllowedMoveTarget(SelectedCell, NewSelectedCell) then begin
635 if ssShift in ShiftState then begin
636 // Make maximum unit move without confirmation dialog
637 for I := SelectedCell.MovesFrom.Count - 1 downto 0 do begin
638 Player.Moves.Remove(SelectedCell.MovesFrom[I]);
639 end;
640 TGame(Game).CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.OneUnit.Power, False);
641 SelectedCell := nil;
642 end else
643 if ssCtrl in ShiftState then begin
644 // If CTRL key pressed then storno all moved from selected cell and
645 // move all power to new selected cell
646 for I := SelectedCell.MovesFrom.Count - 1 downto 0 do
647 Player.Moves.Remove(SelectedCell.MovesFrom[I]);
648 UnitMove := TGame(Game).CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.OneUnit.Power, False);
649 if Assigned(UnitMove) then
650 UnitMove.CountRepeat := TGame(Player.Game).Map.MaxPower;
651 if NewSelectedCell.MapCell.Player = Player then SelectedCell := NewSelectedCell
652 else SelectedCell := nil;
653 end else begin
654 TGame(Game).CurrentPlayer.SetMove(SelectedCell, NewSelectedCell, SelectedCell.MapCell.OneUnit.Power);
655 SelectedCell := nil;
656 end;
657 end else
658 if not Assigned(SelectedCell) and (NewSelectedCell <> SelectedCell) and (NewSelectedCell.MapCell.Player = Player) then begin
659 SelectedCell := NewSelectedCell
660 end else
661 if (NewSelectedCell = SelectedCell) and (NewSelectedCell.MapCell.Player = Player) then begin
662 SelectedCell := nil;
663 end;
664 end;
665end;
666
667procedure TView.CenterMap;
668var
669 MapRect: TRect;
670begin
671 MapRect := TGame(Game).Map.PixelRect;
672 SourceRect := TRect.CreateBounds(TPoint.Create(MapRect.P1.X + MapRect.Size.X div 2 - SourceRect.Size.X div 2,
673 MapRect.P1.Y + MapRect.Size.Y div 2 - SourceRect.Size.Y div 2),
674 TPoint.Create(SourceRect.Size.X,
675 SourceRect.Size.Y));
676end;
677
678procedure TView.CenterPlayerCity(Player: TPlayer);
679begin
680 SourceRect := TRect.CreateBounds(TPoint.Create(Player.StartCell.PosPx.X - SourceRect.Size.X div 2,
681 Player.StartCell.PosPx.Y - SourceRect.Size.Y div 2),
682 TPoint.Create(SourceRect.Size.X,
683 SourceRect.Size.Y));
684end;
685
686procedure TView.ZoomAll;
687var
688 Factor: TPointF;
689 MapRect: TRect;
690 NewZoom: Single;
691begin
692 MapRect := TGame(Game).Map.CalculatePixelRect;
693 Factor := TPointF.Create(DestRect.Size.X / MapRect.Size.X,
694 DestRect.Size.Y / MapRect.Size.Y);
695 if Factor.X < Factor.Y then NewZoom := Factor.X
696 else NewZoom := Factor.Y;
697 if NewZoom = 0 then NewZoom := 1;
698 Zoom := NewZoom * 0.9;
699 CenterMap;
700end;
701
702function TView.IsCellVisible(Cell: TCell): Boolean;
703var
704 RectPolygon: TRect;
705begin
706 RectPolygon := CellToCanvasRect(Cell.Polygon.GetRect);
707 Result := (
708 (RectPolygon.P1.X < DestRect.Size.X) and
709 (RectPolygon.P2.X > 0) and
710 (RectPolygon.P1.Y < DestRect.Size.Y) and
711 (RectPolygon.P2.Y > 0)
712 );
713end;
714
715end.
716
Note: See TracBrowser for help on using the repository browser.