Stian Søiland, IT 112, øvingsgruppe 15 (stud.ass. Helle Haugenes)
Stian Søiland, IT 112, øvingsgruppe 15 (stud.ass. Helle Haugenes)
program Oving3;
uses
Forms, Graphics, Unit1;
{$r oving3.scu}
begin
Application.Create;
Application.CreateForm (TForm1, Form1);
Application.Run;
Application.Destroy;
end.
unit Unit1;
interface
uses
Classes, Forms, Graphics, Grids, matriseklatter,
ExtCtrls, Buttons, StdCtrls, SysUtils;
type
TForm1 = class (TForm)
StringGrid1: TStringGrid;
RadioGroup1: TRadioGroup;
Label1: TLabel;
Button1: TButton;
procedure Button1OnClick (Sender: TObject);
procedure StringGrid1OnSelectCell (Sender: TObject; Col: LongInt;
Row: LongInt);
private
{Insert private declarations here}
public
{Insert public declarations here}
end;
var
Form1: TForm1;
const fylt = #219;
tomt = '';
implementation
procedure TForm1.Button1OnClick (Sender: TObject);
var resultat:boolean;
i,j:integer;
begin
initier(resultat);
if resultat then
begin
// Nullstiller Stringgriden
StringGrid1.Visible := False;
for i:=0 to StringGrid1.Colcount-1 do
for j:=0 to StringGrid1.Rowcount-1 do
StringGrid1.Cells[i,j] := tomt;
// Viser frem Stringgriden som man nå får lov å klikke på
StringGrid1.Visible := True;
// Setter valget til 'markert'
RadioGroup1.ItemIndex := 0;
Label1.Caption := 'Initiert';
end
else
Label1.Caption := 'Feil!';
end;
procedure TForm1.StringGrid1OnSelectCell (Sender: TObject; Col: LongInt;
Row: LongInt);
var markert,resultat:boolean;
antall:integer;
begin
if RadioGroup1.ItemIndex < 1 then
// Markering
begin
Label1.Caption := 'Markerer..';
// Kobler inn ShowSelection for at Stringriden skal bli oppdatert
StringGrid1.Options := StringGrid1.Options + [goShowSelection];
// Sjekker om cellen allerede er markert
hent(Col,Row,markert,resultat);
if resultat then
begin
if not markert then
// Markerer i stringgrid
StringGrid1.Cells[Col,Row] := fylt
else
// Fjerner markering i stringgrid
StringGrid1.Cells[Col,Row] := tomt;
// Lagrer det motsatte av markert-verdien i matrisen
lagre(Col,Row,(not markert),resultat);
end;
// Kobler ut igjen ShowSelection for at ikke den ekle mark›ren skal vises
StringGrid1.Options := StringGrid1.Options - [goShowSelection];
end // markering
else
// Telling
begin
// Kaller prosedyren klatt som returnerer antall
klatt(Col,Row,antall,resultat);
if resultat then
begin
// Skriver ut resultat
Label1.Caption := 'Klatten er ' + inttostr(antall) + ' stor';
end
else
begin
Label1.Caption := 'Feil!';
end;
end; // telling
end; // Prosedyre StringGridOnSelectCell
initialization
RegisterClasses ([TForm1, TStringGrid, TRadioGroup, TLabel, TButton]);
end.
unit matriseklatter;
interface
const
// innholdet i tomme celler.. må være i datatype kolonnedata
tomcelle = false;
type
// Setter matrisens datatype
kolonnedata = boolean;
// Setter matrisens dimensjoner
kolonner = 0..11;
rader = 0..11;
// Prosedyren initier oppretter matrisen, resultat true hvis vellykket
procedure initier(var resultat:boolean);
// Prosedyren hent henter ut data fra matrisen i angitt celle,
// resultat er true hvis vellykket, er koordinatene utenfor
// matrisens dimensjoner er resultat false
procedure hent(kolonne,rad:integer; var data:kolonnedata;
var resultat:boolean);
// Prosedyren lagre lagrer data i matrisen i angitt celle,
// resultat er true hvis vellykket, er koordinatene utenfor
// matrisens dimensjoner er resultat false
procedure lagre(kolonne,rad:integer; data:kolonnedata;
var resultat:boolean);
// Prosedyren klatt finner størrelsen på en klatt hvor koordinatene
// peker på et punkt innenfor klatten. Storrelse er 0 dersom
// ingen klatt er ved punktet, resultat er false hvis koordinatene er
// utenfor matrisens dimensjoner, hvis ikke er resultat true
procedure klatt(kolonne,rad:integer; var storrelse:integer;
var resultat:boolean);
implementation
// Global variabel matrise
type matrisetype = array [kolonner,rader] of kolonnedata;
var matrise : matrisetype;
procedure initier(var resultat:boolean);
var i,j:integer;
begin
// Sjekker om dimensjonene er fornuftige
resultat := not ( (high(kolonner) < low(kolonner)) or
(high(rader) < low(rader)) );
if resultat then
// Gjennomløper hver kolonne i
for i:=low(kolonner) to high(kolonner) do
begin
// Gjennomløper hver rad j
for j:=low(rader) to high(rader) do
begin
// Setter cellen til den tomme konstanten
matrise[i,j] := tomcelle;
end; // radgjennomløping
end; // kolonnegjennomløping
end; // prosedyre initier
// Funksjon for å sjekke om gitte koordinater er innenfor matrisen
function sjekkdimensjon(kolonne,rad:integer):boolean;
begin
sjekkdimensjon := not (
(kolonne < low(kolonner))
or (kolonne > high(kolonner))
or (rad < low(rader))
or (rad > high(rader))
);
end;
procedure hent(kolonne,rad:integer; var data:kolonnedata;
var resultat:boolean);
begin
resultat := sjekkdimensjon(kolonne,rad);
if resultat then
begin
data := matrise[kolonne,rad];
end;
end; // prosedyre hent
procedure lagre(kolonne,rad:integer; data:kolonnedata;
var resultat:boolean);
begin
resultat := sjekkdimensjon(kolonne,rad);
if resultat then
begin
matrise[kolonne,rad] := data;
end;
end; // prosedyre lagre
procedure klatt(kolonne,rad:integer; var storrelse:integer;
var resultat:boolean);
// Peker til en temporær matrise
type matrisepeker = ^matrisetype;
var tempmatrise : matrisepeker;
// Rekursiv funksjon
function rekursiv(matrise:matrisepeker;
kolonne,rad,storrelse:integer):integer;
var i,j:integer;
begin
if matrise^[kolonne,rad] <> tomcelle then
begin
// Denne cellen finnes og er ikke telt, teller opp
storrelse := storrelse + 1;
// ..og markerer den som telt
matrise^[kolonne,rad] := tomcelle;
// Sjekker alle celler som er i nærheten, også diagonalt
// og seg selv en gang til (men den er merket tom nå)..
// noe ueffektivt, men..
for i:=-1 to 1 do
for j:=-1 to 1 do
begin
if sjekkdimensjon(kolonne+i,rad+j) then
storrelse := rekursiv(matrise,kolonne+i,rad+j,storrelse);
end;
end; // if cellen er utelt
// Returnerer storrelse, berørt eller ikke
rekursiv := storrelse;
end; // funksjon rekursiv
begin
resultat := sjekkdimensjon(kolonne,rad);
if resultat then
begin
// Tempmatrisen settes lik originalmatrisen, bare celler
// som er markerte fra før trenger å telles
new(tempmatrise);
tempmatrise^ := matrise;
storrelse := 0;
storrelse := rekursiv(tempmatrise,kolonne,rad,storrelse);
end;
end; // prosedyre klatt
initialization
end.
