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

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

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

> Косяк с выводом, работа с файлом
Renbo
сообщение 6.04.2007 0:01
Сообщение #1


Пионер
**

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

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


Вообщем всё пашет зашибись, только вот возник вдруг косяк с выводом на экран. Косяк возникает где-то при создании, так как я пробывал в файле вручную писать строчки и он выводил нормально.
Проблема: после считывания 2х строчек, он автоматически увеличивает i , которая показывает номер записи. 1 запись = 4 строчки.


USES  CRT,Printer;

VAR
  spravochnik1:text;

function FileExist:boolean;
Begin
  {$I-}
  assign(spravochnik1,'spravka1.txt');
  reset(spravochnik1);
  close(spravochnik1);
  {$I+}
  FileExist:=(IOResult=0);
End;


function get_str(max_len:byte):string;
var
  s:string;
  pb:char;
begin
  s:='';
  repeat
    pb := readkey;
  { If (pb in [#48..#57,#8])  then  }
    if length(s) <= max_len then
    case pb of
      #8: begin
            if length(s) > 0 then
              begin
                write(#8,#32,#8);
                delete(s,length(s),1)
              end
          end
      else
        if length(s) <> max_len then
          begin
            s:=s+pb;
            write(pb)
          end
     end
  until pb=#13;
  writeln;
  get_str:=s
end;


procedure vivod;
var
  i:integer;
  s:string;
Begin
  i:=0;
  assign(spravochnik1,'spravka1.txt');
  reset(spravochnik1);
  writeln('--------------------------------------------------------------------');
  writeln('№':4,'    Код       Название        ФИО заведующего          Телефон');
  writeln('     отдела       отдела             отделом               ');
  writeln('--------------------------------------------------------------------');
  while not eof(spravochnik1) do
    begin
      inc(i);
      write(i:2);
      readln(spravochnik1,s); write(s:9);
      readln(spravochnik1,s); write(s:7);
      readln(spravochnik1,s); write(s);
      readln(spravochnik1,s); writeln(s);
    end;
  close(spravochnik1);
End;

function DaNet:char;
var push,otvet:char;
begin
  otvet:='n';
  write(otvet);
  repeat
    push:=readkey;
    gotoxy(wherex-1,wherey);
    IF push in ['Y','y','n','N'] then otvet:=push;
    write(otvet);
  until ord(push)=13;
  writeln;
danet:=otvet;
end;

procedure sozdanie;
VAR
  s:string;
  push,otvet:char;
Begin
  clrscr;
  If FileExist=true then
    begin
      writeln('Фаил уже существует');
      writeln('Создание нового файла приведёт к удалению старого');
      writeln('Желаете ли вы создать новый фаил(Y/N)?');
      otvet:=DaNet;
      IF otvet in ['Y','y'] then
        begin
          assign(spravochnik1,'spravka1.txt');
          rewrite(spravochnik1);
          repeat
            writeln('введите данные:');
            write('код отдела - '); s:=get_str(5); writeln(spravochnik1,s);
            write('Название отдела - '); s:=get_str(8); writeln(spravochnik1,s);
            write('ФИО зав. отделом - '); s:=get_str(10); writeln(spravochnik1,s);
            write('служебный телефон - '); s:=get_str(7); writeln(spravochnik1,s);
            writeln('Хотите ли сделать ещё запись?(Y/N)');
            otvet:=DaNet;
          until otvet in ['N','n'];
          close(spravochnik1);
        end
    end
  Else
    begin
      assign(spravochnik1,'spravka1.txt');
      rewrite(spravochnik1);
      repeat
        writeln('введите данные:');
        write('код отдела - '); s:=get_str(5); writeln(spravochnik1,s);
        write('Название отдела - '); s:=get_str(5); writeln(spravochnik1,s);
        write('ФИО зав. отделом - '); s:=get_str(5); writeln(spravochnik1,s);
        write('служебный телефон - '); s:=get_str(5); writeln(spravochnik1,s);
        writeln('Хотите ли сделать ещё запись?(Y/N)');
        otvet:=DaNet;
      until otvet in ['N','n'];
      close(spravochnik1);
    end;
End;

procedure prosmotr;
VAR
  s:string;
  i:integer;
Begin
  If FileExist=False then
    begin
      writeln('Создайте сперва фаил!!!');
      readkey;
      exit;
    end;
  clrscr;
  vivod;
  readkey;
End;


procedure podmenu1;
VAR
  F:integer;
  ch:char;
begin
  repeat
    F:=0;
    clrscr;
    writeln(' Ведение основного файла: ');
    writeln('1 -> Создание нового основного файла');
    writeln('2 -> Просмотр на экране основного файла');
    writeln('3 -> Возврат в главное меню');
    repeat
      ch:=readkey;
      IF not(ch in ['1'..'3']) then
        begin
          writeln('неверная клавиша!');
          F:=F+1;
          if F=4 then
            begin
              writeln('программа завершена из-за неправильного ввода данных');
              writeln('нажмите любую кнопку для выхода');
              readkey;
            end
          else
            if F=3 then
              begin
               writeln('у вас ещё ', 4-F,' попытка');
               writeln('выберите существующий пункт подменю');
              end
            else
              begin
                writeln('у вас ещё ', 4-F,' попытки');
                writeln('выберите существующий пункт подменю');
              end;
        end;
    until (ch in ['1'..'3']) or (F=4);
    case ch of
      '1': sozdanie;
      '2': prosmotr;
    end;
  until (F=4) or (ch='3');
end;


Begin
  podmenu1;
End.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 

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