БланкСШаблоном "Константы, процедуры и функции общего назначения";
				 -- Умнов Д.М.	    01.01.100- 29.05.98
				 -- Алексеев С.В.   30.05.98 - 17.08.98
				 -- Умнов Д.М.	    27.08.98 - 31.08.98


  -- Нулевая дата для сравнений
  NullDate :D = 01.01.100;


  -- Константы цветов Windows:
  clBlack	:Integer = 0;
  clMaroon	:Integer = 128;
  clGreen	:Integer = 32768;
  clOlive	:Integer = 32896;
  clNavy	:Integer = 8388608;
  clPurple	:Integer = 8388736;
  clTeal	:Integer = 8421376;
  clGray	:Integer = 8421504;
  clSilver	:Integer = 12632256;
  clRed 	:Integer = 255;
  clLime	:Integer = 65280;
  clYellow	:Integer = 65535;
  clBlue	:Integer = 16711680;
  clFuchsia	:Integer = 16711935;
  clAqua	:Integer = 16776960;
  clLtGray	:Integer = 12632256;
  clDkGray	:Integer = 8421504;
  clWhite	:Integer = 16777215;


  -- Константы типов серий в графике:
  ctLine	:Integer = 0;	-- Линии
  ctArea	:Integer = 1;	-- Области
  ctPoint	:Integer = 2;	-- Точки
  ctBar 	:Integer = 3;	-- Столбцы
  ctHorBar	:Integer = 4;	-- Горизонтальные столбцы
  ctPie 	:Integer = 5;	-- Круговая диаграмма
  ctFastLine	:Integer = 6;


  -- Константы видов серий в графике:
  ckNone	:Integer = 0;	-- Без наворотов
  ckSide	:Integer = 1;	-- Друг за другом, только ctBar и ctHorBar
  ckStacked	:Integer = 2;	-- Соединенные по вертикали, только ctBar и ctHorBar
  ckStacked100	:Integer = 3;	-- Соединенные по вертикали в 100 процентах, только ctBar и ctHorBar


  -- Константы типов справки
  helpContext	:Integer = 1;	-- Вызов справки по номеру темы
  helpContents	:Integer = 3;	-- Вызов главного окна справки (устанавливается разработчиком справки)
  helpOnHelp	:Integer = 4;	-- Помощь по использованию справочной системы Windows
  helpFinder	:Integer = 11;	-- Вызов оглавления справки


  -- Константы сообщений об ошибках
  errWrong	:Integer = ErrUserBasis +  0;	-- Внутренняя ошибка, возбуждаемая процедурой Wrong


  -- Константы типов версии. 
  -- 1Не рекомендуется использовать в программах абсолютные значения данных констант, т.к.
  -- 1состав версий может меняться.
  verDemo	:Integer = 1;	-- Демо-версия
  verBase	:Integer = 2;	-- Версия "Базовая"
  verProf	:Integer = 3;	-- Версия "Проф"
  verSolo	:Integer = 4;	-- Версия "Соло"
  verLite	:Integer = 5;	-- Версия "Лайт"
  verSql	:Integer = 6;	-- Версия "SQL"
  verStrax	:Integer = 7;	-- Версия "Страховщик"
  verOracle	:Integer = 8;	-- Версия "Oracl"
  verEduc	:Integer = 9;	-- Версия "Учебная версия"
  verEconom	:Integer = 10;	-- Версия "Эконом" для 6.9
  verDeveloper	:Integer = 11;	-- Версия "Разработчик"

  КВ_БухУчетТМЦ :Logical; -- используется в БухУчетТМЦ


  proc Wrong (Mess :String);
    -- Процедура выдачи сообщения об ошибке
    УстОшибку(errWrong, 'ОШИБКА: '+Mess);
  end; -- Wrong --


  proc Sorry;
    -- Процедура сообщения о нереализованной возможности
    Сообщение('К сожалению, данная функция пока не реализована');
  end; -- Sorry --


  func ProgramVersion :Integer;
    -- возвращает модификацию программы, для внутренней = verProf
  var ver      :String;
    ver = Версия;
    if (Поз('Демо', ver) > 0) :
      return verDemo;
    elsif (Поз('Базовая', ver) > 0) :
      return verBase;
    elsif (Поз('Проф', ver) > 0) :
      return verProf;
    elsif (Поз('Соло', ver) > 0) :
      return verSolo;
    elsif (Поз('Лайт', ver) > 0) :
      return verLite;
    elsif (Поз('Страховщик', ver) > 0) :
      return verStrax;
    elsif (Поз('Учебная версия', ver) > 0) :
      return verEduc;
    elsif (Поз('Эконом', ver) > 0):
      return verEconom;
    elsif (Поз('Разработчик', ver) > 0):
      return verDeveloper;
    elsif (Поз('(i)', ver) > 0) :
      -- внутренняя модификация программы
      return verProf;
    else
      Wrong('Неизвестная модификация программы');
    end;
  end; -- ProgramVersion --

  func TSS: Integer;
  var result: Integer;
    -- возвращает 
    -- 0 - нет ни Бух уч тмц, ни большого склада
    -- 1 - Бух уч тмц
    -- 2 - Торговля и склад
    -- 3 - все вместе
    if LicenseCheck(58) > 0 :
      result = 1; -- БухУчТМЦ
    end;
    if LicenseCheck(57) > 0 :
      result = result + 2; -- ТиС
    end;
    return result;
  end;

  func Ver69:Logical;
  -- Если модификация 6.9, то возвращает True
  var ver:String;
    ver = Версия;
    if (Поз('6.9', ver) > 0) :
      ^true;
    else
      ^false;
    fi;
  end;

  func VerSQL_Oracl:Integer;
  var ver :String;
    ver = Версия;
    if (Поз('SQL', ver) > 0) :
      return verSQL;
    elsif (Поз('Oracle', ver) > 0) :
      return verSQL;
    else
     return verProf;
    fi;
  end;


  func КолСтрок:Integer; -- Количество строк которое можно вставлять в одной транзакции
  var res:Integer;
    res=100;
    if VerSQL_Oracl=verSQL:
	res=1000;
    fi;
    ^res;
  end;
  func Abs (x :Numeric) :Numeric;
    -- Абсолютное значение целого числа
    ^ if(x<0: -x, x);
  end; -- Abs --


  func GetHelpFileName :String;
    -- Возвращает имя файла с помощью по подсистеме или
    -- '', если такого файла (макроса HELP в плане бухгалтерии) нет
  var HelpFileName :String;
  var SubString    :String;
  var Result	   :String;
  var Len, i	   :Integer;
    try
      HelpFileName = PlanVar('HELP');
    except
      -- Макроса HELP нет в плане бухгалтерии
      Сообщение('Нет справочной информации по данному контексту');
      -- Возвращаем пустую строку
      return '';
    end;
    -- Удаляем кавычки, если они есть
    Len = Длина(HelpFileName);
    Result = '';
    for i = 1..Len do
      SubString = Подстр(HelpFileName, i, 1);
      if (SubString <> '"') and (SubString <> "'") :
	Result = Result + SubString;
      end;
    end;
    return Result;
  end; -- GetHelpFileName --


  proc ShowHelpContext (ContextID :Integer);
    -- Вызывает файл с контекстной помощью и заданным идентификатором темы
  var HelpFileName :String;
    HelpFileName = GetHelpFileName;
    if (HelpFileName = '') :
      -- Нет такого файла
      Exit;
    end;
    -- Вызываем помошь
    КонтекстнаяСправка(HelpFileName, helpContext, ContextID);
    -- Если обработка бланков дает ошибку в этом месте, то Вы пользуетесь
    -- устаревшей версией программы ТБ 6.0*.
    -- Вы можете бесплатно обменять на новую версию ТБ 6.0*., либо
    -- закомментировать вышележащую строку(поставив в начале строки два минуса), 
    -- но во втором случае Вы не сможете вызывать из бланков функции справочной системы
  end; -- ShowHelpContext --


  proc ShowHelpContents;
    -- Вызывает "главную страницу" справки
  var HelpFileName :String;
    HelpFileName = GetHelpFileName;
    if (HelpFileName = '') :
      -- Нет такого файла
      Exit;
    end;
    КонтекстнаяСправка(HelpFileName, helpContents, 0);
    -- Если обработка бланков дает ошибку в этом месте, то Вы пользуетесь
    -- устаревшей версией программы ТБ 6.0*.
    -- Вы можете бесплатно обменять на новую версию ТБ 6.0*., либо
    -- закомментировать вышележащую строку(поставив в начале строки два минуса), 
    -- но во втором случае Вы не сможете вызывать из бланков функции справочной системы
  end; -- ShowHelpContents --


  proc ShowHelpOnHelp;
    -- Вызывает помощь по использованию справочной системы Windows
  var HelpFileName :String;
    HelpFileName = GetHelpFileName;
    if (HelpFileName = '') :
      -- Нет такого файла
      Exit;
    end;
    КонтекстнаяСправка(HelpFileName, helpOnHelp, 0);
    -- Если обработка бланков дает ошибку в этом месте, то Вы пользуетесь
    -- устаревшей версией программы ТБ 6.0*.
    -- Вы можете бесплатно обменять на новую версию ТБ 6.0*., либо
    -- закомментировать вышележащую строку(поставив в начале строки два минуса), 
    -- но во втором случае Вы не сможете вызывать из бланков функции справочной системы
  end; -- ShowHelpOnHelp --


  proc ShowHelpFinder;
    -- Вызывает оглавление справки 
  var HelpFileName :String;
    HelpFileName = GetHelpFileName;
    if (HelpFileName = '') :
      -- Нет такого файла
      Exit;
    end;
    КонтекстнаяСправка(HelpFileName, helpFinder, 0);
    -- Если обработка бланков дает ошибку в этом месте, то Вы пользуетесь
    -- устаревшей версией программы ТБ 6.0*.
    -- Вы можете бесплатно обменять на новую версию ТБ 6.0*., либо
    -- закомментировать вышележащую строку(поставив в начале строки два минуса), 
    -- но во втором случае Вы не сможете вызывать из бланков функции справочной системы
  end; -- ShowHelpOnHelp --

  func IsNum (St :String) :Logical;
    -- Проверяет символ на допустимость в идентификаторе
    Assert(Length(St)=1, "Параметр "+ St + " не является символом");
    If St >= "0" And St <= "9"	: ^ True;
     | True : ^ False;
    Fi;
  end; -- CharCor --

  func CharCor (St :String) :Logical;
    -- Проверяет символ на допустимость в идентификаторе
    Assert(Length(St)=1, "Параметр "+ St + " не является символом");
    If St >= "0" And St <= "9"	: ^ True;
      | St >= "A" And St <= "Z" : ^ True;
      | St >= "a" And St <= "z" : ^ True;
      | St >= "А" And St <= "Я" : ^ True;
      | St >= "а" And St <= "я" : ^ True;
      | St = "." Or St = "_"	: ^ True;
      | True : ^ False;
    Fi;
  end; -- CharCor --

  func IdentCor (St :String) :Logical;
  -- Проверяет, что строка является корректным идентификатором
  Var Len,Iter :Integer;
  Var Char     :String;
  Var Point    :Logical;
    Point = False;
    Len = Length(St);
    For Iter = 1..Len Do
      Char = SubStr(St,Iter,1);
      If Not CharCor(Char) :
	Message("Введенный Вами идентификатор содержит недопустимые символы!");
	^False;
      |Char = "." And Point :
	Message("Введенный Вами идентификатор содержит двойные точки!");
	^False;
      Fi;
      If Char = "." :Point = True;
      | True	    :Point = False;
      Fi;
    Od;
    ^True;
  end; -- IdentCor --


Конец
