BMSTU Delphi Variant 22

МОСКОВСКИЙ ГОСУДАРСТВЕННЫЙ ТЕХНИЧЕСКИЙ УНИВЕРСИТЕТ

ИМ. Н.Э. БАУМАНА

Отчет

По предмету:

«Введение в Программирование»

Вариант 22

Слушатель 2-го

высшего образования Родин Андрей Сергеевич

Вариант 22

Задания по Темам 1 и 2 выдаются преподавателем на занятии. Тема 3. Программирование разветвляющегося вычислительного процесса.

А. Даны вещественные числа X и Y. Определить принадлежит ли точка с координатами (X,Y) заштрихованной части плоскости. Протестировать все ветви алгоритма.

Б. Даны действительные числа x и y. Вычислить f(x,y):

f x yx y xy

y x

x yx yx y

( , ),

,,

;;.

=− +

− +

⎧

⎨⎪

⎩⎪

<=>

2

3

20

2 1

приприпри

Протестировать все ветви алгоритма. Тема 4. Программирование циклического процесса. Типы циклов.

A. Рассмотреть решение предложенной задачи с использованием всех трех видов циклов. Отладить программу с наиболее рациональным вариантом цикла. Обосновать выбор. Определить количество цифр в записи целого неотрицательного числа.

Б. Решить задачу, организовав итерационный цикл с точностью ξ=10-4, 10-5.

- 2 -

xВычислить значение определенного интеграла методом прямоугольников: . Точное

значение:

x x dsin 2

0

1

∫12 1 1(cos ).− Определить, как изменяется число итераций при изменении точности

Тема 5. Массивы. Организация ввода вывода. Строки. А. Написать программу на обработку одномерного массива. Дан вещественный массив из 45 элементов. Преобразовать массив следующим образом: сначала вывести все положительные числа, затем все отрицательные и в конце - нули.

Б. Решить поставленную задачу, используя средства управления вводом/выводом Турбо Паскаля. Дан массив размером N*N, каждый элемент которого - символ *. Вывести только главную и побочную диагонали массива.

Тема 6. Генерация случайных последовательностей чисел. ”Тест”. Составить тест из 10 вопросов по любой теме. Играющий должен ответить на все 10

вопросов, причем они должны появляться в случайном порядке и не повторяться. Программа должна обладать двумя списками реплик на ответы игрока: реплики-поощрения при правильных ответах и реплики-сожаления при неправильных ответах. Выбор реплики из каждого списка также должен быть случайным.

Тема 7. Матрицы. Дана символьная матрица S(6,6). Определить номера тех столбцов матрицы, которые содержат хотя

бы два одинаковых символа. Тема 8. Множества.

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

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

- 3 -

Тема 9. Подпрограммы. Средства отладки Delphi. Решить задачу, используя процедуру или функцию. Выбор обосновать. На примере полученной программы продемонстрировать умение: 1) назначать точку останова; 2) пошаговое выполнение программы с заходом в процедуры и без захода; 3) определять значения переменных.

Дана целочисленная матрица размера N*M. Преобразовать ее, переставив строки в порядке возрастания их наименьших элементов. Тема 10. Создание модулей. Процедурный тип. Нетипизированные параметры.

Разработать модуль, содержащий указанные процедуры и функции. Написать тестирующую программу.

1. Составить подпрограмму-процедуру KOR отыскания максимального отрицательного корня уравнения f(x)=0 c точностью 0.1

В основной программе использовать процедуру для решения уравнений -x2+sin(x/2)=1 и x5+3x3+x2+1=0

2. Составить подпрограмму, определяющую количество различных элементов под побочной диагональю матрицы N*N, и использовать ее для матрицы, состоящей из случайных чисел.

Указание. Использовать нетипизированные параметры. Тема 11. Рекурсия.

Составить программу, используя рекурсивную процедуру (функцию). Используя рекурсию, вывести на экран рисунок:

+++++++++ (9 раз) - - - - - - - - - - - (11 раз) . . . +++++++ . . . . . . . . .++++++ (21 раз) - - - - - - - . . . . . . - - - - - (19 раз) . . . +++++++++ (9 раз) Тема 12. Динамические структуры данных. Списки.

С клавиатуры вводится последовательность вещественных чисел x1, x2, x3... xn n>2. Вывести вначале все отрицательные, а затем неотрицательные, причем порядок отрицательных чисел изменить на обратный.

Тема 13. Файловая система. Задан файл F, состоящий из записей. Каждая запись содержит название книги, автора и год

издания. Переписать в файл G все названия книг в обратном порядке. Тема 14. Простые объекты.

Описать объект, включающий заданные поля и методы. Написать программу, которая создает массив объектов и список объектов и содержит процедуры, работающие с указанными структурами.

Объект - квартира. Параметры: площадь и стоимость. Методы: конструктор и процедура, которая определяет стоимость одного метра. Определить какие квартиры из предложенных, имеют стоимость метра меньше заданной. Реализовать два варианта (с массивом и списком).

Тема 15. Выдается на занятии преподавателем

Тема 16. Записи. Типизированные файлы. Создание меню с использованием классов VCL. Сведения о товарах представлены наименованием каждого товара, ценой, объемом партии, датой

поступления. Программа должна в интерактивном режиме воспринимать каждый из перечисленных вопросов и давать на него ответ.

1. Определять, какие товары поступали начиная с указанной даты. 2. Определять, какой товар имеет наибольшую стоимость партии. 3. Определять даты поступления и наименования товаров, объемы партий которых не меньше

заданного значения. Получить общую стоимость партий этих товаров.

Тема 3. Программирование разветвляющегося вычислительного процесса. А. Даны вещественные числа X и Y. Определить принадлежит ли точка с координатами (X,Y) заштрихованной части плоскости. Протестировать все ветви алгоритма.

Listing 3a { ;--------------------------------------------------------------- ; Program Name: theme3a from variant22 ; Program Description: Программа Вычисляет принадлежность точки заштрихованной части плоскости ; Author: Rodin Andrey ; Date Created: 01.12.2008 ; Last Modification Date: 02.12.2008 ;--------------------------------------------------------------- } program theme3a; {$APPTYPE CONSOLE} uses SysUtils; var x,y:real; chose:char; label repeate; begin repeate: writeln('Please type X and Y'); Readln (x,y); if (x*y>=0) and (x<=sqrt(1-y*y)) then writeln ('Success') else writeln ('Sucks'); writeln('PRESS Y to REPEATE or ANY KEY to EXIT'); readln(chose); if (chose = 'Y') or (chose = 'y') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

- 4 -

result

Тема 3. Программирование разветвляющегося вычислительного процесса. Б. Даны действительные числа x и y. Вычислить f(x,y):

f x yx y xy

y x

x yx yx y

( , ),

,,

;;.

=− +

− +

⎧

⎨⎪

⎩⎪

<=>

2

3

20

2 1

приприпри

Протестировать все ветви алгоритма.

Listing 3b { ;---------------------------------------------------------------------- ; Program Name: theme3b from variant22 ; Program Description: Программа Вычисляет математические выражения ; Author: Rodin Andrey ; Date Created: 02.12.2008 ; Last Modification Date: 02.12.2008 ;---------------------------------------------------------------------- } program theme3b; {$APPTYPE CONSOLE} uses SysUtils; var funk,x,y:word; chose:char; label repeate; begin repeate: funk := 0; writeln('Please type X and Y'); Readln (x,y);

- 5 -

if (x=y) then begin funk := 0; writeln ('x=y') end; if (x<y) then begin funk:=x*x-2*y+x*y; writeln ('x<y') end; if (x>y) then begin funk:=y*y*y-2*x+1; writeln ('x>y') end; writeln('*************************************'); write('RESULT '); writeln(funk); writeln('*************************************'); writeln('PRESS Y to REPEATE or ANY KEY to EXIT'); readln(chose); if (chose = 'Y') or (chose = 'y') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

result

- 6 -

Тема 4. Программирование циклического процесса. Типы циклов. A. Рассмотреть решение предложенной задачи с использованием всех трех видов циклов. Отладить программу с наиболее рациональным вариантом цикла. Обосновать выбор. Определить количество цифр в записи целого неотрицательного числа. Алгоритм:

- 7 -

- 8 -

Листинг 4а: { ;---------------------------------------------------------------------- ; Program Name: theme4a from variant22 ; Program Description: Программа Вычисляет математические выражения ; Author: Rodin Andrey ; Date Created: 02.12.2008 ; Last Modification Date: 02.12.2008 ;---------------------------------------------------------------------- } program theme4a; {$APPTYPE CONSOLE} uses SysUtils; var k,x:integer; i:real; chose:char; label repeate; begin repeate: k:=0; x:=0; i:=0; writeln('Please type Any INTEGER UNSICNED NUMERIC DATA'); readln(x); i:=x; repeat i:=i/10; k:=k+1; until (i<=1); writeln('*************************************'); write ('ARE YOU TYPED: '); writeln (x); write ('WHIS WORD INCLUDE: '); write (k); writeln (' SYMBOL''S'); writeln('*************************************'); writeln('PRESS Y to REPEATE or ANY KEY to EXIT'); readln(chose); if (chose = 'Y') or (chose = 'y') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

Результат:

- 9 -

Тема 4. Программирование циклического процесса. Типы циклов. Б. Решить задачу, организовав итерационный цикл с точностью ξ=10-4, 10-5.

- 10 -

xВычислить значение определенного интеграла методом прямоугольников: . Точное

значение:

x x dsin 2

0

1

∫12 1 1(cos ).− Определить, как изменяется число итераций при изменении точности

begin

while((Cos(1)-1))/2 <= res do

Iteracii1:=0;Iteracii2:=0;res:=0;x:=eps1;

End

res:=x*SIn(x*x);x:=x+eps1;iteracii1:=iteracii1+1;

Xiteracii1

