سوال در گرافیک پاسکال

nimja

Member
سلام
خواهش میکنم به این سوال من جواب دهید.

چطور میشه در گرافیک پاسکال یک چهار ضلعی(مثلا مستطیل) رو با زدن کلیدهای up و down فقط در راستای محور y حرکت داد.برای بازی تنیس میخوام. میخوام راکت ها رو حرکت بدم.
فقط لطف کنید سریع جواب بدید.
ممنون
 

saalek110

Well-Known Member
ممنون.
من با توربو پاسکال 7 الان مقداری کار کردم.
اولین اشکال خطایی به نام division by zero بود که با پچ زیر رفع میشه. گویا در cpu های پر سرعت ایجاد میشه.
http://saalek110c.250free.com/rars/bp7patc1.zip
اگر لینک بالا مشکل داشت از سایت اصلی دانلود کنید.60 کیلو هم بیشتر نیست.
http://skhowell.com/pascalsource.htm

یک برنامه نمونه هم که البته ربطی به سئوال شما نداره را برای تست می گذارم.
از این آدرس:
http://www.partovedarya.blogfa.com/post-61.aspx
کد:
program p1;

uses crt,graph;
const adamak=chr(2); adamak1=chr(1);ziad=chr(43);kam=chr(45);setare=chr(42);space=chr(32);
var grdriver,k,p,m,h,o,j,grmode,i,errcode:integer;chkey:char;
begin
for i:=0 to 5 do
writeln ('');
writeln ('                     @                                                          @ ');
writeln ('                  @@@ (+) for high race & (-) for low race @@@');
writeln ('                     @                                                          @ ');
for i:=0 to 5 do
writeln ('');
writeln ('                  @                                                                    @ ');
writeln ('               @@@ press (space) for exit & press (*) for buzz @@@        ');
writeln ('                  @                                                                     @ ');
for i:=0 to 10 do
writeln ('');
writeln ('                                @@@@               @@@@            ');
writeln ('                             @@@@@@          @@@@@@           ');
writeln ('                             @@@@@@          @@@@@@           ');
writeln ('                                @@@@                @@@@            ');
writeln ('                                                                                   ');
writeln ('                                                                                      ');
writeln ('                                                                                       ');
writeln ('                         @                                                   @      ');
writeln ('                          @@                                          @@       ');
writeln ('                            @@@                                @@@         ');
writeln ('                               @@@@@               @@@@@            ');
writeln ('                                  @@@@@@@@@@@@@               ');
delay(5000);
grdriver:=detect;
initgraph(grdriver,grmode,'c:\tp\bgi');
errcode:=graphresult;
if errcode<>grok then
writeln('graph error',errcode)
else
begin
setbkcolor(15);
setcolor(6);
line(-1,250,155,250);
line(465,250,800,250);
setcolor(1);
for i:=8 to 20 do
begin
circle(220,300,i);
circle(400,300,i);
end;
line(240,300,380,300);
line(200,300,150,300);
line(420,300,470,300);
line(470,300,470,275);
line(470,275,150,275);
line(465,150,155,150);
line(155,150,155,275);
line(150,300,150,275);
line(150,295,145,295);
line(145,295,145,290);
line(145,290,150,290);
line(465,150,465,275);
rectangle(360,160,420,270);
rectangle(389,160,391,270);
setcolor(3);
line(152,160,152,168);
arc(465,265,270,90,5);
arc(155,160,90,180,3);
arc(155,168,180,270,3);
setcolor(14);
for i:=0 to 20 do
circle(500,50,i);
setcolor(9);
rectangle(165,160,225,220);
rectangle(230,160,290,220);
rectangle(295,160,355,220);
settextstyle(10,0,1);
outtextxy(200,225,'seirosafar');
setfillstyle(9,11);
bar3d(365,165,385,220,0,topon);
bar3d(395,165,415,220,0,topon);
bar3d(430,165,465,255,0,topon);
setcolor(6);
setfillstyle(6,10);
bar3d(-1,380,800,600,1,topon);
o:=100;
for j:=0 to 5 do
for i:=0 to 360 do
begin
if keypressed then
begin
chkey:=readkey;
if ((chkey=ziad)and(o>0)) then
o:=o-10;
if (chkey=kam)and(o<200) then
o:=o+10;
if chkey=setare then
begin
for h:=0 to 20 do
begin
sound(704);
setcolor(14);
arc(470,265,270,90,5);
arc(475,265,270,90,5);
arc(467,265,270,90,2);
arc(467,265,270,90,1);
delay(5);
setcolor(15);
arc(470,265,270,90,5);
arc(475,265,270,90,5);
arc(467,265,270,90,2);
arc(467,265,270,90,1);
nosound;
end;
end;
if chkey=space then
halt(1);
end;
setcolor(14);
circle(500,50,round(i/36)+22);
setcolor(15);
setfillstyle(9,15);
bar3d(160-i+1,320,200-i+1,330,0,topon);
bar3d(420-i+1,320,460-i+1,330,0,topon);
bar3d(240-i+1,320,380-i+1,330,0,topon);
bar3d(-20-i+1,320,120-i+1,330,0,topon);
bar3d(500-i+1,320,640-i+1,330,0,topon);
bar3d(680-i+1,320,720-i+1,330,0,topon);
bar3d(760-i+1,320,900-i+1,330,0,topon);
line(147,292,90,200);
setcolor(15);
arc(220,300,0-i,100-i,13);
arc(400,300,0-i,100-i,13);
setcolor(7);
setfillstyle(9,7);
bar3d(160-i,320,200-i,330,0,topon);
bar3d(420-i,320,460-i,330,0,topon);
bar3d(240-i,320,380-i,330,0,topon);
bar3d(-20-i,320,120-i,330,0,topon);
bar3d(500-i,320,640-i,330,0,topon);
bar3d(680-i,320,720-i,330,0,topon);
bar3d(760-i,320,900-i,330,0,topon);
 p:=(round(i/60));
ellipse(140-(4*p)-6,292,0,360,3,p+2);
ellipse(140-(4*p)-2,292,0,360,3,p+1);
ellipse(140-(4*p)+2,292,0,360,3,p);
setcolor(1);
arc(220,300,0-i,100-i,13);
arc(400,300,0-i,100-i,13);
delay(0);
setcolor(6);
k:=round(i/30)-3;
setfillstyle(k,10);
bar3d(-1,380,800,600,1,topon);
setcolor(15);
circle(500,50,(round(i/36)+22));
SETTEXTSTYLE(0,0,2);
outtextxy(175+m,195,adamak);
outtextxy(195+m,195,adamak1);
arc(182+m,219,0,180,10);
arc(202+m,219,0,180,10);
setcolor(15);
outtextxy(240+m,195,adamak);
outtextxy(260+m,195,adamak1);
arc(247+m,219,0,180,10);
arc(267+m,219,0,180,10);
setcolor(15);
ellipse(140-(4*p)-6,292,0,360,3,p+2);
ellipse(140-(4*p)-2,292,0,360,3,p+1);
ellipse(140-(4*p)+2,292,0,360,3,p);
outtextxy(305+m,195,adamak);
outtextxy(325+m,195,adamak1);
arc(312+m,219,0,180,10);
arc(332+m,219,0,180,10);
setcolor(6);
m:=round(i/30);
SETTEXTSTYLE(0,0,2);
outtextxy(175+m,195,adamak);
outtextxy(195+m,195,adamak1);
arc(182+m,219,0,180,10);
arc(202+m,219,0,180,10);
setcolor(12);
outtextxy(240+m,195,adamak);
outtextxy(260+m,195,adamak1);
arc(247+m,219,0,180,10);
arc(267+m,219,0,180,10);
setcolor(10);
outtextxy(305+m,195,adamak);
outtextxy(325+m,195,adamak1);
arc(312+m,219,0,180,10);
arc(332+m,219,0,180,10);
delay(o);
end;
end;
readln;
closegraph
end.

یک اتوبوس است که روی آن نوشته ((سیر و سفر)) و چند نفر آدم هم داخلش نشستند.
 

nimja

