unboundmodedemominercore.pas

DevExpress ExpressQuantumGrid Suite v5.9 Full Source

  if IsGameFinished then
  begin
    FGameStatus := gsWon;
    FillBombCells(ChangedCells);
    FireEvGameStatusChanged(gsWon, ChangedCells);
  end;
end;

function TMinerField.Get_GameDifficulty: TGameDifficulty;
begin
  Result := FGameDifficulty;
end;

procedure TMinerField.Set_GameDifficulty(const Value: TGameDifficulty);
var
  ACells: TCells;
  procedure SetThisDifficulty;
  begin
    FGameDifficulty.Height := Height;
    FGameDifficulty.Width := Width;
    FGameDifficulty.MineCount := MineCount;
  end;
begin
  FGameDifficulty.DifficultyType := Value.DifficultyType;
  case Value.DifficultyType of
    dtBeginner:
    begin
      Height := 9;
      Width := 9;
      MineCount := 10;
    end;
    dtIntermediate:
    begin
      Height := 16;
      Width := 16;
      MineCount := 40;
    end;
    dtExpert:
    begin
      Height := 16;
      Width := 30;
      MineCount := 99;
    end;
    dtCustom:
    begin
      Height := Value.Height;
      Width := Value.Width;
      MineCount := Value.MineCount;
    end;
  end;
  SetThisDifficulty;
  GameStatus := gsNew;
  FireEvGameStatusChanged(gsNew, ACells);
end;

procedure TMinerField.DropMines(AFirstX, AFirstY: Integer);
var
  DeadNumber: Integer;
  DroppedMines: Integer;
  RandomBase: Integer;
  DroppedNumber: Integer;
  XPos, YPos: Integer;
  procedure SetSurround(AXPos, AYPos: Integer);
  var
    i, j: Integer;
  begin
    for i:=-1 to 1 do
      for j:=-1 to 1 do
        if CheckFieldBounds(AXPos+i, AYPos+j) and (FCellState[AXPos+i, AYPos+j].SurroundNumber <> -1) then
          Inc(FCellState[AXPos+i, AYPos+j].SurroundNumber);
  end;
begin
  DeadNumber := FWidth * AFirstY + AFirstX;
  RandomBase := FWidth * FHeight;
  Randomize;
  DroppedMines :=0;
  while DroppedMines < FMineCount do
  begin
    DroppedNumber := Random(RandomBase);

    XPos := DroppedNumber mod FWidth;
    YPos := DroppedNumber div FWidth;

    if (FCellState[XPos, YPos].SurroundNumber <> -1) and (DroppedNumber <> DeadNumber) then
    begin
      FCellState[XPos, YPos].SurroundNumber := -1;
      SetSurround(XPos, YPos);
      Inc(DroppedMines);
    end;
  end;
end;

procedure TMinerField.BombMarkCell(AXPos, AYPos: Integer);
var
  cState: TCellStateRec;
begin
  cState.SurroundNumber := CellState[AXPos, AYPos].SurroundNumber;
  cState.CellState := csBombMarked;
  CellState[AXPos, AYPos] := cState;
end;

procedure TMinerField.QuestionMarkCell(AXPos, AYPos: Integer);
var
  cState: TCellStateRec;
begin
  cState.SurroundNumber := CellState[AXPos, AYPos].SurroundNumber;
  cState.CellState := csQuestionMarked;
  CellState[AXPos, AYPos] := cState;
end;

procedure TMinerField.CloseCell(AXPos, AYPos: Integer);
var
  cState: TCellStateRec;
begin
  cState.SurroundNumber := CellState[AXPos, AYPos].SurroundNumber;
  cState.CellState := csClosed;
  CellState[AXPos, AYPos] := cState;
end;

procedure TMinerField.OpenSurround(AXPos, AYPos: Integer; var AChangedCells: TCells);
  procedure SetCellState(AXPos, AYPos: Integer; var AChangedCells: TCells);
  begin
    if FCellState[AXPos, AYPos].SurroundNumber <> -1 then
      FCellState[AXPos, AYPos].CellState := csOpened;
    SetLength(AChangedCells, Length(AChangedCells)+1);
    AChangedCells[High(AChangedCells)].x := AXPos;
    AChangedCells[High(AChangedCells)].y := AYPos;
  end;
  function CheckIfClosed_Surround(AXPos, AYPos: Integer): Boolean;
  begin
    Result := False;
    if (FCellState[AXPos, AYPos].CellState = csClosed)
      or (FCellState[AXPos, AYPos].CellState = csQuestionMarked) then
      if FCellState[AXPos, AYPos].SurroundNumber = 0 then
        Result := True
      else
        SetCellState(AXPos, AYPos, AChangedCells);
  end;
