Блин, вот я дурак.
Это же мы в цикле for просто делаем предельное число в двое меньше. А не режим саму строку, значение строки не меняется. Я уже понял, спасибо, теперь спокоен!
Модераторы: Oleg_D, Модераторы
function Datas: string;
var h, w, s: string;
k, i, j: integer;
begin
read (FileIN, s);
k:=0;
repeat
for i:=1 to length (s) do
if s[i]=' ' then begin k:=k+1; j:=i;
if k=3 then break;
end;
until k=3;
h:='';
for j:=i to length(s) do h:=h+s[i];
datas:=h;
end;
begin
assign (FileIN, 'C:\Users\IN.txt');
reset (FileIN);
while not eof (FileIN) do begin
writeln(datas); readln(filein);
end;
close (FileIN);
end.
deka47 писал(а):придумал сам себе программу, есть n слов, нужно вывести все после первых трех (скажем есть 5 слов, нужно 2 последнии), слова написаны через пробел и не одна строка в файле, а несколько.
const
words_to_skip = 3;
var
s: string;
i, w: integer;
begin
w := 0; { счётчик слов }
writeln('Введите текст, для завершения в Linux Ctrl+D, в Windows/DOS - Ctrl+Z:');
while not eof do begin
readln(s);
if w < words_to_skip then begin { выделяем слова, разделитель - пробел }
i := 1;
while (w < words_to_skip) and (i <= length(s)) do begin
while (i <= length(s)) and (s[i] = ' ') do inc(i); { пропустим пробелы }
if i <= length(s) then begin { если строка не кончилась, мы в начале слова ... }
while (i <= length(s)) and (s[i] <> ' ') do inc(i); { ... найдём конец слова ... }
inc(w); { ... и увеличим счётчик слов }
end;
if w = words_to_skip then begin { все слова найдены ... }
{ ... пропустим пробелы и выведем остаток строки }
while (i <= length(s)) and (s[i] = ' ') do inc(i);
if i <= length(s) then writeln('> ', copy(s, i, length(s)));
end;
end;
end else { выводим введённое как есть }
writeln('> ', s);
end;
end.
> имя_откомпилированной_программы < имя_файла_с_данными
deka47 писал(а):
- Код: Выделить всё
k := 0;
repeat
for i := 1 to length(s) do
if s[i] = ' ' then begin
k := k + 1;
j := i;
if k = 3 then break;
end;
until k = 3;
...Напишите функции для циклического сдвига слова влево и вправо...
Oleg_D писал(а):Разница будет только в числе циклов: 8 - для байта, 16 - для Word, 32 - для Longint.
function testbit(arg,bit:byte):boolean;
begin
testbit:=(arg and (1 shl bit))<>0;
end;
function writenum(arg:byte):string;
var
s:string;i:byte;
c:char;
begin
s:='';
for i:=1 to 8 do begin
c:=char ((arg mod 2)+ord('0'));
s:=c+s;
arg:=arg div 2;
end;
writenum:=s;
end;
procedure rotatebyte(var n:byte;c:char);
var flag:boolean;
begin
case c of
'l' : begin
flag:=testbit(n,7);
{$R-}
n:=n shl 1;
{$R+}
if flag then
n:=1 or n;
end;
'r' : begin
flag:=testbit(n,0);
n:=n shr 1;
if flag then
n:=128 or n;
end;
end;
end;
var
num:byte;
ch:char;
begin
writeln('введите число от 0 до 255');
readln(num);
if not (num in [0..255]) then
writeln('не корректный ввод');
writeln(writenum(num));
writeln('сдвиг влево или вправо l/r ? ');
repeat
readln(ch);
if not (ch in ['l','r']) then
writeln('не корректный ввод');
until ch in ['l','r'];
rotatebyte(num,ch);
writeln(writenum(num));
readln
end.
function rotatebyte(n: byte; right: boolean): byte;
begin
if right
then rotatebyte := (n shr 1) or (n shl 7)
else rotatebyte := (n shl 1) or (n shr 7);
end;
function byte2bin(b: byte): string;
var
i: integer;
s: string[8];
begin
s := '';
for i := 7 downto 0 do begin
s := chr(ord('0') + b and 1) + s;
b := b shr 1;
end;
byte2bin := s;
end;
var
number: byte;
direction: char;
begin
write('Введите число [0..255]: '); readln(number);
repeat
write('Введите направление сдвига (l/r): '); readln(direction);
if not (direction in ['l', 'r']) then writeln('*** Ошибка: некорректный ввод');
until direction in ['l', 'r'];
writeln('Было: ', byte2bin(number));
writeln('Стало: ', byte2bin(rotatebyte(number, direction = 'r')));
end.
Введите число [0..255]: $a5
Введите направление сдвига (l/r): l
Было: 10100101
Стало: 01001011
function rotatebyte(n: byte; right: boolean): byte;
begin
{$IFOPT R+}{$DEFINE RANGE_ON}{$R-}{$ENDIF}
if right
then rotatebyte := (n shr 1) or (n shl 7)
else rotatebyte := (n shl 1) or (n shr 7);
{$IFDEF RANGE_ON}{$UNDEF RANGE_ON}{$R+}{$ENDIF}
end;
bormant писал(а):В таком случае, если файл собирается с {$R+}, отключение подействует только на нужный участок кода. Если файл собирается с {$R-}, не произойдёт включения опции на остаток файла, как это было бы в первоначальном примере с незащищённой {$R+} после кода работы со сдвигами. Иными словами, состояние директивы компиляции {$R} вне интересующего нас кода изменено не будет.
procedure ReadDesk(var F: Text);
FillChar(Desk, SizeOf(Desk), false);
Desk[y,x]:= S[x]='+';
while not Eof(F) and (y<=Cy) do begin
Readln(F, S);
x:=1;
while (x<=Length(S)) and (x<=Cx) do begin
Desk[y,x]:= S[x]='+';
Inc(x);
end;
Inc(y);
end
procedure ReadSet(var aFile: text; var aSet : TBoundSet);
var k : integer;
begin
aSet:=[];
while not seekEoln(aFile) do begin
Read(aFile, k);
aSet:= aSet+[k];
end;
Readln (aFile);
end;
Paster Fob писал(а): aSet:=[];
Вернуться в Книга "Песни о Паскале"
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1