while((Cos(1)-1))/2 <= res do

res:=0;x:=eps1;

res:=x*SIn(x*x);x:=x+eps2;iteracii1:=iteracii2+2;

Xiteracii2

- 11 -

Листинг 4b { ;---------------------------------------------------------------------- ; Program Name: theme4b from variant22 ; Program Description: Программа Вычисляет Значение определенного ; интеграла методом прямоугольников ; Program Status: Working ; Author: Rodin Andrey ; Date Created: 19.05.2008 ; Last Modification Date: 19.05.2008 ;---------------------------------------------------------------------- } program theme4b; {$APPTYPE CONSOLE} uses SysUtils; var eps1:real=0.0001; eps2:real=0.00001; y,x:real; Iteracii1, Iteracii2 :integer; res:real; begin Iteracii1:=0; Iteracii2:=0; res:=0; x:=eps1; while ((Cos(1)-1))/2 <= res do begin res:=x*SIn(x*x); x:=x+eps1; iteracii1:=iteracii1+1; end; writeln('eps1 = 0.0001'); write('Znachenie X '); writeln(x:2:2); write('Kolichestvo Iteracii '); writeln(iteracii1); writeln(''); writeln(''); writeln(''); res:=0; x:=eps2; while ((Cos(1)-1))/2 <= res do begin res:=x*SIn(x*x); x:=x+eps2; iteracii2:=iteracii2+1; end; writeln('eps1 = 0.00001'); write('Znachenie X '); writeln(x:2:2); write('Kolichestvo Iteracii '); writeln(iteracii2); readln; end.

- 12 -

Тема 5. Массивы. Организация ввода вывода. Строки. А. Написать программу на обработку одномерного массива. Дан вещественный массив из 45 элементов. Преобразовать массив следующим образом: сначала вывести все положительные числа, затем все отрицательные и в конце - нули.

Алгоритм:

b[i]<0

begin

i:=1,Size

a[i]:=random(9)-3

b:=am:=0

i:=1,Size

m:=m+1; b[m]:=b[i]

true False

randomize

n:=0;

a[i]>0

i:=1,Size

n:=n+1; a[n]:=a[i]

true False

k:=0; i:=1; j:=1;

(i<=n)and(j<=m)

if a[i]>b[j]

k:=k+1;c[k]:=a[i];

i:=i+1

true k:=k+1;c[k]:=b[j];

j:=j+1

False

j:=j,m

k:=k+1;c[k]:=b[j]

i:=I,n

k:=k+1;k]:=a[i]

i:=I,Size

End

c[i]

A

A

B

B

- 13 -

- 14 -

Листинг 5а: { ;---------------------------------------------------------------------- ; Program Name: theme5a from variant22 ; Program Description: Программа Преобразовывает массив и выводит ; его элементы в порядке: положительные, отрицательные, нули. ; Program Status: It Working :) ; Author: Rodin Andrey ; Date Created: 02.12.2007 ; Last Modification Date: 31.01.2008 ;---------------------------------------------------------------------- } program theme5a; {$APPTYPE CONSOLE} uses SysUtils; const Size=45; type mass = array [0..Size] of integer; var a,b,c:mass; i,j,k,m,n:integer; chose:char; label repeate; begin repeate: writeln('******************************************************************'); writeln('NOW WE HAVE A RANDOMIZER ARRAY'); randomize; for i:=1 to Size do begin a[i]:=random(9)-3; write (a[i]); write (' '); end; writeln; writeln('******************************************************************'); // Создаем Массив Состоящий Исключительно из Отрицательных чисел writeln; b:=a; m:=0; for i:=1 to Size do begin if b[i]<0 then begin m:=m+1;

- 15 -

b[m]:=b[i] end; end; // Создаем Массив Состоящий Исключительно из Положительных чисел n:=0; for i:=1 to Size do begin if a[i]>0 then begin n:=n+1; a[n]:=a[i] end; end; // Выводим Массивы на Экран writeln(' '); writeln('NEW ARRAY OF UNSIGNED DATA'); for i:=1 to n do begin write (a[i]); write (' '); end; writeln(''); writeln('');writeln(''); writeln('NEW ARRAY OF SIGNED DATA'); for i:=1 to m do begin write (b[i]); write (' '); end; //Собираем 2 массива в 1 новый k:=0; i:=1; j:=1; while (i<=n)and(j<=m)do if a[i]>b[j] then begin k:=k+1; c[k]:=a[i]; i:=i+1 end else begin k:=k+1; c[k]:=b[j]; j:=j+1 end; for i:=i to n do begin k:=k+1; c[k]:=a[i] end; for j:=j to m do begin k:=k+1; c[k]:=b[j] end; // Выводим результат на экран writeln(''); writeln('');writeln(''); writeln('RESULT :) I''m HAPPY !!!');

for i:=1 to Size do begin write (c[i]); write (' '); end; writeln; writeln('******************************************************************'); writeln; writeln; write (' ');write (' ');write (' '); writeln('---> PRESS "R" to REPEATE or ANY KEY to EXIT <---'); readln(chose); if (chose = 'R') or (chose = 'r') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end. Результат

- 16 -

Тема 5. Массивы. Организация ввода вывода. Строки. Б. Решить поставленную задачу, используя средства управления вводом/выводом Турбо Паскаля. Дан массив размером N*N, каждый элемент которого - символ *. Вывести только главную и побочную диагонали массива.

begin

for i := 0 to size

for j := 0 to size

if i=j

a[i,j]:='*';

true

for i := 0 to size

for j :=size

downto 0

if n=j

a[i,j]:='*';

true

n:= (size+1) - i;

i:=1 to size

for j:=1 to size

write (a[i,j])

End

A

A

- 17 -

- 18 -

{ ;---------------------------------------------------------------------- ; Program Name: theme5a from variant22 ; Program Description: Решить поставленную задачу, используя средства ; управления вводом/выводом Турбо Паскаля. Дан массив размером N*N, каждый ; элемент которого - символ *. Вывести только главную и по-бочную ; диагонали массива. ; Program Status: Working :) ; Author: Rodin Andrey ; Date Created: 15.05.2008 ; Last Modification Date: 15.05.2008 ;---------------------------------------------------------------------- } program theme5b; {$APPTYPE CONSOLE} uses SysUtils; const size = 17; type mass = array [1..size,1..size] of char; var a:mass; n:integer; i,j:integer; begin writeln; writeln('--------------------'); writeln('--PRINT NEW ARRAY---'); writeln('--------------------'); writeln(''); for i := 0 to size do for j := 0 to size do begin if i=j then a[i,j]:='*'; end; for i := 0 to size do begin n:= (size+1) - i; for j :=size downto 0 do begin if n=j then a[i,j]:='*'; end; end;

for i:=1 to size do begin for j:=1 to size do write (a[i,j]); writeln; end; readln; end.

Тема 6. Генерация случайных последовательностей чисел.

”Тест”. Составить тест из 10 вопросов по любой теме. Играющий должен ответить на все 10 вопросов, причем они должны появляться в случайном порядке и не повторяться. Программа должна обладать двумя списками реплик на ответы игрока: реплики-поощрения при правильных ответах и реплики-сожаления при неправильных ответах. Выбор реплики из каждого списка также должен быть случайным.

- 19 -

- 20 -

- 21 -

{ ;---------------------------------------------------------------------- ; Program Name: theme6 from variant22 ; Program Description: "Тест". Составить тест из 10 вопросов по любой теме. ; Играющий должен ответить на все 10 вопросов, причем они должны появляться ; в случайном порядке и не повторяться. Программа должна обладать двумя ; списками реплик на ответы игрока: реплики-поощрения при правильных ответах ; и реплики-сожаления при неправильных ответах. Выбор реплики из каждого ; списка также должен быть случайным. ; Author: Rodin Andrey ; Date Created: 26.01.2008 ; Program Status: IT Working ; Last Modification Date: 04.02.2008 ;---------------------------------------------------------------------- } program theme6; {$APPTYPE CONSOLE} uses SysUtils; const QuestionRight: array [1..4] of String = ( 'Absolutno Pravilno', 'Prabilno no Otvet Nepolny', 'Chasticno Pravilno', 'Pravilno' ); QuestionLeft: array [1..4] of String = ( 'Otvet Nevernij Sovsem', 'Glupij Otvet' , 'Otvet Soderzhit Oshibki', 'Otvet Nevernij' ); var i,f,l:integer; x:string[25]; counter:integer; a:array [1..2] of String; chose:char; Question: array [1..10] of String = ( 'Question 1', 'Question 2', 'Question 3', 'Question 4', 'Question 5', 'Question 6', 'Question 7', 'Question 8', 'Question 9', 'Question 10' ); label repeate; begin repeate:

- 22 -

randomize; counter:=(random(20)+5); randomize; repeat i:=1; f:=(random(10)+1); l:=(random(10)+1); a[i]:= Question[f] ; Question[f]:= Question[l]; Question[l]:=a[i]; counter:=counter-1; until (counter <=0); writeln ; writeln ; for i:=1 to 10 do begin write (Question[i]); writeln; end; writeln('******************************************************************'); writeln; for i:=1 to 10 do begin writeln ; writeln ; write (Question[i]); write (' '); write (' '); write ('---> '); write (' '); readln (x); if x='true' then Write (QuestionRight[(random(4)+1)]) else Write (QuestionLeft[(random(4)+1)]); end; writeln; writeln; writeln('******************************************************************'); writeln;writeln; write (' ');write (' ');write (' '); writeln('---> PRESS "R" to REPEATE or ANY KEY to EXIT <---'); readln(chose); if (chose = 'R') or (chose = 'r') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

- 23 -

.Тема 7. Матрицы.

Дана символьная матрица S(6,6). Определить номера тех столбцов матрицы, которые содержат хотя бы два одинаковых символа.

begin

End

randomize;

I:=1,Size