Member
ممنون.
من با توربو پاسکال 7 الان مقداری کار کردم.
اولین اشکال خطایی به نام division by zero بود که با پچ زیر رفع میشه. گویا در cpu های پر سرعت ایجاد میشه.
http://saalek110c.250free.com/rars/bp7patc1.zip
اگر لینک بالا مشکل داشت از سایت اصلی دانلود کنید.60 کیلو هم بیشتر نیست.
http://skhowell.com/pascalsource.htm

یک برنامه نمونه هم که البته ربطی به سئوال شما نداره را برای تست می گذارم.
از این آدرس:
http://www.partovedarya.blogfa.com/post-61.aspx
کد:
program p1;
 
uses crt,graph;
const adamak=chr(2); adamak1=chr(1);ziad=chr(43);kam=chr(45);setare=chr(42);space=chr(32);
var grdriver,k,p,m,h,o,j,grmode,i,errcode:integer;chkey:char;
begin
for i:=0 to 5 do
writeln ('');
writeln ('                     @                                                          @ ');
writeln ('                  @@@ (+) for high race & (-) for low race @@@');
writeln ('                     @                                                          @ ');
for i:=0 to 5 do
writeln ('');
writeln ('                  @                                                                    @ ');
writeln ('               @@@ press (space) for exit & press (*) for buzz @@@        ');
writeln ('                  @                                                                     @ ');
for i:=0 to 10 do
writeln ('');
writeln ('                                @@@@               @@@@            ');
writeln ('                             @@@@@@          @@@@@@           ');
writeln ('                             @@@@@@          @@@@@@           ');
writeln ('                                @@@@                @@@@            ');
writeln ('                                                                                   ');
writeln ('                                                                                      ');
writeln ('                                                                                       ');
writeln ('                         @                                                   @      ');
writeln ('                          @@                                          @@       ');
writeln ('                            @@@                                @@@         ');
writeln ('                               @@@@@               @@@@@            ');
writeln ('                                  @@@@@@@@@@@@@               ');
delay(5000);
grdriver:=detect;
initgraph(grdriver,grmode,'c:\tp\bgi');
errcode:=graphresult;
if errcode<>grok then
writeln('graph error',errcode)
else
begin
setbkcolor(15);
setcolor(6);
line(-1,250,155,250);
line(465,250,800,250);
setcolor(1);
for i:=8 to 20 do
begin
circle(220,300,i);
circle(400,300,i);
end;
line(240,300,380,300);
line(200,300,150,300);
line(420,300,470,300);
line(470,300,470,275);
line(470,275,150,275);
line(465,150,155,150);
line(155,150,155,275);
line(150,300,150,275);
line(150,295,145,295);
line(145,295,145,290);
line(145,290,150,290);
line(465,150,465,275);
rectangle(360,160,420,270);
rectangle(389,160,391,270);
setcolor(3);
line(152,160,152,168);
arc(465,265,270,90,5);
arc(155,160,90,180,3);
arc(155,168,180,270,3);
setcolor(14);
for i:=0 to 20 do
circle(500,50,i);
setcolor(9);
rectangle(165,160,225,220);
rectangle(230,160,290,220);
rectangle(295,160,355,220);
settextstyle(10,0,1);
outtextxy(200,225,'seirosafar');
setfillstyle(9,11);
bar3d(365,165,385,220,0,topon);
bar3d(395,165,415,220,0,topon);
bar3d(430,165,465,255,0,topon);
setcolor(6);
setfillstyle(6,10);
bar3d(-1,380,800,600,1,topon);
o:=100;
for j:=0 to 5 do
for i:=0 to 360 do
begin
if keypressed then
begin
chkey:=readkey;
if ((chkey=ziad)and(o>0)) then
o:=o-10;
if (chkey=kam)and(o<200) then
o:=o+10;
if chkey=setare then
begin
for h:=0 to 20 do
begin
sound(704);
setcolor(14);
arc(470,265,270,90,5);
arc(475,265,270,90,5);
arc(467,265,270,90,2);
arc(467,265,270,90,1);
delay(5);
setcolor(15);
arc(470,265,270,90,5);
arc(475,265,270,90,5);
arc(467,265,270,90,2);
arc(467,265,270,90,1);
nosound;
end;
end;
if chkey=space then
halt(1);
end;
setcolor(14);
circle(500,50,round(i/36)+22);
setcolor(15);
setfillstyle(9,15);
bar3d(160-i+1,320,200-i+1,330,0,topon);
bar3d(420-i+1,320,460-i+1,330,0,topon);
bar3d(240-i+1,320,380-i+1,330,0,topon);
bar3d(-20-i+1,320,120-i+1,330,0,topon);
bar3d(500-i+1,320,640-i+1,330,0,topon);
bar3d(680-i+1,320,720-i+1,330,0,topon);
bar3d(760-i+1,320,900-i+1,330,0,topon);
line(147,292,90,200);
setcolor(15);
arc(220,300,0-i,100-i,13);
arc(400,300,0-i,100-i,13);
setcolor(7);
setfillstyle(9,7);
bar3d(160-i,320,200-i,330,0,topon);
bar3d(420-i,320,460-i,330,0,topon);
bar3d(240-i,320,380-i,330,0,topon);
bar3d(-20-i,320,120-i,330,0,topon);
bar3d(500-i,320,640-i,330,0,topon);
bar3d(680-i,320,720-i,330,0,topon);
bar3d(760-i,320,900-i,330,0,topon);
 p:=(round(i/60));
ellipse(140-(4*p)-6,292,0,360,3,p+2);
ellipse(140-(4*p)-2,292,0,360,3,p+1);
ellipse(140-(4*p)+2,292,0,360,3,p);
setcolor(1);
arc(220,300,0-i,100-i,13);
arc(400,300,0-i,100-i,13);
delay(0);
setcolor(6);
k:=round(i/30)-3;
setfillstyle(k,10);
bar3d(-1,380,800,600,1,topon);
setcolor(15);
circle(500,50,(round(i/36)+22));
SETTEXTSTYLE(0,0,2);
outtextxy(175+m,195,adamak);
outtextxy(195+m,195,adamak1);
arc(182+m,219,0,180,10);
arc(202+m,219,0,180,10);
setcolor(15);
outtextxy(240+m,195,adamak);
outtextxy(260+m,195,adamak1);
arc(247+m,219,0,180,10);
arc(267+m,219,0,180,10);
setcolor(15);
ellipse(140-(4*p)-6,292,0,360,3,p+2);
ellipse(140-(4*p)-2,292,0,360,3,p+1);
ellipse(140-(4*p)+2,292,0,360,3,p);
outtextxy(305+m,195,adamak);
outtextxy(325+m,195,adamak1);
arc(312+m,219,0,180,10);
arc(332+m,219,0,180,10);
setcolor(6);
m:=round(i/30);
SETTEXTSTYLE(0,0,2);
outtextxy(175+m,195,adamak);
outtextxy(195+m,195,adamak1);
arc(182+m,219,0,180,10);
arc(202+m,219,0,180,10);
setcolor(12);
outtextxy(240+m,195,adamak);
outtextxy(260+m,195,adamak1);
arc(247+m,219,0,180,10);
arc(267+m,219,0,180,10);
setcolor(10);
outtextxy(305+m,195,adamak);
outtextxy(325+m,195,adamak1);
arc(312+m,219,0,180,10);
arc(332+m,219,0,180,10);
delay(o);
end;
end;
readln;
closegraph
end.

یک اتوبوس است که روی آن نوشته ((سیر و سفر)) و چند نفر آدم هم داخلش نشستند.

ولی من جواب سوالمو نگرفتم.من فقط میخوام مستطیل رو با کیبور بالا و پایین کنم. همین
 

saalek110

Well-Known Member
مشکل شما در کدام قسمت است؟
=گرفتن ورودی از صفحه کلید
=نمایش مستطیل
=یا قسمتهای بعدی
 

nimja

