sandshow.pas

模拟2维沙堆效果

unit SandShow;
// Methods for visualizing the sandpile

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Grids, SandQue;

type
  TPileForm = class(TForm)
    DrawGrid: TDrawGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure DrawGridDrawCell(Sender: TObject; Col, Row: Longint;
      Rect: TRect; State: TGridDrawState);
  private
    GridSize: Byte;          // # cells in grid (horiz. and vert.)
    TracedCells: TQueue;
  public
    procedure SetGridSize;
    procedure QuickDrawCell(X, Y: Integer);
    procedure UndrawTrace;
//    procedure ClearCells;
  end;

var
  PileForm: TPileForm;

implementation

uses
  SandMain, Sandpile;

{$R *.DFM}

{--------------------- TPileForm ----------------------}

procedure TPileForm.FormCreate(Sender: TObject);
begin
  SetGridSize;
  TracedCells := TQueue.Create;
end;


procedure TPileForm.FormDestroy(Sender: TObject);
var
  Cell: PField;
begin
  while TracedCells.Size > 0 do
  begin
    TracedCells.Dequeue(Pointer(Cell));
    Dispose(Cell);
  end;
  TracedCells.Free;
end;


procedure TPileForm.FormHide(Sender: TObject);
begin
  MainForm.PileCheckBox.Checked := False;
end;


procedure TPileForm.DrawGridDrawCell(Sender: TObject; Col, Row: Longint;
  Rect: TRect; State: TGridDrawState);
begin
  with DrawGrid.Canvas do
  begin
    Brush.Color := MainForm.Colors[MainForm.Pile.Grid[Col,Row]];
    FillRect(Rect);          // Fill the cell with the right color
  end;
end;


procedure TPileForm.QuickDrawCell(X, Y: Integer);
// Draws the cell in the right color according to its height
var
  Cell: PField;
begin
  with DrawGrid.Canvas do
  begin
    if MainForm.Simulation.Tracing then
    begin
      New(Cell);
      Cell.X := X;
      Cell.Y := Y;
      TracedCells.Enqueue(Cell);
      Brush.Color := MainForm.Colors[6]   // Use trace color
    end
    else
      Brush.Color := MainForm.Colors[MainForm.Pile.Grid[X,Y]];
    FillRect(DrawGrid.CellRect(X, Y));
  end;
end;


procedure TPileForm.UndrawTrace;
// Undraws all traced cells and draws the right color
var
  Cell: PField;
begin
  MainForm.Simulation.Suspend;

  while TracedCells.Size > 0 do
  begin
    TracedCells.Dequeue(Pointer(Cell));
    if MainForm.PileCheckBox.Checked then
      with DrawGrid.Canvas do
      begin
        Brush.Color := MainForm.Colors[MainForm.Pile.Grid[Cell.X, Cell.Y]];
        FillRect(DrawGrid.CellRect(Cell.X, Cell.Y));
      end;
    Dispose(Cell);
  end;

  MainForm.Simulation.Resume;
end;

(*
procedure TPileForm.ClearCells;
// Clears all cells in the drawing grid
var
  I, J: Longint;
begin
  with Grid do
  begin
    Canvas.Brush.Color := clWindow;
    Canvas.FillRect(ClientRect);
{    for I := 0 to ColCount -1 do
      for J := 0 to RowCount -1 do
        Canvas.FillRect(CellRect(I,J));     // Fill the cell }
  end;
end;
*)

procedure TPileForm.SetGridSize;
const
  MaxGridClientSize = 470;
begin
  GridSize := MainForm.PileSize;
  // Recalculate grid size
  with DrawGrid do
  begin
    if MainForm.ShowGrid then
      GridLineWidth := 1
    else
      GridLineWidth := 0;
    ColCount := GridSize;
    RowCount := GridSize;
    DefaultColWidth := (MaxGridClientSize - (GridSize*GridLineWidth) - 1) div GridSize;
    DefaultRowHeight := DefaultColWidth;
    Height := GridSize * (DefaultRowHeight + GridLineWidth) +
              (Byte(BorderStyle) * 4) -1;
    Width := Height;
  end;
  ClientHeight := DrawGrid.Height;
  ClientWidth := ClientHeight ;
end;

end.


{ Here are some other methods for drawing the cells.
  They compare the local cell height with the height of the four
  neighbor cells. The methods are very time-consuming, and they
  produce roughly the same result. }

(*
procedure TPileForm.DrawGridDrawCell(Sender: TObject; Col, Row: Longint;
  Rect: TRect; State: TGridDrawState);
begin
  QuickDrawCell(Col, Row);
end;


procedure TPileForm.QuickDrawCell(X, Y: Integer);
// Draws the cell in the right color according to the height difference
// to its neighbors.
var
  I, J: Integer;
  Low, Mid, High: Byte;      // # neighbors above, below, or same height as this cell
begin
  Low  := 0;
  Mid  := 0;
  High := 0;

  with DrawGrid.Canvas do
  with MainForm.Pile do
  begin
    // First find out how many neighbors are High, Low, or Mid
    for I := Y-1 to Y+1 do
      for J := X-1 to X+1 do
        if ((I<>Y) or (J<>X)) {and (MainForm.Pile.OnSurface(I,J))} then
          if Grid[I,J] = Grid[X,Y] then
            Inc(Mid)
          else
          if Grid[I,J] > Grid[X,Y] then
            Inc(High)
          else
            Inc(Low);

    if (Grid[X,Y] = 0) and (High=0) and (Low=0) then
      Brush.Color := MainForm.Colors[0]  // No grains in area
    else
    if (Grid[X,Y] > 0) and (High=0) and (Low=0) then
      Brush.Color := MainForm.Colors[1]  // Flat area with grains in (X,Y)
    else
    if (Mid=0) and (High=0) and (Low<>0) then
      Brush.Color := MainForm.Colors[2]  // (X,Y) is peak point in area
    else
    if (Mid>=0) and (High<>0) and (Low=0) then
      Brush.Color := MainForm.Colors[3]  // (X,Y) is lowest point in area
    else
    if (High>1) and (Low>1) then
      Brush.Color := MainForm.Colors[4]  // A neighbor is higher or lower
    else
      Brush.Color := MainForm.Colors[5]; // A third condition...

    // Fill the cell with the right color
    FillRect(DrawGrid.CellRect(X, Y));
  end;
end;
*)