- Timestamp:
- Jan 30, 2019, 8:08:44 AM (6 years ago)
- Location:
- trunk
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormClient.pas
r269 r273 347 347 FClient.OnNextPlayer := DoNextPlayer; 348 348 FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height)); 349 FClient.ShowCellGrid := Core.ShowCellGrid; 349 FClient.CellGridVisible := Core.CellGridVisible; 350 FClient.UnitShapeVisible := Core.UnitShapeVisible; 350 351 end; 351 352 Redraw; -
trunk/Forms/UFormMain.lfm
r268 r273 149 149 Action = AMapGridVisible 150 150 end 151 object MenuItem34: TMenuItem 152 Action = AUnitShapeVisible 153 end 154 object MenuItem35: TMenuItem 155 Caption = '-' 156 end 151 157 object MenuItem21: TMenuItem 152 158 Action = AToolBarVisible … … 225 231 OnExecute = AMapGridVisibleExecute 226 232 end 233 object AUnitShapeVisible: TAction 234 Caption = 'Unit shape visible' 235 OnExecute = AUnitShapeVisibleExecute 236 end 227 237 end 228 238 object PopupMenuToolbar: TPopupMenu -
trunk/Forms/UFormMain.pas
r268 r273 18 18 19 19 TFormMain = class(TForm) 20 AUnitShapeVisible: TAction; 20 21 AMapGridVisible: TAction; 21 22 AStatusBarVisible: TAction; … … 49 50 MenuItem32: TMenuItem; 50 51 MenuItem33: TMenuItem; 52 MenuItem34: TMenuItem; 53 MenuItem35: TMenuItem; 51 54 MenuItemDebug: TMenuItem; 52 55 MenuItem31: TMenuItem; … … 76 79 procedure AToolBarBigIconsExecute(Sender: TObject); 77 80 procedure AToolBarVisibleExecute(Sender: TObject); 81 procedure AUnitShapeVisibleExecute(Sender: TObject); 78 82 procedure FormActivate(Sender: TObject); 79 83 procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); … … 201 205 end; 202 206 207 procedure TFormMain.AUnitShapeVisibleExecute(Sender: TObject); 208 begin 209 AUnitShapeVisible.Checked := not AUnitShapeVisible.Checked; 210 UpdateClientForms; 211 end; 212 203 213 procedure TFormMain.FormActivate(Sender: TObject); 204 214 begin … … 220 230 Core.PersistentForm.Save(Self); 221 231 SaveConfig(Core.XMLConfig1, 'FormMain'); 222 Core.ShowCellGrid := AMapGridVisible.Checked; 232 Core.CellGridVisible := AMapGridVisible.Checked; 233 Core.UnitShapeVisible := AUnitShapeVisible.Checked; 223 234 Core.Done; 224 235 end; … … 244 255 FormClient.AStatusBarVisible.Checked := AStatusBarVisible.Checked; 245 256 FormClient.AStatusBarVisible.Update; 246 Core.ShowCellGrid := AMapGridVisible.Checked; 247 if Assigned(FormClient.Client) then 248 FormClient.Client.ShowCellGrid := Core.ShowCellGrid; 257 Core.CellGridVisible := AMapGridVisible.Checked; 258 Core.UnitShapeVisible := AUnitShapeVisible.Checked; 259 if Assigned(FormClient.Client) then begin 260 FormClient.Client.CellGridVisible := Core.CellGridVisible; 261 FormClient.Client.UnitShapeVisible := Core.UnitShapeVisible; 262 end; 249 263 FormClient.Redraw; 250 264 for I := 0 to Core.FormClients.Count - 1 do begin … … 255 269 Core.FormClients[I].AStatusBarVisible.Checked := AStatusBarVisible.Checked; 256 270 Core.FormClients[I].AStatusBarVisible.Update; 257 if Assigned(Core.FormClients[I].Client) then 258 Core.FormClients[I].Client.ShowCellGrid := Core.ShowCellGrid; 271 if Assigned(Core.FormClients[I].Client) then begin 272 Core.FormClients[I].Client.CellGridVisible := Core.CellGridVisible; 273 Core.FormClients[I].Client.UnitShapeVisible := Core.UnitShapeVisible; 274 end; 259 275 Core.FormClients[I].Redraw; 260 276 end; … … 265 281 if not FormShown then begin 266 282 Core.LoadConfig; 267 AMapGridVisible.Checked := Core.ShowCellGrid; 283 AMapGridVisible.Checked := Core.CellGridVisible; 284 AUnitShapeVisible.Checked := Core.UnitShapeVisible; 268 285 Core.ScaleDPI; 269 286 Core.PersistentForm.Load(Self, True); -
trunk/Forms/UFormNew.lfm
r270 r273 21 21 Top = 4 22 22 Width = 806 23 ActivePage = TabSheet Map23 ActivePage = TabSheetRules 24 24 Align = alClient 25 25 BorderSpacing.Around = 4 26 TabIndex = 226 TabIndex = 3 27 27 TabOrder = 0 28 28 OnChange = PageControl1Change … … 326 326 object ComboBoxGridType: TComboBox 327 327 Left = 146 328 Height = 38328 Height = 42 329 329 Top = 104 330 330 Width = 208 … … 343 343 object ComboBoxMapShape: TComboBox 344 344 Left = 146 345 Height = 38345 Height = 42 346 346 Top = 144 347 347 Width = 208 … … 546 546 object Panel4: TPanel 547 547 Left = 0 548 Height = 65 5548 Height = 652 549 549 Top = 0 550 Width = 7 39550 Width = 796 551 551 Align = alClient 552 552 BevelOuter = bvNone 553 ClientHeight = 65 5554 ClientWidth = 7 39553 ClientHeight = 652 554 ClientWidth = 796 555 555 TabOrder = 0 556 556 object RadioGroupGrowCells: TRadioGroup … … 587 587 object ComboBoxWinObjective: TComboBox 588 588 Left = 224 589 Height = 38589 Height = 42 590 590 Top = 244 591 591 Width = 328 … … 635 635 Height = 78 636 636 Top = 290 637 Width = 7 16637 Width = 773 638 638 ActivePage = TabSheetCaptureEntireMap 639 639 Anchors = [akTop, akLeft, akRight] … … 647 647 object TabSheetCaptureCells: TTabSheet 648 648 ClientHeight = 74 649 ClientWidth = 7 12649 ClientWidth = 763 650 650 object Label14: TLabel 651 651 Left = 8 … … 669 669 object TabSheetStayAliveTurns: TTabSheet 670 670 ClientHeight = 74 671 ClientWidth = 7 12671 ClientWidth = 763 672 672 object Label13: TLabel 673 673 Left = 8 -
trunk/Forms/UFormNew.pas
r271 r273 417 417 Client.View.ZoomAll; 418 418 //Client.ControlPlayer := GamePreview.Players.First; 419 Client. ShowCellGrid:= True;419 Client.CellGridVisible := True; 420 420 Bitmap.Canvas.Brush.Color := MapBackgroundColor; //clBackground; //PaintBox1.GetColorResolvingParent; 421 421 Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height); -
trunk/Languages/xtactics.cs.po
r272 r273 247 247 msgid "Toolbar visible" 248 248 msgstr "Viditelný nástrojový panel" 249 250 #: tformmain.aunitshapevisible.caption 251 msgid "Unit shape visible" 252 msgstr "Obrys jednotek viditelný" 249 253 250 254 #: tformmain.caption -
trunk/Languages/xtactics.po
r272 r273 236 236 msgctxt "tformmain.atoolbarvisible.caption" 237 237 msgid "Toolbar visible" 238 msgstr "" 239 240 #: tformmain.aunitshapevisible.caption 241 msgid "Unit shape visible" 238 242 msgstr "" 239 243 -
trunk/UClientAI.pas
r265 r273 111 111 TargetCell: TPlayerCell; 112 112 NeighborCell: TPlayerCell; 113 DefendCount: Integer; 113 114 begin 114 115 if ControlPlayer.Defensive then Exit; … … 144 145 end; 145 146 // Attack if target is weaker 146 if Game.AttackProbability(TotalPower, TargetCell.MapCell.OneUnit.Power) >= 147 if Assigned(TargetCell.MapCell.OneUnit) then 148 DefendCount := TargetCell.MapCell.OneUnit.Power 149 else DefendCount := 0; 150 if Game.AttackProbability(TotalPower, DefendCount) >= 147 151 ComputerAggroProbability[ControlPlayer.Agressivity] then begin 148 152 // Try to limit total attacking power to necessary minimum 149 while Game.AttackProbability(TotalPower - 1, TargetCell.MapCell.OneUnit.Power) >=153 while Game.AttackProbability(TotalPower - 1, DefendCount) >= 150 154 ComputerAggroProbability[ControlPlayer.Agressivity] do 151 155 Dec(TotalPower); -
trunk/UClientGUI.pas
r270 r273 49 49 public 50 50 View: TView; 51 ShowCellGrid: Boolean; 51 CellGridVisible: Boolean; 52 UnitShapeVisible: Boolean; 52 53 procedure DrawArrow(Canvas: TCanvas; Pos: TPoint; Angle: Double; 53 54 Text: string; View: TView); … … 110 111 Points: array of Classes.TPoint; 111 112 TextSize: TSize; 113 R: Integer; 112 114 begin 113 115 if Cell.MapCell.Extra = etObjectiveTarget then begin … … 118 120 //Pen.Style := psClear; 119 121 Pen.Style := psSolid; 120 if ShowCellGridthen begin122 if CellGridVisible then begin 121 123 Pen.Color := clBlack; 122 124 Pen.Width := Round(2 * View.Zoom); … … 144 146 Round(TextPos.Y) - TextSize.cy div 2, Text, False); 145 147 end; 148 if UnitShapeVisible and Assigned(Cell.MapCell.OneUnit) then begin 149 TextPos := View.CellToCanvasPos(Pos); 150 R := Trunc(70 * View.Zoom); 151 Pen.Color := clWhite; 152 Pen.Style := psSolid; 153 Pen.Width := Round(10 * View.Zoom); 154 Brush.Style := bsClear; 155 TCanvasEx.Ellipse(Canvas, TRect.Create( 156 TPoint.Create(TextPos.X - R, TextPos.Y - R), 157 TPoint.Create(TextPos.X + R, TextPos.Y + R) 158 )); 159 end; 146 160 end; 147 161 end; … … 154 168 Points: array of Classes.TPoint; 155 169 TextSize: TSize; 170 R: Integer; 156 171 begin 157 172 if Cell.Extra = etObjectiveTarget then begin … … 188 203 189 204 // Show cell text 190 if (Cell.OneUnit.Power <> 0) or (Cell.Extra = etObjectiveTarget) then begin 205 if Assigned(Cell.OneUnit) and (Cell.OneUnit.Power <> 0) or 206 (Cell.Extra = etObjectiveTarget) then begin 191 207 Pen.Style := psSolid; 192 208 Font.Color := clWhite; … … 197 213 TCanvasEx.TextOutEx(Canvas, Round(TextPos.X) - TextSize.cx div 2, 198 214 Round(TextPos.Y) - TextSize.cy div 2, Text, False); 215 end; 216 if UnitShapeVisible and Assigned(Cell.OneUnit) then begin 217 TextPos := View.CellToCanvasPos(Pos); 218 R := Trunc(70 * View.Zoom); 219 Pen.Color := clWhite; 220 Pen.Style := psSolid; 221 Pen.Width := Round(10 * View.Zoom); 222 Brush.Style := bsClear; 223 TCanvasEx.Ellipse(Canvas, TRect.Create( 224 TPoint.Create(TextPos.X - R, TextPos.Y - R), 225 TPoint.Create(TextPos.X + R, TextPos.Y + R) 226 )); 199 227 end; 200 228 end; -
trunk/UCore.pas
r268 r273 95 95 DevelMode: Boolean; 96 96 AnimationSpeed: Integer; 97 ShowCellGrid: Boolean; 97 CellGridVisible: Boolean; 98 UnitShapeVisible: Boolean; 98 99 AutoSaveEnabled: Boolean; 99 100 ReopenLastFile: Boolean; … … 203 204 ScaleDPI1.AutoDetect := XMLConfig1.GetValue('DPIAuto', True); 204 205 FormNewTabIndex := XMLConfig1.GetValue('FormNewTabIndex', 0); 205 ShowCellGrid := XMLConfig1.GetValue('ShowCellGrid', True); 206 CellGridVisible := XMLConfig1.GetValue('CellGridVisible', True); 207 UnitShapeVisible := XMLConfig1.GetValue('UnitShapeVisible', False); 206 208 end; 207 209 … … 219 221 XMLConfig1.SetValue('DPIAuto', ScaleDPI1.AutoDetect); 220 222 XMLConfig1.SetValue('FormNewTabIndex', FormNewTabIndex); 221 XMLConfig1.SetValue('ShowCellGrid', ShowCellGrid); 223 XMLConfig1.SetValue('CellGridVisible', CellGridVisible); 224 XMLConfig1.SetValue('UnitShapeVisible', UnitShapeVisible); 222 225 end; 223 226 -
trunk/UGame.pas
r271 r273 24 24 class procedure PolygonEx(Canvas: TCanvas; const Points: array of Classes.TPoint; Winding: Boolean); 25 25 class procedure PolyLineEx(Canvas: TCanvas; const Points: array of Classes.TPoint); 26 class procedure Ellipse(Canvas: TCanvas; const ARect: TRect); 26 27 end; 27 28 … … 191 192 end; 192 193 194 class procedure TCanvasEx.Ellipse(Canvas: TCanvas; const ARect: TRect); 195 begin 196 LCLIntf.Ellipse(Canvas.Handle, ARect.P1.X, ARect.P1.Y, ARect.P2.X, ARect.P2.Y); 197 end; 198 193 199 { TGame } 194 200 … … 289 295 var 290 296 Cell: TCell; 297 NewPower: Integer; 291 298 begin 292 299 // Randomize map terrain … … 296 303 (Map.IsOutsideShape(PosPx)) then Terrain := ttVoid 297 304 else Terrain := ttNormal; 298 if not Assigned(OneUnit) then 299 OneUnit := Units.AddNew(GameSystem.UnitKinds[0], Random(MaxNeutralUnits + 1)); 305 NewPower := Random(MaxNeutralUnits + 1); 306 if (NewPower > 0) and not Assigned(OneUnit) then begin 307 OneUnit := Units.AddNew(GameSystem.UnitKinds[0], NewPower); 308 end; 300 309 Player := nil; 301 310 end; … … 512 521 SetValue(DOMString(Path + '/StayAliveForDefinedTurns'), StayAliveForDefinedTurns); 513 522 SetValue(DOMString(Path + '/SpecialCaptureCellCount'), SpecialCaptureCellCount); 523 SetValue(DOMString(Path + '/MaxNeutralUnits'), MaxNeutralUnits); 524 SetValue(DOMString(Path + '/MaxPower'), MaxPower); 514 525 Players.SaveConfig(Config, Path + '/Players'); 515 526 end; … … 548 559 StayAliveForDefinedTurns := GetValue(DOMString(Path + '/StayAliveForDefinedTurns'), 20); 549 560 SpecialCaptureCellCount := GetValue(DOMString(Path + '/SpecialCaptureCellCount'), 1); 561 MaxNeutralUnits := GetValue(DOMString(Path + '/MaxNeutralUnits'), 5); 562 MaxPower := GetValue(DOMString(Path + '/MaxPower'), 99); 550 563 Players.LoadConfig(Config, Path + '/Players'); 551 564 end; … … 730 743 CurrentPlayer.Grow; 731 744 CurrentPlayer.UpdateEmptyCellsNeutral; 745 CurrentPlayer.RemoveEmptyUnits; 732 746 CurrentPlayer.UpdateRepeatMoves; 733 747 ComputePlayerStats; -
trunk/UPlayer.pas
r265 r273 122 122 procedure ReduceMovesPower; 123 123 procedure RemoveInvalidMoves; 124 procedure RemoveEmptyUnits; 124 125 procedure UpdateRepeatMoves; 125 126 procedure UpdateEmptyCellsNeutral; … … 1059 1060 if Moves[I].CellFrom.MapCell.Player <> Self then 1060 1061 Moves.Delete(I); 1062 end; 1063 1064 procedure TPlayer.RemoveEmptyUnits; 1065 var 1066 I: Integer; 1067 OneUnit: TUnit; 1068 begin 1069 for I := 0 to PlayerMap.Cells.Count - 1 do 1070 with TPlayerCell(PlayerMap.Cells[I]) do begin 1071 if Assigned(MapCell.OneUnit) and (MapCell.OneUnit.Power = 0) then begin 1072 OneUnit := MapCell.OneUnit; 1073 MapCell.OneUnit := nil; 1074 Units.Remove(OneUnit); 1075 end; 1076 end; 1061 1077 end; 1062 1078 … … 1154 1170 for I := 0 to PlayerMap.Cells.Count - 1 do 1155 1171 with TPlayerCell(PlayerMap.Cells[I]) do begin 1156 if MapCell.OneUnit.Power = 0 then MapCell.Player := nil; 1172 if Assigned(MapCell.OneUnit) and (MapCell.OneUnit.Power = 0) then 1173 MapCell.Player := nil; 1157 1174 end; 1158 1175 end;
Note:
See TracChangeset
for help on using the changeset viewer.