Member
این فعلا برنامه ای که تا الان نوشتم:
کد:
program pnigpong ;
uses graph;
const directory ='c:\tp\bgi';
var driver , mode,a : integer;
begin
a:=20 ;
initgraph ( driver , mode ,directory);
setbkcolor(1);
setcolor (15);
rectangle (100,50,500,250);{miz}
line (125,150,275,150);{khat samte chap}
line (325,150,475,150);{khat samte rast}
line (300,50,300,250); {khat amoodi}
setcolor (4);
bar (80,50,100,100);{rket chap}
setcolor (4);
bar (500,50,520,100);{raket rast}
settextstyle (3,horizdir,2);
setcolor (12);
outtextxy (278,60,'NIMJA');
setcolor (15);
settextstyle (1,horizdir,2);
outtextxy (130,220,'PLAYER 1');
settextstyle (1,horizdir,2);
outtextxy (380,220,'PLAYER 2');
readln;
closegraph
end.

با اجرای این برنامه میز پینگ پنگ نشون داده میشه. که 2 تا راکت سفید داره. من فقط میخوام اون راکت ها رو با استفاده از کیبورد بالا و پایین کنم. ولی بلد نیستم چطوری.مشکلم اینه
در ضمن خیلی ممنون که سریع پاسخ میدید
 

nimja

Member
در ضمن یه مشکل دیگه هم پیش اومده
موقعی که از یونیت crt استفاده میکنم موقع اجرا ارور زیر رو میده:

کد:
200.division by zero
 

saalek110

Well-Known Member
http://pascalprogramming.byethost15.com/lesson3.php#label5

این هم یک اسکلت ساده برای دریافت کلید:
کد:
program test1 ;
uses crt,graph;
var
Keypress : char ;
begin

  WHILE Keypress<>'q' DO
                      begin
                      Keypress := readkey;
                      Writeln(Keypress);

                      if Keypress='a' then
                                     begin
                                     Writeln('raket pak shavad');
                                     Writeln('az mokhtasate raket kam shavad');
                                     Writeln('raket dar jaye jadid rasm shavad');
                                     end;
		      end;



end.
حلقه همچنان در حال چرخش است مگر q را به عنوان خروج بزنیم.
اگر a را بزنیم حکم بالا برنده راکت چپ را دارد.
و 3 حرف دیگر هم شما اضافه کنید تا 4 دکمه داشته باشیم برای حرکت دو راکت به بالا و پایین.

می توانید کلیدهای دیگری را برای کارهای دیگر تعریف کنید. مثلا ریست برنامه یا کارهای دیگر.

همان طور که در کد مشخصه برای اینکه جای قبلی راکت نماند باید اول با رنگ بک گراند راکت را رسم کنید و بعد راکت را در جای جدید بکشید.
در اون تاپیک که آدرس دادم نکات بیشتری ممکنه پیدا کنید.
و یک تاپیک را هم از داخل اون تاپیک آدرس دادم با نامی شبیه (( بازی tv گیم با سی )) در آن هم نکات خوبی هست برای طراحی حلقه ها.
و همچنین با سرچ و دیدن سورسهای سایتها می توانید روشها و کدهای بهتری پیدا کنید.
 

nimja

Member
خیلی ممنون دوست عزیز
من یه کارهایی کردم.این کدش:
کد:
program pnigpong ;
uses crt,graph;
const directory ='c:\tp\bgi';
cup = chr(72);
cdown = chr(80);
cesc = chr(27);
var driver,x,y, mode : integer;
chkey : char;
begin
x:=50;
y:=100;
initgraph ( driver , mode ,directory);
setbkcolor(1);
setcolor (15);
rectangle (100,50,500,250);{miz}
line (125,150,275,150);{khat samte chap}
line (325,150,475,150);{khat samte rast}
line (300,50,300,250); {khat amoodi}
setcolor (4);
setcolor (4);
bar (500,50,520,100);{raket rast}
settextstyle (3,horizdir,2);
setcolor (12);
outtextxy (278,60,'NIMJA');
setcolor (15);
settextstyle (1,horizdir,2);
outtextxy (130,220,'PLAYER 1');
settextstyle (1,horizdir,2);
outtextxy (380,220,'PLAYER 2');
[B]repeat
begin
chkey :=readkey;
if chkey=cdown then
begin
SETFILLSTYLE (0,1);
BAR (80,50,99,Y) ;
x:=x+2;
y:=y+2;
SETFILLSTYLE (1,15);
BAR (80,x,99,y);{raket chap}
end;
end;
until chkey=cesc;
[/B]readln;
closegraph
end.

اون قسمتی که پررنگ کردم مخصوص حرکته.
اول یه کلید رو دریافت میکنه
بعدش اگه کلیدdown بود،یه راکت به رنگ سفیددرست میکنه. اگه دوباره دکمه down رو بزنی مستطیل دیگری 2 واحد پایین تر ایجاد میشه.و برای اینگه از مستطیل قبل اثری نمونه یه مستطتل دیگه همرنگ زمینه ایجاد میکنه تا اثری از قبلیه نمونه.
این نمونه کامل کار میکنه و پایین میاد. ولی بالا اومدن رو نتونستم درست کنم:cry:
شما میتونید کمک کنید؟
 

saalek110

Well-Known Member
خوب بالا رفتن برعکس پایین آمدن است دیگه. فرقی نداره که.
دو تا if هم بذار تا راکت از صفحه خارج نشه.
دکمه خروج هم بذار.
 

saalek110

Well-Known Member
تعداد زیادی سورس game پاسکال در
http://www.programmersheaven.com/zone24/cat1574/index.htm
هست که من این را
http://www.programmersheaven.com/download/28144/download.aspx
انتخاب کردم

اسکواش ساده ای است و دو نفره است
کد:
program graphics;
Uses
 Crt, Graph;
var
   depth,directionr,directionu,y,ballxpos,ballypos : integer;
   GraphDriver, GraphMode : Integer;
   randyc,randxc,randy,randx:integer;
   x1,y1,dec1,dec2,dec3,dec4,dec5,x2,x3,x4,x5,y2,y3,y4,y5: integer;
   x6,y6,dec6,dec7,dec8,dec9,dec10,x7,x8,x9,x10,y7,y8,y9,y10,y11,x11,dec11:integer;
   key:char;
   p1xpos,p1ypos,p2xpos,p2ypos:integer;
   turn,p1turn,p2turn,p1score,p2score:integer;


procedure clear;
begin
setfillstyle(1,0);
bar(290,150,320,380);
end;

procedure eraseall;
begin
setfillstyle(1,0);
bar(1,1,640,480);
end;



 procedure opening;
 begin
     x1:=200;
     y1:=200;
     x2:=250;
     y2:=200;
     x3:=300;
     y3:=200;
     x4:=350;
     y4:=200;
     x5:=400;
     y5:=200;
     x6:=200;
     y6:=300;
     x7:=250;
     y7:=300;
     x8:=300;
     y8:=300;
     x9:=350;
     y9:=300;
     x10:=400;
     y10:=300;
     x11:=430;
     y11:=300;

     dec1:=400;
     dec2:=400;
     dec3:=400;
     dec4:=400;
     dec5:=400;
     dec6:=400;
     dec7:=400;
     dec8:=400;
     dec9:=400;
     dec10:=400;
     dec11:=400;

     setcolor(12);
     settextstyle(10,0,2);
     outtextxy(280,150,'R');
     outtextxy(280,190,'O');
     outtextxy(280,230,'C');
     outtextxy(280,270,'K');
     setcolor(10);
     outtextxy(280,310,'E');
     setcolor(12);
     outtextxy(280,350,'T');
     outtextxy(320,150,'S');
     outtextxy(320,190,'Q');
     outtextxy(320,230,'U');
     outtextxy(320,270,'A');
      setcolor(10);
     outtextxy(320,310,'S');
     setcolor(12);
     outtextxy(320,350,'H');
     setcolor(10);
     outtextxy(180,310,'G');
     outtextxy(210,310,'A');
     outtextxy(240,310,'M');

     repeat



     dec1:=dec1 - 1;
     dec2:=dec2 - 1;
     dec3:=dec3 - 1;
     dec4:=dec4 - 1;
     dec5:=dec5 - 1;
     dec6:=dec6 - 1;
     dec7:=dec7 - 1;
     dec8:=dec8 - 1;
     dec9:=dec9 - 1;
     dec10:=dec10 - 1;
     dec11:=dec11 - 1;

     setcolor(random(15)+1);
     circle(x1,y1,dec1);
     circle(x2,y2,dec2);
     circle(x3,y3,dec3);
     circle(x4,y4,dec4);
     circle(x5,y5,dec5);
     circle(x6,y6,dec6);
     circle(x7,y7,dec7);
     circle(x8,y8,dec8);
     circle(x9,y9,dec9);
     circle(x10,y10,dec10);
     circle(x11,y11,dec11);

     delay(6);
     setcolor(0);
     circle(x1,y1,dec1);
     circle(x2,y2,dec2);
     circle(x3,y3,dec3);
     circle(x4,y4,dec4);
     circle(x5,y5,dec5);
     circle(x6,y6,dec6);
     circle(x7,y7,dec7);
     circle(x8,y8,dec8);
     circle(x9,y9,dec9);
     circle(x10,y10,dec10);
     circle(x11,y11,dec11);




     if dec1 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x1-15,y1-50,'');
     end;

     if dec2 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x2-15,y2-50,'');
     end;

     if dec3 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x3-15,y3-50,'');
     end;

     if dec4 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x4-15,y4-50,'');
     end;

     if dec5 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x5-15,y5-50,'');
     end;



     if dec6 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x6-15,y6-50,'S');
     end;

     if dec7 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x7-15,y7-50,'Q');
     end;

     if dec8 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x8-15,y8-50,'U');
     end;

     if dec9 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x9-15,y9-50,'A');
     end;

     if dec10 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x10-15,y10-50,'S');
     end;


     if dec11 <=0 then
     begin
     setcolor(random(15)+1);
     settextstyle(10,0,5);
     outtextxy(x11-1,y11-50,'H');
     end;


     until keypressed;
