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

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

Переход к теме
<< Назад Вперед >>
Несколько страниц [ 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 ]
Модераторы: paradise, KMA
  

Guest



Новичок

...день добрый!
ммм...я постаралась учесть Ваши советы иии...что-то вот сотворила,но,эта штука не вызывает во мне уверенности(((...а получилось что-то примерно так:
uses crt;
type sap=record
firm,adres,tovar:array[1..20] of char;
rozn,opt:real;
cena:integer;
end;
mas=array[1..500] of sap;
var
fil1:file of sap;
per:sap;
zap,zap2:mas;
i,k,s,otvet,j,d,y,x,m:integer;

begin
assign(fil1,'d:\d.dat');
clrscr;
repeat
writeln;
writeln('Введите 1- Создать файл и записать;');
writeln('Введите 2- Открыть созданный файл и просмотреть;');
writeln('Введите 3- Обработать файл и вывести;');
writeln('Любое другое число- Выйти из программы.');
goToxy(1,24);
write('Ваш выбор: ')
readln(otvet);
case otvet of
1: begin
       clrscr;
       writeln('----------------------------------------------------');
       writeln('naimen firmi.   rozne4naia cena.   optovaia cena.  ');
       writeln('tovara.   nen.(mes) (rub)');
       writeln('------------------------------------');
       reset(fil1);
       i:=1;
       while not eof (fil1) do
               begin
               read(fil1,zap[ i ]);
               y:=wherey;
               x:=1;
               gotoxy(1,24);
               write(zap[ i ].firm);
               x:=x+10;
               gotoxy(11,24);
               writeln(zap[ i ].tovar);
               i:=i+1;
               end;
               close(fil1);
               end;
2: begin clrscr;
reset(fil1);
writeln('задайте необходимую цену-');
readln(k);
s:=0;
j:=0;
i:=1;
while not eof (fil1) do
read(fil1,zap[1]);
if zap[ i ].cena>=k then
       begin
       j:=j+1;
       zap2[j].cena:=zap[ i ].cena;
       zap2[j].firm:=zap[ i ].firm;
       zap2[j].rozn:=zap[ i ].rozn;
       zap2[j].opt:=zap[ i ].opt;
       zap2[j].adres:=zap[ i ].adres;
       s:=s+1;
       end;
       i:=i+1;
       end;
       close(fil1);
       m:=s-1;
       repeat  d:=0;
               for i:=1 to m do
               if zap2[ i ].kolvo>zap2[i+1].kolvo then
                       begin
                       per:=zap1[ i ];
                       zap2[ i ]:=zap2[i+1];
                       zap2[i+1]:=per;
                       d:=1;
                       end;
               until d=0;
               for i:=1 to s do
               writeln;
               writeln('---------------------------------');
               writelnwriteln('naimen firmi. rozne4naia cena. optovaia cena.');
               writeln('tovara.   nen.(mes) (rub)');
               writeln('---------------------------------');
               for i:=1 to s do
                       begin
                       y:=wherey;
                       x:=1;
                       gotoxy(x,y);
                       write(zap2[ i ].firm,);
                       x:=x+10;
                       gotoxy(x,y);
                       write(zap2[ i ].adres:5:1);
                       x:=x+10;
                       gotoxy(x,y);
                       write(zap2[ i ].rozn:5:2);
                       x:=x+10;
                       gotoxy(x,y);
                       writeln(zap2[ i ].opt);
                       end;
                       else otvet:=4;
               end;
       end;
until otvet=4;
end.


(Сообщение отредактировал KMA 8 янв. 2008 21:13)

Всего сообщений: Нет | Присоединился: Never | Отправлено: 29 нояб. 2007 16:44 | IP
nia



Новичок

вот и мучаюсь,что-то я здесь намудрила и очень сильно((((

Всего сообщений: 7 | Присоединился: ноябрь 2007 | Отправлено: 29 нояб. 2007 17:07 | IP
Guest



Новичок


Удалите с углов доски 2nх2n по одной клеточке с противоположных углов. Покажите, что невозможно полностью покрыть эту доску фишками 1х2, так чтоб они не высовывались за края доски и не накрывали друг друга.


К задачке есть приписка: исследование лучше начать с доски 2х2.4х4 и т.д.,чтоб найти понятия, наиболее удобные для представления общего случая.

Мне кажется, что эта програмка может быть представлена так: мы вводим размер поля 2nх2n,размер фишки(const).делаем проверку и показываем,что такими фишками покрыть нельзя. Для обьема может какие-то графические элементы туда вставить...
Вообще меня эта задача повергла в шок, даже не знаю,чем так преподу насолила(((

Всего сообщений: Нет | Присоединился: Never | Отправлено: 29 нояб. 2007 17:34 | IP
Guest



Новичок

И подскажите, пожалуйста, что делать:2 раза регистрировалась, а пароль не приходит

Всего сообщений: Нет | Присоединился: Never | Отправлено: 29 нояб. 2007 17:46 | IP
KMA



Долгожитель

Так, видимо вы все записали в программе, а я просил писать функциями и процедурами. Ладно, объяснить стоит как надо 1 раз. Читайте:

Code Sample:
 
{изменим саму структуру записи: }
TYPE
       cost=record
         opt, rozn: real
       end;
       sap=record
         firm,adres,tovar: string [10];
         cena: cost;  
       end;



Далее хорошо бы организовать ввод данных (с открытием файла, проблем быть не должно). В любом случае предложенная функция будет работать, если вам не обходимо будет просто добавить что-то в файл. Вот она:
Code Sample:
 
{функция возвращает введеные пользователем значения
в виде записи sap}
function addItem: sap;
var _buf: sap;
     i, n: byte;
Begin
        with _buf do
          begin
            write ('Название фирмы ->');
            readLn (firm);
            write ('Адрес ->');
            readLn (adres);  
            write ('Товар ->');
            readLn (tovar);  
            write ('Цена розничная ->');
            readLn (cena.rozn);  
            write ('Цена оптовая ->');
            readLn (cena.opt);  
          end;
        addItem:=_buf;
End;



Соответственно используя эту функцю первый пункт меню будет выглядеть так:

Code Sample:
 
1: begin
      clrScr;
      reWrite (fil1);
      writeLn ('Сколько записей добавите ->');
      readLn (n);
      clrScr;
      for i:=1 to n do
       write (fil1, addItem);
      close (fil1)
   end;



Далее, необходимо вывести все на экран. Опят же выводить все в частности одним куском кода не удобно, поэтому создадим новую процедуру, которая будет выводить на экран соответствующую запись:

Code Sample:
 
{выводит на экран элемент файла}
procedure showItem (item: sap);
Begin
       with sap do
         writeLn (firm:10, adres:10, tovar:10, cena.rozn:5, cena.opt:5);
End;


Тут я оговорил следующее, что под имя товара, адрес и название фирмы отводится по 10 симовлов и по пять на цены. Соответственно все они будут выводиться жестко. Сделай еще процедуру, которая выводит так же шапку. Можно обыкновенными пробелами заполнить. Просто это не суть кода.

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

Code Sample:
 
function tryResetFile (var f: file of sap): boolean;
Begin
    {$I-}
     reset(f);
    {$I+}
     if IOResult<>0
       then tryResetFile:=false {открыт с ошибкой}
       else tryResetFile:=true   {открыт удачно}
End;



Тогда пункт 2 твоей задачи можно представить так:

Code Sample:
 
2: begin
    clrScr;
    if tryResetFile
       then
        begin
          {рисуешь здесь шапку сама}
          while not eof(fil1) do
            begin
               read (fil1, per); {читаем}
               showItem (per) {выводим на экран}
            end;
        end
       else writeLn ('Ошибка чтения файла!');
    close (fil1);  
   end;



Чтобы организовать просмотр по наименованию товара используй следующий код (не знаю каким пунктом ты его сделаешь).

Code Sample:
 
  write ('Введите наименование товара->');
  readLn (_findStr); {_findStr: string [10]; строка для поиска}
  if tryResetFile
     then
      begin
          {рисуешь здесь шапку сама}
          while not eof(fil1) do
            begin
               read (fil1, per); {читаем}
               if per.tovar=_findStr {если товар совпадает с введенным наименованием}
                  then showItem (per) {выводим на экран}
            end;
        end
       else writeLn ('Ошибка чтения файла!');
    close (fil1);


Как видно ничего сложного в этом нет.

Осталась только процедура сортировки.

Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 30 нояб. 2007 14:02 | IP
KMA



Долгожитель

Вот тут был похожий пример только с машинами.  

Можно сортировать как и на прямую с файлами, так и использую промежуточный массив. Я напишу только те моменты, на которые нужно обратить внимание:

Code Sample:
 
procedure sortInFileByCost(var f: file of sap);
var _bufArray: array [1..100] of sap;
     _buf: sap;
     n, i, j: byte;  
Begin
      if not tryResetFile (f)
         then
           begin
             write ('Ошибка чтения файла!');
              close (f);
              exit; {выходим из процедуры}
           end;
      {заполняем массив значениями}
      n:=1;
      while not eof (f) do
        begin
          read (f, _buf);
          _bufArray[ n ]:=_buf;
          n:=n+1;
        end;
      n:=n-1; {последнее значение не в счет}
      close (f);

      {пузырьковая сотировка}
      for i:=1 to n-1 do
       for j:=i to n-1 do  
        if _bufArray[ j ].cena.rozn>_bufArray[ j +1 ].cena.rozn
           begin
             _buf:=_bufArray[j];
             _bufArray[j]:=_bufArray[j+1];
             _bufArray[j+1]:=_buf
           end;  
      {осталось записать весь массив в файл}
      rewrite (f);
      for i:=1 to n do
       write (f, _bufArra[ i ]);
      close (f)
End;



Вот и теперь пожалуй точно все. Остальное дело украшения проги, но это уже тебе делать, мне муторная часть не интересна.

(Сообщение отредактировал KMA 30 нояб. 2007 14:24)

Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 30 нояб. 2007 14:19 | IP
KMA



Долгожитель


Мне кажется, что эта програмка может быть представлена так: мы вводим размер поля 2nх2n,размер фишки(const).делаем проверку и показываем,что такими фишками покрыть нельзя. Для обьема может какие-то графические элементы туда вставить...
Вообще меня эта задача повергла в шок, даже не знаю,чем так преподу насолила(((



А ты знаешь в чем состоит проверка? Лично мне на ум приходит только перебор. А ты теперь представь, сколько вариантов надо перебрать, чтобы показать все это? Я бы понял, если бы тебе задали задачу ПОКАЗАТЬ решение. Я не представляю, если честно как это должно выглядеть, в смысле, чтобы это что-то выводило и как?

Тут даже комбинаторными формулами не вывести сколько здесь возможных варинатов, тем более с учетом симметричности!

Давай так, вначале поставим задачу, а потом ее начнем решать... Итак, как ты думаешь, что должна выводить программа и как это вообще выглядит (ты же не начнешь делать стулик даже не представляя как он выглядит?! Так же и с программой).

Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 30 нояб. 2007 14:34 | IP
nia



Новичок

illegal expression---что это за ошибка,т.е. в результате чего она образуется?

Всего сообщений: 7 | Присоединился: ноябрь 2007 | Отправлено: 30 нояб. 2007 19:23 | IP
KMA



Долгожитель

В BP там косяки с этим делом... в общем суть в том, чтобы вместо:
Code Sample:
 
functifon ... (f: file of sap);



необходимо создать тип:
Code Sample:
 
type
   fileOfSap: file of sap;



и тогда все файлы в заголовках процедур и функций объявлять следующим образом:
Code Sample:
 
function/procedure ... (f: fileOfSap)



Попробуй так, проблема должна решиться.

Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 1 дек. 2007 8:28 | IP
nia



Новичок

у меня 3 ошибки в одной строке...можно я покажу,что я у меня получилось?..просто других ошибок он не показывает,а эту я не понимаю...возможно,я не правильно задала процедуру...

Всего сообщений: 7 | Присоединился: ноябрь 2007 | Отправлено: 1 дек. 2007 16:44 | 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 ]

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