| Autor |
Wiadomość |
| roy |
 Wysł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 |
| Wysł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.
|
|
|
|
| roy |
| Wysł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 |
| Wysł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.
|
|
|
|