program pyatnashk; uses GraphABC; var m:array[1..15] of string; res:array[1..15] of string; che:array[1..15] of boolean; check:boolean; num,j:integer; procedure search;begin; var um:=0; j:=0;check:=false; for var i:=1 to 15 do res[i]:=m[i]; for var i:=1 to 15 do che[i]:=false; for var i:=1 to 14 do if res[i]=inttostr(i) then che[i]:=true; for var i:=1 to 14 do if che[i]=true then j:=j+1; if j=14 then begin while check<>true do begin um:=um+1; if um=16 then um:=15; if res[um]='empty' then check:=true; end; m[um]:='15'; end; end; procedure init;begin; check:=false; num:=random(15)+1; for var i:=1 to 15 do m[i]:=inttostr(i); for var i:=1 to 15 do begin res[i]:=m[i]; if i=num then check:=true; if check=true then begin if i=num then res[i]:='empty'; if i<>num then res[i]:=m[i-1]; end; end; for var i:=1 to 15 do m[i]:=res[i]; //for var i:=1 to 150 do swap(m[random(15)+1],m[random(15)+1]); //for var i:=1 to 15 do writeln(m[i]); end; procedure draw;begin; var k:=0; LockDrawing; Window.Clear; for var i:=1 to 5 do begin for var j:=1 to 3 do begin k:=k+1; rectangle((j*50)-25,(i*50)-25,(j*50)+25,(i*50)+25); if m[k]<>'empty' then textout((j*50),(i*50),m[k]); end; end; Redraw; end; procedure move(ch:string);begin; var um:=0; var chh:=false; if ch='up' then begin repeat um:=um+1; if m[um]='empty' then chh:=true; until chh=true; if um>3 then swap(m[um],m[um-3]); end; if ch='down' then begin repeat um:=um+1; if m[um]='empty' then chh:=true; until chh=true; if um<13then swap(m[um],m[um+3]); end; if ch='right' then begin repeat um:=um+1; if m[um]='empty' then chh:=true; until chh=true; if um<>3 then if um<>6 then if um<>9 then if um<>12 then if um<>15 then swap(m[um],m[um+1]); end; if ch='left' then begin repeat um:=um+1; if m[um]='empty' then chh:=true; until chh=true; if um<>1 then if um<>4 then if um<>7 then if um<>10 then if um<>13 then swap(m[um],m[um-1]); end; end; procedure KeyDown(Key: integer);begin; case Key of VK_Left: move('left'); VK_Right: move('right'); VK_Up: move('up'); VK_Down: move('down'); end; end; procedure initanim;begin; var q:array[1..4] of string; q[1]:='up'; q[2]:='down'; q[3]:='right'; q[4]:='left'; sleep(3000); for var i:=1 to 150 do begin move(q[random(4)+1]); draw; sleep(75); end; end; begin init;draw;initanim; while 0=0 do begin draw; OnKeyDown := KeyDown; search; end; end.