unit uRoutines;
 
interface
 
uses
  //============================== Модули проекта ==============================
  uConsts,
  //=============================== Левые модули ===============================
  rpVersionInfo, {CoolTrayIcon, }RxStrUtils,
  //============================= Системные модули =============================
  Windows, Classes, Forms, Registry, SysUtils, Controls, ComCtrls, ShlObj;
 
type
  TNotifyIcon = (niNone, niInfo, niWarning, niError);
  {TShowBalloonHintMethod = function (Title: String;
                                     Text: String;
                                     IconType: TBalloonHintIcon;
                                     TimeoutSecs: TBalloonHintTimeOut): Boolean of object;   }
 
// ------------------------ Математические функции -----------------------------
function IntegerInRange(const Value, Min, Max: Integer): Boolean;
 
// -------------------------- Логические функции -------------------------------
procedure SetBit(var AValue: Integer; const ABit: Boolean; const ABitNumber: Byte); // Установка бита в 32-битном целом
 
// ------------------------ Функции преобразований -----------------------------
function AdvancedStr2Int(const AValue: string): Integer; // Перевод строки в число в системе счисления 10, 16, 8, 2 
function IsValueSystem(const S: string; const ASystem: Byte): Boolean; // Определение системы счисления числа
function AdvancedDec2Numb(const N: Integer; const A, B, C: Byte): string; // Пpеобpазование целого числа N в число по
основанию B, дополняя слева нулями до длины A и вставляя пробелы через каждые С символов (0 - не вставляет)
function GetShellExecuteError(const ErrorCode: Integer; const FileName: string = ''): string;
 
// ----------------- Функции выдачи сообщений и запросов -----------------------
procedure NotImplementedYet(const ACaption: string); // Выдача сообщения о ещё не реализованном действии
function SaveRequest(const AFileName: string): Integer; // Выдача запроса на сохранение изменённого файла
//function ShowNotification(Title, Text: string; IconType: TNotifyIcon; // Показ уведомления в трее
//                          TimeoutSecs: TBalloonHintTimeOut): Boolean;
function BrowseForFolder(Handle: THandle;         // Вывод диалога выбора директории.
                         const Title: string;
                         var Dir: string): Boolean;
 
// -------------------- Функции для работы с реестром --------------------------
function RegFileExt(AExtension, AExtDescription, AFileDescription,
                    AOpenWith, AParamString: String; AIconIndex: Integer): Boolean;
function FileExtIsRegistered(const AExtension: string): Boolean;
function UnRegFileExt(AExtension, AExtDescription: String): Boolean;
function ExtToFileType(const Ext: string): string; // Описание формата из реестра по расширению
function FileNameToFileType(const AFileName: string): string; // Описание формата из реестра по имени файла
 
// ------------------- Функции для работы со строками --------------------------
function MatchesMask(const S, Mask: string): Boolean; // Соответствие имени файла маске
function MatchesMasks(const S: string; AMasks: TStrings): Boolean; // Соответствие имени файла одной из масок списка
function ExtractFileNameOnly(const AFileName: string): string; // Извлечение из пути имени файла без расширения
function ExtractFileExtOnly(const AFileName: string): string; // Извлечение из пути расширения файла без точки
function SwitchCase(const S: string): string; // Функция переключения регистра символов.
function IsProjectFileName(const AFileName: string): Boolean; // Проверка расширения на равенству расширению файлов
проектов
 
// -------------------- Функции для работы с классами --------------------------
procedure PushStringItem(Items: TStrings; const NewItem: string; const Max: Integer = 16);
 
// -------------------- Функции для работы с файлами ---------------------------
function GetUniqueFileName(const AFolder, APrefix, AExtention: string): string; // Поиск уникального имени файла в папке
AFolder
 
