KMA 
Долгожитель
|
     
Вот сами и работайте с таким кодом. Оформите по человечески, а то ведь реально ничего не разобрать.
(Сообщение отредактировал KMA 2 марта 2007 19:49)
|
Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 2 марта 2007 19:48 | IP
|
|
KMA
Долгожитель
|
Уважаемая, о какой помощи может идти речь, если вы меня даже слушать не хотите???
Понимаете, открыть файл хотя бы для чтения или записи я думаю, все же стоило, а потом удивляетесь почему у вас ничего не выходит. Я просто понадеялся, что раз уж вы написали более или менее "нормальный" код, то понимаете что нужно сделать.
Добавьте перед BEGIN
Assign (f, 'f.dat');
reWrite (f);
И не забудьте закрыть. Вы меня очень сильно разочаровали, боюсь с таким подходом сдать экзамен будет очень сложно.
P. S. inc (x), означает инкремент числа х, что в переводе на русский х:=х+1 (т. е. увеличили число на 1)
seek (f, n); переводит каретку чтения файла на n запись. Начало отсчета ведется с нуля. Т. е. если у вас скажем 30 записей, а вы указали seek (f, 15), то получилось что у вас каретка (указатель) стоит на 16 запеси.
|
Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 2 марта 2007 19:59 | IP
|
|
Guest
Новичок
|
Помогите мне пожалуйста. Что у меня не правильно?
Program proekt;
Uses CRT;
Type
people=record
surname:string[25];
name:string[20];
phone:longint;
end;
const n=10;
VAR ft:text;
Peoples:array[1..n] of people;
f:file of people;
buf:people;
j,i:byte;
v,m:integer;
f_name:string;
searchSurname:string;
Procedure showPeople(buf:people);
Begin
with buf do
begin
write(name:20);
write(surname:25);
writeln(phone);
end
End;
Procedure searchPeopleSurname(searchSurname:string);
Var
buf:people;
w:boolean;
b:integer;
Begin
writeln('Vvedite family');
readln(searchSurname);
seek(f,0);
w:=true;
while not eof(f) do
begin
read(f, buf);
if buf.surname=searchSurname
then
begin
w:=false;
showPeople(buf);
end;
end;
if w then
writeln('Prostite no takoi zapisi net');
End;
Procedure sortAlphabet;
Var
i,j,m,n:integer;
buf:people;
Begin
m:=1;
while(m<>n) or (peoples[m].surname=' ') do
inc(m);
for i:=1 to m-1 do
for j:=i to m-1 do
if peoples[m].surname>peoples[m+1].surname
then
begin
buf:=peoples[m];
peoples[m]:=peoples[m+1];
peoples[m+1]:=buf;
end;
end;
Procedure writeToTXT(buf:people);
Var
s:string;
f_name1:string;
f1:text;
Begin
assign(f1,f_name);
writeln('Vvedite nazvanie faila(D:\spr1.txt)');
readln(f_name1);
reset(f);
rewrite(f1);
while not eof(f) do
begin
read(f,buf);
with buf do begin
if(buf.phone div 10000=41) then
writeln(f1,buf.phone);
end;
close(f);
close(f1);
end;
end;
Procedure sozdanie;
Begin
writeln('Vvedite imya faila(D:\)');
readln(f_name);
f_name:=f_name+'.dat';
assign(f,f_name);
rewrite(f);
{ write('Skolko zapisei vi hotite dobavit');
readln(m);
for j:=1 to m do
begin
write('Name');
readln(buf.name);
write('surname');
readln(buf.surname);
write('Phone');
readln(buf.phone);
write(f,buf);
showPeople(buf);
end; }
end;
Procedure zapolnenie;
Begin
reset(f);
write('Skolko zapisei vi hotite dobavit');
readln(m);
for j:=1 to m do
begin
with buf do begin
write('Name');
readln(buf.name);
write('surname');
readln(buf.surname);
write('Phone');
readln(buf.phone);
seek(f,filesize(f));
write(f,buf);
showPeople(buf);
end;
end;
end;
BEGIN
CLrscr;
sozdanie;
showPeople(buf);
zapolnenie;
searchPeopleSurname(searchSurname);
sortAlphabet;
writeToTXT(buf);
readln;
end.
|
Всего сообщений: Нет | Присоединился: Never | Отправлено: 3 марта 2007 10:56 | IP
|
|
KMA
Долгожитель
|
Понимаешь, у тебя все неправильно, нет четкой логики, как и хорошо оформленного текста программы. Процедура создание вообще какая-то хаотическая. Давай так, пиши мне в асю, а я постараю тебе чем-нибудь допомогать.
|
Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 3 марта 2007 19:44 | IP
|
|
Guest
Новичок
|
Привет это опять я! Я на полном серьёзе. Я написала программу, вот ее код. Посмотрите пожалуйста всё у меня правильно?
Program proekt;
Uses CRT;
Type
people=record
name: string; {марка}
surname: string; {цвет}
phone:Longint; {номер}
end;
VAR
peoples: array [1..20] of people;
buf: people; {вспомогательная переменная}
fpeople: file of people; {файл с хранимыми машинами}
ftext: text; {текстовый файл}
i,n,j, k: byte;
BEGIN
assign (fpeople, 'people.dat');
assign (ftext, 'people1.txt');
ReWrite (fpeople);
writeLn ('Skolko zapisei vi xotite dobavit');
readLn (n);
for j:=1 to n do
begin
write ('Surname');
readLn (buf.surname);
write ('Name');
readLn (buf.name);
write ('Phone');
readLn (buf.phone);
write (fpeople, buf)
end;
close (fpeople);
Reset(fpeople);
writeln('Vvedite family');
readln(searchSurname);
seek(fpeople,0);
falg:=true;
while not eof(fpeople) do
begin
read(fpeople, buf);
if buf.surname=searchSurname
then
begin
falg:=false;
showPeople(buf);
end;
end;
if falg then
writeln('Prostite no takoi zapisi net');
end;
reSet (fpeople);
k:=0;
while not eof (fpeople) do
begin
read (fpeople, buf);
if (buf.phone div 10000=41)
then
begin
inc (k);
peoples[k]:=buf
end
end;
close (fpeople);
k:=1;
while (k<>n) or (peoples[k].surname=' ') do
inc(k);
for i:=1 to k-1 do
for j:=1 to k-1 do
if peoples[j].surname > peoples[j+1].surname
then
begin
buf:=peoples[j];
peoples[j]:=peoples[j+1];
peoples[j+1]:=buf;
end;
reWrite (ftext);
for j:=1 to k do
begin
with peoples[j] do
begin
write (ftext, surname);
write (ftext, name+' ');
writeLn (ftext,phone);
end
end;
close (ftext);
readln;
END.
|
Всего сообщений: Нет | Присоединился: Never | Отправлено: 4 марта 2007 16:02 | IP
|
|
Guest
Новичок
|
Ну помоги же мне поалуйста!
|
Всего сообщений: Нет | Присоединился: Never | Отправлено: 5 марта 2007 10:10 | IP
|
|
KMA
Долгожитель
|
При чем тут машины???
Ладно, сейчас посмотрю.
close (fpeople);
Reset(fpeople);
writeln('Vvedite family');
readln(searchSurname);
seek(fpeople,0);
falg:=true;
while not eof(fpeople) do
begin
read(fpeople, buf);
if buf.surname=searchSurname
then
begin
falg:=false;
showPeople(buf);
end;
end;
if falg then
writeln('Prostite no takoi zapisi net');
end;
Зачем закрывать и открывать файл??? Не надо, достаточно один раз под самый конец закрыть. При этом флаг то тебе нужен, чтобы ответить, нашлись записи или нет, поэтому не надо его постоянно обнулять.
поэтому вместо этого пишешь:
seek (fpeople, 0); {устанавливаем каретку в начало файла}
write ('Surname for search ->');
readLn (searchSurname); {searchSurname это фамилия для поиска}
flag:=true;
while not eof (fpeople) do
begin
read (fpeople, buf); {считываем в buf запись}
if buf.surname=searchSurname
then
begin {если нашли эту запись, то flag обнуляем, а человека выводим }
flag:=false;
writeLn (buf.name, ' ', buf.surname, ' ', buf.phone)
end
end;
Смотрю дальше.
|
Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 6 марта 2007 16:11 | IP
|
|
KMA
Долгожитель
|
все остальное около дела, в общем замени, чтобы читалось лучше:
write (ftext, surname);
write (ftext, name+' ');
writeLn (ftext,phone);
на следующее
write (ftext, surname+' ');
write (ftext, name+' ');
writeLn (ftext,phone);
|
Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 6 марта 2007 16:15 | IP
|
|
KniazWWW
Удален
|
Помогите пожалуйсто решить срочно две задачки.
1) На тему "Строковые переменные".
Определить является ли заданный текст зашифрованной телеграммой – т.е. она состоит из слов, каждое из которых представляет набор из пяти символов, каждый из которых является буквой русского алфавита, причем средняя буква в каждом слове имеет четное значение кода.
2) На тему "Процедуры и функции, рекурсии".
Составить программу «Мыльные пузыри» из К окружностей разного диаметра, разного цвета и появляющихся в произвольных местах экрана. Рисование одного мыльного пузыря оформить в виде процедуры, где координаты центра, радиус, цвет – входные параметры.
Зарание большое спасибо!
|
Всего сообщений: N/A | Присоединился: N/A | Отправлено: 7 марта 2007 15:56 | IP
|
|
Speedy
Удален
|
Привет! Помогите дописать игру, пожалуйста. Не могу сделать, чтобы шарик двигался самостоятельно(т. е. ничего не нажимая) одновременно с платформой(движение стрелочками). И чтобы при нажатии Esc игра завершалась. У меня получается движение только по отдельности.
Вот частичный код программы:
procedure dvigenie_charika;
Begin
x4:=25; y4:=15;
x5:=35; y5:=25;
SizeC:=ImageSize(x4,y4,x5,y5);
GetMem(pp,SizeC);
GetImage(x4,y4,x5,y5,pp^);
repeat
key2:=readkey;
begin
PutImage(x4,y4,pp^,XorPut);
begin
x4:=x4+random(10);
y4:=y4+random(50);
PutImage(x4,y4,pp^,XorPut);
end;
delay(30000); {pauza}
if y4>=GetMaxY then
begin
y4:=0;
PutImage(x4,y4,pp^,XorPut);
end;
if x4>=GetMaxX then
begin
x4:=random(300);
PutImage(x4,y4,pp^,XorPut);
end;
end;
until key2=#27;
FreeMem(pp,SizeC);
End;
procedure dvigenie_platformi;
Const ChValid:set of char=[#27,#077,#075];
Begin
x1:=GetMaxX div 2; y1:=GetMaxY-50;
x2:=(GetMaxX div 2)+70; y2:=(GetMaxY-50)+20;
SizeM:=ImageSize(x1,y1,x2,y2);
GetMem(p,SizeM);
{dvigenie myacha}
GetImage(x1,y1,x2,y2,p^);
repeat
repeat key:=readkey until key in ChValid;
case key of
#077:
begin
PutImage(x1,y1,p^,XorPut);
begin
x1:=x1+20;
PutImage(x1,y1,p^,XorPut);
end;
delay(30000); {pauza}
if x1>=GetMaxX then
begin
x1:=0;
PutImage(x1,y1,p^,XorPut);
end;
end;
#075:
begin
PutImage(x1,y1,p^,XorPut);
begin
x1:=x1-20;
PutImage(x1,y1,p^,XorPut);
end;
delay(30000); {pauza}
if x1>=GetMaxX then
begin
x1:=0;
PutImage(x1,y1,p^,XorPut);
end;
end;
end;
until key=#27;
End;
|
Всего сообщений: N/A | Присоединился: N/A | Отправлено: 8 марта 2007 18:35 | IP
|
|
|
Форум
Турбо Паскаль. Программирование на Pascal
