unboundmodedemomain.pas

DevExpress ExpressQuantumGrid Suite v5.9 Full Source

    FImageIndex := 2;
    DrawButton;
  end;

  SetButtonBounds(Rct);
  if IsPointInRect(Point(X, Y), Rct) then
    if FMouseButtonPressed then
    begin
      FMouseButtonPressed := False;
      miNewClick(nil);
    end;
end;

procedure TUnboundModeDemoMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  Rct: TRect;
begin
  SetButtonBounds(Rct);
  if FMouseButtonPressed then
  begin
    if not IsPointInRect(Point(X, Y), Rct) then
    begin
      FMouseButtonPressed := False;
      DrawButton;
    end;
  end else
  begin
    if (IsPointInRect(Point(X, Y), Rct)) and (Shift = [ssLeft])
      and FDown then
    begin
      FMouseButtonPressed := True;
      DrawButton;
    end;
  end;
end;

procedure TUnboundModeDemoMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Rct: TRect;
begin
  if Button <> mbLeft then Exit;
  SetButtonBounds(Rct);
  if not IsPointInRect(Point(X, Y), Rct) then
  begin
    if FImageIndex = 2 then
    begin
      FImageIndex := 0;
      DrawButton;
    end;
    Exit;
  end;
  if not FMouseButtonPressed then
  begin
    FMouseButtonPressed := True;
    FDown := True;
    DrawButton;
  end;
end;

procedure TUnboundModeDemoMainForm.TimerTimer(Sender: TObject);
begin
  if FTime < 999 then Inc(FTime);
  DrawTime;
end;

procedure TUnboundModeDemoMainForm.DrawMineCount;
var
  Rct: TRect;
  mCount: TArrInteger;
  I: Integer;
begin
  if FMineCount >=0 then
    MakeArrayFromInt(FMineCount, mCount, biMineDigitCount)
  else begin
    MakeArrayFromInt(Abs(FMineCount), mCount, biMineDigitCount);
    mCount[biMineDigitCount - 1] := 10; // minus
  end;
  with ilNumbers do
  begin
    Rct := Rect(psBoardInnerIndent, psBoardInnerIndent,
      psBoardInnerIndent + biMineDigitCount * Width + 2*biCountersBorderWidth,
      biNumberHeight + 2*biCountersBorderWidth);
    Frame3d(Canvas, Rct,
      SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dTopColor],
      SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dBottomColor],
      biCountersBorderWidth);
    for I := 0 to biMineDigitCount - 1 do
      Draw(Canvas, Rct.Left + Width*I, Rct.Top, mCount[biMineDigitCount - 1 - I]);
  end;
end;

procedure TUnboundModeDemoMainForm.DrawTime;
var
  Rct: TRect;
  tArr: TArrInteger;
  I, ATimerWidth: Integer;
begin
  MakeArrayFromInt(FTime, tArr, biTimerDigitCount);
  with ilNumbers do
  begin
    ATimerWidth := biTimerDigitCount * Width + 2 * biCountersBorderWidth;
    Rct := Rect(ClientWidth - ATimerWidth - psBoardInnerIndent,
      psBoardInnerIndent, ClientWidth - psBoardInnerIndent,
      biNumberHeight + 2 * biCountersBorderWidth);
    Frame3d(Canvas, Rct,
      SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dTopColor],
      SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dBottomColor],
      biCountersBorderWidth);
    for I := 0 to biTimerDigitCount - 1 do
      Draw(Canvas, Rct.Left + Width*I, Rct.Top, tArr[biTimerDigitCount - 1 - I]);
  end;
end;

procedure TUnboundModeDemoMainForm.HandleEvGameStatusChanged(Sender: TObject; AGameStatus: TGameStatus; AGameDifficulty:
    TGameDifficulty);
begin
  case AGameStatus of
    gsNew:
    begin
      FGameDifficulty := AGameDifficulty;
      FImageIndex := 2;
      FTime := 0;
      Timer.Enabled := False;
      FMineCount := FGameDifficulty.MineCount;
      CheckMenuItem(FGameDifficulty.DifficultyType);
      OnPaint(Self);
    end;
    gsRun:
    begin
      // Timer on
      Timer.Enabled := True;
      TimerTimer(Self);
    end;
    gsLost:
    begin
      FImageIndex := 1;
      OnPaint(Self);
      // Timer off
      Timer.Enabled := False;
    end;
    gsWon:
    begin
      Timer.Enabled := False;
      FImageIndex := 3;
      FMineCount := 0;
      OnPaint(Self);
      CheckBestTimes;
    end
  end;
end;

procedure TUnboundModeDemoMainForm.ReadMinerSettings;
var
  int: Integer;