end;

 procedure restrict;
begin

     if ballxpos <=120 then
     begin
     directionr := 0;
     end;

     if ballxpos >=500 then
     begin
     directionr := 180;
     end;

     if (ballypos<=230) then
     begin
     directionu := 270;
     end;





end;



    procedure ball;
    var i :integer;
begin
     setbkcolor(0);
     {back left corner}
     setfillstyle(1,15);
     bar(1,70,2,470);
     {back left corner}
     bar(620,91,621,470);


     setfillstyle(1,12);
     bar(120,180,500,181);
     bar(121,310,500,311);

     {outline front wall}
     bar(120,1,500,2);

     {center court line}
     bar(41,430,578,431);
     {left service box}
     bar(1,471,111,472);
     {right service box}
     bar(490,471,621,472);

     setcolor(12);
     {left service box diagonal}
     line(151,431,111,471);
     line(151,432,111,472);
     line(151,433,111,473);

     {right service box diagonal}
     line(460,431,490,471);
     line(460,432,490,472);
     line(460,433,490,473);


     {center court on floor line}
     line(299,430,299,481);
     line(300,431,300,482);
     line(301,432,301,483);
     {____}


     setcolor(15);
     line(1,470,120,350);
     {left corner front wall}
     line(120,350,120,1);
     {right corner front wall}
     line(500,350,500,1);
     {base of tin}
     line(120,351,500,351);
     {right nick}
     line(500,351,620,471);
     {left outline left wall}
     setcolor(12);
     line(1,70,120,1);
     {right outline right wall}
     line(500,1,620,91);


     setbkcolor(0);
     delay(3);
     setcolor(15);
     circle(ballxpos,ballypos,depth);
     setfillstyle(1,15);
     floodfill(ballxpos,ballypos,15);
     setfillstyle(1,9);
     bar(p1xpos,p1ypos,p1xpos+50,p1ypos+50);
     setfillstyle(1,10);
     bar(p2xpos,p2ypos,p2xpos+50,p2ypos+50);
     delay(9);
     setcolor(0);
     circle(ballxpos,ballypos,depth);
     setfillstyle(1,0);
     floodfill(ballxpos,ballypos,0);
     restrict;

end;


procedure increases;
begin
randy:=random(5)+3;
randx:=random(7)+4;
end;            {}

procedure directions;
begin
     randyc:=random(3)+1;
     if randyc = 1 then directionu:=90;
     if randyc = 2 then directionu:=270;
     randxc:=random(3)+1;
     if randxc = 1 then directionr:=0;
     if randxc = 2 then directionr:=180;
end;
                 { }

procedure players;
begin
setfillstyle(1,9);
bar(p1xpos,p1ypos,p1xpos+50,p1ypos+50);
setfillstyle(1,14);
bar(p2xpos,p2ypos,p2xpos+50,p2ypos+50);
if key = 'w' then
begin
p1ypos:=p1ypos - 40;
     setfillstyle(1,9);
     bar(p1xpos,p1ypos,p1xpos +50,p1ypos+50);
     setfillstyle(0,0);
     bar(p1xpos,p1ypos+50,p1xpos + 50,p1ypos+100);

end;

if key = 's' then
begin
p1ypos:=p1ypos + 40;
     setfillstyle(1,9);
     bar(p1xpos,p1ypos,p1xpos +50,p1ypos+50);
     setfillstyle(0,0);
     bar(p1xpos,p1ypos,p1xpos + 50,p1ypos-50);

end;


if key = 'a' then
begin
     p1xpos:=p1xpos - 40;
     setfillstyle(1,9);
     bar(p1xpos,p1ypos,p1xpos +50,p1ypos+50);
     setfillstyle(0,0);
     bar(p1xpos+50,p1ypos,p1xpos + 100,p1ypos+50);

end;

if key = 'd' then
begin
p1xpos:=p1xpos + 40;
     setfillstyle(1,9);
     bar(p1xpos,p1ypos,p1xpos +50,p1ypos+50);
     setfillstyle(0,0);
     bar(p1xpos,p1ypos,p1xpos - 50,p1ypos+50);

end;
{player2 keys}
if key = 'i' then
begin
p2ypos:=p2ypos - 40;
     setfillstyle(1,10);
     bar(p2xpos,p2ypos,p2xpos +50,p2ypos+50);
     setfillstyle(0,0);
     bar(p2xpos,p2ypos+50,p2xpos + 50,p2ypos+100);

end;

if key = 'k' then
begin
p2ypos:=p2ypos + 40;
     setfillstyle(1,10);
     bar(p2xpos,p2ypos,p2xpos +50,p2ypos+50);
     setfillstyle(0,0);
     bar(p2xpos,p2ypos,p2xpos + 50,p2ypos-50);

end;


if key = 'j' then
begin
     p2xpos:=p2xpos - 40;
     setfillstyle(1,10);
     bar(p2xpos,p2ypos,p2xpos +50,p2ypos+50);
     setfillstyle(0,0);
     bar(p2xpos+50,p2ypos,p2xpos + 100,p2ypos+50);

end;

if key = 'l' then
begin
p2xpos:=p2xpos + 40;
     setfillstyle(1,10);
     bar(p2xpos,p2ypos,p2xpos +50,p2ypos+50);
     setfillstyle(0,0);
     bar(p2xpos,p2ypos,p2xpos - 50,p2ypos+50);

end;

    if p1xpos < 10 then p1xpos := 10;
     if p1xpos > 590 then p1xpos := 590;
     if p1ypos > 430 then p1ypos := 430;
     if p1ypos < 10 then p1ypos := 10;

    if p2xpos < 10 then p2xpos := 10;
     if p2xpos > 590 then p2xpos := 590;
     if p2ypos > 430 then p2ypos := 430;
     if p2ypos < 10 then p2ypos := 10;

end;


