unboundmodedemointminerfield.pas

DevExpress ExpressQuantumGrid Suite v5.9 Full Source

unit UnboundModeDemoIntMinerField;

{$I ..\..\cxVer.inc}

interface

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, cxGrid, UnboundModeDemoMinerCore, cxGridCustomTableView, cxGraphics,
  UnboundModeDemoTypes,  UnboundModeDemoMinerDataSource, cxGridTableView,
  cxGridCustomView, cxLookAndFeels;
type
  TIntMinerField = class(TcxCustomGrid)
  private
    FColCount: Integer;
    FRowCount: Integer;
    FCellWidth: Integer;
    FGameStatus: TGameStatus;
    FRedCells: TCells;

    FSurroundColors: TColors;
    FMinerFieldDataSource: TMinerFieldDataSource;

    { Scheme colors}
    FOpenCellBkColor: TColor;
    FClosedCellBkColor: TColor;
    FFrameColor: TColor;
    FRectangleColor: TColor;

    FQuestionMarkCell: Boolean;

    FImages: TImageList;
    FPressedCells: TCells;

    FGameDifficulty: TGameDifficulty;

    FSurprised: Boolean;
    FCreateNewGameEvent: TCreateNewGameEvent;
    FOnMinerFieldAction: TMinerFieldActionEvent;
    FMineCountChanged: TMineCountChangedEvent;
    FOnImageChanged: TImageChangedEvent;
    FGameStatusChanged: TFormGameStatusChangedEvent;
    FColorScheme: TColorScheme;
    procedure SetSchemeColors;
    function GetCellState(ACol, ARow: Integer): TCellStateRec;
    procedure AddPressedCell(ACol, ARow: Integer);
    function CheckFieldBounds(AXPos, AYPos: Integer): Boolean;

    procedure InitNewGame;
    procedure UnpressAndInvalidate;

    procedure InvalidateCells(const AChangedCells: TCells; const ARedCells: TCells);
    procedure UpdateMinerFieldState(const ARedCells: TCells);

    procedure DrawCell(ACellState: TCellStateRec; ACol, ARow: Longint; ARect: TRect; ACanvas: TCanvas);
    procedure InvalidateCell(ACol, ARow: Integer);
    procedure MouseDownHandler(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
    procedure MouseMoveHandler(Sender: TObject; Shift: TShiftState;
    X, Y: Integer);
    procedure MouseUpHandler(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);

    procedure HandleEvMinerFieldChanged(Sender: TObject; var AChangedCells: TCells; var ARedCells: TCells);
    procedure HandleEvGameStatusChanged(Sender: TObject; AGameStatus: TGameStatus; AGameDifficulty: TGameDifficulty; var AChangedCells: TCells; var ARedCells: TCells);
    property CellState[ACol, ARow: Integer]: TCellStateRec read GetCellState;
    procedure SetColorScheme(const Value: TColorScheme);
    procedure SetNumberColors;
  protected
    procedure FireMinerFieldEvent(ACol, ARow: Integer; AMinerFieldActionEventType: TMinerFieldActionEventType); virtual;
    procedure FireNewGameEvent; virtual;
    procedure FireImageChanged(AImageIndex: Integer); virtual;
    procedure FireSetMineCountEvent(AMineCountChangedEventType: TMineCountChangedEventType); virtual;
    procedure FireGameStatusChanged(Sender: TObject; AGameStatus: TGameStatus; AGameDifficulty: TGameDifficulty); virtual;
    procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint); virtual;
    procedure CustomDrawCellHandler(Sender: TcxCustomGridTableView;
      ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateNewGame;
    property QuestionMarkCell: Boolean read FQuestionMarkCell write FQuestionMarkCell;
    property Images: TImageList read FImages write FImages;
    property ColorScheme: TColorScheme read FColorScheme write SetColorScheme;
    property OnMinerFieldAction: TMinerFieldActionEvent read FOnMinerFieldAction write FOnMinerFieldAction;
    property OnImageChanged: TImageChangedEvent read FOnImageChanged write FOnImageChanged;
    property OnMineCountChanged: TMineCountChangedEvent read FMineCountChanged write FMineCountChanged;
    property OnGameStatusChanged: TFormGameStatusChangedEvent read FGameStatusChanged write FGameStatusChanged;
  end;


  TcxGridTableViewNoScrollBars = class(TcxGridTableView)
  protected
    function GetControllerClass: TcxCustomGridControllerClass; override;
  end;

  TcxGridTableControllerNoScrollBars = class(TcxGridTableController)
  public
    procedure InitScrollBarsParameters; override;
  end;

implementation

uses Extctrls, cxGridDBTableView, cxGridLevel, cxControls;

procedure AlignTextInCell(ACanvas: TCanvas; Rect: TRect; AStr: String; Alignment: TAlignment = taCenter);
var
  X, Y: Integer;
begin
  Y := 3;
  X := 1;
  case Alignment of
   taCenter: X := ((Rect.Right - Rect.Left) - ACanvas.TextWidth(AStr)) div 2;
   taLeftJustify: X := 1;
   taRightJustify:  X := ((Rect.Right - Rect.Left) - ACanvas.TextWidth(AStr)) -1;
  end;
  ACanvas.TextRect(Rect,Rect.Left + X, Rect.Top + Y, AStr);
end;

type
  TA = class(TcxGridSite);

{ TIntMinerField }

constructor TIntMinerField.Create(AOwner: TComponent);
var
  GridView: TcxGridTableView;
  Level: TcxGridLevel;
  procedure SetGridViewOptions;
  begin
    with GridView do
    begin
      OptionsData.Editing := False;
      OptionsData.Inserting := False;
      OptionsData.Deleting := False;
      OptionsView.GroupByBox := False;
      OptionsView.GridLines := glNone;
      OptionsView.FocusRect := False;

      OptionsSelection.CellSelect := False;
      OptionsSelection.HideSelection := False;
      OptionsSelection.InvertSelect := False;
      OptionsView.Header := False;
    end;
  end;
begin
  inherited Create(AOwner);
  LookAndFeel.NativeStyle := False;
  LookAndFeel.AssignedValues := [lfvNativeStyle];
  GridView := CreateView(TcxGridTableViewNoScrollBars) as TcxGridTableView;

  Level := Levels.Add;
  Level.GridView := GridView;

  FMinerFieldDataSource := TMinerFieldDataSource.Create;

  MinerField.OnMinerFieldChanged := FMinerFieldDataSource.HandleEvMinerFieldChanged;
  MinerField.OnGameStatusChanged := FMinerFieldDataSource.HandleEvGameStatusChanged;

  FMinerFieldDataSource.OnMinerFieldChanged := HandleEvMinerFieldChanged;
  FMinerFieldDataSource.OnGameStatusChanged := HandleEvGameStatusChanged;

  GridView.DataController.CustomDataSource := FMinerFieldDataSource;
  SetGridViewOptions;

  GridView.OnCustomDrawCell := CustomDrawCellHandler;

  GridView.OnMouseDown := MouseDownHandler;
  GridView.OnMouseUp := MouseUpHandler;
  GridView.OnMouseMove := MouseMoveHandler;

  OnMinerFieldAction := MinerField.HandleMinerFieldActionEvent;

  FCellWidth := GridView.ViewInfo.RecordsViewInfo.RowHeight;
  FColorScheme := csBlue;
  SetNumberColors;
  SetSchemeColors;
end;

destructor TIntMinerField.Destroy;
begin
  FOnMinerFieldAction := nil;
  FMineCountChanged := nil;
  FOnImageChanged := nil;
  FGameStatusChanged := nil;
  FPressedCells := nil;
  FRedCells := nil;
  FMinerFieldDataSource.Free;
  inherited Destroy;
end;

procedure TIntMinerField.CreateNewGame;
begin
  FireNewGameEvent;
  InitNewGame;
end;

procedure TIntMinerField.InitNewGame;
var
  i: Integer;
begin
  FRedCells := nil;

  FColCount := FGameDifficulty.Width;
  FRowCount := FGameDifficulty.Height;
  BeginUpdate;
  try

    Width := FColCount * FCellWidth + 2;
    Height := FRowCount * FCellWidth + 2;
    Top := psBorder + biBoardHeight - psOuterFrameWidth;
    Left := psBorder;

    i := TForm(Owner).ClientRect.Right - TForm(Owner).ClientRect.Left;
    i := TForm(Owner).Width - i - psOuterFrameWidth;
    TForm(Owner).Width :=2*psBorder + Width + i;// + psOuterFrameWidth;

    i := TForm(Owner).ClientRect.Bottom - TForm(Owner).ClientRect.Top;
    i := TForm(Owner).Height - i;
    TForm(Owner).Height := i + 2*(psBorder - psOuterFrameWidth) + biBoardHeight +
      Height;
    if Assigned(TForm(Owner).OnResize) then
      TForm(Owner).OnResize(Owner);

    if not Enabled then Enabled := True;
    for i := (Views[0] as TcxGridTableView).ColumnCount - 1 downto FColCount do
      (Views[0] as TcxGridTableView).Columns[i].Free;
    for i:=0 to FGameDifficulty.Width - 1 do
    begin
      if i >= (Views[0] as TcxGridTableView).ColumnCount then
        with (Views[0] as TcxGridTableView).CreateColumn do
        begin
          MinWidth := FCellWidth;
          Width := FCellWidth;
        end;
    end;
  finally
    EndUpdate;
  end;

end;

procedure TIntMinerField.DrawCell(ACellState: TCellStateRec; ACol, ARow: Integer; ARect: TRect; ACanvas: TCanvas);
var
  CellStr: String;
  procedure DrawOpenedCell;
  begin
    with ACanvas do
    begin
      Brush.Color := FOpenCellBkColor;
      FillRect(ARect);
      Pen.Style := psSolid;
      Pen.Color := FRectangleColor;
      Dec(ARect.Left); Dec(ARect.Top);
      Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
      Font.Style := [fsBold];
      with Font do
        if ACellState.SurroundNumber >= 1 then
          Color := FSurroundColors[ACellState.SurroundNumber-1];
      Brush.Style := bsClear;
      if ACellState.SurroundNumber = 0 then
        CellStr := ''
      else
        CellStr := IntToStr(ACellState.SurroundNumber);
      AlignTextInCell(ACanvas, ARect, CellStr);
    end;
  end;
  procedure DrawClosedCell;
  begin
    if FGameStatus = gsLost then
    begin
      if IsExistsInArray(FRedCells, ACol, ARow) then
      begin
        // red bomb on an empty background
        with ACanvas do
        begin
          Brush.Color := FOpenCellBkColor;
          FillRect(ARect);

          Brush.Style := bsSolid;
          Brush.Color := clRed;
          Dec(ARect.Right);
          Dec(ARect.Bottom);
          FillRect(ARect);
          Brush.Style := bsClear;
        end;
        Inc(ARect.Left); Inc(ARect.Top);
        Inc(ARect.Right); Dec(ARect.Bottom);
        FImages.Draw(ACanvas, ARect.Left, ARect.Top, imRedBomb);
        Exit;
      end;
      if ACellState.SurroundNumber = -1 then
      begin
        with ACanvas do
        begin
          Brush.Color := FOpenCellBkColor;
          FillRect(ARect);
          Pen.Style := psSolid;
          Pen.Color := FRectangleColor;
          Dec(ARect.Left); Dec(ARect.Top);
          Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
          Inc(ARect.Left, 2); Inc(ARect.Top, 2);
          Brush.Style := bsClear;
       end;
       FImages.Draw(ACanvas, ARect.Left, ARect.Top, imBomb);  // bomb image
      end
      else
        Frame3D(ACanvas, ARect, FFrameColor, FOpenCellBkColor, 1) // unpressed
    end else
    if (FGameStatus = gsNew) or (FGameStatus = gsRun) then
    begin
      if IsExistsInArray(FPressedCells, ACol, ARow) then
        Frame3D(ACanvas, ARect, FOpenCellBkColor, FFrameColor, 1) // pressed
      else
        Frame3D(ACanvas, ARect, FFrameColor, FOpenCellBkColor, 1) // unpressed
    end;
    if (FGameStatus = gsWon) then
    begin
       Frame3D(ACanvas, ARect, FFrameColor, FOpenCellBkColor, 1); // unpressed
       if ACellState.SurroundNumber = -1 then
         FImages.Draw(ACanvas, ARect.Left, ARect.Top, imBombMark);  // bomb flag
    end;
  end;
  procedure DrawBombMarkedCell;
  begin
    if FGameStatus = gsLost then
    begin
      if ACellState.SurroundNumber = -1 then
      begin
        Frame3D(ACanvas, ARect, FFrameColor, FOpenCellBkColor, 1); // unpressed
        FImages.Draw(ACanvas, ARect.Left, ARect.Top, imBombMark)  // bomb flag
      end
      else
      begin
        // striked out bomb on an empty background
        with ACanvas do
        begin
          Brush.Color := FOpenCellBkColor;
          FillRect(ARect);
          Pen.Style := psSolid;
          Pen.Color := FRectangleColor;
          Dec(ARect.Left); Dec(ARect.Top);
          Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
          Inc(ARect.Left, 2); Inc(ARect.Top, 2);
          Brush.Style := bsClear;
       end;
        FImages.Draw(ACanvas, ARect.Left, ARect.Top, imStruckOutBomb)
      end;
    end else
    if (FGameStatus = gsRun) or (FGameStatus = gsWon)
      or (FGameStatus = gsNew) then
    begin
      Frame3D(ACanvas, ARect, FFrameColor, FOpenCellBkColor, 1); // unpressed
      FImages.Draw(ACanvas, ARect.Left, ARect.Top, imBombMark);  // bomb flag
    end;
  end;
  procedure DrawQuestionMarkedCell;
  begin
    if (FGameStatus = gsWon) then
    begin
      if ACellState.SurroundNumber = -1 then
      begin
        Frame3D(ACanvas, ARect, FFrameColor, FOpenCellBkColor, 1); // unpressed
        FImages.Draw(ACanvas, ARect.Left, ARect.Top, imBombMark);  // bomb flag
      end
    end else
    if (FGameStatus = gsLost)  then
    begin
      if ACellState.SurroundNumber = -1 then
      begin
        with ACanvas do
        begin
          Brush.Color := FClosedCellBkColor;
          FillRect(ARect);
          Pen.Style := psSolid;
          Pen.Color := FOpenCellBkColor;
          Dec(ARect.Left); Dec(ARect.Top);
          Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
          Inc(ARect.Left, 2); Inc(ARect.Top, 2);
          Brush.Style := bsClear;
       end;
       FImages.Draw(ACanvas, ARect.Left, ARect.Top, imBomb) // bomb on an empty background
     end else
     begin
       Frame3D(ACanvas, ARect, FFrameColor, FOpenCellBkColor, 1); // unpressesd
       FImages.Draw(ACanvas, ARect.Left, ARect.Top, imQuestionMark);      // question mark
     end
     end else
     if (FGameStatus = gsNew) or (FGameStatus = gsRun) then
     begin