boardproperties.pas

用于开发税务票据管理的软件

{ Get the convolution filter used by the pieces.  Since they will all use the
  same one, just find the first piece available and return its filter name. }
function TChessboard.GetPieceFilter: ShortString;
var
  i: Integer;
begin
  Result := '';
  i := High(Board);
  while i >= 0 do
  begin
    if Board[i] <> nil then
    begin
      Result := Board[i].FilterName;
      Exit;
    end;
    Dec(i);
  end;
end;

function TChessboard.ShowMeMessage1: ShortString;
begin
  Result := 'Alistair Keys';
end;

procedure TChessboard.ShowMeMessage2(const NewVal: ShortString);
begin
     { SO THE PROPERTY SHOWS UP AT DESIGN-TIME }
end;

//------------------------------------------------------------------------------
// PROPERTY CHANGING PROCEDURES
//------------------------------------------------------------------------------

procedure TChessboard.ChangeBackgroundColour(const NewVal: TColor);
begin
  if FBackgroundC <> NewVal then
  begin
    FBackgroundC := NewVal;
    ForceRedraw;
  end;
end;

procedure TChessboard.ChangeBlackSquareColour(const NewVal: TColor);
begin
  if FBlackC <> NewVal then
  begin
    FBlackC := NewVal;
    ForceRedraw;
  end;
end;

procedure TChessboard.ChangeDrawGridLines(const NewVal: Boolean);
begin
  if FDrawLines <> NewVal then
  begin
    FDrawLines := NewVal;

    if FDrawLines then
    begin
      DrawGridLines(FBitmap.Canvas);
      DrawGridLines(Canvas);
    end
    else
    begin
      UndrawGridLines(FBitmap.Canvas);
      UndrawGridLines(Canvas);
    end;
  end;
end;

procedure TChessboard.ChangeGridLineColour(const NewVal: TColor);
begin
  if FGridLineColour <> NewVal then
  begin
    FGridLineColour := NewVal;
    ForceRedraw;
  end;
end;

procedure TChessboard.ChangeGridLineWidth(const NewVal: Cardinal);
begin
  if FGridlineWidth <> NewVal then
  begin
    FGridLineWidth := NewVal;
    if FDrawLines then ForceRedraw;
  end;
end;

procedure TChessboard.ChangeHighlightWidth(const NewVal: Cardinal);
begin
  if FHighlightWidth <> NewVal then
  begin
    FHighlightWidth := NewVal;
    if FHighlightSquare.Count > 0 then
    repeat
      Dispose(FHighlightSquare.First);
      FHighlightSquare.Delete(0);
    until FHighlightSquare.Count = 0;
  end;
end;

procedure TChessboard.ChangePic(const NewVal: TPicture);
begin
  if FPic <> NewVal then
  begin
    FPic.Assign(NewVal);
    ForceRedraw;
  end;
end;

procedure TChessboard.ChangePieceFilter(const NewVal: ShortString);
var
  i: Integer;
begin
  i := High(Board);
  while i >= 0 do
  begin
    if Board[i] <> nil then
      Board[i].FilterName := NewVal;

    if FSmoothPieces then ForceRedraw;
    Dec(i);
  end;
end;

procedure TChessboard.ChangeShowHints(const NewVal: Boolean);
var
  i: Integer;
begin
  if FShowHints <> NewVal then
  begin
    FShowHints := NewVal;
    i := High(Board);
    while i >= 0 do
    begin
      if Board[i] <> nil then
        TPiece(Board[i]).ShowHint := FShowHints;

      Dec(i);
    end;
  end;
end;

procedure TChessboard.ChangeShowSquareHighlights(const NewVal: Boolean);
begin
  if NewVal <> FShowSquareHighlights then
  begin
    FShowSquareHighlights := NewVal;
    Invalidate;
  end;
end;

procedure TChessboard.ChangeSmoothPieces(const NewVal: Boolean);
var
  i: Integer;
begin
  if NewVal <> FSmoothPieces then
  begin
    i := High(Board);
    while i >= 0 do
    begin
      if (Board[i] <> nil) then
        Board[i].SmoothImage := NewVal;

      Dec(i);
    end;

    FSmoothPieces := NewVal;
    ForceRedraw;
  end;
end;

procedure TChessboard.ChangeSquareSize(const NewVal: Cardinal);
begin
  if (not FStretch) and (NewVal <> FSquareSize) and (NewVal > 0) then
  begin
    FSquareSize := NewVal;
    ForceRedraw;
  end;
end;

procedure TChessboard.ChangeStretch(const NewVal: Boolean);
begin
  if NewVal <> FStretch then
  begin
    FStretch := NewVal;
    if FStretch then FSquareSize := Min(Width, Height) shr 3;
    ForceRedraw;
  end;
end;

procedure TChessboard.ChangeStretchPic(const NewVal: Boolean);
begin
  if NewVal <> FStretchPic then
  begin
    FStretchPic := True;
    if FPic.Graphic <> nil then
      ForceRedraw;
  end;
end;

procedure TChessboard.ChangeUndoLimit(const NewVal: Byte);
begin
  if FUndoLimit <> NewVal then
  begin
    if FUndoLimit < NewVal then
      DropUndoRecords(FUndoLimit - NewVal);
    FUndoLimit := NewVal;
  end;
end;

procedure TChessboard.ChangeWhiteSquareColour(const NewVal: TColor);
begin
  if FWhiteC <> NewVal then
  begin
    FWhiteC := NewVal;
    ForceRedraw;
  end;
end;