// -------- Функции для работы с компонентами и оконными элементами ------------
procedure SetControlEnabled(Parent: TWinControl; const Enabled: Boolean);  // Рекурсивная установка своства Enabled у
Parent и всех его дочерних контролов
procedure ToggleVisible(AControl: TControl); // Переключение видимости объекта
procedure CallOnIdle; // Принудительный вызов обработчика Application.OnIdle
 
 
// --------------------------- Прочие функции ----------------------------------
function GetProgramVersion: string; // Выдача версии exe-файла
procedure GlobalInit; // Инициализация глобальных переменных
 
 
// Глобальные переменные
var
  WindowsDirectory:     string;
  ProgramExeFile:       string;
  ProgramDirectory:     string;
  ProjectsDirectory:    string;
  UserName:             string;
  AutoCompleteFileName: string; // Файл для хранения пользовательских автозамен
  TagsFileName:         string; // Файл для хранения пользовательских HTML-тэгов
  //ShowBalloon: TShowBalloonHintMethod; // глобальный метод показа баллуна
  ApplicationOnIdleHandler: TIdleEvent; // Указатель на обработчик события Application.OnIdle для вызова его вручную
 
  ActivePageExists: Boolean; // Флаг существования активной страницы PageControl
  ActivePage: TTabSheet; // Ссылка на активную страницу
  CurrentProjectNode: TTreeNode; // Ссылка на текущий проект 
 
  // Запуск только одной копии программы
  MutexHandle:     THandle;
  ActivateMessage: Cardinal;
 
implementation
 
uses uSettings;
 
// ------------------------ Математические функции -----------------------------
function IntegerInRange(const Value, Min, Max: Integer): Boolean;
begin
  Result:= (Value >= Min) and (Value <= Max);
end;
 
// -------------------------- Логические функции -------------------------------
 
// Установка бита в 32-битном целом
procedure SetBit(var AValue: Integer;
                 const ABit: Boolean;
                 const ABitNumber: Byte);
begin
  if ABit
    then AValue:= AValue or (1 shl ABitNumber)
    else AValue:= AValue and not (1 shl ABitNumber);
end;
 
// ------------------------ Функции преобразований -----------------------------
 
// Перевод строки в число в системе счисления 10, 16, 8, 2
function AdvancedStr2Int(const AValue: string): Integer;
var
  Len: Integer;
  Q: string; // Число с отрезанным суффиксом b или h.
begin
  Len:= Length(AValue);
  if Len = 0
    then raise Exception.Create('Вместо числа - пустая стока');
 
  Q:= Copy(AValue, 1, Len - 1);
  if (AValue[Len] in ['H', 'h']) and IsValueSystem(Q, 16)
    then begin
           Result:= StrToInt('$' + Q);
           Exit;
         end;
 
  Q:= Copy(AValue, 3, Len - 2);
  if (LowerCase(Copy(AValue, 1, 2)) = '0x') and IsValueSystem(Q, 16)
    then begin
           Result:= StrToInt('$' + Q);
           Exit;
         end;
 
  Q:= Copy(AValue, 1, Len - 1);
  if (AValue[Len] in ['B', 'b']) and IsValueSystem(Q, 2)
    then begin
           Result:= Numb2Dec(Q, 2);
           Exit;
         end;
 
  if (AValue[1] = '0') and IsValueSystem(Copy(AValue, 2, Len - 1), 8)
    then begin
           Result:= Numb2Dec(AValue, 8);
           Exit;
         end;
 
  if IsValueSystem(AValue, 10)
    then Result:= StrToInt(AValue)
    else raise Exception.Create('Строка "' + AValue + '" не является числом.');
end;
 
// Определение системы счисления числа
function IsValueSystem(const S: string; const ASystem: Byte): Boolean;
var
  i: Integer;
  Digs: TDigitsSet;
begin
  Result:= False;
  if S = ''
    then Exit;
 
  case ASystem of
    16: Digs:= HexDigits;
     8: Digs:= OctDigits;
    10: Digs:= DecDigits;
     2: Digs:= BinDigits;
  else
        Digs:= [];
  end;
 
  for i:= 1 to Length(S) do
    if not (S[i] in Digs)
      then Exit;
 
  Result:= True;