begin
     GraphDriver := Detect;
     InitGraph(GraphDriver, GraphMode, 'c:\tp\bgi');
     if GraphResult <> grOk then Halt(1);
     Randomize;
     {starting position}
     ballxpos:=320;
     ballypos:=250;
     {depth}

     opening;
     eraseall;
     depth:=1;
     p1score:=0;
     p2score:=0;
     p1xpos:=280;
     p1ypos:=200;
     p2xpos:=360;
     p2ypos:=200;
     setbkcolor(0);
     setfillstyle(1,9);
     bar(p1xpos,p1ypos,p1xpos+50,p1ypos+50);
     setfillstyle(1,10);
     bar(p2xpos,p2ypos,p2xpos+50,p2ypos+50);
     p1turn:=1;
     p2turn:=0;
     directions;
     ball;
     delay(1300);                 {sssssddd}

     repeat
     bar(121,310,500,311);
     line(120,350,120,1);

     {if (depth <=7) then if (ballypos <= 352) and (ballypos >=308) then
     begin
     eraseall;
     setcolor(12);
     outtextxy(250,200,'Tin shot!!!');
     turn:=0;
     readln;
     halt(1);
     end;}


     if keypressed then
     begin
     key:=readkey;
     players;
     end;

     {ball bigger start}
     if depth <= 3 then
     begin
     directions;
     setfillstyle(1,9);
     bar(p1xpos,p1ypos,p1xpos+50,p1ypos+50);
     setfillstyle(1,10);
     bar(p2xpos,p2ypos,p2xpos+50,p2ypos+50);
     turn:=1;
     repeat
     depth:=depth + 3;
     ball;
     if keypressed then
     begin
     key:=readkey;
     players;
     end;



     if (directionr = 180) then
     begin
     increases;
     ballxpos:=ballxpos - randx;
     ball;
     restrict;
     end;

     if (directionr = 0) then
     begin
     increases;
     ballxpos:=ballxpos + randx;
     ball;
     restrict;
     end;

     if (directionu = 90) then
     begin
     increases;
     ballypos:=ballypos - randy;
     ball;
     restrict;
     end;

     if (directionu = 270) then
     begin
     increases;
     ballypos:=ballypos + randy;
     ball;
     restrict;
     end;

     restrict;

     until (depth >= 20) or(p1score = 9) or (p2score = 9) or (key = chr(27));
     end;
     {ball bigger end}


     {ball smaller start}
     if (depth >= 20)and ((p1turn = 1)or (p2turn = 0)) then if ((ballxpos >=p1xpos-10) and (ballxpos <=p1xpos +65)) then
     if (ballypos >=p1ypos-10) and (ballypos <= p1ypos + 75) then
     begin
     p1turn:=0;
     p2turn:=1;
     directionu:=90;                                      { }
     sound(500);
     delay(10);
     nosound;
     repeat

     depth:=depth - 1;
     ball;
     if keypressed then
     begin
     key:=readkey;
     players;
     end;





     if (directionr = 180) then
     begin
     increases;
     ballxpos:=ballxpos - randx;
     ball;
     restrict;
     end;

     if (directionr = 0) then
     begin
     increases;
     ballxpos:=ballxpos + randx;
     ball;
     restrict;
     end;

     if (directionu = 90) then
     begin
     increases;
     ballypos:=ballypos - randy;
     ball;
     restrict;
     end;

     if (directionu = 270) then
     begin
     increases;
     ballypos:=ballypos + randy;
     ball;
     restrict;
     end;


     restrict;
     until (depth <= 3) or(key = chr(27))or (turn = 0);
     {ball smaller start}
     end
     else
     begin
     eraseall;
     setcolor(10);
     outtextxy(200,200,'Player 2 wins');
     readln;
     halt(1);
     end;

     if (depth >= 20)and ((p2turn = 1)or (p1turn = 0)) then if ((ballxpos >=p2xpos-10) and (ballxpos <=p2xpos +65)) then
     if (ballypos >=p2ypos-10) and (ballypos <= p2ypos + 75) then
     begin
     p1turn:=1;
     p2turn:=0;
     directionu:=90;                                      { }
     sound(500);
     delay(10);
     nosound;
     repeat

     depth:=depth - 3;
     ball;
     if keypressed then
     begin
     key:=readkey;
     players;
     end;





     if (directionr = 180) then
     begin
     increases;
     ballxpos:=ballxpos - randx;
     ball;
     restrict;
     end;

     if (directionr = 0) then
     begin
     increases;
     ballxpos:=ballxpos + randx;
     ball;
     restrict;
     end;

     if (directionu = 90) then
     begin
     increases;
     ballypos:=ballypos - randy;
     ball;
     restrict;
     end;

     if (directionu = 270) then
     begin
     increases;
     ballypos:=ballypos + randy;
     ball;
     restrict;
     end;


     restrict;
     until (depth <= 3) or (key = chr(27)) or (turn = 0);
     {ball smaller start}
     end
     else
     begin
     eraseall;
     setcolor(9);
     outtextxy(200,200,'Player 1 wins');
     readln;
     halt(1);
     end;

                     {}


     until (key = chr(27)) or(turn = 0);
end.
مسیر bgi را من در سورس به این اصلاح کردم
c:\tp\bgi

کلا در سورسهای گرافیکی bgi چه سی پلاس چه پاسکال بعد دانلود این مسیر را چک کنید.
اگر اشتباه باشد هیچ خطایی برنامه نمی دهد ولی فوری بعد زدن اجرا بسته میشه.

بقیه بازیهای این صفحه را هم می توانید دانلود کنید و از روی کدهای آن ابتکاری برنامه خود را بسازید.
 

nimja

Member
خیلی ممنون
یه سوال دیگه:
دستوری برای رسم دایره توپر هست؟
دستور circle فقط محیط دایره رو رسم میکنه
 

saalek110

Well-Known Member
منبع:
http://01blog.blogfa.com/post-105.aspx

مقدمه ای بر گرافیک کامپیوتری (در پاسکال)

ر برنامه نویسی گرافیکی، نمی توان از رویه های write و یا writeln استفاده کنید، در عوض باید از توابع و رویه های گرافیکی توربوپاسکال استفاده کنید. با استفاده از این توابع می توانید در هرنقطه ای از صفحه نمایش خطوط و اشکال هندسی مختلف نظیر مستطیل، دایره، بیضی رسم کرده و به طرق مختلف آنها را سایه زده و رنگ آمیزی کنید.

شروع برنامه نویسی گرافیکی

در برنامه گرافیکی، خط زیر اولین خطی است که بعد از دستور program قرار می گیرد:
کد:
Uses Graph; {Enables access to graphics modules and constants}
استفاده از دستور Uses، برنامه شما می تواند از پیمانه ها و ثوابت توربوپاسکال استفاده کند. این ثوابت و پیمانه ها در فایلی که یک واحد (unit) نامیده می شود جای می گیرند(مثلا واحد Graph). در فصل 9 به بررسی واحدها خواهیم پرداخت.

کدی که در حالت گرافیکی توسط کامپیوتر تولید می شود، به نوع کامپیوتر بستگی دارد، بنابراین توربو پاسکال، باید نوع سخت افزار گرافیکی ای را که در اختیار سیستم است، بداند دستور
کد:
Var 

  Driver, Mode: integer; {Indicators of kind of graphics hardware}
برای دو متغیر نوع integer (متغیر Driver و Mode ) حافظه ای در نظر می گیرد. محتوی این دو متغیر نوع سخت افزارهای گرافیکی سیستم شما را مشخص می کند. برای تعیین حالت گرافیکی از دستور
کد:
InitGraph (Driver, Mode, 'C:\BP\BGI'); {Initialize graphics mode}
استفاده کنید. رویه ی InitGraph سیستم گرافیکی شما را بررسی کرده، و سپس در متغیرهای Driver و Mode اعدادی مناسب قرار می دهد. پارامتر رشته ای'C:\BP\BGI' شاخه ای را مشخص می کند که در آن نرم افزار کنترل سیستم گرافیکی وجود دارد. رشته ای که بدون کاراکتر است یعنی رشته ی ' ' به این معناست که شاخه جاری حاوی این نرم افزار است. برای این که برنامه های گرافیکی قابل انتقال باشند، اسم شاخه مورد نظر را در یک ثابت رشته ای (Directory) ذخیره می کنیم.

صفحه نمایشی که مانند یک صفحه مختصات است

