Курсова робота - Алгоритм програми, що виконує переміщення фігур
36

clear;virtual; destructor done; end; Tfield=object x1,y1:integer; matr:TMatrixField; constructor init(level:byte); procedure draw; procedure clear; function full:boolean; function fline (n:byte):boolean; procedure dline (n:byte); private x2,y2:integer; end;implementationconstructor tfield.init; var i,j:byte; begin for i:=1 to maxX do for j:=1 to maxY do matr[i,j]:=0; for i:=0 to maxX+1 do matr[i,maxY+1]:=1; for j:=1 to maxY do begin matr[0,j]:=1; matr[maxX+1,j]:=1; end; randomize; for i:=1 to level-1 do for j:=1 to MaxX div 2 do matr[random(maxX-2)+1,maxY-i+1]:=1; x1:=20;y1:=40; x2:=size*maxX; y2:=size*maxY; setviewport(x1,y1,x1+x2,y1+y2,true); end;procedure tblock.initmatrix; var i,j:byte; begin for i:=1 to 4 do for j:=1 to 4 do matr[i,j]:=0; case t of 1:case pos of 1,3: begin mx:=4; my:=1; for j:=1 to mx do matr[j,1]:=1; end; 2,4: begin mx:=1; my:=4; for j:=1 to my do matr[1,j]:=1; end; end; 2: case pos of 1,3: begin mx:=3; my:=2; matr[1,1]:=1; matr[2,1]:=1; matr[2,2]:=1; matr[3,2]:=1; end; 2,4: begin mx:=2; my:=3; matr[1,2]:=1; matr[1,3]:=1; matr[2,1]:=1; matr[2,2]:=1; end; end; 3: case pos of 1: begin mx:=3; my:=2; matr[2,1]:=1; matr[1,2]:=1; matr[2,2]:=1; matr[3,2]:=1; end; 2: begin mx:=2; my:=3; matr[1,1]:=1; matr[1,2]:=1; matr[1,3]:=1; matr[2,2]:=1; end; 3: begin mx:=3; my:=2; matr[2,2]:=1; matr[1,1]:=1; matr[2,1]:=1; matr[3,1]:=1; end; 4: begin mx:=2; my:=3; matr[2,1]:=1; matr[2,2]:=1; matr[2,3]:=1; matr[1,2]:=1; end; end; 4: case pos of 1,3: begin mx:=3; my:=2; matr[2,1]:=1; matr[3,1]:=1; matr[1,2]:=1; matr[2,2]:=1; end; 2,4: begin mx:=2; my:=3; matr[1,1]:=1; matr[1,2]:=1; matr[2,2]:=1; matr[2,3]:=1; end; end; 5: begin mx:=2; my:=2; for i:=1 to 2 do for j:=1 to 2 do matr[i,j]:=1; end; 6: case pos of 1: begin mx:=2; my:=3; matr[2,1]:=1; matr[2,2]:=1; matr[2,3]:=1; matr[1,3]:=1; end; 2: begin mx:=3; my:=2; matr[1,1]:=1; matr[2,1]:=1; matr[3,1]:=1; matr[3,2]:=1; end; 3: begin mx:=2; my:=3; matr[1,1]:=1; matr[1,2]:=1; matr[1,3]:=1; matr[2,1]:=1; end; 4: begin mx:=3; my:=2; matr[1,1]:=1; matr[1,2]:=1; matr[2,2]:=1; matr[3,2]:=1; end; end; 7: case pos of 1: begin mx:=2; my:=3; matr[1,1]:=1; matr[1,2]:=1; matr[1,3]:=1; matr[2,3]:=1; end; 2: begin mx:=3; my:=2; matr[1,2]:=1; matr[2,2]:=1; matr[3,2]:=1; matr[3,1]:=1; end; 3: begin mx:=2; my:=3; matr[2,1]:=1; matr[2,2]:=1; matr[2,3]:=1; matr[1,1]:=1; end; 4: begin mx:=3; my:=2; matr[1,2]:=1; matr[1,1]:=1; matr[2,1]:=1; matr[3,1]:=1; end; end; end; end; procedure kv ( var p: pointer;VAR s:word );var p2:pointer; S2:WORD;begins:=imagesize(0,0,size,size);getmem(p2,s);getimage(0,0,size,size,p2^);setfillstyle(1,4);setcolor(12);bar(0,0,size,size);rectangle(2,2,size-1,size-2);getmem(p,s);getimage(0,0,size,size,p^);putimage(0,0,p2^,normalput);freemem(p2,s);p2:=nil;end;constructor tblock.init; var x1,y1,x2,y2,i,j:integer; begin randomize; t:=random(100)mod 7 +1; pos:=random(3)+1; initmatrix; x:=(maxX-mx) div 2; y:=2; kv(p,s); p2:=nil; end;constructor tblock.init2;begin t:=t1; pos:=pos1; initmatrix; x:=(maxX-mx) div 2; y:=2; kv(p,s); p2:=nil; end;procedure tblock.draw; var i,j:byte; begin s2:=imagesize(0,0,mx*size,my*size); getmem(p2,s2); getimage((x-1)*size,(y-1)*size,(x-1+mx)*size, (y-1+my)*size,p2^); for i:=1 to mx do for j:=1 to my do if matr[i,j]<>0 then putimage((x+i-2)*size, (y+j-2)*size,p^,normalput); end;procedure tblock.clear; var x1,x2,y1,y2:integer; begin putimage((x-1)*size,(y-1)*size,p2^,normalput); freemem(p2,s2); p2:=nil; end;procedure tblock.rotate; begin if pos<4 then inc(pos)else pos:=1; x:=x+((mx+1) div 2); y:=y+((my+1) div 2); x:=x-((mx+1) div 2); y:=y-((my+1) div 2); initmatrix; end;procedure tfield.draw;var i,j:byte; p:pointer; s,r,a,b:word; col:word; ar:array [1..5,1..4]of word; begin setfillstyle(1,blue); bar(0,0,x2,y2); setcolor(3); for i:=1 to maxX-1 do line(size*i,0,size*i,y2); for i:=1 to maxY-1 do line(0,size*i,x2,size*i); ar[1,1]:=75*maxX*size div 100+4; ar[1,2]:=35*maxY*size div 150-4; ar[1,3]:=12; ar[1,4]:=MaxX*size div 6; ar[2,1]:=7*maxX*size div 10+3; ar[2,2]:=75*maxY*size div 150-2; ar[2,3]:=14; ar[2,4]:=MaxX*size div 8; ar[3,1]:=3*maxX*size div 10-6; ar[3,2]:=1*maxY*size div 10-4; ar[3,3]:=13; ar[3,4]:=MaxX*size div 10; for i:=1 to 3 do begin setcolor(ar[i,3]); a:=ar[i,1];b:=ar[i,2]; r:=ar[i,4]; 1line(a,b,a+(r*3 div 10) ,b-(r*95)div 100); line(a-(r*3 div 10) ,b-(r*95)div 100,a,b); line(a+(r*3 div 10),b-(r*95)div 100,a-(r*3 div 10), b-(r*95)div 100); 2line(a,b,a+(r*3 div 10) ,b+(r*95)div 100); line(a-(r*3 div 10) ,b+(r*95)div 100,a,b); line(a-(r*3 div 10),b+(r*95)div 100,a+(r*3 div 10), b+(r*95)div 100); 3line(a,b,a-(r*95)div 100,b+(r*3 div 10)); line(a-(r*95)div 100,b-(r*3 div 10),a,b); line(a-(r*95)div 100,b-(r*3 div 10),a-(r*95)div 100, b+(r*3 div 10)); 4line(a,b,a+(r*95)div 100,b+(r*3 div 10)); line(a+(r*95)div 100,b-(r*3 div 10),a,b); line(a+(r*95)div 100,b-(r*3 div 10),a+(r*95)div 100, b+(r*3 div 10)); 5line(a+(45*r)div 100,b-(88*r)div 100,a,b); line(a+(88*r)div 100,b-(45*r)div 100,a,b); line(a+(45*r)div 100,b-(88*r)div 100,a+(88*r)div 100, b-(45*r)div 100); 6line(a-(45*r)div 100,b-(88*r)div 100,a,b); line(a-(88*r)div 100,b-(45*r)div 100,a,b); line(a-(45*r)div 100,b-(88*r)div 100,a-(88*r)div 100, b-(45*r)div 100); 7line(a-(45*r)div 100,b+(88*r)div 100,a,b); line(a-(88*r)div 100,b+(45*r)div 100,a,b); line(a-(45*r)div 100,b+(88*r)div 100,a-(88*r)div 100, b+(45*r)div 100); 8line(a+(45*r)div 100,b+(88*r)div 100,a,b); line(a+(88*r)div 100,b+(45*r)div 100,a,b); line(a+(45*r)div 100,b+(88*r)div 100,a+(88*r)div 100, b+(45*r)div 100); end; kv( p,s ); for i:=1 to maxX do for j:=1 to maxY do if matr [i,j] = 1 then putimage( (i-1)*size, (j-1)*size,p^,normalput ); freemem( p,s ); p:=nil;end;procedure tfield.clear;begin setviewport(x1,y1,x1+x2,y1+y2,true); setfillstyle(1,0); bar(0,0,x2,y2)end;function tfield.full; var i:byte; begin full:=false; for i:=1 to maxX do if matr[i,2]<>0 then full:=true ; end;function tfield.fline; var i:byte; t:boolean; begin t:=true; for i:=1 to maxX do if matr[i,n]=0 then t:=false; fline:=t; end;procedure tfield.dline; var i,j:byte; pr:^pointer; sz:word; begin for j:=n downto 2 do for i:=1 to maxX do matr[i,j]:=matr[i,j-1] end;destructor tblock.done; begin if p<>nil then freemem (p,s); if p2<>nil then freemem (p2,s2 ); p:=nil; p2:=nil; end;beginend. unit ramki; http://nataliya.kiev.ua interfaceuses graph,crt;type menutype=array[1..10]of string[15]; tramka=object x,y,width,heigth:integer; lighted:boolean; col1,col2,col3:integer; private p:pointer; s:word; public constructor init( x1, y1, xx , yy :word); procedure mkactive; procedure light; procedure unlight; procedure draw; procedure clear; destructor done; end; tsubmenu=object(tramka) punkts:menutype; n:byte; col4:integer; constructor init(const pnk:menutype;n1:byte;x1,y1:word); procedure draw; function result:byte; private h:integer; end; tmainmenu=object(tsubmenu) constructor init(const pnk:menutype;n1:byte); procedure draw; function result:byte; procedure getkoords(i:byte;var xI,yI:word); end; implementationconstructor tramka.init; begin x:=x1; y:=y1; width:=xx;

---

Сторінки: 1 2 3 4 5 6