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
|
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] = 'Вопрос #';
{Вопросы]
|
('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;
|
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}
|
{-------------------}
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;
|
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);
|
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.
|