Programowanie obiektowe

[admin]

Zadanie 1. Nie jest to przykład związany bezpośrednio z programowaniem obiektowym, nie mniej pozwala na łagodne przejście pomiędzy programowanie strukturalnym i obiektowym.
Proszę napisać program który korzystając z funkcji, obliczy objętość : stożka, walca, prostopadłościanu.

program a1;
uses crt;
const pi=3.141;
var a,b,h,r:real; x:byte;
                         function prosto(a,b,h:real):real;
                         begin prosto:= a*b*h; end;
                         function stozek(r,h:real):real;
                         begin stozek:= 2/3*pi*h;end;
                         function walec(r,h:real):real;
                         begin walec:= pi*r*r*h;end;
procedure menu;
begin
     clrscr; write('Twoj wyb˘r: ');readln(x);
     if (x =3) or (x= 2) then begin write('podaj promien ');
     readln(r);write('podaj wysokosc:  ');
     readln(h)end else
     begin write('podaj szeroko˜c ');
     readln(a);write('podaj gˆeboko˜c ');
     readln(b);write('podaj wysokosc:  ');
     readln(h);end;
case x of
1:begin write(prosto(a,b,h));  end;
2:begin write(stozek(r,h)); end;
3:begin write(walec(r,h));  end else;
end;
end;



begin
menu;
readkey;
end.

[admin]

program a1;
uses crt;
const pi=3.141;
var a,b,h,r:real; x,y:byte;
                         function prosto(a,b,h:real):real;
                         begin prosto:= a*b*h; end;
                         function stozek(r,h:real):real;
                         begin stozek:= 2/3*pi*h;end;
                         function walec(r,h:real):real;
                         begin walec:= pi*r*r*h;end;
procedure menu;
begin
     clrscr;
     writeln('Program do obliczania objetosci bryl');
     writeln('Jezeli wybierzesz:');
     writeln('1-oblicza objetosc prostopadloscianu');
     writeln('2-oblicza objetosc stozka');
     writeln('3- oblicza objetosc walca');
      write('Twoj wyb˘r: ');readln(x);
     if (x =3) or (x= 2) then begin write('podaj promien ');
     readln(r);write('podaj wysokosc:  ');
     readln(h)end else
     begin write('podaj szeroko˜c ');
     readln(a);write('podaj gˆeboko˜c ');
     readln(b);write('podaj wysokosc:  ');
     readln(h);end;
case x of
1:begin write('Objetosc prostopadloscianu= ',prosto(a,b,h):0:2); end;
2:begin write('Objetosc stozka= ',stozek(r,h):0:2); end;
3:begin write('Objetosc walca= ',walec(r,h):0:2);  end else;
end;
end;



begin
menu;
readkey;
end.

[admin]

Wersja obiektowa.


program aaa;
uses
  Crt,
  InterfejsUzytkownika;

const
  KursorGora       = #72;     
  KursorDol        = #80;     
  LiniaAutowa      = 78;       
  Predkosc         = 100;       
  Punkty : integer = 0;       
  Runda : integer  = 1;       

type   { definicje klas }

  TObiekt = object             
    x, y : byte;               
    Kod : char;               
    constructor Inicjuj(WspX, WspY : byte);
    destructor Usun; virtual;       
    procedure Pokaz; virtual;     
    procedure Schowaj; virtual;     
    procedure Przesun(WspX, WspY : byte);   
  end;

TPilka = object(TObiekt) { dziedziczy po klasie TObiekt }
  dx : integer;         
  dy : integer;
  constructor Inicjuj(WspX, WspY : byte); 
  procedure Steruj;           
  procedure OdbijOdRakiety;
end;

TRakieta = object(TObiekt)
  constructor Inicjuj(WspX, WspY : byte);
  procedure Pokaz; virtual;
  procedure Schowaj; virtual;
  procedure Steruj;
  function Srodek : byte;
end;

var
  Pilka : TPilka;
  Rakieta : TRakieta;
  i : byte;
  Opoznienie : word;



procedure Punktacja;

begin
  GotoXY(1, 25);
  write('Runda:  ', Runda:3, ' Punkty: ', Punkty:3, '  Srednio:', Punkty/Runda:6:2);
  write('    Esc - koniec.');
end;

procedure KoniecRundy;

begin
  Punktacja;
  Pilka.Usun;
  Czekaj;
  if ch = Esc then Halt(0);
  Inc(Runda);
  Pilka.Inicjuj(1, Random(20)+2);
end;



constructor TObiekt.Inicjuj(WspX, WspY : byte);

begin
  x := WspX;
  y := WspY;
  Pokaz;
end;

destructor TObiekt.Usun;

begin
  Schowaj;
end;

procedure TObiekt.Pokaz;

begin
  PiszXY(x, y, Kod);
end;

procedure TObiekt.Schowaj;

begin
  PiszXY(x, y, ' ');
end;

procedure TObiekt.Przesun(WspX, WspY : byte);
begin
  Schowaj;
  x := WspX;
  y := WspY;
  Pokaz;
end;

constructor TPilka.Inicjuj(WspX, WspY : byte);
begin
  Kod:=#02;
  dx := 1;
  dy := 2*integer(Random(2)) - 1;
  TObiekt.Inicjuj(WspX, WspY);
end;

procedure TPilka.Steruj;

var
  xx, yy : shortint;
begin
  if x = pred(LiniaAutowa) then
    OdbijOdRakiety;
  yy := y+dy;
  if (yy < 1) or (yy > 24) then
    begin
      Buczek(2000, 0.05);
      dy := -dy
    end;
  if x*dx = -1 then
    begin
      Buczek(1000, 0.05);
      dx := -dx
    end;
  xx := x+dx;
  yy := y+dy;
  Przesun(xx, yy);
end;

procedure TPilka.OdbijOdRakiety;

var
  roznica : integer;
begin
  Buczek(500, 0.05);
  roznica := y - Rakieta.Srodek;
  if abs(roznica) < 2 then
    begin
      Inc(Punkty);
      dx := -dx;
      if abs(roznica) = 0 then
        dy := integer(2*Random(2)-1)
      else
        dy := roznica*2*dy
    end
  else
    KoniecRundy;
  Punktacja;
end;

constructor TRakieta.Inicjuj(WspX, WspY:byte);

begin
  Kod := #219;
  TObiekt.Inicjuj(WspX, WspY);
end;

procedure TRakieta.Pokaz;

var
  i : byte;
begin
  for i := 0 to 2 do
    PiszXY(x, y+i, Kod);
end;

procedure TRakieta.Schowaj;

var
  StaryKod : char;
begin
  StaryKod := Kod;
  Kod := ' ';
  Pokaz;
  Kod := StaryKod;
end;

procedure TRakieta.Steruj;
var
  yy : byte;
begin
  Delay(Opoznienie);
  if KeyPressed then
  begin
    yy := y;
    Czekaj;
      case ch of
        KursorGora : if y > 1 then Dec(yy);
        KursorDol  : if y < 22 then Inc(yy);
      end;
    Przesun(x, yy);
  end;
end;

function TRakieta.Srodek:byte;

begin
  Srodek := succ(y);
end;

begin
  ClrScr;
  Opoznienie := 200 div Predkosc;
  Punktacja;
  Rakieta.Inicjuj(LiniaAutowa, 10);
  Pilka.Inicjuj(1, 10);
  repeat
    ch  := #0;
    repeat
      for i := 1 to 4 do
        Rakieta.Steruj;
      Pilka.Steruj;
    until ch = Esc;
  until ch = Esc;
end.