((a[i,j] = a[i+n,j]) and (i+n<=size)

j:=1,Size

a[i,j]:=char(random(9)+33);

I:=1,Size

j:=1,Size

write (a[i,j])

j:=1,Size

i:=1,Size

equal:=1;

n:=1;

i:=0,Size-1

equal:=equal+1;

n:=n+1;

equal >= 2

COLUMN {j} HAVE >= 2 EQUAL CHAR

true

False

True

A

A

{ ;---------------------------------------------------------------------- ; Program Name: theme7 from variant22 ; Program Description: Дана символьная матрица S(6,6). ; Определить номера тех столбцов матрицы, которые содержат хотя бы два ; одинаковых символа. ; Program Status: 04.02.2008 IT Working :) ; Author: Rodin Andrey ; Date Created: 02.02.2008 ; Last Modification Date: 05.05.2008

- 24 -

- 25 -

;---------------------------------------------------------------------- } program theme7; {$APPTYPE CONSOLE} uses SysUtils; const size = 6; type mass = array [1..size,1..size] of char; var chose:char; a:mass; i,j:integer; k,l,m,n:integer; equal:integer; label repeate; begin repeate: writeln; writeln('----------------------------------------------------'); writeln('----------------------------------------------------'); writeln('------------ WE HAVE ARRAY 6*6 of Char -------------'); writeln('----------------------------------------------------'); writeln('----------------------------------------------------'); writeln; writeln; randomize; for i:=1 to size do for j:=1 to size do a[i,j]:=char(random(9)+33); for i:=1 to size do begin write (' ');write (' ');write (' '); for j:=1 to size do begin write (' ');write (' '); write (a[i,j]); write (' '); write (' '); end; writeln; writeln; end; writeln; writeln('----------------------------------------------------'); writeln('----------------------------------------------------'); writeln('--- NOW RESULT WHERE COLUMN HAVE >= 2 EQUAL CHAR --'); writeln('----------------------------------------------------'); writeln('----------------------------------------------------'); writeln(' ');

- 26 -

for j:=1 to size do begin equal:=1; for i:=1 to size do begin n:=1; for l := 0 to size - 1 do begin if ((a[i,j] = a[i+n,j]) and (i+n<=size)) then begin equal:=equal+1; end; n:=n+1; end; end; if equal >= 2 then begin writeln; write('COLUMN '); write(j); write(' HAVE >= 2 EQUAL CHAR '); end; writeln; writeln; end; writeln; writeln; writeln; writeln; //Repeate this Program write(' '); write(' ');write(' '); write('>>>>>> '); write('PRESS R to REPEATE or ANY KEY to EXIT'); write(' '); write(' ');write(' '); write('<<<<<<< '); writeln (' '); readln(chose); if (chose = 'R') or (chose = 'r') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

- 27 -

Тема 8. Множества. Составить программу, используя множественный тип. Дана не пустая последовательность слов из строчных букв русского алфавита: слова разделены

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

begin

ZvonkieSogl := ['б', 'в', 'г', 'д', 'ж',

'з'];

A

A

temp:=a[k];StringLength:=Length(temp);

readln(InputString);

StringLength:=Length(InputString);

i:=1;j:=1;n:=1;

temp:=' ';temp1:=temp;

i := 1, StringLength

InputString[i]=' ') or (InputString[i] = '!'

a[j]:=temp;j:=j+1;

n:=1;temp:=temp1;

temp[n]:= InputString[i]; n:=n+1;

truefalse

j:=j-1;

i:= 1, j

Word {i} {a[i]}

k:=1; m:=1;

be:=0;ve:=0;ge:=0;de:=0;dge:=0;ze:=0;

be1:=0;ve1:=0;ge1:=0;de1:=0;dge1:=0;ze1:=0;

k := 1,j

B

- 28 -

B

temp:=a[k];StringLength:=Length(temp);

i:= 1, j

Word {i} {a[i]}

k:=1; m:=1;

be:=0;ve:=0;ge:=0;de:=0;dge:=0;ze:=0;

be1:=0;ve1:=0;ge1:=0;de1:=0;dge1:=0;ze1:=0;

k := 1,j

m:= 1, StringLength

if temp[m] in ZvonkieSogl

((temp[m]='Ў')and (be=0))

be:=be+1;

((temp[m]='ў') and (ve=0))

ve:=ve+1;

((temp[m]='Ј') and (ge=0))

ge:=ge+1;

((temp[m]='¤') and (de=0))

de:=de+1;

((temp[m]='¦') and (dge=0))

dge:=dge+1;

((temp[m]='§') and (ze=0))

ze:=ze+1;

true

false

true

false

false

false

true

true

true

true

false

true

be1:=be1+be;ve1:=ve1+ve;ge1:=ge1+ge;de1:=de1+de;dge1:=dge1+dge;ze1:=ze1+ze;

be:=0;ve:=0;ge:=0;de:=0;dge:=0;ze:=0;

Result

C

C

D

- 29 -

- 30 -

- 31 -

{ ;---------------------------------------------------------------------- ; Program Name: theme8 from variant22 ; Program Description: Составить программу, используя множественный тип. ; Дана не пустая последовательность слов из строчных букв русского алфавита: ; слова разделены пробелами, за последним словом следует восклицательный знак. ; Вывести в алфавитном порядке все звонкие согласные, которые входят более чем в одно слово. ; Author: Rodin Andrey ; Program Status: ItWorking ; Date Created: 07.05.2008 ; Last Modification Date: 07.05.2008 ;---------------------------------------------------------------------- } program theme81; {$APPTYPE CONSOLE} uses SysUtils; const size = 10; type RussianWord = set of ' '..'п'; mass = array [1..size] of string; var chose:char; InputString:string; temp,temp1:string[10]; be,ve,ge,de,dge,ze:integer; be1,ve1,ge1,de1,dge1,ze1:integer; StringLength:integer; ZvonkieSogl : RussianWord; a:mass; i,j:integer; k,l,m,n:integer; equal:integer; label repeate; begin repeate: ZvonkieSogl := ['Ў', 'ў', 'Ј', '¤', '¦', '§']; writeln; writeln('----------------------------------------------------'); writeln('----------------------------------------------------'); writeln('------------ ‡ў®-ЄЁҐ ‘®Ј« б-лҐ ---------------------'); writeln('---------- "Ў", "ў", "Ј", "¤","¦", "§" ------------'); writeln('----------------------------------------------------'); writeln; writeln; writeln; writeln('----------------------------------------------------');

- 32 -

writeln('----------------------------------------------------'); writeln('------------ PLEASE TYPE ANY WORD ------------------'); writeln('----------------------------------------------------'); writeln('----------------------------------------------------'); writeln; writeln; readln(InputString); Writeln('YOU TYPED '); Writeln; Writeln(InputString); StringLength:=Length(InputString); i:=1; j:=1; n:=1; // создаем переменную. Приходится назвать, т.к. иначе ошибка temp:=' '; temp1:=temp; // Записываем в массив все то что было введено с клавиатуры for i := 1 to StringLength do begin if (InputString[i]=' ') or (InputString[i] = '!') then begin a[j]:=temp; j:=j+1; n:=1; temp:=temp1; end; temp[n]:= InputString[i]; n:=n+1; end; j:=j-1; writeln;writeln;writeln; for i := 1 to j do begin write (' Word ') ; write (i) ; write (' ') ; write (a[i]) ; writeln; end; k:=1; m:=1; be:=0;ve:=0;ge:=0;de:=0;dge:=0;ze:=0; be1:=0;ve1:=0;ge1:=0;de1:=0;dge1:=0;ze1:=0; for k := 1 to j do begin temp:=a[k]; StringLength:=Length(temp); for m := 1 to StringLength do begin // Проверка каждого символа на принадлежность к множеству

- 33 -

if temp[m] in ZvonkieSogl then begin if ((temp[m]='Ў') and (be=0)) then be:=be+1; if ((temp[m]='ў') and (ve=0))then ve:=ve+1; if ((temp[m]='Ј') and (ge=0)) then ge:=ge+1; if ((temp[m]='¤') and (de=0)) then de:=de+1; if ((temp[m]='¦') and (dge=0))then dge:=dge+1; if ((temp[m]='§') and (ze=0)) then ze:=ze+1; end; end; be1:=be1+be;ve1:=ve1+ve;ge1:=ge1+ge;de1:=de1+de;dge1:=dge1+dge;ze1:=ze1+ze; be:=0;ve:=0;ge:=0;de:=0;dge:=0;ze:=0; end; writeln; writeln('----------------------------------------------------'); writeln('----------------------------------------------------'); writeln('---------------------- ђҐ§г«мв вл ------------------'); writeln('----------------------------------------------------'); writeln('----------------------------------------------------'); writeln(' '); // Выводим на Экран звонкие в алфавитном порядке если их встретилось более 2 if be1>=2 then begin write(' '); write(' '); write('Ў'); write(' '); write(' '); end; if ve1>=2 then begin write(' '); write(' '); write('ў'); write(' '); write(' '); end; if ge1>=2 then begin write(' '); write(' '); write('Ј'); write(' '); write(' '); end; if de1>=2 then begin write(' '); write(' '); write('¤'); write(' '); write(' '); end; if dge1>=2 then begin write(' '); write(' '); write('¦'); write(' '); write(' '); end;

if ze1>=2 then begin write(' '); write(' '); write('§'); write(' '); write(' '); end; writeln; writeln; writeln; writeln; //Repeate this Program write(' '); write(' ');write(' '); write('>>>>>> '); write('PRESS R to REPEATE or ANY KEY to EXIT'); write(' '); write(' ');write(' '); write('<<<<<<< '); writeln (' '); readln(chose); if (chose = 'R') or (chose = 'r') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

- 34 -

Тема 9. Подпрограммы. Средства отладки Delphi. Решить задачу, используя процедуру или функцию. Выбор обосновать. На примере полученной программы продемонстрировать умение: 4) назначать точку останова; 5) пошаговое выполнение программы с заходом в процедуры и без захода; 6) определять значения переменных.