در حالت متنی، به موقعیت خطوطی که روی صفحه نمایش چاپ می شوند، زیاد توجه نمی شود. اما در برنامه نویسی گرافیکی موقعیت هر خط یا هر شکلی را که روی صفحه نمایش رسم می کنید، باید کنترل کنید. بنابراین، بدانید که ماهیت صفحه نمایش شما چیست و چگونه می توان به اجزا یک تصویر روی آن مراجعه کرد(این اجزاء پیکسل ها (pixels) یا نقاط نام دارند).

صفحه نمایش را بصورت مختصات X-Y تعدادی نقطه می توان درنظر گرفت که مختصات را پالت (palette) گویند. در اکثر نمایشگرها پهنای آنها از درازای آنها بیشتر است، بنابراین در محور Xها (افقی) تعداد نقاط بیشتر از محور y ها (عمودی) است. ابعاد متداول صفحه نمایش عبارتند از : 200× 320، 350×640 و 480×640 ، که اولین عدد تعداد نقاط را در محور Xها مشخص می کند.

توابع GetMaxX و GetMaxY در توربوپاسکال، بترتیب حداکثر تعداد نقاط در X ها و Yها را برمی گردانند. بنابراین، علیرغم ابعاد واقعی صفحه نمایش، هر نمایشگر دارای ابعادی است که در شکل زیر نشان داده شده اند. مختصات گوشه های صفحه نمایش را در این شکل ملاحظه می کنید. نقطه موجود در گوشه بالای سمت چپ دارای مختصات (0,0) و نقطه موجود در گوشه بالای سمت راست دارای انتساب (GetMaxX,0) می باشد.توابع GetMaxX و GetMaxY آرگومان ندارند. توجه داشته باشید که جهت شماره گذاری محور yها در توربو پاسکال، با آنچه که مرسوم است فرق دارد. نقطه در گوشه بالای سمت چپ صفحه نمایش قرار دارد، و هر چه به سمت پایین پیش می رویم، اندازه مختص Y زیاد می شود. در صفحه مختصات عادی نقطه (0.0) در گوشه پایین سمت چپ قرار دارد.

a1.gif

مثال

برنامه زیر ابعاد صفحه مختصات شما رانشان می دهد. دستورات
کد:
BigX := GetMaxX;

BigY := GetMaxY;
رگترین مختصات X و Y را بترتیب درمتغیر های BigX و BigY ذخیره می کنند. دستور closeGraph; برنامه را به حالت متنی بر می گرداند، تا مقادیر BigX و BigY را بتوان در حالت عادی نشان داد. چون نقطه ی (0.0) در گوشه بالای سمت چپ قرار دارد، ابعاد صفحه نمایش 480×640 می باشد.

نمایش ابعاد صفحه نمایش
کد:
Program showDimensions;

 {Displays Palette dimensions}

  Uses graph; {Enables access to graphics modules and constants.}

  Const 

     Directory = 'c:\BP\BGI'; {Name of graphics directory}

  Var 

     Driver, Mode: integer; {Indicators of kind of graphics hardware}

     BigX, BigY: integer;

Begin {showDimensions}

   InitGraph (Driver, Mode, Directory); {Initialize graphics mode}

 

BigX := GetMaxX;

BigY := GetMaxY;

 CloseGraph;

Writeln ('Pixel at Bottom-right corner is (', BigX :1, ', ', BigY :1, ')')

End; {showDimensions}

رنگ زمینه و متن
وقتی در حالت گرافیکی هستیم کلیه نقاط دارای یکی از رنگ های 16 گانه هستند ( اگر نمایشگر رنگی نباشد، نقاط دارای یکی از رنگ های طیف خاکستری هستند.) رنگی که بطور پیش فرض برای نمایش یک نقطه بکار می رود رنگ زمینه (background color) نام دارد. بنابراین، در حالتی که کامپیوتر روشن می شود، صفحه نمایش خالی است، زیرا کلیه نقاط دارای رنگ زمینه هستند. وقتی خطی می کشید و یا شکلی را رسم می کنید، نقاط تشکیل دهنده آنها را می توان دید، زیرا نقاط دارای رنگ متن(Foreground color) هستند. بطور پیش فرض برای رنگ های زمینه و متن، به ترتیب از سیاه و سفید استفاده می شود. دستورات
کد:
Setbkcolor (Green); {green is the background color.}

Setcolor (red)           {Red is the Foreground color.}
برای زمینه رنگ سبز و برای متن رنگ قرمز را تعیین می کنند. کلمات Green و red در این دستورات، ثوابت رنگی هستند( که برخشی از واحد Graph را تشکیل می دهند). با انتخاب نام ثوابت و یا معادل عددی رنگ ها از جدول زیر می توانید رنگی را فعال کنید( بعنوان مثال، برای فعال کردن رنگ قرمز، از red و یا 4 استفاده می کنیم) وقتی برای متن یا زمینه رنگی را انتخاب شد، تا وقتی که آن را تغییر نداده ایم فعال باقی می ماند.

a2.gif

ترسم خطوط
برای کشیدن یک خط روی صفحه نمایش می توانید از رویه ی line استفاده کنید. دستور
کد:
Line (X1, Y1, X2, Y2)
از نقطه (X1, Y1) تا نقطه (X2, Y2) خطی می کشد.

مثال

برنامه زیر یک جفت خط قطری می کشد که در مرکز صفحه نمایش یکدیگر را قطع می کنند.
کد:
Program Intersect;

 {Draw intersecting lines}

  Uses graph; {Enables access to graphics modules and constants.}

Const 

     Directory = 'c:\BP\BGI'; {Name of graphics directory}

  Var 

     Driver, Mode: integer; {Indicators of kind of graphics hardware}

 

Begin {Intersect}

  InitGraph (Driver, Mode, Directory); {Initialize graphics mode}

  Line (0, 0, GetMaxX, GetMaxY);

 

  Setcolor (Lightgray); 

  Line (GetMaxX, 0, 0, GetMaxY);

 

End. {Intersect}

رسم مستطیل
برای رسم مستطیل روی صفحه نمایش از رویه Rectangle استفاده می کنیم دستور
کد:
Rectangle (x1, y1, x2, y2)
مستطیلی رسم می کند که یکی از قطرهای آن از نقطه (x1, y1) شروع شده و به نقطه (x2, y2) ختم می شود. (x1, y1)مختصات گوشه بالا سمت چپ و (x2, y2) گوشه پایین سمت راست قطر مستطیل را برای رسم مستطیل مشخص می کند.

مثال

برنامه ی زیر یک خانه می کشد. برنامه با تعریف مختصات گوشه های خانه شروع می شود، که در آن سقف خانه متشکل از یک جفت خط متقاطع است که در نقطه (x2, y2) یکدیگر را قطع می کنند.
کد:
Program house;

{Draw a house}

  Uses graph; {Enables access to graphics modules and constants.}

Const 

     Directory = 'c:\BP\BGI'; {Name of graphics directory}

  Var 

     Driver, Mode: integer; {Indicators of kind of graphics hardware}

     X1, Y1, X2, Y2, X3, Y3,

     X4, Y4, X5, Y5, X6, Y6: integer;

Begin {house}

  InitGraph (Driver, Mode, Directory); {Initialize graphics mode}

  X1:=100;   Y1:=200;

  X2:=300;   Y2:=100;

  X3:=500;   Y3:=200;

  X4:=500;   Y4:=400;

  X5:=325;   Y5:=400;

  X6:=275;   Y6:=325;

   

  Line (x1, y1, x2, y2);

  Line (X2, y2, x3, y3); 

 

  Rectangle (x1, y1, X4, Y4);

  Rectangle (X5, Y5, X6, Y6);

End. {House}
با اولین فراخوانی رویه Rectangle، بدنه خانه و با دومین فراخوانی در خانه رسم می شود. خانه را در صفحه ای به ابعاد 480×640 رسم کرده ایم. اگر ابعاد صفحه نمایش شما کوچکتر است، باید مختصات نقاط گوشه ای را مجددا تعریف کنید. برای متمایز کردن گوشه ها در برنامه بالا برچسب هایی برای این نقاط (مثلا x1, y1) قرار داده ایم : این برچسب ها توسط برنامه نشان داده نمی شوند.

