comp(pz) (663514), страница 3

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 3)

ArrowsAndEsc := [Back, Next, F1, Esc];

repeat

ExtentedKey := False;

Flag := False;

CH := ReadKey;

if CH = Esc then

Flag := True;

if CH = #0 then

begin

CH := ReadKey;

ExtentedKey := True

end;

if ExtentedKey then

case CH of

Back: begin

Dec(N);

SelectPage(N);

if N < 1 then N := 1

end;

Next: begin

Inc(N);

SelectPage(N);

if N > 4 then N := 4

end;

F1: begin

Temp[1].Get(X0, Y0, X0 + 380, Y0 + 300);

Temp[2].Get(X0, Y0 + 305, GetMaxX - X0, YS - 5);

Help;

MainWin;

Temp[1].Put(X0, Y0);

Temp[2].Put(X0, Y0 + 305);

if N <= 1 then

FuncKeyWindow[2].Put(XS, YS);

if N = 4 then

FuncKeyWindow[3].Put(XS, YS)

end

end {Case}

until Flag;

ClearDevice

end; {Play}

{-------------------}

procedure TextT(Col: TColor; S: TText);

begin

SetTextJustify(1, 1);

for I := 1 to 4 do

begin

SetColor(Col[I]);

OutTextXY(GetMaxX div 2, GetMaxY div 2 + I * 10 - 40, S[I])

end;

SetTextJustify(0, 0)

end; {TextT}

{-------------------}

procedure TestMode;

{-----------------}

function Quastion(N: Byte; var CH: Char): Byte;

var

I: Byte;

C: Char;

CHEAt: string[1];

Code: Integer;

StrN: string[3];

Res: Byte;

Begin

					КР. 991096.00.00.00 ПЗ	Лист
						——–
Изм.	Лист	№ докум.	Подп.	Дата		14

CH := #0;

SetColor(BRDCol);

Rectangle(0, 0, GetMaxX, GetMaxY);

SetColor(White);

MyText(XT, YT, 'Вопрос #' + QuastionS[N]);

SetColor(Yellow);

for I := 1 to 3 do

begin

if I = Ok[N] then

Cheat := V

else

Cheat := '';

MyText(XT, YT + 10 * I, Answer[N, I] + Cheat)

end;

repeat

C := ReadKey;

if C = #27 then

begin

SetTextJustify(1, 0);

SetViewPort(1, GetMaxY - 100, GetMaxX - 1, GetMaxY - 1, ClipOn);

SetColor(Red);

OutTextXY(GetMaxX div 2, 10, 'Вы действительно хотите выйти?');

SetColor(Green);

OutTextXY(GetMaxX div 2, 30, 'Да(Y), Нет(N)');

SetTextJustify(0, 0);

C := ReadKey;

if C = 'y' then

C := #27

else

begin

C := #0;

ClearViewPort

end;

SetViewPort(0, 0, GetMaxX, GetMaxY, ClipOn)

end

