Autor Wiadomość
roy
PostWysłany: Sob 16:14, 29 Mar 2008    Temat postu:

Zadanie 3 ver 2
Kod:
program trzy_new;
{$APPTYPE CONSOLE}


uses
  SysUtils;


type
  prekord = ^Trekord;
  Trekord = record
    dane: integer;
    dane2:real;
    nast: prekord;
  end;

procedure DodajPoLista(var pocz, ostatni, DoListy: prekord);
var
  NewOne: prekord;
begin
  New(NewOne);
  NewOne^.dane :=random(100);
  NewOne^.dane2 :=random*random(11);
  if pocz = nil then
  begin
    NewOne^.nast := nil;
    pocz := NewOne;
    ostatni := NewOne;
  end
  else
  begin
    NewOne^.nast := DoListy^.nast;
    DoListy^.nast := NewOne;
  end;
  DoListy := NewOne;
end;


procedure losuj(var pocz, ostatni: prekord;var n:integer);
var
  i: integer;

begin
  randomize;
  writeln('Ile elementow wylosowac? ');
  readln(n);
  for i := 1 to n do
    DodajPoLista(pocz, ostatni, ostatni);
end;




procedure drukuj(pocz:prekord);
 begin
  if pocz<>nil then
   begin
    if pocz.nast<>nil then drukuj(pocz.nast);
    writeln(' >>> ',pocz.dane,' - ',pocz.dane2:0:2,' <<<');
   end;
 end;



procedure PrzestawElementNastepny(var pocz, ostatni, DoListy: prekord);
var
  pomoc, poprzedni: prekord;
begin
  if DoListy^.nast <> nil then
  begin
    if DoListy <> pocz then
    begin
      pomoc := DoListy^.nast;
      poprzedni := pocz;
      while poprzedni^.nast <> DoListy do
        poprzedni := poprzedni^.nast;
      DoListy^.nast := pomoc^.nast;
      poprzedni^.nast := pomoc;
      pomoc^.nast := DoListy;
    end
    else
    begin
      pomoc := DoListy^.nast;
      DoListy^.nast := pomoc^.nast;
      pomoc^.nast := DoListy;
      pocz := pomoc;
    end;
    if pomoc = ostatni then
      ostatni := DoListy;
    DoListy := pomoc;
  end;
end;



procedure Sortuj(var pocz, ostatni: prekord);
var
  DoListy: prekord;
  Przestawiono: boolean;
begin
  Przestawiono := True;
  while przestawiono do
  begin
    Przestawiono := False;
    DoListy := pocz;
    if DoListy <> nil then
      while DoListy <> ostatni do
      begin
        if DoListy^.dane > DoListy^.nast^.dane then
        begin
          PrzestawElementNastepny(pocz, ostatni, DoListy);
          Przestawiono := True;
        end;
        DoListy := DoListy^.nast;
      end;
  end;
end;
procedure sumuj(pocz:prekord;n:integer);
 var
  i,a:integer;
  b:real;
 begin
  a:=0;
  b:=0;
  for i:=1 to n do
   begin
    a:=a+pocz.dane;
    b:=b+pocz.dane2;
    pocz:=pocz.nast;
   end;
  writeln('>>> Suma liczb calkowitych: ',a,' <<<');
  writeln('>>> Suma liczb rzeczywistych: ',b:0:2,' <<<');
 end;

var
  pocz, ostatni: prekord;
  Znak: char;
  n:integer;

begin
 randomize;
   repeat
    writeln(chr(218),chr(196),' MENU:');
    writeln(chr(195),chr(196),' 1 - Losuj elementy listy.');
    writeln(chr(195),chr(196),' 2 - Sortuj liste.');
    writeln(chr(195),chr(196),' 3 - Wydrukuj liste. ');
    writeln(chr(195),chr(196),' 4 - Sumuj dane z listy');
    writeln(chr(192),chr(196),' Z - Zakoncz.');
    readln(znak);
    case znak of
      '1':losuj(pocz, ostatni,n);
      '2':Sortuj(pocz, ostatni);
      '3':Drukuj(pocz);
      '4':sumuj(pocz,n);
    end;
    writeln;
  until znak = 'z';

 dispose(pocz);
 writeln('<<< Pamiec wyczyszczono >>>');
 readln;
end.
roy
PostWysłany: Sob 16:13, 29 Mar 2008    Temat postu:

Kod:
program trzy;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
 prekord=^rekord;
 rekord=record
  treal:real;
  tint:integer;
  nast:prekord;
 end;
var
 n,b:integer;
 pocz:prekord;
 a:real;
procedure wpisz(var pocz:prekord; n:integer);
 var
  pomoc:prekord;
  i:integer;
 begin
  for i:=1 to n do
   begin
  if pocz<>nil then pomoc:=pocz else pomoc:=nil;
    new(pocz);
    pocz.treal:=random*100;
    pocz.tint:=random(11);
    pocz.nast:=pomoc;
   end;
 end;

procedure wypisz(pocz:prekord);
 begin
  if pocz<>nil then
   begin
    if pocz.nast<>nil then wypisz(pocz.nast);
    writeln(' - ',pocz.treal:0:2,' - ',pocz.tint);
   end;
 end;

procedure sumuj(pocz:prekord;n:integer; var a:real; var b:integer);
 var
  i:integer;
 begin
  for i:=1 to n do
   begin
    a:=a+pocz.treal;
    b:=b+pocz.tint;
    pocz:=pocz.nast;
   end;
 end;