Дана целочисленная матрица размера N*M. Преобразовать ее, переставив строки в порядке возрастания их наименьших элементов.

begin

randomize;

I:=1,rows

j:=1,cols

a[i,j]:=random(9);

(((MinColsResult(n) > MinColsResult(n+1)) and

(n+1 <= rows)))

A

A

I:=1,rows

j:=1,cols

a[i,j]

n:=1;

I:=1,rows

Minimalniy Element {n} Stroki –

{MinColsResult(n)}

n:=n+1countet:=rows;

Repeatcountet =

0

I:=1,rows

n:=1;

b[i]:= a[i+1]; a[i+1]:= a[i]; a[i]:= b[i];

n:=n+1

true fasle

countet:= countet-1;

n:=1

B

- 35 -

I:=1,rows

Minimalniy Element {n} Stroki –

{MinColsResult(n)}

n:=n+1

I:=1,rows

j:=1,cols

a[i,j]

End

B

k:=10;

BeginMinColsResult

j:=1,cols

a[n,j] < k

k:=a[n,j];

true

MinColsResult:=k

End

false

{ ;---------------------------------------------------------------------- ; Program Name: theme9 from variant22 ; Program Description: Дана целочисленная матрица размера N*M. ; Преобразовать ее, переставив строки в порядке возрастания их ; наименьших элементов. ; Program Status: IT Working :) 03.02.2008 ; Author: Rodin Andrey ; Date Created: 02.02.2008 ; Last Modification Date: 07.02.2008 ;---------------------------------------------------------------------- } program theme9; {$APPTYPE CONSOLE} uses SysUtils; const

- 36 - rows = 15;

- 37 -

cols = 10; type mass = array [1..rows,1..cols] of integer; var chose:char; a,b:mass; i,j:integer; k,n,m,countet:integer; function MinColsResult (n: integer): integer; begin {MinColsResult} k:=10; for j:=1 to cols do begin if a[n,j] < k then k:=a[n,j]; end; MinColsResult:=k; end {MinColsResult}; label repeate; begin repeate: writeln; writeln; writeln('---------------------'); writeln('--WE HAVE ARRAY N*M--'); writeln('---------------------'); writeln; randomize; for i:=1 to rows do for j:=1 to cols do a[i,j]:=random(9); for i:=1 to rows do begin for j:=1 to cols do begin write (a[i,j]); write (' '); end; writeln; end; writeln; writeln; writeln('----------------------------------------'); writeln('--Paspechataem Minimalnie Elementi -----'); writeln('----------------------------------------'); writeln; n:=1; for i:=1 to rows do begin write(' Minimalniy Element '); write(n); write (' Stroki - '); writeln(MinColsResult(n)); n:=n+1 end;

- 38 -

countet:=rows; repeat n:=1; for i:=1 to rows do begin if (((MinColsResult(n) > MinColsResult(n+1)) and (n+1 <= rows))) then begin b[i]:= a[i+1]; a[i+1]:= a[i]; a[i]:= b[i]; end; n:=n+1; end; countet:= countet-1; until countet = 0; writeln;writeln;writeln; // Выводим значения минимальных элементов каждой строки writeln('----------------------------------------'); writeln('------------ Sorting Rows -------------'); writeln('----------------------------------------'); writeln; n:=1; for i:=1 to rows do begin write(' Minimalniy Element '); write(n); write (' Stroki - '); writeln(MinColsResult(n)); n:=n+1 end; writeln;writeln; // Выводим результат внесения изменений writeln('----------------------------------------'); writeln('---------------Result-------------------'); writeln('----------------------------------------'); writeln; for i:=1 to rows do begin for j:=1 to cols do begin write (a[i,j]); write (' '); end; writeln; end; writeln; writeln; //Repeate this Program writeln('PRESS R to REPEATE or ANY KEY to EXIT'); readln(chose); if (chose = 'R') or (chose = 'r') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

- 39 -

- 40 -

Тема 10. Создание модулей. Процедурный тип. Нетипизированные параметры. Разработать модуль, содержащий указанные процедуры и функции. Написать тестирующую

программу. 1. Составить подпрограмму-процедуру KOR отыскания максимального отрицательного корня

уравнения f(x)=0 c точностью 0.1 В основной программе использовать процедуру для решения уравнений -x2+sin(x/2)=1 и

x5+3x3+x2+1=0

begin

Max Otricatelniy Koren Uravneniya -x2+sin(x/2)=1

Uravnenie1(-0.1):0:2)

End

BeginUravnenie1

while (-(x*x)+Sin(x/2)-1)<>0

(-(x*x)+Sin(x/2)-1) < 0.1

Break

x:=x-0.1;x:=round(x*10)/10;

true

false

End

Listing theme10a.dpr { ;---------------------------------------------------------------------- ; Program Name: theme10a from variant22 ; Program Description: Составить подпрограмму-процедуру KOR отыскания ; максимального отрицательного корня уравнения f(x)=0 c точностью 0.1 ; В основной программе использовать процедуру для решения уравнений ; -x2+sin(x/2)=1 и x5+3x3+x2+1=0 ; Program Status: Not Working :) ; Author: Rodin Andrey ; Date Created: 23.05.2008 ; Last Modification Date: 23.05.2008 ;---------------------------------------------------------------------- } program theme10a;

- 41 -

- 42 -

{$APPTYPE CONSOLE} uses SysUtils, Module_theme10a in 'Module_theme10a.pas'; begin Writeln('Max Otricatelniy Koren Uravneniya -x2+sin(x/2)=1 ');

Writeln(Uravnenie1(-0.1):0:2); Writeln;Writeln; Writeln('Max Otricatelniy Koren Uravneniya x5+3x3+x2+1=0 ');

Write(Uravnenie2(-0.1):0:2); readln; end.

Listing Module_theme10a.pas

// ************************************************************************* Unit Module_theme10a; ***************************************************************************** {---------------------------------------------------------------------} Interface {---------------------------------------------------------------------} function Uravnenie1 (x:real):real; function Uravnenie2 (x:real):real; {---------------------------------------------------------------------} Implementation {---------------------------------------------------------------------} function Uravnenie1 (x:real):real; begin while (-(x*x)+Sin(x/2)-1)<>0 do begin if (-(x*x)+Sin(x/2)-1) < 0.1 then Break; x:=x-0.1; x:=round(x*10)/10; end; Uravnenie1:=x; end; function Uravnenie2 (x:real):real; begin while (x*x*x*x*x+3*(x*x*x)+x*x+1) <>0 do begin if (x*x*x*x*x+3*(x*x*x)+x*x+1) < 0.1 then Break; x:=x-0.1; x:=round(x*10)/10; end; Uravnenie2:=x; end; End.

Result

- 43 -

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

диагональю матрицы N*N, и использовать ее для матрицы, состоящей из случайных чисел. Указание. Использовать нетипизированные параметры.

begin

End

for i:=1 to N

for j:=1 to N

a[i,j]:=random(9);

for i:=1 to N

for j:=1 to N

(a[i,j])

Unicum ;

(a[i,j])

- 44 -

BeginUnicum

i+j>N+1

EndUnicum

q:=1;

for i:=1 to N

for j:=1 to N

b[q]:=a[i,j];q:=q+1;

for i := 1 to q -1

b[i]

counter:=q*(q-1);

Repeat Until counter=0

for I := 1 to q - 1

((b[i]>= b[i+1]) and (i+1<=q-1))

d[i]:=b[i]; b[i]:=b[i+1]; b[i+1]:=d[i];

counter:= counter - 1;

for i := 1 to q -1

b[i])

x:=1;

for i := 1 to q -1

b[i] <> b[i+1]

d[x]:= b[i]; x:=x+1;

b[i]

UNICUM (x-1) ELEMTNTA

A

A

- 45 -

- 46 -

Listing theme10b.dpr

{ ;---------------------------------------------------------------------- ; Program Name: theme10b from variant22 ; Program Description: Составить подпрограмму, определяющую количество ; различных элементов под побочной диагональю матрицы N*N, и использовать ; ее для матрицы, состоящей из случайных чисел. ; Указание. Использовать нетипизированные параметры. ; Program Status: IT Working :) ; Author: Rodin Andrey ; Date Created: 08.02.2008 ; Last Modification Date: 08.02.2008 ;---------------------------------------------------------------------- } program theme10b; {$APPTYPE CONSOLE} uses SysUtils; const N = 6; M = n*n; type mass = array [1..N,1..N] of integer; mass2 = array [1..M] of integer; var chose:char; counter:integer; a:mass; b,c,d:mass2; i,j,q,l,s,x:integer; procedure Unicum ; begin {Unicum} q:=1; for i := 1 to N do begin for j := 1 to n do begin if i+j>N+1 then begin b[q]:=a[i,j]; q:=q+1; end; end; end; writeln; writeln; for i := 1 to q -1 do begin write(' '); write( b[i]); write(' '); end;

- 47 -

writeln; writeln; writeln('-----------------------------------------------------'); writeln('------------------ Sorting --------------------------'); writeln; counter:=q*(q-1); repeat for I := 1 to q - 1 do begin if ((b[i]>= b[i+1]) and (i+1<=q-1))then begin d[i]:=b[i]; b[i]:=b[i+1]; b[i+1]:=d[i]; end; end; counter:= counter - 1; until counter=0 ; for i := 1 to q -1 do begin write(' '); write( b[i]); write(' '); end; writeln; writeln; writeln('-----------------------------------------------------'); writeln('------------------ UNICALNIE ------------------------'); writeln; x:=1; for i := 1 to q -1 do begin if b[i] <> b[i+1] then begin write (' '); d[x]:= b[i]; x:=x+1; write (b[i]); write (' '); end; end; writeln; writeln;writeln; write ('UNICUM '); write (x-1); write (' ELEMTNTA '); end; {Unicum} label repeate;

