Форум
» Назад на решение задач по физике и термеху
Регистрация | Профиль | Войти | Забытый пароль | Присутствующие | Справка | Поиск

» Добро пожаловать, Гость: Войти | Регистрация
    Форум
    Информационные технологии
        Турбо Паскаль. Программирование на Pascal
Отметить все сообщения как прочитанные   [ Помощь ]
» Добро пожаловать на форум "Информационные технологии" «

Переход к теме
<< Назад Вперед >>
Несколько страниц [ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 ]
Модераторы: paradise, KMA
  

KMA



Долгожитель

Вот сами и работайте с таким кодом. Оформите по человечески, а то ведь реально ничего не разобрать.


(Сообщение отредактировал KMA 2 марта 2007 19:49)

-----
Gentoo, FreeBSD 7.2, PHP, JavaScript (jQuery), Python, Shell
Помогаю с задачами только на форуме.
Все мои действия четко согласуются с правилами раздела. Поэтому никаких претензий и обид.

Всего сообщений: 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 запеси.

-----
Gentoo, FreeBSD 7.2, PHP, JavaScript (jQuery), Python, Shell
Помогаю с задачами только на форуме.
Все мои действия четко согласуются с правилами раздела. Поэтому никаких претензий и обид.

Всего сообщений: 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



Долгожитель

Понимаешь, у тебя все неправильно, нет четкой логики, как и хорошо оформленного текста программы. Процедура создание вообще какая-то хаотическая. Давай так, пиши мне в асю, а я постараю тебе чем-нибудь допомогать.

-----
Gentoo, FreeBSD 7.2, PHP, JavaScript (jQuery), Python, Shell
Помогаю с задачами только на форуме.
Все мои действия четко согласуются с правилами раздела. Поэтому никаких претензий и обид.

Всего сообщений: 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;

Смотрю дальше.  

-----
Gentoo, FreeBSD 7.2, PHP, JavaScript (jQuery), Python, Shell
Помогаю с задачами только на форуме.
Все мои действия четко согласуются с правилами раздела. Поэтому никаких претензий и обид.

Всего сообщений: 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);

-----
Gentoo, FreeBSD 7.2, PHP, JavaScript (jQuery), Python, Shell
Помогаю с задачами только на форуме.
Все мои действия четко согласуются с правилами раздела. Поэтому никаких претензий и обид.

Всего сообщений: 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

Эта тема закрыта, новые ответы не принимаются

Переход к теме
<< Назад Вперед >>
Несколько страниц [ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 ]

Форум работает на скрипте © Ikonboard.com