رسم دایره و مکان آن
برای رسم دایره از رویه ی Circle استفاده می کنیم. دستور
کد:
Circle (x, y, Radius)


دایره ای رسم می کند که مرکز آن نقطه (x, y) و پارامتر سوم شعاع دایره است.

رویه Arc، یک کمان یا بخشی از دایره را رسم می کند. برای رسم کمان باید، زاویه شروع و پایان آن را در مبنای درجه مشخص کنید. دستور:
کد:
Arc (X, Y, 180, Radius)
نیمه فوقانی دایره ای به مرکز (x, y) را رسم می کند. اگر ساعتی را روی صفحه نمایش تصور کنید، زاویه صفر درجه ساعت 3 و زاویه 30 درجه ساعت 2 و زاویه 60 درجه ساعت 1 و زاویه 90 درجه ساعت 12 را نشان می دهد و الی آخر.

مثال

برنامه زیر یک چهره خندان را رسم می کند، رسم شکل، با کشیدن یک دایره کامل (به شعاع HeadRadius) شروع می شود سپس سه دایره کوچکتر (به شعاع EyenoseRadius) که نمایشگر چشمها و بینی هستند کشیده می شوند. سپس برای لب خندان، کمانی از درجه 210 ( ساعت 8) تا 340 درجه (ساعت 4) رسم می شود. مرکز کمان، همان مرکز دایره بیرونی است، ولی اندازه شعاع آن 75% شعاع دایره است.

رسم یک صورت خندان
کد:
Program HappyFace;

{Draw a happy Face}

    Uses graph; {Enables access to graphics modules and constants.}

Const 

    Directory = 'c:\BP\BGI'; {Name of graphics directory}

  Var 

    Driver, Mode: integer; {Indicators of kind of graphics hardware}

    MidX, MidY, LeftEyeX, RightEyeX, EyeY, NoseX, NoseY,

    HeadRadius, EyeNoseRadius, SmileRadius, StepX, StepY :Intrger;

Begin

   InitGraph (Driver, Mode, Directory); {Initialize graphics mode}

   MidX :=GetMaxX div 2;

   MidY :=GetMaxY div 2;

   HeadRadius := GetMaxY div 4;

   Circle (MidX, MidY,);

   StepX := HeadRadius div 4;

   setpY := stepX;

   leftEyeX := MidX- StepX;

   RightEyeX := MidX+ StepX;

   EyeY := MidY-setpY;

   EyeNoseRadius := HeadRadius div 10;

   Circle (leftEyeX, EyeY, EyeNoseRadius);

   Circle (RightEyeX, EyeY, EyeNoseRadius);

   NoseX := MidX;

   NoseY :=MidY + stepY;

   Circle (NoseX, NoseY, EyeNoseRadius);

   SmileRadius := Round(0.75 * HeadRadius);

   Arc (MidX, MidY, 210,330, SmileRadius)

End.


==============================================
سبك و روش برنامه

نوشتن برنامه هاي گرافيكي عمومي

برنامه صورت خندان( برنامه بالا)عمومي است، و روي هر صفحه گرافيكي تصويري مشابه ايجاد مي كند، در حاليكه اندازه موقعيت خانه اي كه توسط برنامه «ساخت خانه» كشيده مي شود، وابسته به سيستم است. همانطور كه ملاحظه مي كنيد، نوشتن برنامه هاي وابسته به سيستم آسان تر است. اما با كمي تمرين مي توانيد برنامه هاي گرافيكي عمومي بنويسيد. براي عموميت بخشدن به برنامه «ساخت خانه» بصورت زير مي توانيد مقادير مختصات گوشه هاي شكل خانه را پايه اي كنيد.
کد:
X1 := GetMaxX div 4 ;  Y1 := GetMaxY div 2;

X2 := GetMaxX div 2 ;  Y2 := Get MaxY div 4;
رسم اشكال توپور

تاكنون كليه اشكال گرافيكي ما بصورت خطي رسم مي شوند. براي رنگ آميزي قسمت هايي از صفحه نمايش با رنگ هاي مختلف بايد از رويه SetFillStyle استفاده كنيد تا نوع رنگ و نحوه رنگ آميزي مشخص شود. دستور
کد:
SetFillStyle (SlashFill, Red)
الگوي رنگ آميزي را رنگ قرمز و بصورت هاشور تعيين مي كند و تا وقتي كه بار ديگر رويه SetFillStyle را فراخواني نكنيد اين حالت فعال خواهد بود. در جدول زير حالات ممكن براي اولين پارامتر رويه SetFillStyle را ملاحظه مي كنيد. براي اين رويه هم از نام ثابت و هم از معادل عددي مي توانيد استفاده كنيد. براي رنگ مي توانيد يكي از گزينه هاي جدول رنگ ها كه در قسمت رنگ زمينه و متن مورد بررسي قرار گرفت استفاده كنيد را در قسمت پارامتر دوم بكار بريد.

براي رنگ آميزي بخشي از يك شكل از رويه FloodFill استفاده كنيد. دستور FloodFill(X, Y, white) ناحيه اي از صفحه نمايش كه نقطه ي (X, Y) در آن قرار دارد و با خطوط سفيد محصور شده است را با الگوي رنگ آميزي جاري، رنگ مي كند. خطوط دور شكل نيز رنگ آميزي مي شوند، هنگام استفاده از اين رويه مراقب باشيد، زيرا ممكن است نتايج غير منتظره اي بدست آوريد.


a3.gif

مثال

براي رنگ آميزي برنامه ساخت خانه مي توانيم برنامه زير را در انتهاي برنامه ي ساخت خانه جاي دهيم. سقف با رنگ خاكستري و الگوي هاشوري رنگ آميزي مي شود. خود خانه به رنگ سفيد و بصورت راه راه رنگ مي شود، و درب خانه با رنگ آبي و بصورت توپر رنگ مي شود.
کد:
SetFillStyle (HatchFill, LightGray);

FloodFill (X2, Y2+10, White);

SetFillStyle (LineFill, White);

FloodFill (X2, Y2+10, White);

SetFillStyle (SolidFill, Blue);

FloodFill (X2, Y2+10, White);
در هر بار فراخواني FloodFill، ازX2 كه نقطه مياني محور X هاست بعنوان اولين پارامتر استفاده مي كنيم. دومين پارامتر( كه در جهت محود Y هاست) مشخص مي كند كه كدام بخش از خانه بايد رنگ شود.( سقف بدنه يا در خانه) كليه ي خطوط حاشيه اي خانه به رنگ سفيد هستند( رنگ متن پيش فرض)، بنابراين سومين پارامتر اين رويه White است.

ميله ها و برش هايي از دايره

در توربو پاسكال رويه هايي وجود دارد كه ميله و برشي از دايره را رسم مي كنند. يك ميله در واقع يك مستطيل توپور است، و يك برش دايره، قطعه ي رنگ شده اي از دايره است. دستور
کد:
SetFillStyle (XHAtchFill, White);

Bar (X1, Y1, X2, Y2)
مستطيلي رنگي مي كشد كه قطر آن را نقطه ي (X1, Y1) شروع و به (X2, Y2) ختم مي شود. براي قرار دادن يك برش دايره اي روي چشم راست چهره خندان از برنامه شكل خندان دستورات
کد:
SetFillStyle (XHatchFill, White);

PieSlice (MidX, MidY, 10, 60, SmileRadius)
را به انتهاي برنامه ي چهره خندان اضافه كنيد. اين برش دايره اي داراي شعاع SmileRadius بوده و به مركز (MidX, MidY)رسم مي شود. برش دايره از 10 درجه شروع شده و به 60 درجه ختم مي شود. با استفاده از رويه ها Bar و PieSlice مي توانيد، نمودارهاي دايره اي و ميله اي رسم كنيد. بزودي نحوه ي چاپ پيغام را زير چهره خندان شرح خواهيم داد.

اضافه كردن نوشتار به ترسيمات