begin
  SetCellState(AXPos, AYPos, AChangedCells);
  if CheckFieldBounds(AXPos-1, AYPos-1) and CheckIfClosed_Surround(AXPos-1, AYPos-1) then
    OpenSurround(AXPos-1, AYPos-1, AChangedCells);
  if CheckFieldBounds(AXPos-1, AYPos) and CheckIfClosed_Surround(AXPos-1, AYPos) then
    OpenSurround(AXPos-1, AYPos, AChangedCells);
  if CheckFieldBounds(AXPos, AYPos-1) and CheckIfClosed_Surround(AXPos, AYPos-1) then
    OpenSurround(AXPos, AYPos-1, AChangedCells);
  if CheckFieldBounds(AXPos+1, AYPos+1) and CheckIfClosed_Surround(AXPos+1, AYPos+1) then
    OpenSurround(AXPos+1, AYPos+1, AChangedCells);
  if CheckFieldBounds(AXPos+1, AYPos) and CheckIfClosed_Surround(AXPos+1, AYPos) then
    OpenSurround(AXPos+1, AYPos, AChangedCells);
  if CheckFieldBounds(AXPos, AYPos+1) and CheckIfClosed_Surround(AXPos, AYPos+1) then
    OpenSurround(AXPos, AYPos+1, AChangedCells);
  if CheckFieldBounds(AXPos-1, AYPos+1) and CheckIfClosed_Surround(AXPos-1, AYPos+1) then
    OpenSurround(AXPos-1, AYPos+1, AChangedCells);
  if CheckFieldBounds(AXPos+1, AYPos-1) and CheckIfClosed_Surround(AXPos+1, AYPos-1) then
    OpenSurround(AXPos+1, AYPos-1, AChangedCells);
end;

function TMinerField.CheckFieldBounds(AXPos, AYPos: Integer): Boolean;
begin
   Result := False;
   if (AXPos >=0) and (AYPos >=0) and (AXPos <= High(FCellState)) and
   (AYPos <= High(FCellState[0])) then Result := True;
end;

function TMinerField.Get_GameStatus: TGameStatus;
begin
  Result := FGameStatus;
end;

procedure TMinerField.Set_GameStatus(const Value: TGameStatus);
begin
  FGameStatus := Value;
  if FGameStatus = gsNew then
    CreateNewGame;
end;

function TMinerField.IsGameFinished: Boolean;
var
  i, j: Integer;
  FreeCells: Integer;
begin
  Result := False;
  FreeCells := 0;
  for i:=0 to High(FCellState) do
    for j:=0 to High(FCellState[i]) do
      if (FCellState[i, j].CellState = csClosed) or
        (FCellState[i, j].CellState = csQuestionMarked) then
      begin
        Inc(FreeCells);
        if FreeCells > FMineCount then Exit;
      end;
  if FreeCells = (FMineCount - FCellsBombMarkedCount) then Result := True;
end;

procedure TMinerField.FireEvGameStatusChanged(AGameStatus: TGameStatus; var AChangedCells: TCells);
var
  i: Integer;
  ACells: TChangedCells;
  ARedCells: TCells;
begin
  if Assigned(FGameStatusChanged) then
  begin
    SetLength(ACells, Length(AChangedCells));
    for i:=0 to High(AChangedCells) do
    begin
      ACells[i].Pos := AChangedCells[i];
      ACells[i].CellState := FCellState[AChangedCells[i].x, AChangedCells[i].y];
    end;
    SetLength(ARedCells, Length(FRedCells));
    for i:=0 to High(FRedCells) do
      ARedCells[i] := FRedCells[i];
    FGameStatusChanged(Self, AGameStatus, FGameDifficulty, ACells, ARedCells);
  end;
  AChangedCells := nil;
end;

procedure TMinerField.FireEvMinerFieldChanged(var AChangedCells: TCells);
var
  ACells: TChangedCells;
  ARedCells: TCells;
  i: Integer;
begin
  if Assigned(FMinerFieldChanged) then
  begin
    SetLength(ACells, Length(AChangedCells));
    for i:=0 to High(AChangedCells) do
      with AChangedCells[i] do
      begin
        ACells[i].Pos.x := x;
        ACells[i].Pos.y := y;
        ACells[i].CellState.CellState := FCellState[x, y].CellState;
        ACells[i].CellState.SurroundNumber := FCellState[x, y].SurroundNumber;
      end;
    AChangedCells := nil;
    SetLength(ARedCells, Length(FRedCells));
    for i:=0 to High(FRedCells) do
      ARedCells[i] := FRedCells[i];

    FMinerFieldChanged(Self, ACells, ARedCells);
  end;
end;

procedure TMinerField.HandleEvCreateNewGame(Sender: TObject);
begin
  GameStatus := gsNew;
end;

procedure TMinerField.HandleEvChangeGameDifficulty(Sender: TObject; const AGameDifficulty: TGameDifficulty);
begin
  GameDifficulty := AGameDifficulty;
end;

procedure TMinerField.HandleMinerFieldActionEvent(Sender: TObject; ACol,
  ARow: Integer; AMinerFieldEventType: TMinerFieldActionEventType);
var
  AChangedCell: TCells;
begin
  SetLength(AChangedCell, 1);
  AChangedCell[High(AChangedCell)].x := ACol;
  AChangedCell[High(AChangedCell)].y := ARow;
  case AMinerFieldEventType of
    meOpenCell: OpenCell(ACol, ARow);
    meCloseCell:
    begin
      CloseCell(ACol, ARow);
      FireEvMinerFieldChanged(AChangedCell);
    end;
    meBombMarkCell:
    begin
      BombMarkCell(ACol ,ARow);
      FireEvMinerFieldChanged(AChangedCell);
    end;
    meQuestionMarkCell:
    begin
      QuestionMarkCell(ACol, ARow);
      FireEvMinerFieldChanged(AChangedCell);
    end;
    meCheckSurround: CheckSurround(ACol, ARow);
  end;
end;

initialization
  MinerField := TMinerField.Create;

finalization
  MinerField.Free;
end.