unboundmodedemointminerfield.pas

胜天进销存源码,国产优秀的进销存

       if not IsExistsInArray(FPressedCells, ACol, ARow) then
         Frame3D(ACanvas, ARect, FFrameColor, FOpenCellBkColor, 1) // unpresses
       else
         Frame3D(ACanvas, ARect, FOpenCellBkColor, FFrameColor, 1); // pressed
       FImages.Draw(ACanvas, ARect.Left, ARect.Top, imQuestionMark);      // question mark
     end
  end;
begin
  with ACanvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := FClosedCellBkColor;
    FillRect(ARect);
  end;

  case ACellState.CellState of
    csOpened: DrawOpenedCell;
    csClosed: DrawClosedCell;
    csBombMarked: DrawBombMarkedCell;
    csQuestionMarked: DrawQuestionMarkedCell;
  end;
end;

procedure TIntMinerField.SetSchemeColors;
begin
  FOpenCellBkColor := SchemeColors[Integer(FColorScheme), 0];
  FClosedCellBkColor := SchemeColors[Integer(FColorScheme), 1];
  FFrameColor := SchemeColors[Integer(FColorScheme), 2];
  FRectangleColor := SchemeColors[Integer(FColorScheme), 3];
end;

procedure TIntMinerField.SetNumberColors;
begin
  SetLength(FSurroundColors, 8);
  FSurroundColors[0] := clBlue;
  FSurroundColors[1] := clGreen;
  FSurroundColors[2] := clRed;
  FSurroundColors[3] := clNavy;
  FSurroundColors[4] := clPurple;
  FSurroundColors[5] := clBlue;
  FSurroundColors[6] := clBlue;
  FSurroundColors[7] := clGray;
end;

procedure TIntMinerField.AddPressedCell(ACol, ARow: Integer);
begin
  SetLength(FPressedCells, Length(FPressedCells) + 1);
  FPressedCells[High(FPressedCells)].x := ACol;
  FPressedCells[High(FPressedCells)].y := ARow;
end;

function TIntMinerField.CheckFieldBounds(AXPos, AYPos: Integer): Boolean;
begin
   Result := False;
   if (AXPos >=0) and (AYPos >=0) and (AXPos < FColCount) and
     (AYPos < FRowCount) then Result := True;
end;

procedure TIntMinerField.FireNewGameEvent;
begin
  if Assigned(FCreateNewGameEvent) then
    FCreateNewGameEvent(Self);
end;

procedure TIntMinerField.UnpressAndInvalidate;
var
  i: Integer;
  CellsToInvalidate: TCells;
begin
  SetLength(CellsToInvalidate, Length(FPressedCells));
  for i:=0 to High(FPressedCells) do
    CellsToInvalidate[i] := FPressedCells[i];
  FPressedCells := nil;
  for i:=0 to High(CellsToInvalidate) do
    InvalidateCell(CellsToInvalidate[i].x,
      CellsToInvalidate[i].y);
end;

procedure TIntMinerField.InvalidateCells(const AChangedCells: TCells; const ARedCells: TCells);
var
  i: Integer;
begin
  for i:=0 to High(AChangedCells) do
    with AChangedCells[i] do
      InvalidateCell(x, y);
  for i:=0 to High(ARedCells) do
    with ARedCells[i] do
      InvalidateCell(x, y);
end;

procedure TIntMinerField.FireMinerFieldEvent(ACol, ARow: Integer; AMinerFieldActionEventType: TMinerFieldActionEventType);
begin
  if Assigned(FOnMinerFieldAction) then
    FOnMinerFieldAction(Self, ACol, ARow, AMinerFieldActionEventType);
end;

procedure TIntMinerField.UpdateMinerFieldState(const ARedCells: TCells);
var
  i: Integer;
begin
  SetLength(FRedCells, Length(ARedCells));
  for i:=0 to High(ARedCells) do
    FRedCells[i] := ARedCells[i];
end;

procedure TIntMinerField.FireImageChanged(AImageIndex: Integer);
begin
  if Assigned(FOnImageChanged) then
    FOnImageChanged(Self, AImageIndex);
end;

procedure TIntMinerField.FireSetMineCountEvent(AMineCountChangedEventType: TMineCountChangedEventType);
begin
  if Assigned(FMineCountChanged) then
    FMineCountChanged(Self, AMineCountChangedEventType);
end;

procedure TIntMinerField.MouseToCell(X, Y: Integer; var ACol, ARow: Integer);
var
  AHitTest: TcxCustomGridHitTest;
