PDA

Zobacz pełną wersję : Odczyt, wyswietlenie i zmiana pliku tekstowego



milyzg
29-05-07, 18:15
Witam,

Przepraszaszm , ze tak odrazu z grubej rury.
Probuje napisac w pascalu program, ktory
odczytuje utworzony wczesniej plik tekstowy,
oraz go wyswietla , jesli sie nie miesci na
ekranie to klawiszami Page Up , Page Down
przewija go.


Po nacisnieciu klawisza F2 - program ma sie
zapytac o numer wiersza do usuniecia , jesli
wynik jest rozny od zera to usuwa ten wiersz,
a gdy nie ma podanego wiersza wyswietla komunikat
" plik tekstowy nie ma tyle wierszy"

oto co juz mam:


uses dos,crt;

const
page = 20;


function IntToStr(I: Longint): String;
{ Convert any integer type to a string }
var
S: string[11];
begin
Str(I, S);
IntToStr := S;
end;


var
t : string;
f,k : text;
lba,pos,b,wiersz,i : longint;
key : char;



procedure kasowanieZKopia(wiersz : longint);
var
h, m, s, hund : Word;
pos,i : longint;
begin
GetTime(h,m,s,hund);
rename(f,'P'+IntToStr(h)+intToStr(s)+IntToStr(hund )+'.bak');
Assign(k,'plik.txt');
Rewrite(k);
Reset(f);
pos:=0;
while not eof(f) do begin
readln(f,t);
inc(pos);
if pos<>wiersz then
writeln(k,t);
end;
close(f);
close(k);
end;



begin
lba:=0;
Assign(f,'plik.txt');
Reset(f);
pos:=1;
repeat
b:=0;
clrscr;
{status wiersza gornego, to do :) }
while (not eof(f)) and ((b+1) mod (page+1)<>0) do begin
readln(f,t);
writeln(b+pos,': ',t);
inc(b);
end;
if eof(f) then
writeln('koniec');

{sttus wiersza dolnego, to do :) }
key:=readkey;
if key=#0 then begin
key:=readkey;
case key of
{strzalki gora i dol zostawie , zasada podobna do pgup i pgdn }
'Q' : if not eof(f) then
pos:=pos+page;
'I' : begin
pos:=pos-page;
if pos<1 then
pos:=1;
close(f);
reset(f);
for i:=1 to pos-1 do
readln(f,t);
end;
'<' : begin
write('podaj linie do usuniecia: ');
readln(wiersz);
if (wiersz>0) then begin
close(f);
kasowanieZKopia(wiersz);
Assign(f,'plik.txt');
Reset(f);
pos:=1;
end
else begin
writeln('plik tekstowy nie ma tyle wierszy');
repeat until keypressed;
end;
end;
end;
end;
until key=#27;
end.



Nie dziala to jak trzeba, mam jeszcze cos takiego

START

var f, f1: tet;
m,n,k: longint;


procedure kopiuj (zrodlo, cel:string);

var fz, fc:text;
s:string;
begin
assign (fz,zrodlo);
assign (fc,cel);
reset (fc);
whilenot eof (fz) do
begin
readln (fz,s);
writeln (fc, s);
end;
close (fc);
clse (fz);
end;


procedure usun_wiersz (n:longint; pl:string);
var f1,f2:text;
m: longint;
s: string;
begin
kopiuj (pl,'tmptmp.tmp');
assign (fz,'tmptmp');
assign (fc,pl);
reset (f2);
rewrite (f1);

for m:=1 to n=1 do
begin
readln(f2,s);
writeln(f1,s);
end;

readln (f2,s);
while nof eof (f2) do
begin
readln (f2,s);
writeln (f1,s);
end
close (f2);
close (f1);
end;


Moze , ktos pisal cos podobnego i z 2 czesci umie zrobic 1 calosc