- 48 -

begin repeate: writeln; writeln; writeln('---------------------'); writeln('--WE HAVE ARRAY N*M--'); writeln('---------------------'); writeln; randomize; for i:=1 to N do for j:=1 to N do a[i,j]:=random(9); for i:=1 to N do begin for j:=1 to N do begin write (a[i,j]); write (' '); end; writeln; end; writeln; writeln; writeln('-----------------------------------------------------'); writeln('-------------- Pod Pobochnoj ------------------------'); writeln('---------------- Diagonalju -------------------------'); writeln; Unicum ; writeln; writeln; writeln('PRESS R to REPEATE or ANY KEY to EXIT'); readln(chose); if (chose = 'R') or (chose = 'r') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

- 49 -

Тема 11. Рекурсия.

Составить программу, используя рекурсивную процедуру (функцию). Используя рекурсию, вывести на экран рисунок:

+++++++++ (9 раз) - - - - - - - - - - - (11 раз) . . . +++++++ . . . . . . . . .++++++ (21 раз) - - - - - - - . . . . . . - - - - - (19 раз) . . . +++++++++ (9 раз) Алгоритм

Листинг 11 { ;---------------------------------------------------------------------- ; Program Name: Тема 11. Рекурсия ; Program Description: Составить программу, используя рекурсивную процедуру (функцию). ; Используя рекурсию, вывести на экран рисунок: ; Program Status: ItWorking ; Author: Rodin Andrey ; Date Created: 16.05.2008 ; Last Modification Date: 16.05.2008 ;---------------------------------------------------------------------- } program theme11; {$APPTYPE CONSOLE} uses SysUtils; procedure ReCursia(Character: char; Length: integer); Begin {ReCursia} if Length-1>=0 then

- 50 -

- 51 -

begin write(character); Length:=Length-1; ReCursia(Character , Length); end; End; {ReCursia} begin writeln; writeln; ReCursia(' ' , 9); ReCursia('+' , 9); writeln; writeln; ReCursia(' ' , 8); ReCursia('-' , 11); writeln; writeln; ReCursia(' ' , 9); ReCursia('.' , 1); ReCursia(' ' , 3); ReCursia('.' , 1); ReCursia(' ' , 3); ReCursia('.' , 1); writeln; writeln; ReCursia(' ' , 4); ReCursia('+' , 5); ReCursia('.' , 9); ReCursia('+' , 5); writeln; writeln; ReCursia(' ' , 5); ReCursia('-' , 5); ReCursia('.' , 9); ReCursia('-' , 5); writeln; writeln; ReCursia(' ' , 9); ReCursia('.' , 1); ReCursia(' ' , 3); ReCursia('.' , 1); ReCursia(' ' , 3); ReCursia('.' , 1); writeln; writeln; ReCursia(' ' , 9); ReCursia('+' , 9); readln; end.

Результат:

- 52 -

Тема 12. Динамические структуры данных. Списки. С клавиатуры вводится последовательность вещественных чисел x1, x2, x3... xn n>2. Вывести

вначале все отрицательные, а затем неотрицательные, причем порядок отрицательных чисел изменить на обратный.

Алгоритм:

begin

Head := Nil

x^.tpel := Nil;x^.Data := Digit;

First := x ;

A

A

while Digit<>0

You Are Typed ZERO

NOW RESULT

Digit

if Digit <> 0

Digit

New(x^.tpel); x := x^.tpel;x^.tpel := Nil;x^.Data := Digit;

New(Pre);Pre^.Data := Digit;Pre^.tpel := First;

First := Pre;

Read(Digit);

true

if Digit > 0

true false

while First <>

Nil

First^.Data, ' '

First := First^.tpel;

End

false

- 53 -

- 54 -

Листинг: { ;---------------------------------------------------------------------- ; Program Name: Тема 12. Динамические структуры данных. Списки. ; Program Description: С клавиатуры вводится последовательность вещественных ; чисел x1, x2, x3... xn n>2. Вывести вначале все отрицательные, а затем ; неотрицательные, причем порядок отрицательных чисел изменить на обратный. ; Program Status: Working :) 10.02.2008 ; Author: Rodin Andrey ; Date Created: 10.02.2008 ; Last Modification Date: 10.02.2008 ;---------------------------------------------------------------------- } program theme12copy; {$APPTYPE CONSOLE} uses SysUtils; type index = ^element; element=record Data:integer; tpel:index; end; var digit: integer; chose: char; Head, {указатель на начало списка} x, y, First,Pre,Next,Last {вспомогательный указатель для создания очередного элемента списка} : index; label repeate; begin repeate: // создадим первый элемент writeln('----------------------------------------------------'); writeln('------------------- PLEASE -------------------------'); writeln('----------- TYPE ANY NUMERIC DATA ------------------'); Writeln ('---- IF You Typed Zero Program well be Closed ----'); Head := Nil; read(Digit);

- 55 -

if Digit <> 0 then {Формируем и вставляем первый элемент списка} Begin New(x); x^.tpel := Nil; x^.Data := Digit; First := x ; Read (Digit); End; while Digit<>0 do Begin if Digit>0 then begin New(x^.tpel); {Формируем и вставляем элемент в конец списка} x := x^.tpel; x^.tpel := Nil; x^.Data := Digit; end; if Digit < 0 then begin New(Pre); Pre^.Data := Digit; Pre^.tpel := First; First := Pre; end; Read(Digit); End; writeln; writeln; writeln('You Are Typed ZERO'); writeln('----------------------------------------------------'); writeln('NOW RESULT'); while First <> Nil do Begin Write(First^.Data, ' '); First := First^.tpel; End ; writeln; writeln; //Repeate this Program writeln('PRESS R to REPEATE or ANY KEY to EXIT'); readln(chose); if (chose = 'R') or (chose = 'r') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

Результат:

- 56 -

Тема 13. Файловая система. Задан файл F, состоящий из записей. Каждая запись содержит название книги, автора и год

издания. Переписать в файл G все названия книг в обратном порядке. Алгоритмы:

begin

i:=0;Assign (FBooks, 'f.txt');Assign (GBooks, 'g.txt');

- Please Type What You Want -- 1 - Insert ---------------- 2 - Read ------------------ 3 - Write ----------------- 4 - Sea Result -----------

x

You May Only type 1,2,3,4'

End

case x of

BeginAddNewRecord

BeginReadRecord

BeginWriteRecord

BeginSeaResultRecord

BeginAddNewRecord

'Input Book Name'

Books[i].BookName

'Input Book Author'

Books[i].Author

'Input Year'

Books[i].Year

reset(FBooks);Seek (FBooks, FileSize(Fbooks))

Write(FBooks, Books[i]);Close(FBooks);

EndAddNewRecord

- 57 -

BeginReadRecord

reset(FBooks);Seek (FBooks, 0);

while not Eof(Fbooks)

read (FBooks, Books[i]);

IOResult <> 0

'FileRecord Was Not be Read'write (Books[i].BookName);

write (Books[i].Author)write (Books[i].Year);

truefalse

i:=i+1 ;

EndReadRecord

Close(FBooks);

- 58 -

BeginWriteRecord

reset(FBooks);Seek (FBooks, 0);reset(GBooks);

Seek (GBooks, 0);rewrite(GBooks);

m:=1;

while not Eof(Fbooks)

read (FBooks, Books[i]);

IOResult <> 0

'FileRecord Was Not be Read'tempword1:= Books[i].BookName;

x:=length(tempword1);

NewBooks[m].NewName:=tempword3;Seek (GBooks, FileSize(GBooks));

Write(GBooks, NewBooks[m]);

tempword3:='';i:=i+1;m:=m+1;

for k := x downto 1

tempword2:= copy (tempword1,k,1);tempword3:= tempword3 + tempword2;

truefalse

Close(FBooks);Close(GBooks);

EndWriteRecord

- 59 -

{ ;---------------------------------------------------------------------- ; Program Name: Файловая система. theme13 from variant22 ; Program Description: Задан файл F, состоящий из записей. ; Каждая запись содержит название книги, автора и год издания. ; Переписать в файл G все названия книг в обратном порядке. ; Program Status: Working :) 24.02.2008 ; Author: Rodin Andrey ; Date Created: 02.02.2008 ; Last Modification Date: 05.05.2008 ;---------------------------------------------------------------------- } program theme13; {$APPTYPE CONSOLE} type Organizer = record

- 60 - BookName: String[60];

- 61 -

Author: String[20]; Year: Integer; end; NewOrganizer = record NewName: String[60]; end; const MAXRecord=100; var Books: array[1..MAXRecord] of Organizer; NewBooks: array[1..MAXRecord] of NewOrganizer; FBooks: file of Organizer; GBooks: file of NewOrganizer; FileRecords: Organizer; chose:char; i,x,k,m:integer; tempword1, tempword2, tempword3:String[60]; procedure AddNewRecord ; begin {AddNewRecord} writeln('Input Book Name'); Readln(Books[i].BookName); writeln('Input Book Author'); readLn(Books[i].Author); writeln('Input Year'); readLn(Books[i].Year); reset(FBooks); Seek (FBooks, FileSize(FBooks)); // Переходим к концу файла {$S-} Write(FBooks, Books[i]); {$S+} writeln;writeln;writeln;writeln;writeln;writeln; if IOResult <> 0 then writeln ('FileRecord Was Not be Writen') else writeln ('Next Data Seccesefull Writen'); writeln;writeln; write ('Name -->'); write (Books[i].BookName); writeln; write ('Author -->'); write (Books[i].Author); writeln; write ('Year -->'); write (Books[i].Year); writeln; Close(FBooks); end {AddNewRecord}; procedure ReadRecord ; begin {ReadRecord} reset(FBooks); Seek (FBooks, 0); while not Eof(FBooks) do begin