{procedure sortuj(var pocz:prekord;n:integer);
 var
  i,j:integer;                                  //   #### #  #   ##    ###
  pomoc:prekord;                                //   #  # # #   #  #   #  #
 begin                                          //   ###  ##    ####   #  #
  for i:=1 to n do                              //   #  # #     #  #   #  #
   for j:=1 to n do                             //   ###  ####  #  ##  ###
   begin                                        //                  #
    new(pomoc);
     if pocz.tint>pocz.nast.tint then
      pomoc:=@pocz.nast.tint;
   end;
 end;          }

begin
 randomize;
 writeln('Podaj ilosc elementow');
 readln(n);
 wpisz(pocz,n);
 wypisz(pocz);
 sumuj(pocz,n,a,b);
 writeln('Suma liczb rzeczywistych: ',a:0:2);
 writeln('Suma liczb calkowitych: ',b);
 {sortuj(pocz,n); }
 wypisz(pocz);
 readln;

  { TODO -oUser -cConsole Main : Insert code here }
end.
Kod:
roy
PostWysłany: Sob 16:13, 29 Mar 2008    Temat postu:

Kod:
program jeden;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
 tdana=real;
 plista=^tlista;
 tlista=record
  klucz:tdana;
  nast:plista;
 end;

var
 pocz:plista;
 opcja:char;
 d:tdana;

procedure NaStos(var pocz:plista; d:tdana);
 var
  pomoc:plista;
 begin
  if pocz<>nil then pomoc:=pocz else pomoc:=nil;
  new(pocz);
  pocz.klucz:=d;
  pocz.nast:=pomoc;
 end;

procedure ZeStosu(var pocz:plista; d:tdana);
 var
  pomoc:plista;
 begin
  if pocz<>nil then
   begin
    pomoc:=pocz;
    pocz:=pomoc.nast;
    dispose(pomoc);
   end
  else writeln('>>> Nie ma co usuwac <<<');


 end;


procedure wypisz(pocz:plista);
 var
  i:integer;
 begin
  i:=1;
  repeat
   writeln('Element ',i,' - ',pocz.klucz:0:2);
   inc(i);
   pocz:=pocz.nast;
  until pocz=nil;
 end;

begin
 randomize;
 pocz:=nil;
 d:=0;
 repeat
  writeln('        Instrukcje na stosie');
  writeln('           -d-    dodaj       ');
  writeln('           -u-    usun       ');
  writeln('           -w-    wypisz       ');
  writeln('           -k-    koniec       ');
  readln(opcja);

  case opcja of
   'd':begin
        d:=random*random(101); //od 0 do 10 real
        NaStos(pocz,d);
       end;
   'w':if pocz<>nil then wypisz(pocz);
   'u':ZeStosu(pocz,d);
  end;
 until opcja='k';
 dispose(pocz);
 writeln('>>> Pamiec zwolniono <<<');
 readln;
  { TODO -oUser -cConsole Main : Insert code here }
end.
roy
PostWysłany: Sob 16:13, 29 Mar 2008    Temat postu: Lista 3

Kod:
program dwa;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
 tdana=real;
 plista=^tlista;
 tlista=record
  klucz:tdana;
  nast:plista;
 end;

var
 pocz,kon:plista;
 opcja:char;
 d:tdana;

procedure DoKolejki(var pocz:plista;var kon:plista; d:tdana);
 var
  pomoc:plista;
 begin
  new(pomoc);
  pomoc.klucz:=d;
  pomoc.nast:=nil;
  if pocz=nil then
   begin
    pocz:=pomoc;
    kon:=pocz.nast;
   end
   else kon.nast:=pomoc;
  kon:=pomoc;
 end;

procedure ZKolejki(var pocz:plista;var kon:plista; d:tdana);
 var
  pomoc:plista;
 begin
  if pocz<>nil then
   begin
    pomoc:=pocz;
    pocz:=pomoc.nast;
    dispose(pomoc);
   end
  else writeln('>>> Nie ma co usuwac <<<');


 end;


procedure wypisz(pocz:plista);
 var
  i:integer;
 begin
  i:=1;
  if pocz<>nil then
   repeat
    writeln('Element ',i,' - ',pocz.klucz:0:2);
    inc(i);
    pocz:=pocz.nast;
   until pocz=nil;
 end;

procedure wypisz2(pocz:plista);
 begin
  if pocz<>nil then
   begin
    if pocz.nast<>nil then wypisz2(pocz.nast);
    writeln(' - ',pocz.klucz:0:2);
   end;
 end;

begin
 randomize;
 pocz:=nil;
 kon:=pocz;
 d:=0;
 repeat
  writeln('        Instrukcje na stosie');
  writeln('           -d-    dodaj       ');
  writeln('           -u-    usun       ');
  writeln('           -w-    wypisz       ');
  writeln('           -x-    wypisz rek.  ');
  writeln('           -k-    koniec       ');
  readln(opcja);

  case opcja of
   'd':begin
        d:=random*random(101); //od 0 do 10 real
        DoKolejki(pocz,kon,d);
       end;
   'w':wypisz(pocz);
   'u':ZKolejki(pocz,kon,d);
   'x':wypisz2(pocz);
  end;
 until opcja='k';
 dispose(pocz);
 writeln('>>> Pamiec zwolniono <<<');
 readln;
  { TODO -oUser -cConsole Main : Insert code here }
end.

Powered by phpBB © 2001, 2005 phpBB Group