until C in ['1', '2', '3', #27];

if C <> #27 then

begin

Val(C, Res, Code);

if Res = Ok[N] then

begin

Quastion := 1;

SetColor(Green);

MyText(GetMaxX div 2 - 20, GetMaxY - 200, 'ВЕРНО')

end

else

begin

Quastion := 0;

SetColor(Red);

MyText(GetMaxX div 2 - 28, GetMaxY - 200, 'НЕВЕРНО')

end;

Delay(Time_2)

end

else

CH := C;

ClearDevice

end; {Quastion}

{-----------------}

function Mark(Res: Byte): Char;

begin

case Res of

1: Mark := '1';

2: Mark := '2';

					КР. 991096.00.00.00 ПЗ	Лист
						——–
Изм.	Лист	№ докум.	Подп.	Дата		15

3: Mark := '3';

4: Mark := '4';

5: Mark := '5';

else

Mark := '0'

end

end; {Mark}

{-----------------}

var

I: Byte;

Result: Byte;

StrRes: string[2];

TempS: TText;

C: Char;

begin

C := #0;

ClearDevice;

Result := 0;

TempS := EndofTest;

for I := 1 to 5 do

begin

if Quastion(I, C) = 1 then

Inc(Result);

if C = #27 then Exit

end;

ClearDevice;

SetColor(BRDCol);

Rectangle(0, 0, GetMaxX, GetMaxY);

Str(Result, StrRes);

TempS[3] := EndofTest[3] + StrRes;

TempS[4] := EndofTest[4] + Mark(Result);

SetColor(BRDCol);

Rectangle(GetMaxX div 2 - 150, GetMaxY div 2 - 60,

GetMaxX div 2 + 150, GetMaxY div 2 + 40);

TextT(TestCol, TempS);

_Pause;

ClearDevice

end; {TestMode}

{-------------------}

procedure MainMenu;

var

C: Char;

ExtentedKey: Boolean;

TempCol: TColor;

K: ShortInt;

begin

ClearDevice;

TempCol[1] := MenuCol[1];

TempCol[2] := MenuCol[3];

TempCol[3] := MenuCol[4];

TempCol[4] := MenuCol[4];

K := 1;

repeat

SetColor(BRDCol);

Rectangle(GetMaxX div 2 - 150, GetMaxY div 2 - 60,

GetMaxX div 2 + 150, GetMaxY div 2 + 40);

Rectangle(0, 0, GetMaxX, GetMaxY);

ExtentedKey := False; {флаг поступления расширенного кода}

TextT(TempCol, Menu);

while KeyPressed do ReadKey; {очистка буфера клавиатуры}

C := ReadKey; {считывание кода новой нажатой клавиши}

if C = #0 then {если "да" - код расширенный}

begin

					КР. 991096.00.00.00 ПЗ	Лист
						——–
Изм.	Лист	№ докум.	Подп.	Дата		16

C := ReadKey; {считывается второй символ расширенного кода}

ExtentedKey := True

end;

if ExtentedKey then {если код был расширенный}

case C of

#72: K := K - 1;

#80: K := K + 1

end;

if C = #13 then

case K of

1: Play; {Обучение}

2: TestMode; {Проверка знаний}

3: Exit {Выход}

end;

if K < 1 then K := 3;

if K > 3 then K := 1;

for I := 2 to 4 do

TempCol[I] := MenuCol[4];

TempCol[K + 1] := MenuCol[3]; {Смена цвета выделленого пункта}

until C = #27 {т.е. нажата клавиша "Esc"}

end; {MainMenu}

{-------------------}

begin

MyInitGraph; {Инициализация графического режима}

Title; {Титульный лист}

MainMenu; {Главное меню}

CloseGraph; {Закрытие графического режима}

end. {LEAN_Ecm;}

{-------------------}

Текст модуля Sm_Const

unit Sm_Const;

interface

uses Graph, Sm_Graph;

type

TText = array [1..4] of string;

TColor = array [1..4] of Word;

------------------- type

const

X0: Integer = 10; {Начальная координата X}

Y0: Integer = 20; {Начальная координата Y}

XS: Integer = 10; {FuncKey}

YS: Integer = 440; {FuncKey}

XC: Integer = 400; {Context}

YC: Integer = 20; {Context}

XT: Integer = 80; {Test}

YT: Integer = 150; {Test}

X: Integer = 15; {Координата вывод текста X}

Y: Integer = 330; {Координата вывод текста Y}

ARBCol: Word = LightCyan; {Цвет внешней границы стрелки Big}

ARSCol: Word = Red; {Цвет внешней границы стрелки Small}

FILCol: Word = Blue; {Цвет стрелки Big}

MemCol: Word = LightGreen; {Цвет ячеек памяти}

CPUCol: Word = DarkGray; {Цвет CPU}

BRDCol: Word = Brown; {Цвет рамки}

TxtCol: Word = White; {Цвет текста}

BArrow: TArrow = (X1 : 15; Y1 : 2; Y2 : 5); {Форма стрелки Big}

SArrow: TArrow = (X1 : 5; Y1 : 0; Y2 : 1); {Форма стрелки Small}

TestCol: TColor = (Green, White, Blue, Red); {Цвет окна теста}

MenuCol: TColor = (Cyan, 0, LightGreen, Blue);

V: string[1] = '';

Q: string[9] = 'Вопрос #';

{Вопросы]

					КР. 991096.00.00.00 ПЗ	Лист
						——–
Изм.	Лист	№ докум.	Подп.	Дата		17

Quastions: array [1..5] of string =

('1. Что такое ВЗУ?',

'2. Что в ходит в процесор?',

'3. Через какое устройство в ЭВМ происходит обмен данными?',

'4. Где в начальный момент находится программа? ',

'5. Какое из устройств расшифровывает первую машинную команду?');

{Варианты ответов}

Answer: array [1..5, 1..3] of string =

(('1. Внешнее записывающее устройство', '2. Внешнее запоминающее устройство', '3. Внутреннее запоминающее устройство'), ('1. ЦУУ + АЛУ + ВЗУ', '2. УВвода + ОЗУ', '3. ЦУУ + АЛУ + КОП'),

('1. АЛУ ','2. ОЗУ', '3. ВЗУ'),

('1. В ВЗУ','2. В АЛУ','3. В УУ'),

('1. ВЗУ', '2. ЦУУ', '3. АЛУ'));

{Номера правильных ответов}

OK: array [1..5] of Byte = (2, 3, 2, 1, 2);

{Текст Меню}

Menu: TText =('Ваш выбор:',

'Обучение',

'Проверка знаний',

'Esc - Выход');

{Текст итога тестовой части программы}

EndofTest: TText = ('Ваш результат:',

'Всего вопросов: 5',

'Количество правильных ответов: ',

'Оценка: ');

------------------- const

implementation

end.

Текст модуля Sm_graph

unit Sm_Graph;

interface

uses

Graph, Crt;

{-------------------} {Uses}

type

TArrow = record X1, Y1, Y2: Integer; end;

TImage =

object

private

Image: Pointer;

Size : Word;

public

procedure Destroy;

procedure Get(X1, Y1, X2, Y2: Integer);

procedure Put(X, Y: Integer);

end;

{-------------------} {Type}

const

CArrow: TArrow = (X1 : 15; Y1 : 2; Y2 : 5);

Time_1: Word = 5000; {Время мерцания}

Time_2: Word = 15000; {Время задержки экрана после ответа на вопрос}

Time_3: Word = 300; {Время анимации}

Time_4: Word = 400; {Время задержки вывода текста по буквам}

procedure _Pause;

procedure Animation(X, Y: Integer; D: Integer; XY: Byte; S: string; Vis: Boolean);

procedure Arrow(X, Y, L: Integer; DIRectIOn: Byte);

procedure BLink(X, Y: Integer; S: string);

procedure MyInitGraph;

					КР. 991096.00.00.00 ПЗ	Лист
						——–
Изм.	Лист	№ докум.	Подп.	Дата		18

procedure MyText(X, Y: Integer; S: string);

procedure Title;

var

TempImage: TImage;

implementation

{---------Object TImage----------}

procedure TImage.Destroy;

begin

if Image <> nil then

begin

FreeMem(Image, Size);

Image := nil;

Size := 0;

end

end; {Timage.Destroy}

{-------------------}

procedure TImage.Get(X1, Y1, X2, Y2: Integer);

begin

Destroy;

Size := ImageSize(X1, Y1, X2, Y2);

GetMem(Image, Size);

GetImage(X1, Y1, X2, Y2, Image^);

end; {TImage.Get}

{-------------------}

procedure TImage.Put(X, Y: Integer);

begin

if Image <> nil then

PutImage(X, Y, Image^, 0);

end; {TImage.Put}

{---------Object TImage----------}

procedure MyInitGraph;

var

GD, GM : Integer;

begin

GD := Detect;

InitGraph(GD, GM,'');

if GraphResult <> grOK then

Halt(1);

end; {MyInitGraph}

{-------------------}

procedure MyText(X, Y: Integer; S: string);

var

I: Word;

C: Char;

begin

MoveTo(X, Y);

I := 0;

repeat

Inc(I);

OutText(S[I]);

Delay(Time_4);

until (I = Length(S));

end; {NyText}

{-------------------}

procedure _Pause;

begin

ReadKey;

end; {_Pause}

					КР. 991096.00.00.00 ПЗ	Лист
						——–
Изм.	Лист	№ докум.	Подп.	Дата		19

{-------------------}

procedure Animation(X, Y: Integer; D: Integer;

XY: Byte; S: string; Vis: Boolean);

{Animation}

var

DX, DY: Integer;

I: Integer;

begin

DX := 1;

DY := 1;

SetColor(Green);

if D < 0 then

begin

DX := -1;

DY := -1;

end;

case XY of

1: DY := 0;

2: DX := 0;

end;

D := Abs(D);

for I := 1 to D do

begin

TempImage.Get(I * DX + X,

I * DY + Y,

TextWidth(S) + I * DX + X,

TextHeight(S) + I * DY + Y);

OutTextXY(X + I * DX, Y + TextHeight(S) + I * DY, S);

Delay(Time_3);

if I <> D then

TempImage.Put(X + I * DX, Y + I * DY);

if (I = D) and not VIs then

TEMPImage.Put(X + I * DX, Y + I * DY);

end;

end; {Animation}

{-------------------}

procedure Arrow(X, Y, L: Integer; Direction: Byte);

type

COOrAR = array [1..6] of Integer;

var

X1: Integer;

Y1: Byte;

Y2: Byte;

XX: COOrAR;

YY: COOrAR;

procedure Change1;

begin

X1 := -X1;

L := -L

end;

procedure Change2;

var

I: Byte;

Temp: Integer;

begin

for I := 1 to 6 do

begin

TEMP := XX[I];

XX[I] := YY[I];

YY[I] := TEMP;

end;

					КР. 991096.00.00.00 ПЗ	Лист
						——–
Изм.	Лист	№ докум.	Подп.	Дата		20

end;

procedure ArrowCCOOr;

begin

XX[1] := X1; YY[1] := Y2;

XX[2] := X1; YY[2] := Y1;

XX[3] := L; YY[3] := Y1;

XX[4] := L; YY[4] := -Y1;

XX[5] := X1; YY[5] := -Y1;

XX[6] := X1; YY[6] := -Y2;

end;

var

I: Byte;

begin

X1 := CArrow.X1;

Y1 := CArrow.Y1;

Y2 := CArrow.Y2;

if L < X1 then L := X1;

case Direction of

2, 4: Change1;

end;

ArrowCCOOr;

case Direction of

3, 4: Change2;

end;

MoveTo(X, Y);

for I := 1 to 6 do

LineTo(X+XX[I], Y+YY[I]);

LineTo(X, Y);

end; {Arrow}

{-------------------}

procedure Title;

const

Word_1: string = 'Курсовая работа по информатике.';

Word_2: string = 'Тема: взаимодействие основных частей ЭВМ при выполнении программы';

Word_3: string = 'Выполнили студенты группы МРС-91:';

Word_4: string = 'Егоров О.В.';

Word_5: string = 'Шетманюк М.В.';

begin

ClearDevice;

SetColor(LightGreen);

Rectangle(0, 0, GetMaxX, GetMaxY);

SetFillStyle(1, Blue);

FloodFill(1,1, LightGreen);

SetColor(LightGray);

Rectangle(25, 25,GetMaxX-25, GetMaxY-25);

SetFillStyle(1, DarkGray);

FloodFill(101,101, LightGray);

SetTextJustify(1, 0);

SetTextStyle(0,0,2);

SetColor(Black);

OutTextXY(GetMaxX div 2+1, GetMaxY div 2-1, Word_1);

SetColor(Brown);

OutTextXY(GetMaxX div 2, GetMaxY div 2, Word_1);

SetTextStyle(0,0,0);

SetColor(Red);

OutTextXY(GetMaxX div 2, GetMaxY-35, 'Хабаровск 2000');

SetColor(Black);

OutTextXY(GetMaxX div 2+1, GetMaxY div 2-1+18, Word_2);

SetColor(Brown);

OutTextXY(GetMaxX div 2, GetMaxY div 2+18, Word_2);

SetTextJustify(0, 0);

					КР. 991096.00.00.00 ПЗ	Лист
						——–
Изм.	Лист	№ докум.	Подп.	Дата		21

SetColor(Black);

OutTextXY(GetMaxX-Length(Word_3)*8+1-180, GetMaxY-100-1, Word_3);

SetColor(White);

OutTextXY(GetMaxX-Length(Word_3)*8-180, GetMaxY-100, Word_3);

SetColor(Black);

OutTextXY(GetMaxX+1-180, GetMaxY-90-1, Word_4);

SetColor(LightGreen);

OutTextXY(GetMaxX-180, GetMaxY-90, Word_4);

SetColor(Black);

OutTextXY(GetMaxX+1-180, GetMaxY-80-1, Word_5);

SetColor(LightGreen);

OutTextXY(GetMaxX-180, GetMaxY-80, Word_5);

_Pause;

ClearDevice;

end; {Title}

{-------------------}

procedure BLink(X, Y: Integer; S: string);

var I: Byte;

begin

for I := 1 to 3 do

begin

SetColor(Black);

Delay(Time_1);

OutTextXY(X, Y + TextHeight(S), S);

SetColor(Green);

Delay(Time_1);

OutTextXY(X, Y + TextHeight(S), S)

end

end; {Blink}

{-------------------}

end.

					КР. 991096.00.00.00 ПЗ	Лист
						——–
Изм.	Лист	№ докум.	Подп.	Дата		22