Клеточная карта с тремя островами. Раскрашенная карта. - презентация

1 Клеточная карта с тремя островами

2 Раскрашенная карта

3

4 TfrmCellMap = class(TForm) sgrSea: TStringGrid; btnLoad: TButton; btnShow: TButton; btnPaint: TButton; btnClear: TButton; procedure FormCreate(Sender: TObject); procedure btnLoadClick(Sender: TObject); procedure btnShowClick(Sender: TObject); procedure btnPaintClick(Sender: TObject); procedure btnClearClick(Sender: TObject); private { Private declarations } public { Public declarations } end;

5 const N=10; type TMapArr=array[1..N,1..N] of integer; TColorMap=class(TObject) Map:TMapArr; qIsl:word; procedure Put(_Map:TStringGrid); procedure Get(var _Map:TStringGrid); procedure Paint; procedure PaintIsland(x,y:word); end;

6 procedure TColorMap.Put(_Map: TStringGrid); var i,j:word; begin for i:=1 to N do for j:=1 to N do if _Map.Cells[ j - 1, i -1 ]'' then Map[i,j]:=-1; end;

7 procedure TColorMap.Paint; var i, j : word; begin qIsl := 0; for i := 1 to N do for j := 1 to N do if Map[i,j]= - 1 then begin qIsl := qIsl + 1; PaintIsland( i, j ); end;

8 procedure TColorMap.PaintIsland( x, y : word); begin Map[x,y] := qIsl; if Map[ x – 1, y ] = – 1 then PaintIsland(x – 1 y); if Map[x,y – 1] = – 1 then PaintIsland(x, y – 1); if Map[x + 1, y] = – 1 then PaintIsland(x + 1, y); if Map[x, y + 1] = – 1 then PaintIsland(x, y + 1); end;

9 procedure TColorMap.Get(var _Map: TStringGrid); var i, j : word; begin for i := 1 to N do for j := 1 to N do if Map[i, j] 0 then _Map.Cells[ j - 1, i - 1]:=IntToStr(Map[i, j]); end;

10 procedure TfrmCellMap.FormCreate(Sender: TObject); var i : integer; begin Sea := TWave.Create; sgrSea.ColCount := N; sgrSea.RowCount := N; for i := 0 to N - 1 do begin sgrSea.ColWidths[ i ] := sgrSea.Width div N - 2; sgrSea.RowHeights[ i ] := sgrSea.Height div N - 2; end;

11 procedure TfrmCellMap.btnLoadClick(Sender: TObject); begin Sea.Put(sgrSea); end; procedure TfrmCellMap.btnShowClick(Sender: TObject); begin Sea.Get(sgrSea); end; procedure TfrmCellMap.btnPaintClick(Sender: TObject); begin Sea.Paint; end; procedure TfrmCellMap.btnClearClick(Sender: TObject); var i, j: word; begin for i := 0 to N - 1 do for j := 0 to N - 1 do sgrSea.Cells[i, j] := ''; end;