برنامه نویسی با سحر

پیوند جدید سخت افزار با سحر

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

۱- نمرات ۵۰ دانشجو را بگیرد سپس با کمک زیربرنامه آنهارا به صورت صعودی مرتب کند ؟

برنامه:


PROGRAM SOODI_MORATTAB;
uses crt,dos;
const tedad=50;
var i:integer;
arr:array [1..tedad] of real;
{ *** SELECTIONSORT *** }
procedure selectionsort;
var i,j:integer;
temp:real;
begin
for i:=1 to tedad-1 do
for j:=i+1 to tedad do
begin
if arr[i]>arr[j] then
begin
temp:=arr[i];
arr[i]:=arr[j];
arr[j]:=temp;
end; { for if }
end; { for for j:=i+1 }
end; { for procedure }
{ --- MAIN BODY --- }
begin
clrscr;
textcolor(10);
writeln(' PLEASE ENTER ',tedad,' NUMBERS : ');
for i:=1 to tedad do
begin
write(' IN[',i,']=');
readln(arr[i]);
end; { for for i }
selectionsort;
writeln;
textcolor(11);
writeln(' SORTED RESULT : ');
writeln;
for i:=1 to tedad do
begin
writeln(' OUT[',i,']=',arr[i]:4:2);
delay(40000);
end;
readkey;
end.
 


۲.

این برنامه دفترچه تلفن :

برنامه:


PROGRAM TELEPHONE;
uses crt;
var a:array[1..50,1..4] of string;
i,j,k,m,n,o,p:integer;
s:string;
c:char;
{****} procedure f(s1:string); {***********************}
begin
n:=1;
repeat
if s1[n]<>' ' then
begin
sound(1500);
delay(40000);
nosound;
end;
write(s1[n]);
n:=n+1;
delay(2000);
until s1[n]='.';
s1:=' ';
end;
{****} procedure g(x,y:integer;s1:string); {*******************}
begin
gotoxy(x,y);
if s1[1]=' ' then f(s1)
else write(s1);
end;
{****} function menu:byte; {*********************}
begin
m:=1;
j:=5;
repeat;
clrscr;
if (j=72) or (j=1) then m:=m*-1;
g(j,4,'1.ADD');
g(j,5,'2.DELETE');
g(j,6,'3.EDIT');
g(j,7,'4.SEARCH');
g(j,8,'5.REPORT');
g(j,9,'6.RESTART');
g(j,10,'7.EXIT');
if m=-1 then j:=j-1
else j:=j+1;
g(10,15,'PLEASE ENTER SELECT(1-7):');
delay(40000);
until keypressed;
s:=readkey;
if not((s='1')or(s='2')or(s='3')or(s='4')or(s='5')or(s='6')or(s='7'))then
begin
sound(1500);
g(35,15,'INCORECT NUMBER');
delay(50000);
nosound;
end
else
begin
val(s,k,m);
menu:=k;
end;
end;
{****} procedure list; {**************}
begin
clrscr;
for j:=1 to i-1 do
for k:=1 to length (a[j,2]) do
a[j,2,k]:=upcase(a[j,2,k]);
for j:=1 to i-2 do
for k:=j+1 to i-1 do
if(a[j,2]>a[k,2]) then
for m:=1 to 4 do
begin
s:=a[j,m];
a[j,m]:=a[k,m];
a[k,m]:=s;
end;
gotoxy(1,3);
for k:=1 to 80 do write('Í');
g(10,3,'NAME');
g(30,3,'FAMILY');
g(50,3,'TELEPHONE');
for k:=1 to i-1 do
begin
textcolor(red);
gotoxy(6,3+k);
write(k,'_');
textcolor(yellow);
if a[k,4]='1' then textcolor(white);
g(10,3+k,a[k,1]);
g(30,3+k,a[k,2]);
g(50,3+k,a[k,3]);
if a[k,4]='1' then
begin
textcolor(yellow);
a[k,4]:='';
end;
end;
end;
{****} procedure report; {*******************}
begin
g(30,2,'REPORT LIST');
list;
readln;
end;
{****} procedure add; {**********************}
begin
clrscr;
g(14,8,' ENTER PROPERTIES.');
g(18,10,'NAME:');
readln(a[i,1]);
g(18,12,'FAMILY:');
readln(a[i,2]);
g(18,14,'TELEPHONE:');
readln(a[i,3]);
i:=i+1;
end;
{****} procedure delete; {********************}
begin
clrscr;
list;
g(1,1,' INTER PERSONS NUMBER (RED COLOR) IN LIST TO DELETE(1_.');
write(i-1,'):');
readln(k);
g(1,1,' ARE YOU SURE YOU WANT TO DELETE ".');
write(a[k,1],' ',a[k,2],'"?','(Y/N): ');
if readkey='y' then
begin
for j:=k to i do
for m:=1 to 3 do
a[j,m]:=a[j+1,m];
i:=i-1;
end;
report;
end;
{****} procedure edit; {******************}
begin
clrscr;
list;
g(1,1,' ENTER PERSONS NUMBER (RED COLOR) IN THE LIST TO EDIT(1_.');
write(i-1,'):' );
readln(k);
clrscr;
g(15,10,'1.EDIT NAME');
g(15,12,'2.EDIT FAMILY');
g(15,14,'3.EDIT PHONE NUMBER');
g(14,16,' PLEASE ENTER SELECT(1_3):.');
readln(j);
g(14,20,' EDIT .');
write('"',a[k,j],'":');
readln(s);
a[k,j]:=s;
a[k,4]:='1';
report;
end;
{****} procedure search; {*******************}
begin
clrscr;
g(15,10,'1.SEARCH NAME');
g(15,12,'2.SEARCH FAMILY');
g(15,14,'3.SEARCH PHONE NUMBER');
g(14,17,' PLEASE ENTER SELECT(1_3):.');
readln(o);
list;
a[i,4]:='';
repeat
g(1,1,'SEARCH ABOUT:');
textcolor(red);
g(10,2,'PRESS SPACE FOR SEARCH AGAIN & AND DOT(.) FOR EXIT');
textcolor(yellow);
g(14,1,a[i,4]);
c:=readkey;
if c=' ' then a[i,4]:='';
if o=2 then c:=upcase(c);
if c<>' ' then
begin
a[i,4]:=a[i,4]+c;
for j:=1 to i-1 do
begin
s:='';
s:=copy(a[j,o],1,length(a[i,4]));
if s=a[i,4] then a[j,4]:='1';
end;
end;
list;
until c='.';
end;
{****} procedure restart; {*************}
begin
i:=1;
clrscr;
g(31,10,' LIST CLEAR.');
for k:=1 to 3 do delay(50000);
end;
{********* MAIN BODY **********}
begin
clrscr; {titraje}
textbackground(2);
for k:=1 to 1000 do writeln(' ');
textcolor(black);
g(29,3,' IN THE NAME OF GOD.');
g(26,5,' PROJEYE DAFTAR TELEPHONE.');
g(27,7,'OSTAD:MR FARHAD HAMIDI');
g(24,9,' OSTADE RAHNAMA:MR FARHAD HAMIDI.');
gotoxy(1,3);
for k:=1 to 2 do delay(60000);
clrscr;
textbackground(lightblue);
for k:=1 to 1000 do writeln(' ');
textcolor(yellow);
g(16,10,' BARNAME NEVISAN: BEHNAM BAGHERI.');
for j:=1 to 3 do delay(60000);{end of titraj}
i:=1;
repeat
k:=menu;
case k of
1:add;
2:delete;
3:edit;
4:search;
5:report;
6:restart;
end;
until k=7;
end.
{**********} END {***************}

 

پایان قسمت اول

+ نوشته شده در  شنبه شانزدهم تیر 1386ساعت 18:42  توسط سحر دیناروند  |