end;
 
{ Пpеобpазует целое число N в число по основанию B,
  дополняя слева нулями до длины A и вставляя пробелы
  через каждые С символов (0 - не вставляет).}
function AdvancedDec2Numb(const N: Integer; const A, B, C: Byte): string;
var
  i, Len: Integer;
  S: string;
begin
  Result:= '';
  S:= Dec2Numb(N, A, B);
  Len:= Length(S);
 
  if C > 0
    then begin
           for i:= Len downto 1 do
             begin
               Result:= S[i] + Result;
               if (Len - i + 1) mod C = 0
                 then Result:= ' ' + Result;
             end;
           Result:= Trim(Result);
         end
    else Result:= S;
end;
 
function GetShellExecuteError(const ErrorCode: Integer; const FileName: string = ''): string;
var
 FN:string;
begin
{      Value                               Meaning
 0                The operating system is out of memory or resources.
 ERROR_FILE_NOT_FOUND  The specified file was not found.
 ERROR_PATH_NOT_FOUND  The specified path was not found.
 ERROR_BAD_FORMAT  The .EXE file is invalid (non-Win32 .EXE or error
                        in .EXE image).
 SE_ERR_ACCESSDENIED  The operating system denied access to the specified file.
 SE_ERR_ASSOCINCOMPLETE  The filename association is incomplete or invalid.
 SE_ERR_DDEBUSY          The DDE transaction could not be completed because other
                        DDE transactions were being processed.
 SE_ERR_DDEFAIL          The DDE transaction failed.
 SE_ERR_DDETIMEOUT  The DDE transaction could not be completed because the
                        request timed out.
 SE_ERR_DLLNOTFOUND  The specified dynamic-link library was not found.
 SE_ERR_FNF          The specified file was not found.
 SE_ERR_NOASSOC          There is no application associated with the given
                        filename extension.
 SE_ERR_OOM          There was not enough memory to complete the operation.
 SE_ERR_PNF          The specified path was not found.
 SE_ERR_SHARE       A sharing violation occurred.}
 
 Result:='';
 FN:='';
 if FileName<>''
  then FN:=' '+FileName;
 case ErrorCode of
  {0                      }  0 : Result:='Системе не хватает памяти или ресурсов для выполнения операции';
  {SE_ERR_FNF             }  2 : Result:='Файл'+FN+' не найден.';
  {SE_ERR_PNF             }  3 : Result:='Путь к файлу'+FN+' не найден.';
  {SE_ERR_ACCESSDENIED    }  5 : Result:='Нет доступа к файлу'+FN+'.';
  {SE_ERR_OOM             }  8 : Result:='Недостаточно памяти для выполнения операции.';
  {ERROR_BAD_FORMAT       } 11 : Result:='Файл'+FN+' не является приложением Win32 или повреждён.';
  {SE_ERR_SHARE           } 26 : Result:='Ошибка при совместном доступе к файлу'+FN+'.';
  {SE_ERR_ASSOCINCOMPLETE } 27 : Result:='The filename association is incomplete or invalid.';
  {SE_ERR_DDETIMEOUT      } 28 : Result:='The DDE transaction could not be completed because the request timed out.';
  {SE_ERR_DDEFAIL         } 29 : Result:='Транзакция DDE не может быть выполнена.';
  {SE_ERR_DDEBUSY         } 30 : Result:='Транзакция DDE не может быть выполнена, т.к. выполняется другая транзакция
DDE.';
  {SE_ERR_NOASSOC         } 31 : Result:='Файлу'+FN+' не сопоставлено приложение для его открытия.';
  {SE_ERR_DLLNOTFOUND     } 32 : Result:='Не найдена необходимая динамическая библиотека (DLL).';
  1,4,6,7,9,10,12..25          : Result:='Ошибка при работе с файлом'+FN+'.';
 end;//case
end;
 
// ----------------- Функции выдачи сообщений и запросов -----------------------
 
