IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Задача на файл и еще...
UnSpi
сообщение 28.05.2005 13:53
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 12
Пол: Мужской

Репутация: -  0  +


Пожалуйста помогите рещить такую задачу!!!!!! :molitva:
Реально ,вопрос жизни и смерти!!!!!!
Вот условие:
В текстовый файл занесена строка длиной более 255 символов (в строке может быть только одно слово). Вывести на экран строку, удалив повторяющие «лишние» пробелы, если они есть, и во всех словах перенести последнюю букву в начало слова.
заранее спасибо!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
UnSpi
сообщение 28.05.2005 18:50
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 12
Пол: Мужской

Репутация: -  0  +


Вот та задача:
program file5;
uses crt; {strings}
procedure Memory(var f:text);
var x :char;
flag :byte;
stop :boolean;
ChType :string;
Memtype,Totalmem :integer;
begin
stop:=true;
Totalmem:=0;
while stop do
begin
read(f,x);
flag:=1;
if x='b' then begin
read(f,x);
if x='e' then begin
read(f,x);
if x='g' then begin {begin}
read(f,x);
if x='i' then begin
read(f,x);
if x='n' then begin writeln('razmer pamyati dlya dannih=0');
halt;
end;
end;
end;
end;
end;

if x='v' then begin
read(f,x);
if x='a' then begin {var}
read(f,x);
if x='r' then repeat
read(f,x);
if x='b' then begin
read(f,x);
if x='e' then begin
read(f,x);
if x='g' then begin {begin}
read(f,x);
if x='i' then begin
read(f,x);
if x='n' then begin stop:=false;
end;
end;
end;
end;
end;
if x=',' then inc(flag);
if x=':' then begin
ChType:='';
read(f,x);
while x<>';'do begin
Chtype:=Chtype+x;
read(f,x);
end;
{ case ChType of
'byte' :Memtype:=1;
shortint:Memtype:=1;
word :Memtype:=2;
integer :Memtype:=2;
longint :Memtype:=4;
real :Memtype:=6;
double :Memtype:=8;
extended:Memtype:=10;
comp :Memtype:=8
single :Memtype:=4;
char :Memtype:=1;
string :Memtype:=256;
pchar :Memtype:=4;
pointer :Memtype:=4;
boolean :Memtype:=1;
bytebool:Memtype:=2;
wordbool:Memtype:=2;
longbool:Memtype:=4;}
if Chtype='byte' then Memtype:=1;
if Chtype='shortint' then Memtype:=1;
if Chtype='word' then Memtype:=2;
if Chtype='integer' then Memtype:=2;
if Chtype='longint' then Memtype:=4;
if Chtype='real' then Memtype:=6;
if Chtype='double' then Memtype:=8;
if Chtype='extended' then Memtype:=10;
if Chtype='comp' then Memtype:=8;
if Chtype='single' then Memtype:=4;
if Chtype='char' then Memtype:=1;
if Chtype='string' then Memtype:=256;
if Chtype='pchar' then Memtype:=4;
if Chtype='pointer' then Memtype:=4;
if Chtype='boolean' then Memtype:=1;
if Chtype='bytebool' then Memtype:=2;
if Chtype='wordbool' then Memtype:=2;
if Chtype='longbool' then Memtype:=4;
Totalmem:=Totalmem+flag*Memtype;
flag:=1;
end;

until not stop;
end;
end;
end;
writeln('the size of memory for data:',Totalmem);
end;
var
fp :text;
begin
ClrScr;
assign(fp,'FILE.TXT');
{$I+}
reset(fp);
{$I-}
if IOResult <> 0 then BEGIN writeln('FILE NOT FOUND');
halt;
END
else Memory(fp);
readkey;
end.


Сообщение отредактировано: volvo - 28.05.2005 19:02
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 18.07.2025 7:13
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"