begin
  with TRegistry.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    OpenKey(Section, False);
    if ValueExists(Difficulty) then
    begin
      int := ReadInteger(Difficulty);
      case int of
        0..3: FGameDifficulty.DifficultyType := TDifficultyType(int);
      else
        FGameDifficulty.DifficultyType := dtBeginner;
      end;
    end;
    if FGameDifficulty.DifficultyType = dtCustom then
    begin
      if ValueExists('Width') then
        FGameDifficulty.Width := ReadInteger(UnboundModeDemoTypes.Width);
      if ValueExists('Height') then
        FGameDifficulty.Height := ReadInteger(UnboundModeDemoTypes.Height);
      if ValueExists('MineCount') then
        FGameDifficulty.MineCount := ReadInteger(MineCount);
    end;
    if ValueExists(Mark) then
      ReadInteger(Mark);
    if ValueExists(Name1) then
      FNames[0] := ReadString(Name1);
    if ValueExists(Name2) then
      FNames[1] := ReadString(Name2);
    if ValueExists(Name3) then
      FNames[2] := ReadString(Name3);
    if ValueExists(Time1) then
      FTimes[0] := ReadInteger(Time1);
    if ValueExists(Time2) then
      FTimes[1] := ReadInteger(Time2);
    if ValueExists(Time3) then
      FTimes[2] := ReadInteger(Time3);
  finally
    CloseKey;
    Free;
  end;
end;

procedure TUnboundModeDemoMainForm.WriteMinerSettings;
var
  i: Integer;
begin
  with TRegistry.Create do
    try
      RootKey := HKey_CURRENT_USER;
      if not OpenKey(Section, False) then
      begin
        CreateKey(Section);
        OpenKey(Section, False);
      end;
      WriteInteger(Difficulty, Integer(FGameDifficulty.DifficultyType));
      WriteInteger('Width', FGameDifficulty.Width);
      WriteInteger('Height', FGameDifficulty.Height);
      WriteInteger('MineCount', FGameDifficulty.MineCount);
      WriteInteger(Mark, 1);
      for i:=0 to High(FNames) do
      begin
        WriteString('Name' + IntToStr(i+1), FNames[i]);
        WriteInteger('Time' + IntToStr(i+1), FTimes[i]);
      end;
  finally
    CloseKey;
    Free;
  end;
end;

procedure TUnboundModeDemoMainForm.InitGameSettings;
begin
  FGameDifficulty.DifficultyType := dtBeginner;
  ResetFastestTimes;
end;

procedure TUnboundModeDemoMainForm.ResetFastestTimes;
var
  i: Integer;
begin
  SetLength(FTimes, 3);
  SetLength(FNames, 3);
  for i:=0 to High(FTimes) do
  begin
    FTimes[i] := 999;
    FNames[i] := 'Anonymous';
  end;
end;

procedure TUnboundModeDemoMainForm.CheckBestTimes;
var
  Level: String;
begin
  if FGameDifficulty.DifficultyType = dtCustom then Exit;
  if FTimes[Integer(FGameDifficulty.DifficultyType)] > FTime then
  begin
    case FGameDifficulty.DifficultyType of
      dtBeginner: Level := 'beginner';
      dtIntermediate: Level := 'intermediate';
      dtExpert: Level := 'expert';
    end;
    FTimes[Integer(FGameDifficulty.DifficultyType)] := FTime;
    FNames[Integer(FGameDifficulty.DifficultyType)] := InputBox('You are the champion in the '+ Level+' level', 'Please enter your name.',
      FNames[Integer(FGameDifficulty.DifficultyType)]);
    miBestTimesClick(nil);
  end;
end;

procedure TUnboundModeDemoMainForm.CheckMenuItem(AGameDifficulty: TDifficultyType);
begin
  case AGameDifficulty of
    dtBeginner: miBeginner.Checked := True;
    dtIntermediate: miIntermediate.Checked := True;
    dtExpert: miExpert.Checked := True;
    dtCustom: miCustom.Checked := True;
  end;
end;

procedure TUnboundModeDemoMainForm.HandleEvImageChanged(Sender: TObject; AImageIndex: Integer);
begin
  case AImageIndex of
    imSmile: FImageIndex := 2;
    imAstonisment: FImageIndex := 0;
    imWon: FImageIndex := 3;
    imLost: FImageIndex := 1;
  end;
  DrawButton;
end;

procedure TUnboundModeDemoMainForm.HandleMineCountChangedEvent(Sender: TObject;
  AMineCountChangedEventType: TMineCountChangedEventType);
begin
  case AMineCountChangedEventType of
    mcIncMineCount: Inc(FMineCount);
    mcDecMineCount: Dec(FMineCount);
  end;
  DrawMineCount;
end;

procedure TUnboundModeDemoMainForm.miGreenClick(
  Sender: TObject);
begin
  if IntMinerField.ColorScheme <> csGreen then
  begin
    IntMinerField.ColorScheme := csGreen;
    FormPaint(Self);
    TMenuItem(Sender).Checked := True;
  end;
end;

procedure TUnboundModeDemoMainForm.miBlueClick(
  Sender: TObject);
begin
  if IntMinerField.ColorScheme <> csBlue then
  begin
    IntMinerField.ColorScheme := csBlue;
    FormPaint(Self);
    TMenuItem(Sender).Checked := True;
  end
end;

procedure TUnboundModeDemoMainForm.miSystemClick(
  Sender: TObject);
begin
  if IntMinerField.ColorScheme <> csSystem then
  begin
    IntMinerField.ColorScheme := csSystem;
    FormPaint(Self);
    TMenuItem(Sender).Checked := True;
  end;
end;

procedure TUnboundModeDemoMainForm.miGoldClick(
  Sender: TObject);
begin
  if IntMinerField.ColorScheme <> csGold then
  begin
    IntMinerField.ColorScheme := csGold;
    FormPaint(Self);
    TMenuItem(Sender).Checked := True;
  end;
end;

end.