// Выдача сообщения о ещё не реализованном действии
procedure NotImplementedYet(const ACaption: string);
begin
  Application.MessageBox(PChar('Действие "' + ACaption + '" ещё не реализовано.'),
                         PChar('Информация'),
                         MB_OK + MB_ICONINFORMATION);
  //ShowNotification('Информация', 'Действие "' + ACaption + '" ещё не реализовано.', niInfo, 10);
end;
 
// Выдача запроса на сохранение изменённого файла
function SaveRequest(const AFileName: string): Integer;
var
  Msg: string;
begin
  if AFileName <> ''
    then Msg:= 'Сохранить изменения в файле "' + AFileName + '"?'
    else Msg:= 'Файл был изменён. Сохранить изменения?';
 
  Result:= Application.MessageBox(PChar(Msg),
                                  PChar('Запрос на сохранение'),
                                  MB_YESNOCANCEL + MB_ICONQUESTION);
end;
 
{// Показ уведомления в трее
function ShowNotification(Title, Text: string; IconType: TNotifyIcon;
                          TimeoutSecs: TBalloonHintTimeOut): Boolean;
begin
  if Assigned(ShowBalloon) and TBooleanOption(ProgramSettings.OptionsByName[snShowNotifications]).Value
    then Result:= ShowBalloon(Title, Text, TBalloonHintIcon(IconType), TimeoutSecs)
    else Result:= False;
end; }
 
// Вывод диалога выбора директории.
function BrowseForFolder(Handle: THandle;
                         const Title: string;
                         var Dir: string): Boolean;
var
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
  FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
 
  with BrowseInfo do
    begin
  hwndOwner:=       Handle;
  pszDisplayName:=  @DisplayName;
  lpszTitle:=       PChar(Title);
  //ulFlags:=         BIF_RETURNONLYFSDIRS + BIF_EDITBOX;
  ulFlags := BIF_RETURNONLYFSDIRS or
             $0040 or
             BIF_EDITBOX or
             BIF_STATUSTEXT;
    end;
 
  lpItemID:=                   SHBrowseForFolder(BrowseInfo);
 
  Result:=                     lpItemId <> nil;
 
  if Result
    then begin
           SHGetPathFromIDList(lpItemID, TempPath);
           Dir:= TempPath;
           GlobalFreePtr(lpItemID);
         end;
end;
 
// -------------------- Функции для работы с реестром --------------------------
 
