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
|
|
|