program text_files;
{$APPTYPE CONSOLE}
uses
SysUtils;
var F:textfile;
S:string;
mystring:string;
choice:char;
procedure write_file;
begin
AssignFile(F, 'mytext.txt');
Rewrite(F);
Readln(S);
While not (S='@@@') do
begin
writeln(F,S);
Readln(S);
end;
CloseFile(F);
end;
procedure read_file;
begin
AssignFile(F, 'mytext.txt');
Reset(F);
While not eof (F) do
begin
Readln(F, S);
writeln(S);
end;
CloseFile(F);
end;
begin
repeat
writeln('Text files');
writeln('1. Create a file, @@@ to finish');
writeln('2. Read a file');
writeln('3. Quit');
readln(choice);
case choice of
'1': write_file;
'2': read_file;
'3': writeln;
end;
until not (choice in ['1','2']);
end.
Note that the write_file procedure overwrites the current copy of the text file. Extend the program to allow entry of a file name by the user so that a new file can be created.
The program would be better if it displayed the files available for opening. One way to do this is to add each new file name to a list and store this list in a text file. We use the same techniques we have just seen for writing to the list of files and reading from it, but there is a twist. First, an algorithm for adding a new file name to the existing list:
while not eof (old list of files) do
begin
read a file name from the old file
write the file name into the new file
end
add the new file name to the bottom of the list
close the old and new files
Now the list of files has been updated so we can read it back and display it on screen
while not eof (old list of files) do
begin
read file name from list
display file name on screen
end
The list, however, is incomplete because we wrote the new file name into the new file but we are reading from the old file. We need to copy the contents of the new file into the old file:
while not eof (new list of files) do
begin
read a file name from the new file
write the file name into the old file
end
Now we can read the complete list of file name from the old list. This is a bit involved so you will need to study the code carefully. Note that the file 'oldfilelist.txt' must exist in the same folder as the code before the program is run because both the write_file and read_file procedures try to read from it, which only works if the file exists. Use Notepad to create a blank file with the name 'oldfilelist.txt'.
program Project1;
{$APPTYPE CONSOLE}
uses SysUtils;
var choice:char;
procedure listfiles(fn:string);
var new_list_of_files, old_list_of_files : textfile;
fname:string;
begin
//read old list of files, write to new list, adding
new file name
AssignFile(old_list_of_files, 'oldfilelist.txt');
Reset(old_list_of_files);
AssignFile(new_list_of_files, 'newfilelist.txt');
Rewrite(new_list_of_files);
while not eof (old_list_of_files) do
begin
readln(old_list_of_files, fname);
writeln(new_list_of_files, fname);
end;
writeln(new_list_of_files, fn); //add new file
name to list
closefile(old_list_of_files);
closefile(new_list_of_files);
//copy updated file list to old file so it's
complete when we read it in read_file
AssignFile(old_list_of_files, 'oldfilelist.txt');
rewrite(old_list_of_files);
AssignFile(new_list_of_files, 'newfilelist.txt');
Reset(new_list_of_files);
while not eof (new_list_of_files) do
begin
readln(new_list_of_files, fname);
writeln(old_list_of_files, fname)
end;
closefile(old_list_of_files);
closefile(new_list_of_files);
end;
procedure write_file;
var S, filename: string;
F:textfile;
begin
writeln ('Enter name of new file');
readln(filename);
filename:=filename+'.txt';
listfiles(filename); //call procedure
AssignFile(F, filename);
Rewrite(F);
writeln('Enter text of new file, @@@ to finish');
Readln(S);
While not (S='@@@') do
begin
writeln(F,S);
Readln(S);
end;
CloseFile(F);
end;
procedure read_file;
var S, filename,fname: string;
new_list_of_files, old_list_of_files : textfile;
F:textfile;
begin
writeln('Here is a list of the files:');
AssignFile(old_list_of_files, 'oldfilelist.txt');
Reset(old_list_of_files);
while not eof (old_list_of_files) do
begin
readln(old_list_of_files, fname);
writeln(fname);
end;
closefile(old_list_of_files);
writeln;
writeln ('Enter name of file to open (without .txt)');
readln(filename);
writeln('Here is the file:');
writeln;
filename:=filename + '.txt';
AssignFile(F, filename);
Reset(F);
While not eof (F) do
begin
Readln(F, S);
writeln(S);
end;
CloseFile(F);
end;
begin
repeat
writeln('Text files');
writeln('1. Create a file');
writeln('2. Read a file');
writeln('3. Quit');
writeln;
readln(choice);
case choice of
'1': write_file;
'2': read_file;
'3': writeln;
end; //case
until not (choice in ['1','2']);
end.
We will see later that the Windows environment offers a better way to display file names and to select and display them.
It's time that we introduced printing. Here is some code that illustrates how to print a text file.
program Project1;
{$APPTYPE CONSOLE}
uses SysUtils, printers;
var F:textfile;
S:string;
begin
AssignFile(F, 'myfile.txt');
Reset(F);
printer.BeginDoc;
Printer.Canvas.Font.Size := 12;
While not eof (F) do
begin
Readln(F, S);
//writeln(S);
Printer.Canvas.TextOut(100,80,S);
end;
Printer.endDoc;
CloseFile(F);
readln;
end.
This does not quite work because the values in Printer.Canvas.TextOut(100,80,S); are fixed so the line is printed at the same place every time. THe solution to this should not take too long to work out.
Add a printing procedure to your program. For more about print controls see here (some of this is for Windows applications but a lot of the printer canvas controls work in console applications too). Output is to the default printer. Windows programming will provide a proper print dialogue box.
Here is a possible solution:
procedure print_file;
var filestring, filename,fname: string;
new_list_of_files, old_list_of_files : textfile;
sourcefile:textfile;
x,y:integer;
begin
writeln('Here is a list of the files:');
AssignFile(old_list_of_files, 'oldfilelist.txt');
Reset(old_list_of_files);
while not eof (old_list_of_files) do
begin
readln(old_list_of_files, fname);
writeln(fname);
end;
closefile(old_list_of_files);
writeln;
writeln ('Enter name of file to open (without .txt)');
readln(filename);
writeln('Here is the file:');
writeln;
filename:=filename + '.txt';
AssignFile(sourcefile, filename);
Reset(sourcefile);
printerx:=100; printery:=100;
printer.BeginDoc;
Printer.Canvas.Font.Size := 12;
While not eof (sourcefile) do
begin
Readln(sourcefile, filestring);
Printer.Canvas.TextOut(printerx, printery, filestring);
printery:=printery+150; //increment y value to move text down page. What about
multiple pages?
end;
Printer.endDoc;
CloseFile(sourcefile);
end;
We can adapt the code to process integers:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils,
printers;
var choice:char;
procedure listfiles(fn:string);
var new_list_of_files, old_list_of_files : textfile;
fname:string;
begin
//read old list of files, write to new list, adding new file name
AssignFile(old_list_of_files, 'oldfilelist.txt');
Reset(old_list_of_files);
AssignFile(new_list_of_files, 'newfilelist.txt');
Rewrite(new_list_of_files);
while not eof (old_list_of_files) do
begin
readln(old_list_of_files, fname);
writeln(new_list_of_files, fname);
end;
writeln(new_list_of_files, fn); //add new file name to list
closefile(old_list_of_files);
closefile(new_list_of_files);
//copy updated file list to old file so it's complete when we read it in read_file
AssignFile(old_list_of_files, 'oldfilelist.txt');
rewrite(old_list_of_files);
AssignFile(new_list_of_files, 'newfilelist.txt');
Reset(new_list_of_files);
while not eof (new_list_of_files) do
begin
readln(new_list_of_files, fname);
writeln(old_list_of_files, fname)
end;
closefile(old_list_of_files);
closefile(new_list_of_files);
end;
procedure write_file;
var filename: string;
integerfile:textfile;
inputvalue:integer;
begin
writeln ('Enter name of new file');
readln(filename);
filename:=filename+'.dat';
listfiles(filename); //call procedure
AssignFile(integerfile, filename);
Rewrite(integerfile);
writeln('Enter some integers, -1 to finish');
Readln(inputvalue);
While not (inputvalue=-1) do
begin
writeln(integerfile, inttostr(inputvalue)); //note use of inttostr to convert integer variable to string
Readln(inputvalue);
end;
CloseFile(integerfile);
end;
procedure read_file;
var filename,fname: string;
new_list_of_files, old_list_of_files : textfile;
integerfile:textfile;
inputvalue:integer;
begin
writeln('Here is a list of the files:');
AssignFile(old_list_of_files, 'oldfilelist.txt');
Reset(old_list_of_files);
while not eof (old_list_of_files) do
begin
readln(old_list_of_files, fname);
writeln(fname);
end;
closefile(old_list_of_files);
writeln;
writeln ('Enter name of file to open (without .txt)');
readln(filename);
writeln('Here is the file:');
writeln;
filename:=filename + '.dat';
AssignFile(integerfile, filename);
Reset(integerfile);
While not eof (integerfile) do
begin
Readln(integerfile, inputvalue);
writeln(inputvalue);
end;
CloseFile(integerfile);
end;
procedure print_file;
var filename,fname: string;
new_list_of_files, old_list_of_files : textfile;
integerfile:textfile;
inputvalue:integer;
x,y:integer;
begin
writeln('Here is a list of the files:');
AssignFile(old_list_of_files, 'oldfilelist.txt');
Reset(old_list_of_files);
while not eof (old_list_of_files) do
begin
readln(old_list_of_files, fname);
writeln(fname);
end;
closefile(old_list_of_files);
writeln;
writeln ('Enter name of file to open');
readln(filename);
writeln('Here is the file:');
writeln;
filename:=filename + '.dat';
AssignFile(integerfile, filename);
Reset(integerfile);
x:=100; y:=100;
printer.BeginDoc;
Printer.Canvas.Font.Size := 12;
While not eof (integerfile) do
begin
Readln(integerfile, inputvalue);
Printer.Canvas.TextOut(x,y, inttostr(inputvalue));
y:=y+150;
end;
Printer.endDoc;
CloseFile(integerfile);
end;
begin
repeat
writeln('File of Integers');
writeln('1. Create a file');
writeln('2. Read a file');
writeln('3. Print a file');
writeln('4. Quit');
writeln;
readln(choice);
case choice of
'1': write_file;
'2': read_file;
'3': print_file;
'4': writeln;
end; //case
until not (choice in ['1','2','3']);
end.