Changeset 268
- Timestamp:
- Jan 20, 2019, 9:32:16 PM (6 years ago)
- Location:
- trunk
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormClient.pas
r265 r268 254 254 ) 255 255 ); 256 Client.DrawCities(PaintBox1.Canvas, TempView); 257 end; 258 end; 259 for Y := 0 to CountP.Y do begin 260 for X := 0 to CountP.X do begin 261 TempView.Assign(View); 262 TempView.DestRect := TRect.Create( 263 TPoint.Create( 264 -StartP.X + R.Size.X * X, 265 -StartP.Y + R.Size.Y * Y 266 ), 267 TPoint.Create( 268 -StartP.X + R.Size.X * X + View.DestRect.Size.X, 269 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y 270 ) 271 ); 272 Client.DrawSelection(PaintBox1.Canvas, TempView); 273 end; 274 end; 275 TempView.Free; 276 for Y := 0 to CountP.Y do begin 277 for X := 0 to CountP.X do begin 278 TempView.Assign(View); 279 TempView.DestRect := TRect.Create( 280 TPoint.Create( 281 -StartP.X + R.Size.X * X, 282 -StartP.Y + R.Size.Y * Y 283 ), 284 TPoint.Create( 285 -StartP.X + R.Size.X * X + View.DestRect.Size.X, 286 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y 287 ) 288 ); 256 289 Client.DrawArrows(PaintBox1.Canvas, TempView); 257 290 end; 258 291 end; 259 TempView.Free;260 292 end else begin 261 293 Client.DrawCellLinks(PaintBox1.Canvas, View); 262 294 Client.Paint(PaintBox1.Canvas, View); 295 Client.DrawCities(PaintBox1.Canvas, View); 296 Client.DrawSelection(PaintBox1.Canvas, View); 263 297 Client.DrawArrows(PaintBox1.Canvas, View); 264 298 end; … … 316 350 FClient.OnNextPlayer := DoNextPlayer; 317 351 FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height)); 352 FClient.ShowCellGrid := Core.ShowCellGrid; 318 353 end; 319 354 Redraw; -
trunk/Forms/UFormMain.lfm
r250 r268 15 15 OnKeyUp = FormKeyUp 16 16 OnShow = FormShow 17 LCLVersion = '1.8. 2.0'17 LCLVersion = '1.8.4.0' 18 18 WindowState = wsMaximized 19 19 object ToolBar1: TToolBar … … 146 146 Caption = '-' 147 147 end 148 object MenuItem33: TMenuItem 149 Action = AMapGridVisible 150 end 148 151 object MenuItem21: TMenuItem 149 152 Action = AToolBarVisible … … 218 221 OnExecute = AStatusBarVisibleExecute 219 222 end 223 object AMapGridVisible: TAction 224 Caption = 'Map grid visible' 225 OnExecute = AMapGridVisibleExecute 226 end 220 227 end 221 228 object PopupMenuToolbar: TPopupMenu -
trunk/Forms/UFormMain.pas
r253 r268 18 18 19 19 TFormMain = class(TForm) 20 AMapGridVisible: TAction; 20 21 AStatusBarVisible: TAction; 21 22 AToolBarVisible: TAction; … … 47 48 MenuItem30: TMenuItem; 48 49 MenuItem32: TMenuItem; 50 MenuItem33: TMenuItem; 49 51 MenuItemDebug: TMenuItem; 50 52 MenuItem31: TMenuItem; … … 70 72 ToolButton5: TToolButton; 71 73 ToolButton9: TToolButton; 74 procedure AMapGridVisibleExecute(Sender: TObject); 72 75 procedure AStatusBarVisibleExecute(Sender: TObject); 73 76 procedure AToolBarBigIconsExecute(Sender: TObject); … … 178 181 end; 179 182 183 procedure TFormMain.AMapGridVisibleExecute(Sender: TObject); 184 begin 185 AMapGridVisible.Checked := not AMapGridVisible.Checked; 186 UpdateClientForms; 187 end; 188 180 189 procedure TFormMain.AToolBarBigIconsExecute(Sender: TObject); 181 190 begin … … 211 220 Core.PersistentForm.Save(Self); 212 221 SaveConfig(Core.XMLConfig1, 'FormMain'); 222 Core.ShowCellGrid := AMapGridVisible.Checked; 213 223 Core.Done; 214 224 end; … … 234 244 FormClient.AStatusBarVisible.Checked := AStatusBarVisible.Checked; 235 245 FormClient.AStatusBarVisible.Update; 246 Core.ShowCellGrid := AMapGridVisible.Checked; 247 if Assigned(FormClient.Client) then 248 FormClient.Client.ShowCellGrid := Core.ShowCellGrid; 249 FormClient.Redraw; 236 250 for I := 0 to Core.FormClients.Count - 1 do begin 237 251 Core.FormClients[I].AToolBarBigIcons.Checked := AToolBarBigIcons.Checked; … … 241 255 Core.FormClients[I].AStatusBarVisible.Checked := AStatusBarVisible.Checked; 242 256 Core.FormClients[I].AStatusBarVisible.Update; 257 if Assigned(Core.FormClients[I].Client) then 258 Core.FormClients[I].Client.ShowCellGrid := Core.ShowCellGrid; 259 Core.FormClients[I].Redraw; 243 260 end; 244 261 end; … … 248 265 if not FormShown then begin 249 266 Core.LoadConfig; 267 AMapGridVisible.Checked := Core.ShowCellGrid; 250 268 Core.ScaleDPI; 251 269 Core.PersistentForm.Load(Self, True); -
trunk/Forms/UFormNew.lfm
r266 r268 21 21 Top = 4 22 22 Width = 749 23 ActivePage = TabSheet Rules23 ActivePage = TabSheetMode 24 24 Align = alClient 25 25 BorderSpacing.Around = 4 26 TabIndex = 326 TabIndex = 0 27 27 TabOrder = 0 28 28 object TabSheetMode: TTabSheet … … 32 32 object Panel3: TPanel 33 33 Left = 0 34 Height = 65 134 Height = 655 35 35 Top = 0 36 Width = 7 4336 Width = 739 37 37 Align = alClient 38 38 BevelOuter = bvNone 39 ClientHeight = 65 140 ClientWidth = 7 4339 ClientHeight = 655 40 ClientWidth = 739 41 41 TabOrder = 0 42 42 object RadioButtonModeLocal: TRadioButton … … 44 44 Height = 30 45 45 Top = 14 46 Width = 6846 Width = 70 47 47 Caption = 'Local' 48 48 Checked = True … … 55 55 Height = 30 56 56 Top = 48 57 Width = 15 457 Width = 156 58 58 Caption = 'Network server' 59 59 OnChange = RadioButtonModeLocalChange … … 64 64 Height = 30 65 65 Top = 152 66 Width = 1 4966 Width = 151 67 67 Caption = 'Network client' 68 68 OnChange = RadioButtonModeLocalChange … … 71 71 object EditServerAddress: TEdit 72 72 Left = 24 73 Height = 3673 Height = 43 74 74 Top = 112 75 75 Width = 220 … … 78 78 object SpinEditServerPort: TSpinEdit 79 79 Left = 256 80 Height = 3680 Height = 43 81 81 Top = 112 82 82 Width = 79 … … 102 102 object ListViewServers: TListView 103 103 Left = 26 104 Height = 4 19104 Height = 423 105 105 Top = 181 106 106 Width = 334 … … 130 130 Left = 27 131 131 Height = 31 132 Top = 61 2132 Top = 616 133 133 Width = 94 134 134 Action = AServerAdd … … 139 139 Left = 240 140 140 Height = 31 141 Top = 61 2141 Top = 616 142 142 Width = 94 143 143 Action = AServerRemove … … 148 148 Left = 136 149 149 Height = 30 150 Top = 61 2150 Top = 616 151 151 Width = 94 152 152 Action = AServerModify … … 324 324 object ComboBoxGridType: TComboBox 325 325 Left = 146 326 Height = 42326 Height = 38 327 327 Top = 104 328 328 Width = 208 … … 340 340 object ComboBoxMapShape: TComboBox 341 341 Left = 146 342 Height = 42342 Height = 38 343 343 Top = 144 344 344 Width = 208 -
trunk/Languages/xtactics.cs.po
r265 r268 230 230 msgstr "Vykonat" 231 231 232 #: tformmain.amapgridvisible.caption 233 msgid "Map grid visible" 234 msgstr "Mřížka mapy viditelná" 235 236 #: tformmain.astatusbarvisible.caption 237 msgid "Status bar visible" 238 msgstr "Stavová lišta viditelná" 239 232 240 #: tformmain.atoolbarbigicons.caption 233 241 msgctxt "tformmain.atoolbarbigicons.caption" … … 274 282 msgid "Help" 275 283 msgstr "Nápověda" 276 277 #: tformmain.menuitem22.caption278 msgctxt "tformmain.menuitem22.caption"279 msgid "Statusbar visible"280 msgstr "Viditelná stavová lišta"281 284 282 285 #: tformmain.menuitem8.caption … … 707 710 #: tformsettings.checkboxreopenlastfile.caption 708 711 msgid "Reopen last game on start" 709 msgstr "Znovu otevřít poslední hru při startu"712 msgstr "Znovu otevřít poslední hru při startu" 710 713 711 714 #: tformsettings.label1.caption -
trunk/Languages/xtactics.po
r265 r268 220 220 msgstr "" 221 221 222 #: tformmain.amapgridvisible.caption 223 msgid "Map grid visible" 224 msgstr "" 225 226 #: tformmain.astatusbarvisible.caption 227 msgid "Status bar visible" 228 msgstr "" 229 222 230 #: tformmain.atoolbarbigicons.caption 223 231 msgctxt "tformmain.atoolbarbigicons.caption" … … 263 271 msgctxt "tformmain.menuitem16.caption" 264 272 msgid "Help" 265 msgstr ""266 267 #: tformmain.menuitem22.caption268 msgctxt "tformmain.menuitem22.caption"269 msgid "Statusbar visible"270 273 msgstr "" 271 274 -
trunk/UClientGUI.pas
r267 r268 48 48 public 49 49 View: TView; 50 ShowCellGrid: Boolean; 50 51 procedure DrawArrow(Canvas: TCanvas; Pos: TPoint; Angle: Double; 51 52 Text: string; View: TView); … … 58 59 procedure DrawCellLinks(Canvas: TCanvas; View: TView); 59 60 procedure DrawNeighborLinks(Canvas: TCanvas; View: TView); 61 procedure DrawCities(Canvas: TCanvas; View: TView); 62 procedure DrawSelection(Canvas: TCanvas; View: TView); 60 63 procedure Paint(Canvas: TCanvas; View: TView); 61 64 constructor Create; override; … … 107 110 end; 108 111 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; 112 // Cannot set clear border as it will display shifted on gtk2 113 //Pen.Style := psClear; 114 Pen.Style := psSolid; 115 if ShowCellGrid then begin 117 116 Pen.Color := clBlack; 118 Pen.Style := psSolid; 119 Pen.Width := 3; 117 Pen.Width := Round(2 * View.Zoom); 120 118 end else begin 121 // Cannot set clear border as it will display shifted on gtk2122 //Pen.Style := psClear;123 119 Pen.Color := Brush.Color; 124 Pen.Style := psSolid;125 120 Pen.Width := 0; 126 121 end; 122 127 123 // Transform view 128 124 SetLength(Points, Length(Cell.MapCell.Polygon.Points)); … … 130 126 Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.Polygon.Points[I])); 131 127 Brush.Style := bsSolid; 132 //Polygon(Points, False, 0, Length(Points));133 128 TCanvasEx.PolygonEx(Canvas, Points, False); 134 //MoveTo(Points[0].X, Points[0].Y);135 //LineTo(Points[1].X, Points[1].Y);136 129 137 130 // Show cell text … … 237 230 not ControlPlayer.PlayerMap.Cells.SearchCell(Move.CellTo.MapCell).InVisibleRange then 238 231 Continue; 239 if Move.CountRepeat > 0 then Pen.Width := 2240 else Pen.Width := 1;232 if Move.CountRepeat > 0 then Pen.Width := Round(2 * View.Zoom) 233 else Pen.Width := Round(1 * View.Zoom); 241 234 Angle := ArcTan2(PosTo.Y - PosFrom.Y, PosTo.X - PosFrom.X); 242 235 if (Angle > +Pi) or (Angle < -Pi) then … … 312 305 MapCell: TCell; 313 306 CellText: string; 307 Points: array of Classes.TPoint; 308 I: Integer; 314 309 begin 315 310 with Canvas, View do begin … … 404 399 end; 405 400 401 procedure TClientGUI.DrawCities(Canvas: TCanvas; View: TView); 402 var 403 Cell: TPlayerCell; 404 MapCell: TCell; 405 CellText: string; 406 Points: array of Classes.TPoint; 407 I: Integer; 408 begin 409 with Canvas, View do begin 410 if Assigned(ControlPlayer) then begin 411 for Cell in ControlPlayer.PlayerMap.Cells do begin 412 if (Cell.MapCell.Terrain <> ttVoid) and View.IsCellVisible(Cell.MapCell) then begin 413 if Cell.MapCell.Terrain = ttCity then begin 414 // Cannot set clear border as it will display shifted on gtk2 415 //Pen.Style := psClear; 416 Pen.Color := clBlack; 417 Pen.Style := psSolid; 418 Pen.Width := Round(6 * View.Zoom); 419 420 // Transform view 421 SetLength(Points, Length(Cell.MapCell.Polygon.Points) + 1); 422 for I := 0 to Length(Cell.MapCell.Polygon.Points) - 1 do 423 Points[I] := PointToStdPoint(View.CellToCanvasPos(Cell.MapCell.Polygon.Points[I])); 424 Points[Length(Points) - 1] := Points[0]; 425 TCanvasEx.PolyLineEx(Canvas, Points); 426 end; 427 end; 428 end; 429 end else begin 430 for MapCell in TGame(Game).Map.Cells do begin 431 if (MapCell.Terrain <> ttVoid) and View.IsCellVisible(MapCell) then begin 432 if View.IsCellVisible(MapCell) and (MapCell.Terrain <> ttVoid) then begin 433 if MapCell.Terrain = ttCity then begin 434 // Cannot set clear border as it will display shifted on gtk2 435 //Pen.Style := psClear; 436 Pen.Color := clBlack; 437 Pen.Style := psSolid; 438 Pen.Width := Round(6 * View.Zoom); 439 440 // Transform view 441 SetLength(Points, Length(MapCell.Polygon.Points) + 1); 442 for I := 0 to Length(MapCell.Polygon.Points) - 1 do 443 Points[I] := PointToStdPoint(View.CellToCanvasPos(MapCell.Polygon.Points[I])); 444 Points[Length(Points) - 1] := Points[0]; 445 TCanvasEx.PolyLineEx(Canvas, Points); 446 end; 447 end; 448 end; 449 end; 450 end; 451 end; 452 end; 453 454 procedure TClientGUI.DrawSelection(Canvas: TCanvas; View: TView); 455 var 456 Cell: TPlayerCell; 457 MapCell: TCell; 458 CellText: string; 459 Points: array of Classes.TPoint; 460 I: Integer; 461 begin 462 with Canvas, View do begin 463 if Assigned(ControlPlayer) then begin 464 if Assigned(View.FocusedCell) then begin 465 Pen.Color := clYellow; 466 Pen.Style := psSolid; 467 Pen.Width := Round(2 * View.Zoom); 468 469 // Transform view 470 SetLength(Points, Length(View.FocusedCell.MapCell.Polygon.Points) + 1); 471 for I := 0 to Length(View.FocusedCell.MapCell.Polygon.Points) - 1 do 472 Points[I] := PointToStdPoint(View.CellToCanvasPos(View.FocusedCell.MapCell.Polygon.Points[I])); 473 Points[Length(Points) - 1] := Points[0]; 474 TCanvasEx.PolyLineEx(Canvas, Points); 475 end; 476 end; 477 end; 478 end; 479 406 480 { TView } 407 481 -
trunk/UCore.pas
r265 r268 95 95 DevelMode: Boolean; 96 96 AnimationSpeed: Integer; 97 ShowCellGrid: Boolean; 97 98 AutoSaveEnabled: Boolean; 98 99 ReopenLastFile: Boolean; … … 202 203 ScaleDPI1.AutoDetect := XMLConfig1.GetValue('DPIAuto', True); 203 204 FormNewTabIndex := XMLConfig1.GetValue('FormNewTabIndex', 0); 205 ShowCellGrid := XMLConfig1.GetValue('ShowCellGrid', True); 204 206 end; 205 207 … … 217 219 XMLConfig1.SetValue('DPIAuto', ScaleDPI1.AutoDetect); 218 220 XMLConfig1.SetValue('FormNewTabIndex', FormNewTabIndex); 221 XMLConfig1.SetValue('ShowCellGrid', ShowCellGrid); 219 222 end; 220 223 -
trunk/UGame.pas
r265 r268 23 23 class procedure TextOutEx(Canvas: TCanvas; X,Y: Integer; const Text: string; MovePen: Boolean = True); 24 24 class procedure PolygonEx(Canvas: TCanvas; const Points: array of Classes.TPoint; Winding: Boolean); 25 class procedure PolyLineEx(Canvas: TCanvas; const Points: array of Classes.TPoint); 25 26 end; 26 27 … … 180 181 end; 181 182 183 class procedure TCanvasEx.PolyLineEx(Canvas: TCanvas; 184 const Points: array of Classes.TPoint); 185 begin 186 LCLIntf.Polyline(Canvas.Handle, @Points[0], Length(Points)); 187 end; 188 182 189 { TGame } 183 190 -
trunk/UMapType.pas
r258 r268 20 20 private 21 21 const 22 CellMulX = 1.12 ;23 CellMulY = 1.292 ;22 CellMulX = 1.12 * 1.028; 23 CellMulY = 1.292 * 1.03; 24 24 function IsCellsPosNeighbor(CellPos1, CellPos2: TPoint): Boolean; 25 25 procedure GetCellPosNeighbors(CellPos: TPoint; Cell: TCell); … … 38 38 TSquareMap = class(TMap) 39 39 private 40 const41 CellMulX = 1.05;42 CellMulY = 1.05;43 40 function GetSquarePolygon(Pos: TPoint; Size: TPoint): TPolygon; 44 41 public 45 42 procedure Generate; override; 46 function CalculatePixelRect: TRect; override;47 43 end; 48 44 … … 52 48 private 53 49 const 54 CellMulX = 0.5 5;55 CellMulY = 1 .05;50 CellMulX = 0.5; 51 CellMulY = 1; 56 52 function GetTrianglePolygon(Pos: TPoint; Size: TPoint; Reverse: Boolean): TPolygon; 57 53 protected … … 76 72 private 77 73 const 78 CellMulX = 0.95;79 CellMulY = 3. 35;74 CellMulX = 1; 75 CellMulY = 3.5; 80 76 function GetTilePolygon(Pos: TPoint; Size: TPoint): TPolygon; 81 77 protected … … 173 169 Result := inherited CalculatePixelRect; 174 170 Result.P2 := Result.P2 - TPoint.Create( 175 Trunc(0. 45 * DefaultCellSize.X / CellMulX),176 Trunc( 0.90 *DefaultCellSize.Y / CellMulY)171 Trunc(0.5 * DefaultCellSize.X / CellMulX), 172 Trunc(DefaultCellSize.Y / CellMulY) 177 173 ); 178 174 end; … … 212 208 Shift := TPointF.Create(0.5, 0.5) * TPointF.Create(Cos(Angle), Sin(Angle)); 213 209 Result.P2 := Result.P2 - TPoint.Create( 214 Trunc(0. 47* DefaultCellSize.X / CellMulX),215 Trunc(1. 2* Shift.Y * DefaultCellSize.Y / CellMulY)210 Trunc(0.5 * DefaultCellSize.X / CellMulX), 211 Trunc(1.35 * Shift.Y * DefaultCellSize.Y / CellMulY) 216 212 ); 217 213 end; … … 344 340 NewCell := TCell.Create; 345 341 NewCell.Map := Self; 346 NewCell.PosPx := TPoint.Create(Trunc(X * DefaultCellSize.X * CellMulX),347 Trunc(Y * DefaultCellSize.Y * CellMulY));342 NewCell.PosPx := TPoint.Create(Trunc(X * DefaultCellSize.X), 343 Trunc(Y * DefaultCellSize.Y)); 348 344 NewCell.Polygon := GetSquarePolygon(NewCell.PosPx, DefaultCellSize); 349 345 NewCell.Id := GetNewCellId; … … 382 378 383 379 FPixelRect := CalculatePixelRect; 384 end;385 386 function TSquareMap.CalculatePixelRect: TRect;387 begin388 Result := inherited CalculatePixelRect;389 Result.P2 := Result.P2 + TPoint.Create(390 Trunc(0.05 * DefaultCellSize.X / CellMulX),391 Trunc(0.05 * DefaultCellSize.Y / CellMulY)392 );393 380 end; 394 381 … … 424 411 AreaSize: TPoint; 425 412 const 426 CellGapWidth = 4;413 LinkTolerance = 8; 427 414 begin 428 415 Clear; … … 457 444 LinkLine := TLine.Create(Cell.PosPx, Cell2.PosPx + 458 445 TPoint.Create(X * AreaSize.X, Y * AreaSize.Y)); 459 LinkLine.Distance := LinkLine.Distance - CellGapWidth;446 LinkLine.Distance := LinkLine.Distance; 460 447 MP := LinkLine.GetMiddle; 461 448 // Create half plane vector … … 473 460 if Cell2 <> Cell then begin 474 461 LinkLine := TLine.Create(Cell.PosPx, Cell2.PosPx); 475 LinkLine.Distance := LinkLine.Distance - CellGapWidth;462 LinkLine.Distance := LinkLine.Distance; 476 463 MP := LinkLine.GetMiddle; 477 464 // Create half plane vector … … 493 480 P := Cells[J].Polygon; 494 481 P.Move(TPoint.Create(X * AreaSize.X, Y * AreaSize.Y)); 495 if Cells[I].Polygon.EdgeDistance(P) < 2 * CellGapWidththen482 if Cells[I].Polygon.EdgeDistance(P) < LinkTolerance then 496 483 Cells[I].ConnectTo(Cells[J]); 497 484 end; … … 500 487 for I := 0 to Cells.Count - 1 do begin 501 488 for J := I + 1 to Cells.Count - 1 do begin 502 if Cells[I].Polygon.EdgeDistance(Cells[J].Polygon) < 2 * CellGapWidththen489 if Cells[I].Polygon.EdgeDistance(Cells[J].Polygon) < LinkTolerance then 503 490 Cells[I].ConnectTo(Cells[J]); 504 491 end; … … 603 590 Result := inherited CalculatePixelRect; 604 591 Result.P2 := Result.P2 + TPoint.Create( 605 Trunc( 0.05 * DefaultCellSize.X / CellMulX - 0.30* DefaultCellSize.X / CellMulX),606 Trunc(0.05 * DefaultCellSize.Y / CellMulY)592 Trunc(- 0.25 * DefaultCellSize.X / CellMulX), 593 0 607 594 ); 608 595 end;
Note:
See TracChangeset
for help on using the changeset viewer.