unboundmodedemomain.pas

DevExpress ExpressQuantumGrid Suite v5.9 Full Source

unit UnboundModeDemoMain;

interface

uses
  UnboundModeDemoTypes, Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ImgList, Menus, ActnList, UnboundModeDemoIntMinerField,
  ExtCtrls, StdCtrls, cxGridLevel, cxControls, cxGridCustomView,
  cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid, cxGraphics,
  DB, DBTables, cxLookAndFeels;

type
  TUnboundModeDemoMainForm = class(TForm)
    mmMain: TMainMenu;
    miGame: TMenuItem;
    miNew: TMenuItem;
    sep1: TMenuItem;
    miBeginner: TMenuItem;
    miIntermediate: TMenuItem;
    miExpert: TMenuItem;
    sep2: TMenuItem;
    miMarks: TMenuItem;
    sep3: TMenuItem;
    miBestTimes: TMenuItem;
    miExit: TMenuItem;
    miAbout: TMenuItem;
    ilGame: TImageList;
    miCustom: TMenuItem;
    N1: TMenuItem;
    ilNumbers: TImageList;
    Timer: TTimer;
    ilFaces: TImageList;
    miColors: TMenuItem;
    miGold: TMenuItem;
    miGreen: TMenuItem;
    miBlue: TMenuItem;
    miSystem: TMenuItem;
    LookAndFeelController: TcxLookAndFeelController;
    procedure FormCreate(Sender: TObject);
    procedure miExitClick(Sender: TObject);
    procedure miNewClick(Sender: TObject);
    procedure miBeginnerClick(Sender: TObject);
    procedure miIntermediateClick(Sender: TObject);
    procedure miExpertClick(Sender: TObject);
    procedure miCustomClick(Sender: TObject);
    procedure miAboutClick(Sender: TObject);
    procedure miMarksClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure miBestTimesClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure miGreenClick(Sender: TObject);
    procedure miBlueClick(Sender: TObject);
    procedure miSystemClick(Sender: TObject);
    procedure miGoldClick(Sender: TObject);
  private
    FNames: array of String;
    FTimes: array of Integer;
    FGameDifficulty: TGameDifficulty;
    FImageIndex: Integer;
    FDown: Boolean;
    FMineCount: Integer;
    FTime: Integer;
    FOnChangeGameDifficulty: TChangeGameDifficultyEvent;
    function IsPointInRect(APoint: TPoint; ARect: TRect): Boolean;
    procedure SetButtonBounds(var ARect: TRect);
    procedure FireGameDifficultyChangedEvent(const ANewGameDifficulty: TGameDifficulty);
    procedure DrawMineCount;
    procedure DrawTime;
    procedure DrawButton;
    procedure DrawIndicatorBoard;
    procedure DrawOuterFrame;
    procedure ReadMinerSettings;
    procedure WriteMinerSettings;
    procedure InitGameSettings;
    procedure ResetFastestTimes;
    procedure CheckBestTimes;
    procedure CheckMenuItem(AGameDifficulty: TDifficultyType);
  public
    IntMinerField: TIntMinerField;
    FMouseButtonPressed: Boolean;
    procedure HandleMineCountChangedEvent(Sender: TObject; AMineCountChangedEventType: TMineCountChangedEventType);
    procedure HandleEvGameStatusChanged(Sender: TObject; AGameStatus: TGameStatus; AGameDifficulty: TGameDifficulty);
    procedure HandleEvImageChanged(Sender: TObject; AImageIndex: Integer);
  end;

var
  UnboundModeDemoMainForm: TUnboundModeDemoMainForm;

implementation

{$R *.DFM}

uses
  Registry, UnboundModeDemoMinerCore, UnboundModeDemoMinerDataSource, UnboundModeDemoCustomField,
  UnboundModeDemoFastestSweepers, AboutDemoForm;

procedure TUnboundModeDemoMainForm.FireGameDifficultyChangedEvent(const ANewGameDifficulty: TGameDifficulty);
begin
  if Assigned(FOnChangeGameDifficulty) then
    FOnChangeGameDifficulty(Self, ANewGameDifficulty);
end;

procedure TUnboundModeDemoMainForm.FormCreate(Sender: TObject);
begin
  FOnChangeGameDifficulty := MinerField.HandleEvChangeGameDifficulty;
  IntMinerField := TIntMinerField.Create(Self);
  IntMinerField.Parent := Self;
  IntMinerField.Visible := True;

  FImageIndex := imSmile;
  IntMinerField.Images := ilGame;
  IntMinerField.OnImageChanged := HandleEvImageChanged;
  IntMinerField.OnMineCountChanged := HandleMineCountChangedEvent;
  IntMinerField.OnGameStatusChanged := HandleEvGameStatusChanged;
  InitGameSettings;
  ReadMinerSettings;
end;

procedure TUnboundModeDemoMainForm.FormShow(Sender: TObject);
begin
  miNewClick(nil);
end;

procedure TUnboundModeDemoMainForm.FormDestroy(Sender: TObject);
begin
  WriteMinerSettings;
  FTimes := nil;
  FNames := nil;
end;

procedure TUnboundModeDemoMainForm.miExitClick(Sender: TObject);
begin
  Close;
end;

procedure TUnboundModeDemoMainForm.miNewClick(Sender: TObject);
begin
  FTime := 0;
  Timer.Enabled := False;
  FireGameDifficultyChangedEvent(FGameDifficulty);
  FMineCount := FGameDifficulty.MineCount;
  DrawMineCount;
end;

procedure TUnboundModeDemoMainForm.miBeginnerClick(Sender: TObject);
begin
  FGameDifficulty.DifficultyType := dtBeginner;
  miNewClick(nil);
end;

procedure TUnboundModeDemoMainForm.miIntermediateClick(Sender: TObject);
begin
  FGameDifficulty.DifficultyType := dtIntermediate;
  miNewClick(nil);
end;

procedure TUnboundModeDemoMainForm.miExpertClick(Sender: TObject);
begin
  FGameDifficulty.DifficultyType := dtExpert;
  miNewClick(nil);
end;

procedure TUnboundModeDemoMainForm.miCustomClick(Sender: TObject);
var
  CustomField: TUnboundModeDemoCustomFieldForm;
begin
  CustomField := TUnboundModeDemoCustomFieldForm.Create(Self);
  try
    CustomField.edtHeight.Text := IntToStr(FGameDifficulty.Height);
    CustomField.edtWidth.Text := IntToStr(FGameDifficulty.Width);
    CustomField.edtMineCount.Text := IntToStr(FGameDifficulty.MineCount);

    if CustomField.ShowModal = mrOK then
    with FGameDifficulty do
    begin
      Height := StrToInt(CustomField.edtHeight.Text);
      Width := StrToInt(CustomField.edtWidth.Text);
      MineCount := StrToInt(CustomField.edtMineCount.Text);
      FGameDifficulty.DifficultyType := dtCustom;
      miNewClick(nil);
    end;
  finally
    CustomField.Free;
  end;
end;

procedure TUnboundModeDemoMainForm.miBestTimesClick(Sender: TObject);

begin
  with TUnboundModeDemoFastestSweepersForm.Create(Self) do
  try
    lbBeginnerTime.Caption := IntToStr(FTimes[0]);
    lbIntermediateTime.Caption := IntToStr(FTimes[1]);
    lbExpertTime.Caption := IntToStr(FTimes[2]);
    lbBeginnerName.Caption := FNames[0];
    lbIntermediateName.Caption := FNames[1];
    ibExpertName.Caption := FNames[2];
    ShowModal;
    if FastestTimesResetted then
      ResetFastestTimes;
  finally
    Free;
  end;
end;

procedure TUnboundModeDemoMainForm.FormResize(Sender: TObject);
begin
  with Screen do
    if Left + Self.Width > Width then
      Left := Width - Self.Width;
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clBlueSky;
    FillRect(Rect(0, 0, Width, Height));
  end;
  FormPaint(Sender);