- 62 -

{$S-} read (FBooks, Books[i]); {$S+} if IOResult <> 0 then writeln ('FileRecord Was Not be Read') else writeln ; write ('------------------------'); writeln ; write (i); write (')'); write (' '); write (Books[i].BookName); write (' '); write (Books[i].Author); write (' '); write (Books[i].Year); write (' '); i:=i+1 ; end; readln(chose); Close(FBooks); end {ReadRecord}; procedure WriteRecord (k,x:integer); begin {WriteRecord} reset(FBooks); Seek (FBooks, 0); reset(GBooks); Seek (GBooks, 0); rewrite(GBooks); m:=1; while not Eof(FBooks) do begin {$S-} read (FBooks, Books[i]); {$S+} if IOResult <> 0 then writeln ('FileRecord Was Not be Read') else tempword1:= Books[i].BookName; x:=length(tempword1); for k := x downto 1 do begin tempword2:= copy (tempword1,k,1); tempword3:= tempword3 + tempword2; end; writeln ; write ('------------------------'); writeln ; write (i); write (')'); write (' '); write (tempword3); write (' '); NewBooks[m].NewName:=tempword3;

- 63 -

Seek (GBooks, FileSize(GBooks)); // Переходим к концу файла {$S-} Write(GBooks, NewBooks[m]); {$S+} tempword3:=''; i:=i+1; m:=m+1; end; readln(chose); Close(FBooks); Close(GBooks); end {WriteRecord}; procedure SeaResultRecord ; begin {SeaResultRecord} reset(GBooks); Seek (GBooks, 0); i:=1; while not Eof(GBooks) do begin {$S-} read (GBooks, NewBooks[i]); {$S+} if IOResult <> 0 then writeln ('FileRecord Was Not be Read') else writeln ; write ('------------------------'); writeln ; write (i); write (')'); write (' '); write (NewBooks[i].NewName); write (' '); write (' '); i:=i+1 ; end; readln(chose); Close(GBooks); end {SeaResultRecord}; label repeate; begin repeate: i:=0;

Assign (FBooks, 'f.txt'); Assign (GBooks, 'g.txt'); writeln('-----------------------------------------------'); writeln('------------------- You May -------------------'); writeln('----- Insert, Delete, Write or Sea Record -----'); writeln('-----------------------------------------------'); writeln; writeln('--------- Please Type What You Want -----------'); writeln('---------- 1 - Insert ------------------------'); writeln('---------- 2 - Read --------------------------'); writeln('---------- 3 - Write -------------------------'); writeln('---------- 4 - Sea Result --------------------'); Readln(x); case x of 1: AddNewRecord ; 2: ReadRecord; 3: WriteRecord(0,0); 4: SeaResultRecord ; else writeln(' You May Only type 1,2,3,4'); end; writeln; writeln; writeln('PRESS R to REPEATE or ANY KEY to EXIT'); readln(chose); if (chose = 'R') or (chose = 'r') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.

- 64 -

Тема 14. Простые объекты.

Описать объект, включающий заданные поля и методы. Написать программу, которая создает массив объектов и список объектов и содержит процедуры, работающие с указанными структурами.

Объект - квартира. Параметры: площадь и стоимость. Методы: конструктор и процедура, которая определяет стоимость одного метра. Определить какие квартиры из предложенных, имеют стоимость метра меньше заданной. Реализовать два варианта (с массивом и списком).

- 65 -

- 66 -

begin

End

myCost:=0;myArea:=0;

readln(myCost);readln(myArea);

Room1.CreateObject(myCost, myArea);

printResult (Room1.Cost, Room1.Area,

Room1.CostbyMeter);

writeln(' Please Type Maximum Cost by meter ---->');

MaxCostbyMeter;

K:=0;

MaxCostbyMeter >= Room1.CostbyMeter

k:=1;

(Room1.Cost, Room1.Area, Room1.CostbyMeter)


k:=1;



k:=1;


k=0

Sorry ... :

true

false




Room2.CostbyMeter);




Room2.CostbyMeter);

A

A

A

BeginyRoom.priceByMeterTm

CostbyMeter:=eCost/eArea;

EndyRoom.priceByMeterTm

BeginTmyRoom.CreateObject

Cost:=eCost;Area:=eArea;

priceByMeter(Cost,Area);

EndTmyRoom.CreateObject

BeginprintResult

EndprintResult

Cost;Area;

CostbyMeter;

Listing theme14.dpr { ;---------------------------------------------------------------------- ; Program Name: Простые объекты. theme14 from variant22 ; Program Description: Описать объект, включающий заданные поля и методы. ; Написать программу, которая создает массив объектов и список объектов и ; содержит процедуры, работающие с указанными структурами. ; Объект - квартира. Параметры: площадь и стоимость. ; Методы: конструктор и процедура, которая определяет стоимость одного метра. ; Определить какие квартиры из предложенных, имеют стоимость метра ; меньше заданной. Реализовать два варианта (с массивом и списком). ; Program Status: NotWorking :) 12.05.2008 ; Author: Rodin Andrey ; Date Created: 02.02.2008 ; Last Modification Date: 05.05.2008 ;---------------------------------------------------------------------- } program theme14; {$APPTYPE CONSOLE} uses SysUtils, Module_theme14a in 'Module_theme14a.pas', Module_theme14b in 'Module_theme14b.pas'; var chose:char; i,k:integer; myCost,myArea,MaxCostbyMeter:real; Room1,Room2,Room3: TmyRoom; label repeate; begin repeate: myCost:=0; myArea:=0; // ***************************************************************************** // ** Запрашиваем информацию от пользователя об имеющихся квартирах ** ** // ** ** // *****************************************************************************

- 67 -

- 68 -

// ***************************************************************************** // ** Room1 ** // ** ** // ***************************************************************************** writeln(' '); writeln(' '); writeln(' Please Type Cost --->'); readln(myCost); writeln(' '); writeln(' '); writeln(' Please Type Area --->'); readln(myArea); writeln; writeln; Room1.CreateObject(myCost, myArea); writeln; writeln; writeln; writeln; printResult (Room1.Cost, Room1.Area, Room1.CostbyMeter); // ***************************************************************************** // ** Room2 ** // ** ** // ***************************************************************************** writeln(' '); writeln(' '); writeln(' Please Type Cost --->'); readln(myCost); writeln(' '); writeln(' '); writeln(' Please Type Area --->'); readln(myArea); writeln; writeln; Room2.CreateObject(myCost, myArea); writeln; writeln; writeln; writeln; printResult (Room2.Cost, Room2.Area, Room2.CostbyMeter); // ***************************************************************************** // ** Room3 ** // ** ** // ***************************************************************************** writeln(' '); writeln(' '); writeln(' Please Type Cost --->');

- 69 -

readln(myCost); writeln(' '); writeln(' '); writeln(' Please Type Area --->'); readln(myArea); writeln; writeln; Room3.CreateObject(myCost, myArea); writeln; writeln; writeln; writeln; printResult (Room3.Cost, Room3.Area, Room3.CostbyMeter); // ***************************************************************************** // ** Вводим приемлемую для нас цену за метр и выводим на экран ** ** // ** подходящие ** // ***************************************************************************** writeln(' '); writeln(' '); writeln(' '); writeln(' Please Type Maximum Cost by meter ---->'); readln (MaxCostbyMeter); writeln(''); writeln(''); writeln(''); writeln('*******************************************'); K:=0; if MaxCostbyMeter >= Room1.CostbyMeter then begin printResult (Room1.Cost, Room1.Area, Room1.CostbyMeter); k:=1; writeln;writeln; end; if MaxCostbyMeter >= Room2.CostbyMeter then begin printResult (Room2.Cost, Room2.Area, Room2.CostbyMeter); k:=1; writeln;writeln; end; if MaxCostbyMeter >= Room3.CostbyMeter then begin printResult (Room3.Cost, Room3.Area, Room3.CostbyMeter); k:=1; writeln;writeln; end; if k=0 then writeln(' Sorry ... :('); writeln('*******************************************');

- 70 -

writeln('PRESS R to REPEATE or ANY KEY to EXIT'); readln(chose); if (chose = 'R') or (chose = 'r') then goto repeate else writeln ('It''s All, ByBy !!! :)'); readln; end.


// ********************************************************************** ** Unit Module_theme14a; ** // ***************************************************************************** {---------------------------------------------------------------------------} Interface {---------------------------------------------------------------------------} type TmyRoom = object Cost,Area:real; CostbyMeter:real; function priceByMeter(var eCost:real; var eArea:real):real; constructor CreateObject(var eCost:real; var eArea:real); end; {---------------------------------------------------------------------------} Implementation {---------------------------------------------------------------------------} // *********************************************************************** function TmyRoom.priceByMeter(var eCost:real; var eArea:real):real; // ************************************************************************ begin {priceByMeter} CostbyMeter:=eCost/eArea; end; {priceByMeter} // ********************************************************************** // constructor TmyRoom.CreateObject(var eCost:real; var eArea:real); // ********************************************************************** // begin {CreateObject} Cost:=eCost; Area:=eArea; priceByMeter(Cost,Area); end; {CreateObject} End.

- 71 -


// ************************************************************************ Unit Module_theme14b; // ************************************************************************** {------------------------------------------------------------------------} Interface {------------------------------------------------------------------------} procedure printResult(Cost:real; Area:real; CostbyMeter:real); {-------------------------------------------------------------------------} Implementation {-------------------------------------------------------------------------} // ************************************************************************* procedure printResult(Cost:real; Area:real; CostbyMeter:real); // ************************************************************************* begin {printResult} writeln('*******************************************'); writeln('Room'); write('Cost '); write((Cost):0:2); write(' $'); write(' '); write('Area '); write((Area):0:2); writeln(' m'); writeln('*******************************************'); write('Prise By Meter: '); write((CostbyMeter):0:2); writeln(' $/m'); writeln('*******************************************'); end; {printResult} End.

