Darmowe Forum

program cynwaladnerw;
uses crt,dos;
var tab: array[1..2,1..2] of integer;
x,y,z:integer;
procedure p1;
begin
write('Podaj liczbe:');readln(z);
end;

procedure p2;
begin
 for x:=1 to 2 do begin
for y:=1 to 2 do begin tab[x,y]:=z;end;
end;
end;

 procedure p3;
 begin
  for x:=1 to 2 do begin  writeln;
for y:=1 to 2 do begin write(tab[x,y]:3);end;
end;
 end;
procedure final;
begin
p1;p2;p3;readkey;end;

begin
clrscr;
final;
end.

Zadanie1 . Program wpisujÂący do tablicy 10x10 kolejne liczby rozpoczynajÂąc od liczby 5.

program a1;
uses crt,dos;
var A: array[1..10,1..10] of integer;
x,y,z: byte;
begin z:=5;
 clrscr;
 for x:=1 to 10 do begin
 for y:=1 to 10 do begin a[x,y]:=z;inc(z);  end;
 end;
for x:=1 to 10 do begin   writeln;writeln;
 for y:=1 to 10 do begin write(a[x,y]:4);  end;
 end;
readkey;
end.


inc(z) oznacza tyle samo co z:=z+1;
dec(z) to jest z:=z-1;

Zadanie 2. W programie zadeklarowano trzy procedury;
P1- proszÂącÂą o wprowadzenie dwĂłch liczb;
P2 - wpisujÂąca pierwszÂą liczbĂŞ do wszystkich komĂłrek tablicy A[1..3,1..3] i druga liczbĂŞ do tablicy B[1..3,1..3]
P3- wyÂświetlajÂący dwie tablice A i B.

program zyzio;
uses crt,dos;
var x,y,z,s:integer;
A,B: array[1..3,1..3] of integer;
procedure p1;
begin clrscr;
write('Podaj pierwsza liczbe: ');readln(x);
write('Podaj druga liczbe: ');readln(y);
end;
procedure p2;
begin
 for s:=1 to 3 do begin
 for z:=1 to 3 do begin A[s,z]:=x;B[s,z]:=y; end;
 end;
end;
procedure p3;
begin
for s:=1 to 3 do begin writeln;
 for z:=1 to 3 do begin write(A[s,z]:4); end;
 end;
writeln;
for s:=1 to 3 do begin writeln;
 for z:=1 to 3 do begin write(B[s,z]:4); end;
 end; readkey;
end;

begin
p1;p2;p3;
end.

Zadanie 3. Program zawiera dwie procedury. Pierwsza o nazwie p1 prosi o podanie dwĂłch liczb. Liczby te okreÂślajÂą poÂłoÂżenie (wspó³rzĂŞdne) literki "A" na ekranie.  Istnieje moÂżliwoœÌ wprowadzania liczb z zakresu x:(1..70), y:(1..21). Druga procedura o nazwie p2 wyÂświetla literĂŞ A na ekranie o wspó³rzĂŞdnych [x,y]. Program dziaÂła do czasu kiedy zostanÂą wprowadzone wartoÂści x=0 i y=0.
UWAGA: jeÂżeli zostanÂą podane liczby nie znajdujÂące siĂŞ w podanym zakresie (dziedzinie), program czeka i na wprowadzenie wartoÂści poprawnych.

program zyzio;
uses crt,dos;
var x,y:integer;

procedure p1;
begin
repeat
write('Podaj pierwsza liczbe x: ');readln(x);
write('Podaj druga liczbe y: ');readln(y); clrscr;
until (x>=0) and (x<=70) and (y>=0) and (y<=21);
end;

procedure p2; {polozenie literki A}
begin clrscr;
 gotoxy(x,y); write('A');delay(100); gotoxy(1,1);
end;
procedure p3;
begin
repeat
 p1;p2;
 until (x=0) and (y=0);  readkey;
end;



begin
p3;
end.