// Регистрация расширения, установка иконки и ассоциативной программы
function RegFileExt(AExtension, AExtDescription, AFileDescription,
                    AOpenWith, AParamString: String; AIconIndex: Integer): Boolean;
  var  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
  with Reg do begin
    RootKey := HKEY_CLASSES_ROOT;
    OpenKey(AExtension, True);
    WriteString('', AExtDescription);
    OpenKey('\' + AExtDescription, True);
    WriteString('', AFileDescription);
    OpenKey('DefaultIcon', True);
    WriteString('', AOpenWith + ','+IntToStr(AIconIndex));
    OpenKey('\' + AExtDescription + '\Shell\Open\Command', True);
    WriteString('', '"' + AOpenWith + '" "' + AParamString + '"');
  end;
  Result := True;
  except
    Result := False;
  end;
  Reg.Free;
end;
 
// Проверка регистрации
function FileExtIsRegistered(const AExtension: string): Boolean;
var
  Reg: TRegistry;
begin
  Reg:= TRegistry.Create;
  try
    Reg.RootKey:= HKEY_CLASSES_ROOT;
    Result:= Reg.KeyExists(AExtension);
  finally
    Reg.Free();
  end;
end;
 
// Удаление регистрации
function UnRegFileExt(AExtension, AExtDescription: String): Boolean;
  var Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    with Reg do
     begin
      RootKey := HKEY_CLASSES_ROOT;
      DeleteKey(AExtension);
      DeleteKey('\' + AExtDescription);
     end;
   Result := True;
  except
   Result := False;
  end;
  Reg.Free;
end;
 
// Описание формата из реестра по расширению
function ExtToFileType(const Ext: string): string;
var
  Reg: TRegIniFile;
  LinkKey: string; // ccылка из ключа .ext на ключ Ext.File
begin
  Reg:= TRegIniFile.Create();
  try
    // Открытие ключа .ext
    Reg.RootKey:= HKEY_CLASSES_ROOT;
    if Reg.OpenKey('.' + Ext, False)
      then begin
             LinkKey:= Reg.ReadString('', '', '');
             Reg.CloseKey();
           end;
 
    // Открытие ключа Ext.File
    if Reg.OpenKey(LinkKey, False)
      then begin
             Result:= Reg.ReadString('', '', '');
             Reg.CloseKey();
           end;
  finally
    Reg.Free();
  end;
 
  if (LinkKey = '') or (Result = '')
    then Result:= 'Файл ''' + Ext + '''';
end;
 
// Описание формата из реестра по имени файла
function FileNameToFileType(const AFileName: string): string;
begin
  Result:= ExtToFileType(ExtractFileExtOnly(AFileName));
end;
 
// ------------------- Функции для работы со строками --------------------------
// Соответствие имени файла маске
function MatchesMask(const S, Mask: string): Boolean;
var
  si, mi: Integer;
  b: Boolean;
begin
  if Mask = ''
    then begin
           Result:= True;
           Exit;
         end;
 
    si:= 1;
    mi:= 1;
 
    while mi <= Length(mask) do
      begin
        case mask[mi] of
          '?': begin
                 Inc(si);
                 Inc(mi);
                 Continue;
               end; // '?':
 
          '*': begin
                 if mi = Length(mask)
                   then begin
                          Result:= True;
                          Exit
                        end;
 
                 Inc(mi);
 
                 while si <= Length(s) + 1 do
                   begin
                     b := MatchesMask(Copy(s, si, Length(s) - si + 1),
                                      Copy(mask, mi, Length(mask) - mi + 1));
                     if b
                       then begin
                              Result:= True;
                              Exit
                            end;
 
                     Inc(si);
                   end; // while
 
                 Result:= False;
                 Exit;
               end; // '*':
          else begin
                 if si > Length(s)
                   then begin
                          Result:= False;
                          Exit
                        end;
 
                 if s[si] <> mask[mi]
                   then begin
                          Result:= False;
                          Exit;
                        end;
               end // else
        end; // case
 
        Inc(si);
        Inc(mi);
    end; // while
 
  Result:= (si = Length(s) + 1) and (mi = Length(mask) + 1);
end;
 
// Соответствие имени файла одной из масок списка
function MatchesMasks(const S: string; AMasks: TStrings): Boolean;
var
  Index: Integer;
begin
  for Index:= 0 to AMasks.Count - 1 do
    begin
      Result:= MatchesMask(S, AMasks[Index]);
 
      if Result
        then Exit;
    end;
 
  Result:= False;
end;
 
// Извлечение из пути имени файла без расширения
function ExtractFileNameOnly(const AFileName: string): string;
var
  Index, PointPos: Integer;
begin
  Result:= ExtractFileName(AFileName);
 
  PointPos:= 0;
  for Index:= Length(Result) downto 1 do
    if Result[Index] = '.'
      then begin
             PointPos:= Index;
             Break;
           end;
 
  if PointPos <> 0
    then Result:= Copy(Result, 1, PointPos - 1);
end;
 
// Извлечение из пути расширения файла без точки
function ExtractFileExtOnly(const AFileName: string): string;
var
  Index, PointPos: Integer;
begin
  Result:= '';
 
  PointPos:= 0;
  for Index:= Length(AFileName) downto 1 do
    if AFileName[Index] = '.'
      then begin
             PointPos:= Index;
             Break;
           end;
 
  if PointPos <> 0
    then Result:= Copy(AFileName, PointPos + 1, Length(AFileName));
end;
 
// Переключение регистра символов
function SwitchCase(const S: string): string;
var
  Index: Integer;
  Symbol: Char;
begin
  Result:='';
  for Index:=1 to Length(S) do
    begin
      Symbol:=S[Index];
      case Symbol of
        #$41..#$5A, #$C0..#$DF: Inc(Symbol, $20);
        #$61..#$7A, #$E0..#$FF: Dec(Symbol, $20);
      end;
      Result:= Result + Symbol;
    end;
end;
 
// Проверка расширения на равенству расширению файлов проектов
function IsProjectFileName(const AFileName: string): Boolean;
begin
  Result:= AnsiLowerCase(ExtractFileExtOnly(AFileName)) = ProjectDefaultExt;
end;
 
// -------------------- Функции для работы с классами --------------------------
 
procedure PushStringItem(Items: TStrings; const NewItem: string; const Max: Integer = 16);
var
  Index, Count: Integer;
begin
  if NewItem = ''
    then Exit;
 
  Index:= Items.IndexOf(NewItem);
 
  if Index < 0
    then Items.Insert(0, NewItem)
    else Items.Move(Index, 0);
 
  Count:= Items.Count;
  while Count > Max do
    begin
      Items.Delete(Count - 1);
      Dec(Count);
    end;
end;
 
 
// -------------------- Функции для работы с файлами ---------------------------
 
// Поиск уникального имени файла в папке AFolder
function GetUniqueFileName(const AFolder, APrefix, AExtention: string): string;
var
  Index: Integer;
begin
  Index:= 1;
  repeat
    Result:= IncludeTrailingPathDelimiter(AFolder) + APrefix + IntToStr(Index) + AExtention;
    Inc(Index);
  until not FileExists(Result);
end;
 
 
// -------- Функции для работы с компонентами и оконными элементами ------------
 
// Рекурсивная установка своства Enabled у Parent и всех его дочерних контролов
procedure SetControlEnabled(Parent: TWinControl; const Enabled: Boolean);
var
  Control: TControl;
  Index: Integer;
begin
  if not Assigned(Parent)
    then Exit;
 
  Parent.Enabled:= Enabled;
  for Index:= 0 to Parent.ControlCount - 1 do
   begin
     Control:= Parent.Controls[Index];
     if Control is TWinControl
       then SetControlEnabled(TWinControl(Control), Enabled) // Рекурсия !!!
       else Control.Enabled:= Enabled;
   end;
end;
 
 
// Переключение видимости объекта
procedure ToggleVisible(AControl: TControl); 
begin
  AControl.Visible:= not AControl.Visible;
end;
 
// Принудительный вызов обработчика Application.OnIdle
procedure CallOnIdle;
var
  Done: Boolean;
begin
  if Assigned(ApplicationOnIdleHandler)
    then ApplicationOnIdleHandler(nil, Done);
end;
 
 
// --------------------------- Прочие функции ----------------------------------
 
// Выдача версии exe-файла
function GetProgramVersion: string;
var
  Info: TrpVersionInfo;
begin
  Info:= TrpVersionInfo.Create(nil);
  try
    Result:= Format(AboutText, [Info.FileVersion]);
  finally
    Info.Free();
  end;
end;
 
procedure GlobalInit; // Инициализация глобальных переменных
var
  Buffer: array[0..MAX_PATH - 1] of Char;
  Size: Cardinal;
begin
  GetWindowsDirectory(Buffer, MAX_PATH);
  WindowsDirectory:= Buffer;
 
  ProgramExeFile:=   ParamStr(0);
  ProgramDirectory:= ExtractFileDir(ProgramExeFile);
 
  ProjectsDirectory:= ProgramDirectory + '\Projects';
  if not DirectoryExists(ProjectsDirectory)
    then if not CreateDir(ProjectsDirectory)
           then ProjectsDirectory:= ProgramDirectory;
 
  Size:= MAX_PATH;
  GetUserName(Buffer, Size);
  UserName:= Buffer;
 
  AutoCompleteFileName:= ProgramDirectory + '\AutoComplete.ini';
  TagsFileName:= ProgramDirectory + '\HtmlTags.xml';
end;
 
end.