Процедура рисования:
procedure draw(k:integer);
var i,j:integer;
begin
for i:=0 to 100 do
for j:=0 to 200 do
begin
if a[i,j]=1 then
form1.label1.Canvas.Pixels[i,j]:=clyellow else
if a[i,j]=2 then
form1.label1.Canvas.Pixels[i,j]:= clwhite else
form1.label1.Canvas.Pixels[i,j]:=clblack;
end;
end;
Процедура init:
procedure init;
var i,j:integer;
begin
for i:=1 to 100 do
for j:=1 to 200 do
begin
if form1.label1.canvas.Pixels[i,j]=clyellow then a[i,j]:=1;
if form1.label1.canvas.Pixels[i,j]=clblack then a[i,j]:=2;
end;
end;
Процедура перемещения:
procedure move;
var i,j:integer;
begin
flag:=true;
for i:=2 to 99 do
for j:=198 downto 1 do
begin
if a[i,j]=2 then c[i,j]:=a[i,j];
if a[i,j]=1 then
begin
c[i,j]:=1;
if c[i,j+1]=0 then
begin
flag:=false;
c[i,j]:=0;
c[i,j+1]:=1;
end else
if random(2)=1 then
begin
if c[i+1,j+1]=0 then
begin
flag:=false;
c[i,j]:=0;
c[i+1,j+1]:=1;
end
end else
if c[i-1,j+1]=0 then
begin
flag:=false;
c[i,j]:=0;
c[i-1,j+1]:=1;
end
end;
end;
a:=c;
end;
Процедура Turn:
procedure turn;
var i,j:integer;
begin
for i:=1 to 100 do
for j:=1 to 199 do
c[i,j]:=a[i,200-j];
a:=c;
end;
procedure schet;
var i,j,n:integer;
begin
n:=0;
for i:=1 to 100 do
for j:=1 to 100 do
if a[i,j]=1 then
n:=n+1;
t:=t+1;
form1.Label2.Caption:=inttostr(t div 10);
if flag then
begin
t:=0;
turn;
end;
end;
Процедура Timer:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
move;
schet;
draw(1);
application.ShowMainForm:=false;
end;
Загрузка изображения песочных часов, где черный цвет - препятствие, желтый - песок. Песок падает вниз:
procedure TForm1.FormActivate(Sender: TObject);
begin
form1.Height:=213;
form1.Width:=100;
image1.Picture.LoadFromFile('send.bmp');
label1.Canvas.Draw(0,0,image1.Picture.Bitmap);
init;
end;
Полностью исходник можно найти в разделе - Исходники на Delphi |
Главная
Каталог файлов