program a2;
uses crt,dos;
var a:string;
s,j:integer;

begin clrscr;
write('Podaj imie ');readln(a);
s:=length(a);
repeat
for j:=1 to s do
begin
write(a[j]); sound(1000);delay(100); nosound;
end; write(' ');
  until keypressed;

readkey;
end.
----------------------------v.1.3 semi wypas----------------------------

----------------------------------------------------------
program a2;
uses crt,dos;
var a:string;
s,j:integer;
procedure adam;
begin
clrscr;
write('Podaj imie ');readln(a);
s:=length(a);
end;
procedure ewa;
begin
for j:=1 to s do
begin
write(a[j]); sound(1000);delay(100); nosound;
end; write(' ');
end;


begin adam;
repeat
   ewa;
until keypressed;

readkey;
end.

-----------------------------------------------------------------------------
program a2;
uses crt,dos;
var a: array [1..3] of string;
s:array[1..3] of integer;
j:integer;
procedure adam;
begin
clrscr;
for j:=1 to 3 do begin
write('Podaj imie ');readln(a[j]);
s[j]:=length(a[j]); end;
end;

procedure ewa(var k:integer);
var j:integer;
l:string;
begin
 l:=a[k];
for j:=1 to s[k] do
begin
write(l[j]);delay(100);
end; write(' ');

end;


begin adam;
repeat
  for j:=1 to 3 do
   ewa(j);
until keypressed;

readkey;
end.

program rysio;
uses crt,dos;
var x,y:integer;
statek: array[1..6,1..2] of char;
procedure wprowadz;
var x:integer;
begin
for x:=1 to 6 do statek[x,2]:=chr(178);
statek[3,1]:=chr(221);
end;
procedure wysw(var a,b:integer);
var x,y:integer;
begin
 for y:=1 to 2 do begin
 for x:=1 to 6 do begin
 gotoxy(a+x,b+y);write(statek[x,y]);end;
 end;
end;


begin clrscr; x:=30;y:=5;
wprowadz; wysw(x,y);readkey;
end.

--------------------------------------------------------------------------------
program rysio;
uses crt,dos;
var x,y:integer;
statek: array[1..6,1..2] of char;
procedure wprowadz;
var x:integer;
begin
for x:=1 to 6 do statek[x,2]:=chr(178);
statek[3,1]:=chr(221);
end;
procedure wysw(var a,b:integer);
var x,y:integer;
begin
 for y:=1 to 2 do begin
 for x:=1 to 6 do begin
 gotoxy(a+x,b+y);write(statek[x,y]);end;
 end;
end;
procedure ruch;
var x,b,y:integer;
begin x:=10;b:=1; y:=10;
repeat
x:=x+b;
if((x>60) or (x<2)) then b:=-b;
wysw(x,y);delay(100);clrscr;
until keypressed; end;

begin clrscr;
wprowadz; ruch;readkey;
end.
--------------------------------------------------------------
program rysio;
uses crt,dos;
var x,y:integer;
statek: array[1..6,1..2] of char;
procedure wprowadz;
var x:integer;
begin
for x:=1 to 6 do statek[x,2]:=chr(178);
statek[3,1]:=chr(221);
end;
procedure wysw(var a,b:integer);
var x,y:integer;
begin
 for y:=1 to 2 do begin
 for x:=1 to 6 do begin
 gotoxy(a+x,b+y);write(statek[x,y]);end;
 end;
end;
procedure ruch;
var x,x1,b1,b,y,y1:integer;
begin x:=10;b:=1; y:=10; x1:=10;b1:=2;y1:=15;
repeat
x:=x+b;x1:=x1+b1;
if((x1>60) or (x1<2)) then b1:=-b1;
if((x>60) or (x<2)) then b:=-b;
wysw(x,y);wysw(x1,y1); delay(200);clrscr;
until keypressed; end;

begin clrscr;
wprowadz; ruch;readkey;
end.