end;

procedure TUnboundModeDemoMainForm.miAboutClick(Sender: TObject);
begin
  ShowAboutDemoForm;
end;

procedure TUnboundModeDemoMainForm.miMarksClick(Sender: TObject);
begin
  with Sender as TMenuItem do
    Checked := not Checked;
  IntMinerField.QuestionMarkCell := (Sender as TMenuItem).Checked;
end;

procedure TUnboundModeDemoMainForm.DrawButton;
var
  Rct, RctBk, RctPressed: TRect;
begin
  SetButtonBounds(Rct);
  with Canvas, Rct do
  begin
    Brush.Style := bsSolid;
    RctBk.Left := Left - 1;
    RctBk.Top := Top - 1;
    RctBk.Right := Right + 1;
    RctBk.Bottom := Bottom + 1;
    Brush.Color := SchemeColors[Integer(IntMinerField.ColorScheme), cliButtonColor];
    FillRect(Rect(RctBk.Left, RctBk.Top, RctBk.Right + 1, RctBk.Bottom + 1));

    Brush.Color :=
      SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dTopColor];
    FrameRect(RctBk);

    if not FMouseButtonPressed then
    begin
      Frame3d(Canvas, Rct,
        SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dBottomColor],
        SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dTopColor],  2);
      ilFaces.Draw(Canvas, Rct.Left + 1, Rct.Top + 1 , FImageIndex);
    end else
    with RctBk, Canvas do
    begin
      RctPressed.Left := Left + 1;
      RctPressed.Top := Top + 1;
      RctPressed.Right := Right + 1;
      RctPressed.Bottom := Bottom + 1;

      FrameRect(RctPressed);
      Brush.Color := SchemeColors[Integer(IntMinerField.ColorScheme), 8];
      FillRect(
      Rect(RctPressed.Left + 1, RctPressed.Top + 1, RctPressed.Right - 1, RctPressed.Bottom-1));
      ilFaces.Draw(Canvas, Rct.Left + 4, Rct.Top + 4 ,2);
    end;
  end;
end;

procedure TUnboundModeDemoMainForm.DrawOuterFrame;
var
  Rct: TRect;
begin
  Rct := Rect(1, 1, Width, Height);
  Frame3d(Canvas, Rct,
    SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dTopColor],
    SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dBottomColor],
    psOuterFrameWidth);
end;

procedure TUnboundModeDemoMainForm.DrawIndicatorBoard;
var
  Rct: TRect;
begin
  Rct := Rect(psBorder, psBorder,
    (ClientWidth - (psBorder - psOuterFrameWidth)) , biBoardHeight);
  Frame3d(Canvas, Rct,
    SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dTopColor],
    SchemeColors[Integer(IntMinerField.ColorScheme), cliFrame3dBottomColor], 2);
end;

procedure TUnboundModeDemoMainForm.FormPaint(Sender: TObject);
begin
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color :=
      SchemeColors[Integer(IntMinerField.ColorScheme), cliBackground];
    FillRect(Rect(0, 0, Width, Height));
  end;
  DrawOuterFrame;
  DrawIndicatorBoard;
  DrawTime;
  DrawMineCount;
  DrawButton;
end;

function TUnboundModeDemoMainForm.IsPointInRect(APoint: TPoint; ARect: TRect): Boolean;
begin
  Result := (ARect.Left <= APoint.x) and (APoint.x <= ARect.Right) and
            (ARect.Top <= APoint.y) and (APoint.y <= ARect.Bottom);
end;

procedure TUnboundModeDemoMainForm.SetButtonBounds(var ARect: TRect);
var
  AButtonXPos: Integer;
begin
  AButtonXPos := (Width div 2) - (biButtonWidth div 2);
  ARect := Rect(AButtonXPos, psBoardInnerIndent,
    AButtonXPos + biButtonWidth , psBoardInnerIndent + biButtonWidth);
end;

procedure TUnboundModeDemoMainForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Rct: TRect;
begin
  FDown := False;
  if FImageIndex = 0 then
  begin