begin
  ACol := -1;
  ARow := -1;
  AHitTest := ViewInfo.GetHitTest(X, Y);
  if AHitTest is TcxGridRecordCellHitTest then
  begin
    ACol := TcxGridRecordCellHitTest(AHitTest).Item.Index;
    ARow := TcxGridRecordCellHitTest(AHitTest).GridRecord.Index;
  end;
end;

procedure TIntMinerField.InvalidateCell(ACol, ARow: Integer);
var
  InvalidRect: TRect;
begin
  with (Views[0] as TcxGridTableView) do
    InvalidRect := ViewInfo.RecordsViewInfo[ARow].GetCellViewInfoByItem(Items[ACol]).Bounds;
  Views[0].Painter.Invalidate(InvalidRect);
end;

procedure TIntMinerField.MouseDownHandler(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ACol, ARow: Integer;
  i, j: Integer;
begin
  SetCaptureControl(Views[0].Site);
  MouseToCell(X, Y, ACol, ARow);
  if (ACol = - 1) or (ARow = -1) then
    Exit;

  if (Shift = [ssLeft, ssRight]) or (Shift = [ssLeft, ssRight])
    or (Shift = [ssMiddle]) or (Shift = [ssLeft, ssMiddle])
    or (Shift = [ssRight, ssMiddle]) then
  begin
    FireImageChanged(imAstonisment);
    FSurprised := True;
    for i:=-1 to 1 do
      for j:=-1 to 1 do
          if CheckFieldBounds(ACol+i, ARow+j) and (
            (CellState[ACol+i, ARow+j].CellState = csClosed)
            or (CellState[ACol+i, ARow+j].CellState = csQuestionMarked)) then
          begin
            AddPressedCell(ACol+i, ARow+j);
            InvalidateCell(ACol+i, ARow+j);
          end;
    Exit;
  end;

  if Button = mbLeft then
  begin
    FireImageChanged(imAstonisment);
    FSurprised := True;
    if (CellState[ACol, ARow].CellState = csClosed)
        or (CellState[ACol, ARow].CellState = csQuestionMarked) then
      begin
        AddPressedCell(ACol, ARow);
        InvalidateCell(ACol, ARow);
      end;
    Exit;
  end;

  if Button = mbRight then
  begin
    if CellState[ACol, ARow].CellState = csOpened then Exit;
    if CellState[ACol, ARow].CellState = csClosed then
    begin
      FireMinerFieldEvent(ACol, ARow, meBombMarkCell);
      FireSetMineCountEvent(mcDecMineCount);
    end
    else

    if (CellState[ACol, ARow].CellState = csBombMarked) and
      FQuestionMarkCell then
    begin
      FireMinerFieldEvent(ACol, ARow, meQuestionMarkCell);
      FireSetMineCountEvent(mcIncMineCount);
    end
    else
    begin
      FireMinerFieldEvent(ACol, ARow, meCloseCell);
      if not FQuestionMarkCell then FireSetMineCountEvent(mcIncMineCount);
    end;
    InvalidateCell(ACol, ARow);
  end;
end;

procedure TIntMinerField.MouseMoveHandler(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  ACol, ARow: Integer;
  i, j: Integer;
begin
  MouseToCell(X, Y, ACol, ARow);
  if (ACol = - 1) or (ARow = -1) then
  begin
    if FPressedCells <> nil then
      UnpressAndInvalidate;
    if FSurprised then
    begin
      FireImageChanged(imSmile);
      FSurprised := False;
    end;
    Exit;
  end;
  if Shift = [ssLeft]	 then
  begin
    if (CellState[ACol, ARow].CellState = csOpened) then
    begin
      if FPressedCells <> nil then
      begin
        UnpressAndInvalidate;
        InvalidateCell(ACol, ARow);
      end;
    end else
    if (CellState[ACol, ARow].CellState = csClosed)
      or (CellState[ACol, ARow].CellState = csQuestionMarked) then
      if not IsExistsInArray(FPressedCells, ACol, ARow) then
      begin
        UnpressAndInvalidate;
        AddPressedCell(ACol, ARow);
        InvalidateCell(ACol, ARow);
      end;
    Exit;
  end;

  if (Shift = [ssLeft, ssRight]) or (Shift = [ssLeft, ssRight])
    or (Shift = [ssMiddle]) or (Shift = [ssLeft, ssMiddle])
    or (Shift = [ssRight, ssMiddle]) then
  begin
    UnpressAndInvalidate;
    for i:=-1 to 1 do
      for j:=-1 to 1 do
        if CheckFieldBounds(ACol+i, ARow+j) and
          ((CellState[ACol+i, ARow+j].CellState = csClosed) or
          (CellState[ACol+i, ARow+j].CellState = csQuestionMarked)) then
          begin
            AddPressedCell(ACol+i, ARow+j);
            InvalidateCell(ACol+i, ARow+j);
          end;
   end;
end;

procedure TIntMinerField.MouseUpHandler(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ACol, ARow: Integer;
begin
  SetCaptureControl(nil);
  MouseToCell(X, Y, ACol, ARow);
  if (ACol = - 1) and (ARow = -1) then
    Exit;
  if ((Shift = [ssLeft]) and (Button = mbRight)) or ((Shift = [ssRight]) and (Button = mbLeft))
     or (Button = mbMiddle) then
  begin
    FireImageChanged(imSmile);
    FSurprised := False;
    UnpressAndInvalidate;
    if CellState[ACol, ARow].CellState = csOpened then
      FireMinerFieldEvent(ACol, ARow, meCheckSurround);
    Exit;
  end;
  if Button = mbLeft then
  begin
    FireImageChanged(imSmile);
    FSurprised := False;
    if IsExistsInArray(FPressedCells, ACol, ARow) then
    begin
      FireMinerFieldEvent(ACol, ARow, meOpenCell);
      UnpressAndInvalidate;
    end;
    Exit;
  end;
  if Button = mbRight then
    UnpressAndInvalidate;
end;

procedure TIntMinerField.HandleEvGameStatusChanged(Sender: TObject; AGameStatus: TGameStatus;
  AGameDifficulty: TGameDifficulty; var AChangedCells: TCells; var ARedCells: TCells);
begin
  case AGameStatus of
    gsNew:
    begin
      FGameStatus := gsNew;
      FGameDifficulty := AGameDifficulty;
      InitNewGame;
    end;
    gsRun:
    begin
      FGameStatus := gsRun;
    end;
    gsLost:
    begin
      FGameStatus := gsLost;
      UpdateMinerFieldState(ARedCells);
      InvalidateCells(AChangedCells, ARedCells);
      Views[0].Painter.Invalidate;
      Enabled := False;
    end;
    gsWon:
    begin
      FGameStatus := gsWon;
      UpdateMinerFieldState(ARedCells);
      InvalidateCells(AChangedCells, ARedCells);
      Views[0].Painter.Invalidate;
      Enabled := False;
    end
  end;
  ARedCells := nil;
  AChangedCells := nil;
  FireGameStatusChanged(Sender, AGameStatus, AGameDifficulty);
end;

procedure TIntMinerField.HandleEvMinerFieldChanged(Sender: TObject; var AChangedCells: TCells; var ARedCells: TCells);
begin
  InvalidateCells(AChangedCells, ARedCells);
  AChangedCells := nil;
  ARedCells := nil;
end;

procedure TIntMinerField.CustomDrawCellHandler(Sender: TcxCustomGridTableView;
  ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
var
  DrawRect: TRect;
  ACol, ARow: Integer;
  CellRec: TCellStateRec;
begin
  ACol := AViewInfo.Item.Index;
  ARow := AViewInfo.RecordViewInfo.Index;
  DrawRect := AViewInfo.Bounds;
  CellRec := FMinerFieldDataSource.CellState[ACol, ARow];
  DrawCell(CellRec, ACol, ARow, DrawRect, ACanvas.Canvas);
  ADone := True;
end;

procedure TIntMinerField.FireGameStatusChanged(Sender: TObject;
  AGameStatus: TGameStatus; AGameDifficulty: TGameDifficulty);
begin
  if Assigned(FGameStatusChanged) then
    FGameStatusChanged(Sender, AGameStatus, AGameDifficulty);
end;

function TIntMinerField.GetCellState(ACol, ARow: Integer): TCellStateRec;
begin
  Result := FMinerFieldDataSource.CellState[ACol, ARow];
end;

procedure TIntMinerField.SetColorScheme(const Value: TColorScheme);
begin
  FColorScheme := Value;
  SetSchemeColors;
  Views[0].Painter.Invalidate;
end;

{ TcxGridTableViewNoScrollBars }

function TcxGridTableViewNoScrollBars.GetControllerClass: TcxCustomGridControllerClass;
begin
  Result := TcxGridTableControllerNoScrollBars;
end;

{ TcxGridTableControllerNoScrollBars }

procedure TcxGridTableControllerNoScrollBars.InitScrollBarsParameters;
begin
end;

end.