در حالت گرافيكي صفحه نمايش نمي توانيد براي نمايش كاراكترها يا متن ها از دستور Write يا WriteLn استفاده كنيد، در عوض بايد همانند ساير اشكال كاراكترها را نيز رسم كنيد. خوشبختانه در توربو پاسكال رويه اي وجود داردكه اين كار را انجام مي دهد. دستور
کد:
OutTextXY (MidX – HeadRadius, GetMaXY – 20, 'Text')
كليه كاراكترهاي موجود در رشته (سومين پارامتر) را در موقعيت مختصاتي كه مشخص شده اند، چاپ مي كند. رشته در موقعيت MidX – HeadRadius و20 چاپ مي شود.


a4.gif

نوشته شده توسط جمشيدي
 

saalek110

Well-Known Member
منبع:
http://www.partovedarya.blogfa.com/cat-39.aspx

گرافیک

سلام به دوستاین خوبم :

بعضی از دوستان پاسکال بلدن ولی در رابطه با توابع گرافیکی !!!؟؟؟

خوب من یه سری از اونا رو براتون میذارم.............موفق باشید.

ابتدا باید بدانید که برای رفتن به حالت گرافیک باید از دستورات زیر استفاده کرد .
کد:
Uses graph;

var

grdriver,grmode,errcode:integer;

begin

grdriver:=detect; 

{این دستور میگه بهترین مد گرافیکی درایو را انتخاب کن}

initgraph(grdriver,grmode,'c:\tp\bgi');

{ آدرس جایی که توربوپاسکال نصب است را می نویسیم.}

errcode:=graphresult;

if errcode<>grok then

halt;

.

.

.
..............................................................................................................

روالها:

..............................................................................................................
کد:
           cleardevice;
صفحه نمایش گرافیکی را پاک کرده و مکان نمای گرافیکی را در مختصات (0,0) قرار میدهد. البته اگر قبلش دستور setbkcolor را بدهید با آن رنگ زمینه را تغییر می دهد.

..............................................................................................................
کد:
Setbkcolor(color:word);
داخل پرانتز از 0 تا 15 عدد بذاری پس زمینه تغییر میکنه.

..............................................................................................................
کد:
Closegraph;
برای آزاد نمودن حافظه از اطلاعات گرافیکی استفاده می شود.

..............................................................................................................
کد:
) ;شعاع,زاویه پایانی,زاویه شروعArc(x:integer,y:integer,
کمانی را از زاویه شروع تا زاویه پایانی رسم می کنه.

..............................................................................................................
کد:
Circle(x:integer,y:integer, شعاع) ;
دایره ای به شعاع خواسته شده رسم می کند.

..............................................................................................................
کد:
Line(x,y,x1,y1);
رسم می کند. (x1,y1) به (x,y) خطی از

..............................................................................................................
کد:
Putpixel(x,y,شماره رنگ از 0 تا 15 );
یه نقطه رنگی به رنگ مورد نظر می کشه.

..............................................................................................................
کد:
Rectangle(x1,y1,x2,y2:integer);
رسم می کند. (x1,y1) به (x,y) یک مستطیل از

..............................................................................................................
کد:
Setcolor(شماره رنگ از 0 تا 15 );
رنگ جاری رسم اشکال را تغییر می دهد.

..............................................................................................................
کد:
Bar(x1,y1,x2,y2);
تعریف شده است .etfillstyleیک مستطیل توپر میکشه که بوسیله دستور

..............................................................................................................
کد:
Bar3d(x1,y1,x2,y2,depth,topon);
با این تفاوت که عمق هم داره و برای نمودار کاربرد دارد. bar مثل

..............................................................................................................
کد:
Setfillstyle  الگو), رنگ ) ;
برای پر کردن ناحیه هایی از صفحه نمایش گرافیکی را تعیین می نماید.

..............................................................................................................
کد:
Setlinestyle(linestyle,الگو ,ضخامت);
الگو وضخامت خطوط ترسیمی در حالت گرافیکی را تعیین می کند.

..............................................................................................................
کد:
Outtext(‘ یک نوشته ‘);
در وضعیت جاری نوشته چاپ می شود.

..............................................................................................................
کد:
Outtextxy(x,y,’ یک نوشته ‘);
نوشته چاپ می شود. (x,y) درنقطه

..............................................................................................................
کد:
Settextstyle(فونت,جهت نوشتن متن,اندازه کارکترها);
مشخصات مربوط به نمایش کارکترها را در حالت گرافیکی را تعیین می کند.

.............................................................................................................
کد:
Lineto(x,y);
رسم می کند.(x1,y1) خطی از مکانی که در آن است به
 

nimja

Member
خیلی ممنون از شما

واقعا خیلی راهنماییم کردید. الان حرکت توپ رو هم درست کردم
کد:
کد:
rogram pnigpong ;
uses crt,graph;
const directory ='c:\tp\bgi';
cup = chr(72);
cdown = chr(80);
cesc = chr(27);
var driver,x,y,xc,yc,limy,limx, mode : integer;
chkey : char;
begin
x:=50;
y:=100;
xc:=300;
yc:=150;
limy:=1;
limx:=1;
initgraph ( driver , mode ,directory);
setfillstyle (1,1);
bar (100,50,500,250);{miz}
setfillstyle (1,4);
bar (501,x,520,y);{raket rast}
BAR (80,x,99,y); {raket chap}
{rasme toop}
setcolor(15);
circle (300,150,5);
setfillstyle(1,15 );
floodfill(300,150,15);
[B]{bakhshe harekat}
repeat
begin
{harekat toop}
if yc>=245 THEN
limy:=limy*(-1);
if yc<=55 then
limy:=limy*(-1);
if xc>=495 then
limx:=limx*(-1);
if xc<=105 then
limx:=limx*(-1);
xc:=xc+limx;
yc:=yc+limy;
setfillstyle (1,1);
bar (100,50,500,250);{miz}
setcolor(15);
circle (xc,yc,5);
setfillstyle(1,15 );
floodfill(xc,yc,15);
chkey :=readkey;
{key}
if chkey=cdown then
begin
SETFILLSTYLE (0,0);
BAR (80,50,99,250) ;
BAR (501,50,520,250) ;
x:=x+2;
y:=y+2;
SETFILLSTYLE (1,4 );
BAR (80,x,99,y);{raket chap}
bar (501,x,520,y)
end;
if chkey=cup then
begin
SETFILLSTYLE (0,0);
BAR (80,50,99,250) ;
BAR (501,50,520,250) ;
x:=x-2;
y:=y-2;
SETFILLSTYLE (1,4);
BAR (80,x,99,y);{raket chap}
bar (501,x,520,y)
end;
end;
until chkey=cesc[/B];
readln;
closegraph
end.

این حرکت به خوبی کار مینه. فقط یه مشکل کوچیک داره.هر وقت دکمه up یا down رو بزنی و فشار بدی توپ حرکت میکنه. یعنی با بالا کردن و پایین کردن راکت ها توپ حرکت میکنه.و وقتی هیچ دکمه ای رو نزنی توپ ثابت میمونه.
نمیشه کاری کرد توپ به حرکتش ادامه بده؟؟؟
 

saalek110

Well-Known Member
با سلام.
من آن حلقه را برای آشنایی دادم و گفتم برید داخل اون دو تاپیک چند نوع حلقه بحث شده.
حلقه زیر را تست بزنید:
کد:
program test1 ;
uses crt,graph;
var
Keypress : char ;
begin

  WHILE Keypress<>'q' DO
      begin
       if keypressed then
            begin
            Keypress := readkey;
              if Keypress='a' then
                  begin
                    Writeln('raket pak shavad');
                    Writeln('az mokhtasate raket kam shavad');
                    Writeln('raket dar jaye jadid rasm shavad');
                 end;
	    end;
	      Writeln(Keypress);
              {circle move here}
      end;
end.

در آنجایی که نوشتم circle move here محل تغییر مکان دایره(توپ) است. یعنی جایی است که حلقه با سرعت در حال چرخش است. داخل این حلقه پر سرعت if keypressed را داریم. نوعی اندرونی حساب میشه که وقتی اجرا میشه که کاربر دکمه ای را بزنید و الا گویی وجود ندارد و جلوی چرخش حلقه پر سرعت را نمی گیره.
 

جدیدترین ارسال ها

بالا