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
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'; |
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. |