برنامه های نوشته شده به زبان پاسکال

[sunyboy]

بازی بسیار جالب و فکری کارت که به زبان پاسکال نوشته ام


لینک دریافت: http://w17.easy-share.com/1701659400.html

پسورد : www.forum.daneshjuha.org (http://www.forum.daneshjuha.org)

[M.E]

salam mishe barname bazi dozo ham bezarin

[sunyboy]

salam mishe barname bazi dozo ham bezarin



برنامه بازی دوز به زبان پاسکال







program dooz;
type
home=array[1..3,1..3] of real ;
var
i,count6,j,i1,j1,i2,num,numgh,j2,l,k,m,count,count 1,error,error1:integer;
counter,a,b:integer;
sum,sum1:real;
pos:string;
cell:home;
begin
for l:=1 to 30 do
writeln;
for l:=1 to 35 do
write(' ');
writeln('-----------');
for l:=1 to 34 do
write('-');
write('| DooZ Game |');
for l:=1 to 33 do
write('-');
for l:=1 to 35 do
write(' ');
writeln('-----------');
writeln;
writeln;
count:=0;
error:=1;
for i:=1 to 3 do
for j:=1 to 3 do
cell [i,j]:=0.1;
for i:=1 to 3 do
begin
write (' ');
for l:=1 to 3 do
write('|',' ','| ');
for j:=1 to 5 do
writeln;


end;
repeat
counter:=0;
count6:=0;
numgh:=0;
pos:='';
repeat
repeat
writeln('Please Enter Number of row and column:');
readln(a,b);
if (a>3) or (a<1) or (b>3) or (b<1) then
begin
error:=0;
writeln('The number that you entered is invalid !!!');
end
else
error:=1;
until error=1;
count1:=0;
pos:='else';
if (cell[a,b]=0) or (cell[a,b]=1) then
begin
writeln('The cell that you choose, had became full');
error1:=0;
end
else
error1:=1;
until error1=1;
count:=count+1;
cell[a,b]:=1;
if cell[2,2]=0.1 then
begin
cell[2,2]:=0;
count1:=1;
end;
num:=0;
{------------------------------------Ghotr---------------------------------}
{-----------Ghot1----------}
sum:=0;
for j:=1 to 3 do
sum:=sum+cell[j,j];
if (sum>2) and (sum<3) then
begin
numgh:=1;
pos:='ghotr1';
end
else if sum=3 then
begin
num:=5;
end
else if sum=0 then
begin
num:=10;
end;
{------------Ghotr2--------------}
sum1:=0;
sum1:=cell[1,3]+cell[2,2]+cell[3,1];
if (sum1>2) and (sum1<3) then
begin
numgh:=2;
pos:='ghotr2';
end
else if sum1=3 then
begin
num:=5;
end
else if sum1=0 then
begin
num:=10;
end;
writeln;


{------------------------------------Soton-----------------------------------}
repeat
sum:=0;
count6:=count6+1;
for j:=1 to 3 do
sum:=sum+cell[j,count6];
if (sum>2) and (sum<3) then
begin
num:=count6;
pos:='soton';
end
else if sum=3 then
begin
count6:=3;
num:=5;
end
else if sum=0 then
begin
num:=10;
count6:=3;
end;
writeln;
until count6=3;
{-------------------------------Satr-----------------------------------------}
repeat
sum:=0;
counter:=counter+1;
for j:=1 to 3 do
sum:=sum+cell[counter,j];
if (sum>2) and (sum<3) then
begin
num:=counter;
pos:='satr';
end
else if sum=3 then
begin
counter:=3;
num:=5;
end
else if sum=0 then
begin
num:=10;
counter:=3;
end;
writeln;
until counter=3;
{---------------------Checking-----------------------------------------------}


If num=10 then
begin
writeln('------Sory You Lose-------');
count:=5;
end
else if num=5 then
begin
write(' ');
for l:=1 to 70 do
write('_');
writeln;
for l:=1 to 3 do
begin
write(' |');
for k:=1 to 69 do
write(' ');
writeln('|');
end;
write(' |',' We greet to you for this victory');
for l:=1 to 20 do
write(' ');
writeln('|');
write(' |');
for k:=1 to 69 do
write(' ');
writeln('|');
write(' |',' You Won');
for l:=1 to 33 do
write(' ');
writeln('|');
count:=5;
for l:=1 to 3 do
begin
write(' |');
for k:=1 to 69 do
write(' ');
writeln('|');
end;
write(' ');
for l:=1 to 70 do
write('-');
writeln;
end


else if (num=1) or (num=2) or (num=3) then
begin


if pos='satr' then
begin
for j2:=1 to 3 do
if cell[num,j2]=0.1 then
if count1=0 then
begin
cell[num,j2]:=0;
count1:=1;
end;
end
else if pos='soton' then
begin
for j2:=1 to 3 do
if cell[j2,num]=0.1 then
if count1=0 then
begin
cell[j2,num]:=0;
count1:=1;
end;
end;
end;
if pos='ghotr1' then
begin
for j2:=1 to 3 do
if cell[j2,j2]=0.1 then
if count1=0 then
begin
cell[j2,j2]:=0;
count1:=1;
end;
end
else if pos='ghotr2' then
begin
if count1=0 then
if cell[1,3]=0.1 then
begin
cell[1,3]:=0;
count1:=1;
end
else if cell[2,2]=0.1 then
begin
cell[2,2]:=0;
count1:=1;
end
else if cell[3,1]=0.1 then
begin
cell[3,1]:=0;
count1:=1;
end;
end
else if pos='else' then
begin
for i:=1 to 3 do
for j:=1 to 3 do
if count1=0 then
if cell[i,j]=0.1 then
begin
cell[i,j]:=0;
count1:=1;
end;
end;
writeln;
writeln;
write('--< Game Ground >');
for l:=1 to 63 do
write('-');
writeln;
for l:=1 to 5 do
writeln;
For l:=1 to 3 do
begin
write(' ');
for k:=1 to 3 do
if cell[l,k]=0.1 then
write('|',' ','| ')
else
write ('|',cell[l,k]:1:0,'| ');
for m:=1 to 8 do
writeln;
end;
until count=5;
if (num<>5) and (num<>10) then
begin
writeln(' ------------------------< Nobody don`t won >---------------------------');
writeln(' ------------------------< Try again later >---------------------------');
end;
writeln(' /\');
writeln(' / \ ');
writeln(' / || \ Press Enter For Exit');
writeln('--------');
readln;


end.

[Amin4All]

سلام.
نیاز مبرم به 4 تا(یا بیشتر ) مسئله ساده یا حرفه ای مالی به زبان پاسکال دارم .

مثل یه همچین چیزی :


برنامه ای بنویسید که حقوق یک کارمند را دریافت کرده و اگر کمتر از 4500000 ریال باشد بدون کسر مالیات ان را پرداخت کند.در غیر این صورت تا کمتر از 6000000 ریال 7 % مالیات کمتر از 7500000 , 10% مالیات , کمتر از 9000000 , 15 % و بیشتر از 9000000 , 20% مالیات کسر نماید (این برنامه حقوق خالص را مشخص میکند )


برنامه به زبان پاسکال :


Program
var a count
begin
read a)
if a<4500000 then
write :=(a)
end
else
if (a>4500000)and (a<6000000) then
begin
b=(a-4500000)*7/100
a=a-b
write (a)
end
if (a>6000000)and (a<7500000)then
begin
.
.
.

[sunyboy]

سلام.
نیاز مبرم به 4 تا(یا بیشتر ) مسئله ساده یا حرفه ای مالی به زبان پاسکال دارم .

مثل یه همچین چیزی :

اسم برنامه ها و بگین شاید تونستیم کمکی کنیم:36:

[Amin4All]

اسم برنامه ها و بگین شاید تونستیم کمکی کنیم:36:



هر برنامه ای باشه فقط با پاسکال نوشته شده باشه و مثل همون مثال مربوط به حقوق و دستمزد ومالی باشه .(الته مال خودم نیست )

[Hidden 71]

سلام خسته نباشید
میشه برنامه ای بنویسید که عددی دریافت وبه مبنای 16 ببره..