- 72 -

Тема 15. Выдается на занятии преподавателем

Листинг «Калькулятор» unit C_unit;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

ButtonReset: TButton;

ButtonEqual: TButton;

ButtonSumma: TButton;

ButtonRaznost: TButton;

ButtonProizvedenie: TButton;

ButtonDelenie: TButton;

ButtonExit: TButton;

Edit1: TEdit;

procedure ButtonSummaClick(Sender: TObject);

procedure ButtonDelenieClick(Sender: TObject);

procedure ButtonExitClick(Sender: TObject);

procedure ButtonResetClick(Sender: TObject);

procedure ButtonEqualClick(Sender: TObject);

procedure ButtonRaznostClick(Sender: TObject);

procedure ButtonProizvedenieClick(Sender: TObject);

private

- 73 - { Private declarations }

- 74 -

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

var

Sum:real;

operation:char='@';

{$R *.dfm}

procedure operate;

var s:string;

code:integer;

n:real;

begin

s:=Form1.Edit1.text; { читаем сроку из параметра text Edit1}

Form1.Edit1.clear; { очищаем Edit1}

val(s,n,code); { преобразуем строку в число}

case operation of { выполняем операцию}

'@': sum:=n;

'+': sum:=sum+n;

'-': sum:=sum-n;

'*': sum:=sum*n;

'/': sum:=sum/n;

end;

end;

procedure TForm1.ButtonResetClick(Sender: TObject);

begin

Edit1.Clear;

operation:='@';

Edit1.SetFocus;

end;

procedure TForm1.ButtonSummaClick(Sender: TObject);

begin

operate;

operation:='+';

Edit1.SetFocus;

end;

- 75 -

procedure TForm1.ButtonEqualClick(Sender: TObject);

var s:string;

begin

operate; { выполнить предыдущую операцию}

str(sum:6:3,s); { преобразовать результат в строку}

Edit1.text:=s; { вывести строку в окно компонента Edit1}

operation:='@';

Edit1.setfocus; { установить курсор на кнопку Button1}

end;

procedure TForm1.ButtonDelenieClick(Sender: TObject);

begin

operate;

operation:='/';

Edit1.setfocus;

end;

procedure TForm1.ButtonExitClick(Sender: TObject);

begin

Close;

end;

procedure TForm1.ButtonRaznostClick(Sender: TObject);

begin

operate; { выполнить предыдущую операцию}

operation:='-'; { установить состояние "операция +"}

Edit1.setfocus; { установить активным окно компонента Edit1}

end;

procedure TForm1.ButtonProizvedenieClick(Sender: TObject);

begin

operate;

operation:='*';

Edit1.setfocus;

end;

end.

Записная Книжка Листинг NoteBooks.dproj

program NoteBooks;

uses

Forms,

Note in 'Note.pas' {NoteBookForm},

Add in 'Add.pas' {AddNewForm},

Search in 'Search.pas' {SearchForm};

{$R *.res}

begin

Application.Initialize;

Application.MainFormOnTaskbar := True;

Application.CreateForm(TNoteBookForm, NoteBookForm);

Application.CreateForm(TAddNewForm, AddNewForm);

Application.CreateForm(TSearchForm, SearchForm);

Application.Run;

end.

Листинг Add.pas

unit Add;

interface

uses


Dialogs, StdCtrls;

type

- 76 -

- 77 -

TAddNewForm = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Button1: TButton;

Button2: TButton;

procedure Button1Click(Sender: TObject);


procedure Edit1Change(Sender: TObject);

private

{ Private declarations }

public


end;

type zap=record

fam:string[22]; {Фамилия}

name:string[22]; {Имя}

fon:string[22]; {Телефон}

adr:string[22]; {Адрес}

end;

var

AddNewForm: TAddNewForm;

f:file of zap;

z:zap;

implementation

{$R *.dfm}

procedure TAddNewForm.Button1Click(Sender: TObject);

var

size:integer;

begin

AssignFile(f,'telefon.dat');

{$I-} Reset(F); {$I+}

if ioresult=0 then

begin size := FileSize(f);

- 78 -

seek(f,size);

end

else rewrite(f);

z.fam:=edit1.text;

z.name:=edit2.text;

z.fon:=edit3.text;

z.adr:=edit4.text;

edit1.clear;

edit2.clear;

edit3.clear;

edit4.clear;

write(f,z);

edit1.setfocus;

closefile(f);

end;

procedure TAddNewForm.Button2Click(Sender: TObject);

begin

self.hide;

end;

procedure TAddNewForm.Edit1Change(Sender: TObject);

begin

edit2.clear;

edit3.clear;

edit4.clear;

end;

end.

Листинг Note.pas

unit Note;

interface

uses


Dialogs, StdCtrls, ExtCtrls, jpeg;

type

- 79 -

TNoteBookForm = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Image1: TImage;




private


public


end;

var

NoteBookForm: TNoteBookForm;

implementation

uses Search, Add;

{$R *.dfm}

procedure TNoteBookForm.Button1Click(Sender: TObject);

var size:integer;

begin

AddNewForm.Show;

AddNewForm.edit1.setfocus;

end;


begin

SearchForm.show;

SearchForm.edit1.setfocus;

end;


begin

Close;

end;

- 80 -

end.

Листинг Search.pas unit Note;

interface

uses


Dialogs, StdCtrls, ExtCtrls, jpeg;

type

TNoteBookForm = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Image1: TImage;




private


public


end;

var

NoteBookForm: TNoteBookForm;

implementation

uses Search, Add;

{$R *.dfm}


var size:integer;

begin

AddNewForm.Show;

AddNewForm.edit1.setfocus;

end;


begin

SearchForm.show;

SearchForm.edit1.setfocus;

end;


begin

Close;

end;

end.

- 81 -

- 82 -

Тема 16. Записи. Типизированные файлы. Создание меню с использованием классов VCL. Сведения о товарах представлены наименованием каждого товара, ценой, объемом партии, датой

поступления. Программа должна в интерактивном режиме воспринимать каждый из перечисленных вопросов и давать на него ответ.

1. Определять, какие товары поступали начиная с указанной даты. 2. Определять, какой товар имеет наибольшую стоимость партии. 4. Определять даты поступления и наименования товаров, объемы партий которых не меньше

заданного значения. Получить общую стоимость партий этих товаров. 5.

- 83 -

(z.DataofDelivery) >= DataControlCheck

while not eof(F)

read(F,Z);

z.Quantity>= QuantityControlCheck

true

x:=0;StringGrid1.Cells[x,y]:=DateToStr(z.

DataofDelivery);x:=1;

StringGrid1.Cells[x,y]:=z.NameGood;x:=2;

str(z.Quantity,s);StringGrid1.Cells[x,y]:=s;

x:=3;str(z.Prise,s);

StringGrid1.Cells[x,y]:=s;x:=4;

str(z.Prise*z.Quantity,s);StringGrid1.Cells[x,y]:=s;

allCostwhatYouSee:=allCostwhatYouSee + z.Prise*z.Quantity;

maxCostOfParty < z.Prise*z.Quantity

maxCostOfParty:= z.Prise*z.Quantity;

lbl_maxCostotPartyName.Caption:=z.NameGood;

y:=y+1;

false

false

true

true

false

EndTForm1.FormCreate(Sender: TObject);

A

- 84 -

- 85 -

Listing SKLAD.dproj

program SKLAD; uses Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.

