Procedure OutPutString(Color, Fon, TaOld, Width: Byte);

{Функция выдачи сообщений об ошибках Message при нарушении диапазона

[NumberMin.. NumberMax] на вводе целочисленных значений элементов полей записи}

Function error(Message: string; NumberMin, NumberMax: LongInt):boolean;

{Функция выдачи сообщения об ошибке Mes при вводе вещественных значений элементов полей записи}

Function error1:boolean;

{Ввод строки символов S с проверкой диапазона количества символов [1..LenNaimt] и со строкой приглашения Inv}

Procedure InputString(Var S: String; LenNaimt: byte; Inv: String);

{Ввод целочисленных данных Number (ширина поля Width) с проверкой диапазона [NumberMin.. NumberMax] и со строкой приглашения Inv}

Procedure InputNumber(Var Number: Real; NumberMin, NumberMax: LongInt;

Width: Byte; Inv: String);

{Ввод вещественных данных R (ширина поля Width)

с проверкой на допустимый символ и со строкой приглашения Inv}

Procedure InputReal(Var R: Real; Width: Byte; Inv: String);

Implementation {Исполняемая часть - реализация процедур и функций}

Uses CRT;

Const

ErrMes=' Ошибка ввода!!! ';

MesNumb='Численное значение должно быть в диапазоне ';

TaOld=15; {Стандартный атрибут: белые символы на черном фоне}

TaNew=Red+16*LightGray+Blink;{красный цвет на сером фоне с мерцанием}

Color=Yellow; {желтый цвет символов}

Fon =Blue; {голубой цвет фона}

Var flag: boolean;

Function IntToStr(I: Longint): String;

var

S: string[11];

begin

Str(I, S);

IntToStr := S;

end;

Procedure OutMessageXY(X,Y:Byte;Str1,Str2:String);

Var Xcur, Ycur: byte;

Begin

Xcur:=WHereX; {запоминание текущей позиции курсора}

Ycur:=WHereY;

GotoXY(X, Y);

TextAttr:=TaNew;

Write(Str1,Str2);

TextAttr:=TaOld;

GotoXY(Xcur, Ycur); {восстановление позиции курсора}

End;

Procedure OutPutString(Color, Fon, TaOld, Width: Byte);

Var Str: String;

i, Xcur, Ycur: byte;

Begin

Xcur:=WHereX; {запоминание текущей позиции курсора}

Ycur:=WHereY;

Str:='';

TextAttr:=Color+16*Fon; {установка атрибута для вывода пробелов}

for i:=1 to Width do Str:=Str + ' ';

Write(Str);

TextAttr:=TaOld; {восстановление прежних атрибутов}

GotoXY(Xcur, Ycur); {восстановление позиции курсора}

End;

Function error(Message: string; NumberMin, NumberMax: LongInt):boolean;

Var Mes: string;

begin

error:=true;

if flag then

begin

Mes:=ErrMes + Message;

writeln(Mes, '[', NumberMin, '..', NumberMax,']');

error:=false;

end;

end;

Function error1:boolean;

Var Mes: string;

begin

error1:=true;

if flag then

begin

Mes:=ErrMes + ' Введено НЕ число....';

writeln(Mes);

error1:=false;

end;

end;

Procedure InputString(Var S: String; LenNaimt: byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, LenNaimt);

Readln(S);

if length(S)>LenNaimt then flag:=true;

until error('Количество символов в строке должно быть в диапазоне ',1,LenNaimt);

End;

Procedure InputNumber(Var Number: Real; NumberMin, NumberMax: LongInt;

Width: Byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, Width);

{$I-}

Readln(Number);

{$I+}

if IOResult<>0 then flag:=true

else if (Number<NumberMin) or (Number>NumberMax) then flag:=true;

until error(MesNumb, NumberMin, NumberMax);

End;

Procedure InputReal(Var R: Real; Width: Byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, Width);

{$I-}

Readln(R);

{$I+}

if IOResult<>0 then flag:=true;

until error1;

End;

end. {Конец модуля}

program Project1; // основная программа

uses

Forms,

Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.Run;

end.

Unit File_Rec; {подключение модуля File_Rec }

Interface

{ Логическая функция возвращает значение True, если файл FileName существует, иначе возвращает значение False. Если файл существует, то он закрывается. }

Function FileExists(FileName: String): Boolean;

{Функция проверки существования файла записей FileName

с выдачей аварийного сообщения, если F=True}

Function Pust(FileName: string; F: boolean):boolean;

{Процедура вывода на экран списка файлов текущего каталога}

Procedure DirCat;

Implementation

Uses Input, Dos;

Const NoFile='Файл не существует!!! ';

PovtVvod=' Повторите ввод. ';

function FileExists(FileName: String): Boolean;

var F: file;

begin

{$I-}

Assign(F, FileName);

Reset(F);

Close(F);

{$I+}

FileExists := (IOResult = 0) and (FileName <> '');

end; { FileExists }

Function Pust(FileName: string; F: boolean):boolean;

Var D: SearchRec begin

Pust:=true;

FindFirst(FileName, AnyFile, D);

If DosError<>0 then

begin

Pust:=False;

if F then OutMessageXY(20,24,NoFile,PovtVvod);

end end;

Procedure DirCat;

Var s : SearchRec;

i : Byte;begin

FindFirst('*.*', AnyFile, s);

Writeln(' Список файлов текущего каталога');

Writeln;

While DosError=0 do

begin

i:=i+1;

if i<5 then write(s.Name:15)

else

begin

writeln(s.Name:15);

i:=0; end;

FindNext(s) end;

Writeln end;

End.

Приложение Б

(обязательное)

Блок схемы

Размещено на http://www.allbest.ru/

Рисунок Б.1 - Блок-схема алгоритма

Размещено на http://www.allbest.ru/

Рисунок Б.2 - блок-схема алгоритма

Размещено на http://www.allbest.ru/

Рисунок Б.3 - Блок-схема алгоритма

Размещено на http://www.allbest.ru/

Рисунок Б.4 - Блок-схема алгоритма

Размещено на Allbest.ru