Программа


PROGRAM Accounts_Department;
CONST PassWord='ЗАЧЕТ';  { Пароль }
      Tax=0.15;  { Суммарный налог }
FUNCTION UpCaseString(S:String):string;
                         { Функция перевода строчных букв строки в прописные }
  Var i:byte;        { Счетчик символов в строке }
  Begin
    for i:=1 to Length(S) do { Цикл преобразования букв }
      case S[i] of { Преобразование букв: }
        'a'..'z':S[i]:=UpCase(S[i]);   { Преобразование латиницы }
        { Преобразование кирилицы: }
        'а'..'п':S[i]:=Chr(Ord(S[i])-32);
        'р'..'я':S[i]:=Chr(Ord(S[i])-80);
        'ё'     :S[i]:='Ё';
      end;
    UpCaseString:=S  { Определение значения функции }
  End;
FUNCTION Key:boolean; { Функция запроса и проверки пароля }
  Var i:byte; { Счетчик количества запросов пароля }
      Str:String; { Переменная для считывания пароля }
  Begin
    Key:=FALSE;  { Начальный сброс значения функции }
    for i:=1 to 3 do { Цикл трехкратного запроса пароля }
      begin
        Write('Введите пароль: ');  { Вывод приглашения ввести пароль }
        ReadLn(Str);   { Ввод пароля }
        if UpCaseString(Str)=PassWord then
        begin
          WriteLn('Пароль принят');  { Вывод подтверждения корректности пароля }
          Key:=TRUE;  { Переопределение значения функции }
          Break { Прерывание цикла запроса пароля }
        end;
        WriteLn('НЕВЕРЕНЫЙ ПАРОЛЬ!',#7);
                             { Вывод сообщения об ошибке и звукового сигнала }
      end
  End;
FUNCTION GetSum(Invitation:String):real;
                                { Функция ввода суммы начисления (удержания) }
  Var Sum:real;  { Буферная переменная для ввода суммы }
      Error:boolean; { Флаг ошибки при вводе суммы }
  Begin
    repeat { Цикл ввода суммы до получения корректного значения }
      {$I-}  { Отключение проверки ввода/вывода }
      Write(Invitation);  { Вывод приглашения ко вводу суммы }
      ReadLn(Sum);  { Ввод суммы }
      Error:=(IOResult<>0) or (Sum<=0);
      { Проверка отсутствия ошибок ввода/вывода и корректности введенной суммы }
      {$I+}  { Включение проверки ввода/вывода }
      if Error then WriteLn('Неверное значение!',#7)
                                    { При обнаружении ошибки вывод сообщения }
    until not Error; { Выход из цикла при отсутствии ошибок }
    GetSum:=Sum { Определение значения функции }
  End;
PROCEDURE Accounts;  { Процедура вычисления заработной платы }
  Var Charge:real; { Начисления }
      Deduction:real; { Удержания }
      Salary:real;  { Зарплата }
  Begin
    { Ввод сумм начислений и удержаний }
    Charge:=GetSum('Введите сумму начислений: ');
    Deduction:=GetSum('Введите сумму удержаний: ');
    Salary:=Charge*(1-Tax)-Deduction; { Вычисление зарплаты }
    { Вывод зарплаты: }
    if Salary>=0
    then WriteLn('Заработная плата: ', Salary:8:2)
    else WriteLn('Долг за работником: ', -Salary:8:2);
    WriteLn('Нажмите <Enter>'); { Вывод приглашения нажать <Enter> }
    ReadLn { Остановка программы до нажатия <Enter> }
  End;
BEGIN
  WriteLn; { Пропуск строки }
  if Key then Accounts { Если получен пароль то расчет заработной платы }
END.

Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию