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