topu düşürmeden yukardaki taşları kırmaya çalışıyosunuz.(bilmeyen warmı ki
)
uses graph,crt,mouse63;
type resim=record w:word;p: pointer;end;
.....top=record x,y,hx,hy:real;end;
var dizi:array[1..30,1..20] of Byte;
....resimler:array[1..2] of resim;{1:top,2:imle‡}
....mp,mx,my:word;
....t:top;
function acibul(p1x,p1y,p2x,p2y:real):real;
var t,lx,ly,d:real;
begin
..lx:=p2x-p1x;ly:=p2y-p1y;
..if ((lx=0) and (ly=0)) then d:=0 else
..begin
....if lx=0 then
....begin
......if ly>=0 then t:=90 else t:=270;
....end
....else t:=arctan(ly/lx)*180/pi;
....if lx<0 then t:=t+180;if((lx>=0)and(ly<0))then t:=t+360;d:=abs(t);
..end;
..acibul:=d;
end;
procedure sekillericiz;
var i,j:byte;
begin
..for i:=1 to 30 do for j:=1 to 20 do begin setfillstyle(1,dizi[i,j]);bar(20*i+2,j*18-13,20*i+18,j*18-5);end;
end;
procedure arabirim;
begin
..setcolor(15);line(0,430,639,430);sekillericiz;
end;
procedure init;
procedure dosyaacma;
var t:text;i,j:byte;c:char;
begin
..assign(t,'ARK.DAT');{$I-}reset(t);{$I+}if ioresult<>0 then halt;
..for i:=1 to 30 do begin for j:=1 to 20 do read(t,c,dizi[i,j]);readln(t);end;close(t);
end;
procedure gr;
var gd,gm:integer;
begin
..gd:=VGA;gm:=VGAHi;initgraph(gd,gm,'');if graphresult<>0 then halt;
end;
procedure m;
begin
..setmou***y(30,609,420,420);setpixeltomickey(5,4) ;setmouseposition(320,420);
end;
procedure resimayari;
const pat:fillpatterntype=(32,4,32,4,32,4,32,4);
begin
..setfillstyle(1,15);fillellipse(2,2,2,2);
..resimler[1].w:=imagesize(0,0,4,4);
..getmem(resimler[1].p,resimler[1].w);
..getimage(0,0,4,4,resimler[1].p^);
..cleardevice;
..setcolor(15);moveto(3,0);lineto(57,0);lineto(60, 2);lineto(60,4);lineto(57,6);lineto(3,6);lineto(0, 4);lineto(0,2);lineto(3,0);
..setfillpattern(pat,15);floodfill(15,3,15);
..resimler[2].w:=imagesize(0,0,60,6);
..getmem(resimler[2].p,resimler[2].w);
..getimage(0,0,60,6,resimler[2].p^);
..cleardevice;
end;
begin
..if not mouse_installed then halt;
..dosyaacma;gr;m;resimayari;arabirim;mp:=mouseposi tion(mx,my);
..t.x:=320;t.y:=400;t.hx:=1/sqrt(2);t.hy:=-1/sqrt(2);
end;
procedure deinit;
var i:byte;
begin
..for i:=1 to 2 do freemem(resimler[i].p,resimler[i].w);
..closegraph;setmou***y(1,79,1,25);setmousepositio n(1,1);setpixeltomickey(40,30);
end;
procedure oldu;
var s:real;
begin
..if abs(t.x-mx)>30 then
..begin
....t.x:=320;t.y:=400;t.hx:=0;t.hy:=-1;
..end
..else
..begin
....s:=(t.x-mx)/30;
....t.hx:=s;t.hy:=-t.hy;
..end;
end;
procedure hareket;
var i,j:byte;kx,ky:real;
begin
..t.x:=t.x+t.hx;t.y:=t.y+t.hy;
..if t.x>610 then begin t.x:=610;t.hx:=-t.hx;end;
..if t.x<30 then begin t.x:=30;t.hx:=-t.hx;end;
..if t.y>420 then oldu;
..if t.y<10 then begin t.y:=10;t.hy:=-t.hy;end;
..for i:=1 to 30 do for j:=1 to 20 do
..if dizi[i,j]=0 then continue else
..if (t.x>i*20) and (t.x<(i+1)*20) and (t.y>j*18-13) and (t.y<j*18-5) then
..begin
....kx:=abs(t.x-(i*20+10))/16;ky:=abs(t.y-(j*18-9))/8;
....if kx>ky then t.hx:=-t.hx else if ky>kx then t.hy:=-t.hy else begin t.hx:=-t.hx;t.hy:=-t.hy;end;
....setfillstyle(1,0);bar(i*20+2,j*18-13,i*20+18,j*18-5);dizi[i,j]:=0;
..end;
end;
begin
..init;
..repeat
....putimage(round(t.x),round(t.y),resimler[1].p^,XORPUT);putimage(mx-30,my,resimler[2].p^,XORPUT);delay(5);
....putimage(round(t.x),round(t.y),resimler[1].p^,XORPUT);putimage(mx-30,my,resimler[2].p^,XORPUT);
....mp:=mouseposition(mx,my);
....hareket;
..until keypressed;
..deinit;
end.
bu da bunun editörü:
uses graph,crt,mouse63;
var gd,gm:integer;dizi:array[1..30,1..20] of byte;c:char;p,x,y:word;imlecx,imlecy,k:byte;
procedure Sekillericiz;
var i,j:byte;
begin
..for i:=1 to 30 do for j:=1 to 20 do begin setfillstyle(1,dizi[i,j]);bar(20*i+2,(j-1)*18+5,20*(i+1)-2,j*18-5);end;
end;
procedure imlecciz;
begin
..setcolor(15);setwritemode(xorput);rectangle(imle cx*20,(imlecy-1)*18+4,(imlecx+1)*20,imlecy*18-4);setwritemode(normalput);
end;
procedure imlec2ciz;
begin
..setcolor(15);setwritemode(xorput);line(x-5,y,x+5,y);line(x,y-5,x,y+5);setwritemode(normalput);
end;
procedure ekran;
begin
..setcolor(15);
..for gd:=0 to 15 do
..begin
....setfillstyle(1,gd);
....rectangle(gd*10+15+(1-gd div 8)*80,(gd div 8+1)*20+380,gd*10+24+(1-gd div 8)*80,(gd div 8+1)*20+400);
....bar(gd*10+16+(1-gd div 8)*80,(gd div 8+1)*20+381,gd*10+23+(1-gd div 8)*80,(gd div 8+1)*20+399);
..end;
..sekillericiz;
end;
procedure dosyayayaz;
var t:text;i,j:byte;
begin
..assign(t,'ARK.DAT');rewrite(t);for i:=1 to 30 do begin for j:=1 to 20 do write(t,' ',dizi[i,j]);writeln(t);end;close(t);
end;
procedure dosyaacma;
var t:text;i,j:byte;c:char;
begin
..assign(t,'ARK.DAT');{$I-}reset(t);{$I+}if ioresult<>0 then begin rewrite(t);close(t);reset(t);end;
..for i:=1 to 30 do begin for j:=1 to 20 do read(t,c,dizi[i,j]);readln(t);end;close(t);
end;
begin
..gd:=VGA;gm:=VGAHi;initgraph(gd,gm,'');if graphresult<>0 then halt;dosyaacma;
..setmou***y(1,640,1,480);setmouseposition(320,240 );setpixeltomickey(1,1);ekran;
..repeat
....p:=mouseposition(x,y);imlecx:=x div 20+1;imlecy:=y div 18+1;
....if (y<360) and (x<600) then begin imlecciz;delay(10);imlecciz;end else begin imlec2ciz;delay(10);imlec2ciz;end;
....if p=leftpress then
....begin
......if (y<360) and (x<600) then
......begin
........dizi[imlecx,imlecy]:=k;setfillstyle(1,k);bar(imlecx*20+2,imlecy*18-13,imlecx*20+18,imlecy*18-5);
......end
......else
......begin
........if (x>94) and (x<175) and (y>400) and (y<440) then k:=((y-400) div 20)*8+(x-95) div 10;
......end;
....end;
....if keypressed then c:=readkey;
..until c=#27;
..closegraph;
..dosyayayaz;
end.