Autor Zpráva
kásper.ua
Profil *
dobry den mam zitra vodevzdat prikdlad z paskalu a vubec nevim jak na nej... data se maji ukaldat do textaku..jak ukladat tak i nacitat... nasel jem na netu dobrej priklad jenze ten to uklada to dat :(..

Tak jestli by byl nekdo ochotnej mi to upravit do textaku?!

Tady je zdojak na ten prikad co jsem nasel ale uklada to dat a cte to z dat a ja to potrebuju do textaku :((...

{Program pouziva typovy soubor "adresar.dat"}

program ADRESAR;
uses crt;
type osoba=record
jmeno :string[10];
vek :0..99;
plat :word;
pohl :boolean;
end;
var f :file of osoba;
pom :osoba;
ch :char;

procedure Ramecek(x1,y1,x2,y2:integer; Title:string);
var i:integer;
begin
GotoXY(x1,y1); Write('É');
GotoXY(x2,y1); Write('»');
GotoXY(x1,y2); Write('E');
GotoXY(x2,y2); Write('1');
for i:=x1+1 to x2-1 do
begin
GotoXY(i,y1); Write('Í');
GotoXY(i,y1+2); Write('Ä');
GotoXY(i,y2); Write('Í');
end;
for i:=y1+1 to y2-1 do
begin
GotoXY(x1,i); Write('o');
GotoXY(x2,i); Write('o');
end;
GotoXY(x1,y1+2); Write('Ç');
GotoXY(x2,y1+2); Write('¶');
GotoXY((x1+x2-Length(Title)) div 2,y1+1);
Write(Title);
end;

procedure Menu;
begin
ClrScr;
Ramecek(4,2,77,23,'A D R E S A R');
GotoXY(29,7); Write('Vlozeni ................. 1');
GotoXY(29,8); Write('Vlozeni podle abecedy ... 2');
GotoXY(29,10); Write('Smazani osoby ........... 3');
GotoXY(29,11); Write('Smazani vseho ........... 4');
GotoXY(29,13); Write('Vypis ................... 5');
GotoXY(29,15); Write('Vyhledat ................ 6');
GotoXY(29,17); Write('Konec ................... Esc');
GotoXY(29,19); Write('Pocet lidi v adresari: ',FileSize(f):4)
end;

procedure Vloz;
var ch :char;
begin
clrscr;
Ramecek(4,2,77,23,'Vlozeni zaznamu');
GotoXY(29,5);
Write('Zaznam cislo: ',FilePos(f)+1);
GotoXY(29,7);
Write('Jmeno: ');readln(pom.jmeno);GotoXY(29,8);
Write('Vek: ');readln(pom.vek);GotoXY(29,9);
Write('Plat: ');readln(pom.plat);GotoXY(29,10);
Write('Muz? (a/n) ');ch:=readkey;
if (ch='a') or (ch='A') then pom.pohl:=True
else pom.pohl:=False;
GotoXY(29,11);
seek(f,filesize(f));
write(f,pom);
end;

procedure Vloz2; {Setrideni podle abecedy}
var pole :array [1..10] of osoba;
pocet,i,j :integer;
pom2 :osoba;
begin
Vloz;
seek(f,0);
pocet:=filesize(f);
for i:=1 to pocet do {Vlozeni zaznamu ze souboru do pole}
begin
read(f,pom);
pole[i]:=pom;
end;
for i:=1 to pocet do {setrideni pole podle abecedy}
for j:=i to pocet do
if pole[i].jmeno>pole[j].jmeno then
begin
pom2:=pole[i]; {prohozeni promenych}
pole[i]:=pole[j];
pole[j]:=pom2;
end;
rewrite(f);
for i:=1 to pocet do {Vlozeni vsech zaznamu zpet z pole do souboru}
begin
pom:=pole[i];
write(f,pom);
end;
end;

procedure Vypis;
begin
seek(f,0);
while not (eof(f)) do
begin
clrscr;
Ramecek(4,2,77,23,'Vypis zaznamu');
read(f,pom);
gotoxy(29,7);
Write('Zaznam cislo: ',FilePos(f));
GotoXY(29,9);
write('Jmeno: ',pom.jmeno);GotoXY(29,10);
write('Vek: ',pom.vek);GotoXY(29,11);
write('Plat: ',pom.plat);GotoXY(29,12);
write('Muz?: ',pom.pohl);
readkey;
end;
end;

procedure Smaz;
var jm :string[10];
f2 :file of osoba;
begin
clrscr;
Ramecek(4,2,77,23,'Smazani zaznamu');
GotoXY(18,7);
write('Zadej jmeno, ktere chces smazat z adresare: ');
readln(jm);
assign(f2,'pomfile.dat'); {pomocny soubor s prom f2}
rewrite(f2);
seek(f,0);
while not (eof(f)) do
begin
read(f,pom);
if pom.jmeno<>jm then write(f2,pom)
else continue;
end;
close(f); close(f2);
erase(f);
rename(f2,'adresar.dat');
assign(f,'adresar.dat');
reset(f);
end;

{********************nasleduji 4 procedury na vyhledavani*******************}

procedure Pohl; {Hledani podle pohlavi}
var a :char;
begin
Ramecek(4,2,77,23,'Hledani v adresari');
GotoXY(18,9);
write('Hledat: 1.muze, 2.zeny: ');a:=readkey;
gotoxy(18,10);
write('Vyhovuji osoby: ');
seek(f,0);
while not eof(f) do
begin
read(f,pom);
if a='1' then if pom.pohl=True then write(pom.jmeno,', ');
if a='2' then if pom.pohl=False then write(pom.jmeno,', ');
end;
readkey;
end;

procedure Vek; {Hledani podle veku}
var a,b :integer;
begin
Ramecek(4,2,77,23,'Hledani v adresari');
GotoXY(18,9);
write('Zadej rozmezi: ');read(a,b);
gotoxy(18,10);
write('Vyhovuji osoby: ');
seek(f,0);
while not eof(f) do
begin
read(f,pom);
if (pom.vek>a) and (pom.vek<b) then write(pom.jmeno,', ');
end;
readkey;
end;

procedure Plat; {Hledani podle platu}
var a,b :integer;
begin
Ramecek(4,2,77,23,'Hledani v adresari');
GotoXY(18,9);
write('Zadej rozmezi: ');read(a,b);
gotoxy(18,10);
write('Vyhovuji osoby: ');
seek(f,0);
while not eof(f) do
begin
read(f,pom);
if (pom.plat>a) and (pom.plat<b) then write(pom.jmeno,', ');
end;
readkey;
end;

procedure Hledej;
var i :char;
begin
clrscr;
Ramecek(4,2,77,23,'Hledani v adresari');
GotoXY(15,7);
write('Podle ceho hledat: 1.pohlavi, 2.vek, 3.plat: ');
i:=readkey;
case i of
'1' :Pohl;
'2' :Vek;
'3' :Plat;
end;
end;
{***********************nahore 4 procedury na vyhledavani*******************}


BEGIN
Assign(f,'adresar.dat');
{$I-} Reset(f);{$I+}
if IOResult<>0 then Rewrite(f);
Menu;
ch:=readkey;
repeat
case ch of
'1' :Vloz;
'2' :Vloz2;
'3' :Smaz;
'4' :rewrite(f);
'5' :Vypis;
'6' :Hledej;
#27 :Exit;
end;
Menu;
ch:=readkey;
until ch=#27;
close(f);
END.
koudi
Profil
dobry den mam zitra vodevzdat prikdlad z paskalu a vubec nevim jak na nej
No, tak to jsi s tim měl začít dřív.

data se maji ukaldat do textaku..jak ukladat tak i nacitat... nasel jem na netu dobrej priklad jenze ten to uklada to dat :(..
To je takový problém si změnit koncovku?

Tak jestli by byl nekdo ochotnej mi to upravit do textaku?!
Ne, je to tvuj úkol.

Tady je zdojak na ten prikad co jsem nasel ale uklada to dat a cte to z dat a ja to potrebuju do textaku :((...
Vážně myslíš, že se někomu bude chtít celý to číst?
kásper.ua
Profil *
diky ::D
loyza
Profil
By mě zajímalo na co do tej školy (je to do školy?) chodíš. Úkoly dělat tak, že je stáhnu z netu a odevzdám. Když si s nimi nevím rady, tak se zeptám na diskusi a někdo mi to upraví. Nemusíš do tý školy chodit vůbec a máš to jednodušší. Získané znalosti budou stejné, akorát ušetříš čas.
prasopsisko
Profil *
2loyza : Vítej v českém školství :), nebo :( ?
Timy
Profil
loyza
Hmm, tys nikdy neopisoval? Případně každý, kdo opisuje by měl přestat chodit do školy...? Co když je expert na všechny ostatní předměty a počítače jdou zcela mimo něj?
mikisek007
Profil
Nazdárek prosím Vás potřeboval bych pomoci s pár příkladama do pascalu....... něco už mám, ale nějak to nefunguje jak má a s něčím si nevím rady........... Prosím o pomoc...
Děkuji
P.S. odepisujte když tak na můj mail... Mikisek007@seznam.cz

Ať žije pascal...
Petr Tichý
Profil
mikisek007
Krátce, buď se zeptej na konkrétní problém nebo si na to přijdi sám a nebo je tady ještě jedna možnost. Popiš co potřebuješ do sekce "Práce a zakázky" a nabídni odměnu.
Toto téma je uzamčeno. Odpověď nelze zaslat.

0