Listing Unit1.pas

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, Menus; type TForm1 = class(TForm) StringGrid1: TStringGrid; SaveButton: TButton; Button_Filters: TButton; Minquantity: TEdit; TEditDataofDelivery: TEdit; LblMaxCost: TLabel; Button1: TButton; GroupBox1: TGroupBox; Label5: TLabel; Label3: TLabel; GroupBox2: TGroupBox; Label4: TLabel; Label6: TLabel; lbl_maxCostotPartyName: TLabel; lblAllCost: TLabel; LabelMaxCost: TLabel; Label2: TLabel; Button2: TButton; Sbros: TButton; procedure FormCreate(Sender: TObject); procedure Button2Click(Sender: TObject); procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure SaveButtonClick(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button_FiltersClick(Sender: TObject); procedure SbrosClick(Sender: TObject); private { Private declarations } public { Public declarations } end; type DBRecord=record DataofDelivery : TDateTime; {Дата поставки}

- 86 -

NameGood:string[50]; {Наименование товара} Quantity:integer; {Кол-во шт.} Prise:integer; {Цена} Cost:integer; {Общая Стоимость} end; var Form1: TForm1; F:file of DBRecord; Z:DBRecord; dataControlCheck: TDateTime; // Дата поставки д.б. больше этой величины quantityControlCheck: integer; // Количество товара д.б. больше этой величины maxCostOfParty: integer; // Максимальная Цена Партии Товаров allCostwhatYouSee: integer; // Общая Цена Всего что отображается SGX,SGY:integer; filename:string[255]='MainBD.dbs'; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var x,y,i:integer; s:string[10]; begin for i:=0 to 5 do begin StringGrid1.Cells[0,i]:=''; StringGrid1.Cells[1,i]:=''; end; form1.Caption:='Склад - ['+filename+']'; StringGrid1.Cells[0,0]:='Дата Поступления'; StringGrid1.Cells[1,0]:='Наименование товара'; StringGrid1.Cells[2,0]:='Кол-во'; StringGrid1.Cells[3,0]:='Цена'; StringGrid1.Cells[4,0]:='Общая Стоимость'; AssignFile(F,filename); {$I-} Reset(F); {$I+} if ioresult<>0 then begin StringGrid1.Cells[0,1]:='База не найдена'; end else begin y:=1; dataControlCheck:=StrToDate(TEditDataofDelivery.text); quantityControlCheck:=StrToInt(Minquantity.Text); maxCostOfParty:=0; allCostwhatYouSee:=0; while not eof(F) do begin read(F,Z); if (z.DataofDelivery) >= DataControlCheck then begin if z.Quantity>= QuantityControlCheck then begin x:=0; StringGrid1.Cells[x,y]:=DateToStr(z.DataofDelivery); x:=1; StringGrid1.Cells[x,y]:=z.NameGood;

- 87 -

x:=2; str(z.Quantity,s); StringGrid1.Cells[x,y]:=s; x:=3; str(z.Prise,s); StringGrid1.Cells[x,y]:=s; x:=4; str(z.Prise*z.Quantity,s); StringGrid1.Cells[x,y]:=s; allCostwhatYouSee:=allCostwhatYouSee + z.Prise*z.Quantity; if maxCostOfParty < z.Prise*z.Quantity then begin maxCostOfParty:= z.Prise*z.Quantity; lbl_maxCostotPartyName.Caption:=z.NameGood; end; y:=y+1; end; end; end; end; LabelMaxCost.Caption:= IntToStr(maxCostOfParty); lblAllCost.Caption:= IntToStr(allCostwhatYouSee); {$I-} CloseFile(F); {$I+} end; procedure TForm1.Button1Click(Sender: TObject); begin close; end; procedure TForm1.Button2Click(Sender: TObject); var x,y,i:integer; s:string[10]; begin for i:=0 to 5 do begin StringGrid1.Cells[0,i]:=''; StringGrid1.Cells[1,i]:=''; end; form1.Caption:='Склад - ['+filename+']'; StringGrid1.Cells[0,0]:='Дата Поступления'; StringGrid1.Cells[1,0]:='Наименование товара'; StringGrid1.Cells[2,0]:='Кол-во'; StringGrid1.Cells[3,0]:='Цена'; StringGrid1.Cells[4,0]:='Общая Стоимость'; AssignFile(F,filename); {$I-} Reset(F); {$I+} if ioresult<>0 then begin StringGrid1.Cells[0,1]:='База не найдена'; end else begin y:=1; dataControlCheck:=StrToDate(TEditDataofDelivery.text); quantityControlCheck:=StrToInt(Minquantity.Text); maxCostOfParty:=0; allCostwhatYouSee:=0; while not eof(F) do begin

- 88 -

read(F,Z); if (z.DataofDelivery) >= DataControlCheck then begin if z.Quantity>= QuantityControlCheck then begin x:=0; StringGrid1.Cells[x,y]:=DateToStr(z.DataofDelivery); x:=1; StringGrid1.Cells[x,y]:=z.NameGood; x:=2; str(z.Quantity,s); StringGrid1.Cells[x,y]:=s; x:=3; str(z.Prise,s); StringGrid1.Cells[x,y]:=s; x:=4; str(z.Prise*z.Quantity,s); StringGrid1.Cells[x,y]:=s; allCostwhatYouSee:=allCostwhatYouSee + z.Prise*z.Quantity; if maxCostOfParty < z.Prise*z.Quantity then begin maxCostOfParty:= z.Prise*z.Quantity; lbl_maxCostotPartyName.Caption:=z.NameGood; end; y:=y+1; end; end; end; end; LabelMaxCost.Caption:= IntToStr(maxCostOfParty); lblAllCost.Caption:= IntToStr(allCostwhatYouSee); {$I-} CloseFile(F); {$I+} end; {Сохранение результатов} procedure TForm1.SaveButtonClick(Sender: TObject); var y,Num,Code:integer; begin AssignFile(F,filename); rewrite(F); y:=1; if StringGrid1.Cells[0,0] <> 'База не найдена' then begin while StringGrid1.Cells[0,y]<>'' do begin z.DataofDelivery:=StrToDate(StringGrid1.Cells[0,y]); z.NameGood:=StringGrid1.Cells[1,y]; val(StringGrid1.Cells[2,y], Num, Code); z.Quantity:=Num; val(StringGrid1.Cells[3,y], Num, Code); z.Prise:=Num; write(F,Z);

- 89 -

y:=y+1; end; end; {$I-} CloseFile(F); {$I+} end; procedure TForm1.SbrosClick(Sender: TObject); var x,y,i:integer; s:string[10]; begin for i:=0 to 5 do begin StringGrid1.Cells[0,i]:=''; StringGrid1.Cells[1,i]:=''; end; form1.Caption:='Склад - ['+filename+']'; StringGrid1.Cells[0,0]:='Дата Поступления'; StringGrid1.Cells[1,0]:='Наименование товара'; StringGrid1.Cells[2,0]:='Кол-во'; StringGrid1.Cells[3,0]:='Цена'; StringGrid1.Cells[4,0]:='Общая Стоимость'; AssignFile(F,filename); {$I-} Reset(F); {$I+} if ioresult<>0 then begin StringGrid1.Cells[0,1]:='База не найдена'; end else begin y:=1; TEditDataofDelivery.text:='31.12.1999'; Minquantity.Text:='0'; dataControlCheck:=StrToDate(TEditDataofDelivery.text); quantityControlCheck:=StrToInt(Minquantity.Text); maxCostOfParty:=0; allCostwhatYouSee:=0; while not eof(F) do begin read(F,Z); if (z.DataofDelivery) >= DataControlCheck then begin if z.Quantity>= QuantityControlCheck then begin x:=0; StringGrid1.Cells[x,y]:=DateToStr(z.DataofDelivery); x:=1; StringGrid1.Cells[x,y]:=z.NameGood; x:=2; str(z.Quantity,s); StringGrid1.Cells[x,y]:=s; x:=3; str(z.Prise,s); StringGrid1.Cells[x,y]:=s; x:=4; str(z.Prise*z.Quantity,s); StringGrid1.Cells[x,y]:=s;

- 90 -

allCostwhatYouSee:=allCostwhatYouSee + z.Prise*z.Quantity; if maxCostOfParty < z.Prise*z.Quantity then begin maxCostOfParty:= z.Prise*z.Quantity; lbl_maxCostotPartyName.Caption:=z.NameGood; end; y:=y+1; end; end; end; end; LabelMaxCost.Caption:= IntToStr(maxCostOfParty); lblAllCost.Caption:= IntToStr(allCostwhatYouSee); {$I-} CloseFile(F); {$I+} end; procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); begin SGX:=ACol; SGY:=ARow; end; procedure TForm1.Button3Click(Sender: TObject); var i:integer; begin for i:=SGY to 98 do begin StringGrid1.Cells[0,i]:=StringGrid1.Cells[0,i+1]; StringGrid1.Cells[1,i]:=StringGrid1.Cells[1,i+1]; end; end; procedure TForm1.Button4Click(Sender: TObject); var i:integer; begin for i:=99 downto SGY+1 do begin StringGrid1.Cells[0,i]:=StringGrid1.Cells[0,i-1]; StringGrid1.Cells[1,i]:=StringGrid1.Cells[1,i-1]; end; StringGrid1.Cells[0,SGY]:=''; StringGrid1.Cells[1,SGY]:=''; end; procedure TForm1.Button_FiltersClick(Sender: TObject); var x,y,i:integer; s:string[10]; begin for i:=0 to 4 do begin StringGrid1.Cells[0,i]:=''; StringGrid1.Cells[1,i]:=''; end; form1.Caption:='Склад - ['+filename+']'; StringGrid1.Cells[0,0]:='Дата Поступления'; StringGrid1.Cells[1,0]:='Наименование товара'; StringGrid1.Cells[2,0]:='Кол-во'; StringGrid1.Cells[3,0]:='Цена'; StringGrid1.Cells[4,0]:='Общая Стоимость'; AssignFile(F,filename); {$I-} Reset(F); {$I+}

- 91 -

y:=1; for i := 0 to 99 do begin x:=0; StringGrid1.Cells[x,y]:=' '; x:=1; StringGrid1.Cells[x,y]:=' '; x:=2; StringGrid1.Cells[x,y]:=' '; x:=3; StringGrid1.Cells[x,y]:=' '; x:=4; StringGrid1.Cells[x,y]:=' '; y:=y+1; end; if ioresult<>0 then begin StringGrid1.Cells[0,1]:='База не найдена'; end else begin y:=1; if TEditDataofDelivery.text = '0' then TEditDataofDelivery.text:= '11.11.1990'; dataControlCheck:=StrToDate(TEditDataofDelivery.text); quantityControlCheck:=StrToInt(Minquantity.Text); maxCostOfParty:=0; allCostwhatYouSee:=0; while not eof(F) do begin read(F,Z); if (z.DataofDelivery) >= DataControlCheck then begin if z.Quantity>= QuantityControlCheck then begin x:=0; StringGrid1.Cells[x,y]:=DateToStr(z.DataofDelivery); x:=1; StringGrid1.Cells[x,y]:=z.NameGood; x:=2; str(z.Quantity,s); StringGrid1.Cells[x,y]:=s; x:=3; str(z.Prise,s); StringGrid1.Cells[x,y]:=s; x:=4; str(z.Prise*z.Quantity,s); StringGrid1.Cells[x,y]:=s; allCostwhatYouSee:=allCostwhatYouSee + z.Prise*z.Quantity; if maxCostOfParty < z.Prise*z.Quantity then begin maxCostOfParty:= z.Prise*z.Quantity; lbl_maxCostotPartyName.Caption:=z.NameGood; end; y:=y+1;

end; end; end; end; LabelMaxCost.Caption:= IntToStr(maxCostOfParty); lblAllCost.Caption:= IntToStr(allCostwhatYouSee); {$I-} CloseFile(F); {$I+} end; end.

Result:

- 92 -

- 93 -

- 94 -

BMSTU Delphi Variant 22

Documents

Transcript of BMSTU Delphi Variant 22