Блин, вот я дурак.
Это же мы в цикле 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