Навчальна контролююча програма Призма
Begin
X_Y:= Chr(201);
X1_Y:= Chr(187);
X_Y1:= Chr(200);
X1_Y1 := Chr(188);
Vert:=Chr(186);
Vert1 :=Vert;
Horiz :=Chr(205);
Horiz1 := Horiz;
end;
wX:=WhereX;
wY:=WhereY;
TextColor(Color);
GoToXy(X,Y);
for x0:=1 to X1-X do Write(CSet.Horiz);
GotoXY(X,Y1);
for x0:=1 to X1-X do Write(CSet.Horiz1);
wY:=Y;
for y0:=1 to (Y1-Y)+1 do
Begin
GotoXY(X,wY);
Write(CSet.Vert);
wY:=wY+1;
end;
wY:=Y;
for y0:=1 to (Y1-Y)+1 do
Begin
GotoXY(X1,wY);
Write(CSet.Vert1);
wY:=wY+1
end;
GoToXy(X,Y);
write(CSet.X_Y);
GoToXy(X1,Y);
write(CSet.X1_Y);
GoToXy(X,Y1);
write(CSet.X_Y1);
GoToXy(X1,Y1);
write(CSet.X1_Y1);
if BorderType <> 3 then
Begin
GoToXy(X1-4,Y);
write('[X]');
GoToXy(X+3,Y);
write(WinName);
end;
NormVideo;
GotoXY(X+2,Y+2);
End;
procedure ErrorKey;
Begin
RichWindow(20,10,61,17, 2,'[Error]',Yellow,Red,true);
TextBackGround(Red);
TextColor(7);
OutTxt('You can press only this keys:');
OutTxt(' ');
OutTxt(' 1, 2, 3, F1, Esc(or x) - That''s All!');
OutTxt('^^^^^^');
TMus(Error);
ReadKey;
Return:=False;
end;
{----------------------------------------------}
{------convert----}
function IntToStr(w : Word) : String;
var
s : String;
Begin
Str(w:0,s);
if Length(s) = 1 then
s := '0' + s;
IntToStr := s;
end;
{---------------}
function RealToStr(N:Real;Mant:byte): String;
var S:String;
Begin
Str(N:0:mant,S);
RealToStr := S;
end;
function PutZero(var n:word):string;
var St:String;
Begin
Str(n, St);
if Length(St) = 1 then St:='0'+St;
PutZero := St;
end;
{------- time ------}
procedure TimeTo(x,y:byte);
Begin
if not keypressed then
Begin
repeat
GetTime(h,m,s,hund);
GotoXY(x,y);
Write('[',IntToStr(h),':',IntToStr(m),':',IntToStr(s),']');
GotoXY(2,2);
Delay(100);
Until Keypressed;
end;
end;
{--------------- write log ------------------}
procedure TDateToF(var Text:String);
const
days : array [0..6] of String[9] =
('Nedilya','Ponedilok','Vivtorok','Sereda',
'Chetver','Pjatnutsa','Subota');
var
y, m, d, dow : Word;
Begin
GetDate( y, m, d, dow);
text:= (days[dow]+', '+ IntToStr(m)+ '/'+ IntToStr(d)+ '/'+ IntToStr(y));
end;
procedure WriteLog(mark:real;try,folse:byte);
Var F:Text;
i:byte;
Data:String;
Begin
TDateToF(Data);
WriteLN('Log Execute');
{$I-}Assign(F,'Data\Log.txt');
ReSet(F);
{$I+}
if IoResult <> 0 then Rewrite(F) else ReSet(F);
Append(F);
Write(F,#13);
Write(f,'> ['+Data+']');
Write(F,#13);
for i:=1 to 25 do Write(F,'_');
Write(F,#13);
GetTime(h,m,s,hund);
Write(F,'Results last test:'+#13);
Write(F,'Begin: '+IntToStr(hS)+':'+IntToStr(mS)+', finish: ');
Write(F,PutZero(h),':',PutZero(m),':',PutZero(s),#13);
Write(F,#13+'-True ansvers: '+IntToStr(try));
Write(F,#13+'-False Ansvers: '+IntToStr(folse),#13);
Write(F,#13+'Mark: '+RealToStr(Mark,1));
if Frac(Mark)>=0.5 then Write(F,'+');
Write(F,#13+#13+'>end log'+#13);
for i:=1 to 25 do Write(F,'_');
Write(F,#13);
for i:=1 to 50 do write(f,'-');
Close(F);
end;
Procedure TMus(SoundType:TSound);
Var
i:word;
Begin
If SOundType = welcome then
Begin
for i:=1 to 30 do
Begin
Sound(i*10);
Delay(i*10);
end;
NoSound;
end;
If SOundType = Result then
Begin
Sound(100);Delay(900);
Sound(200);Delay(800);
Sound(300);Delay(700);
Sound(400);Delay(600);
NoSounD;Delay(1000);
end;
If SOundType = Error then
Begin
for i:=1 to 2 do
Begin
Sound(300);Delay(300);
Sound(200);
NoSound;Delay(500);
Sound(100);Delay(700);
NoSound;Delay(100);
end;
end;
If SOundType = Beep then
Begin
Sound(100);Delay(200);
Sound(200);Delay(300);
NoSound;
end;
NoSound;
End;