unit MiscRoutines;

interface

uses Windows, Classes, Controls, Spin, Forms, SysUtils, SharedData;

const
  IDABORT     = 3;
  IDCANCEL    = 2;
  IDIGNORE    = 5;
  IDNO        = 7;
  IDOK	      = 1;
  IDRETRY     = 4;
  IDYES       = 6;

type
  // Если в классе определена такая функция, то можно передавать ее
  // в 'ValidateByResult'; последняя вызывает ее, если нажато 'Ok'   
  TValidatorFunc = function : Boolean of Object;
type
  // Если в классе определена такая функция, то можно передавать ее
  // в 'ValidateByResult'; последняя вызывает ее, если нажато 'Cancel'
  TCleanerProc = procedure of Object;

// =======================================================================
// Функции выводят стандартные окна сообщений
function          CustomMsg(Msg:string;Flags:LongInt):Integer;
function          Info(Msg:string):Integer;
function          Warning(Msg:string):Integer;
function          Error(Msg:string):Integer;
function          AskYN(Msg:string):Integer;
function          AskYNC(Msg:string):Integer;
procedure         StubMessage;
// Функция возвращает строку с описанием последней системной ошибки
function          MessageFromSystem:string;
// =======================================================================
//                Функции полезны при файловых операциях
//                Удаляет из строки ведущие пробелы
procedure         StripLeadingFast(Dest,Src : PChar);
                  assembler;register;forward;
//                Удаляет из строки завершающие пробелы
procedure         StripTrailingFast(Dest,Src : PChar);
                  assembler;register;forward;
//                Удаляет из строки ВСЕ пробелы
procedure         StripAllBlanksFast(Dest,Src:PChar);
                  assembler;register;forward;
//                Удаляет из строки ВСЕ символы обратной косой черты
procedure         StripBackslashesFast(Dest,Src:PChar);
                  assembler;register;forward;
//                Удаляет из строки ВСЕ пробелы и ВСЕ символы '\'
procedure         StripBackslashesAndBlanksFast(Dest,Src:PChar);
                  assembler;register;forward;
//                Удаляет из строки ведущие и завершающие пробелы
procedure         StripLeadingAndTrailing(var Str : string);
//                Аналоги C - функций; не выделяют имя устройства.
procedure         SplitPath(FullPath:string;var DriveDir,Name,Ext:string);
function          MakePath(DriveDir,Name,Ext:string):string;
// =======================================================================
//                Самое важное - ультранизкий доступ к памяти.
procedure         memSetMemory(dst:pointer;c:DWORD;n:DWORD);
                  assembler;register;forward;
procedure         memZeroMemory(dst:pointer;n:DWORD);
                  assembler;register;forward;
procedure         memCopyMemory(dst,src:pointer;n:DWORD);
                  assembler;register;forward;
// Сравнение двух блоков: True если равны, иначе False (memcmp наоборот)
function          memCompareMemory(blk1,blk2:pointer;n:DWORD):Boolean;
                  assembler;register;forward;
function          DlgGetString(var S:string;Def,Caption:string):Boolean;
function          DlgGetDouble(var X:double;Def,Caption:string):Boolean;
function          DlgGetInteger(var V:integer;Def,Caption:string):Boolean;
// Следующие функции ВЫДАЮТ сообщения
// Проверка, является ли содержимое поля редактирования числом double
function          ContainDouble(Text:string;var dV:double;
                  EditName:string):Boolean;
// Проверка, является ли содержимое поля целым числом
function          CheckSpinContens(Edit:TSpinEdit;FieldName:string):Boolean;
// Следующие функции НЕ ВЫДАЮТ сообщения, а просто очищают неверные поля
function          ValidDouble(Text:string):string;
function          ValidInteger(Edit:TSpinEdit):integer;
// Если mrOk, то проверка допустимости всех полей диалога
function          ValidateByResult(Validator:TValidatorFunc;
                  Cleaner:TCleanerProc;
                  ModalResult:integer):Boolean;
// Выбор кода возврата по виртуальному коду клавиши
function          ChooseResult(Key:Word;ModalResult:integer):integer;
// Запись строки в поток (бинарный формат)
procedure         WriteStr(var Stream:TStream;Str : string);
// Чтение строки из потока (бинарный формат)
function          ReadStr(var Stream:TStream):string;
// Функция считывает из потока следующее слово. Словом считается последо-
// вательность символов между пробелом/символом табуляции/концом строки
// (любые комбинации) или последовательность любых символов между двойными
// кавычками. Остаток строки после пары символов '//' игнорируется.
// ВНИМАНИЕ !!! Кавычки не возвращаются.
function          fSmartScan(var Stream : TStream) : string;
// Функция считывает следующее слово из ASCIIZ - строки (прим. см. выше)
// ВНИМАНИЕ !!! Пара символов '//' никак не интерпретируется (как есть).
// ВНИМАНИЕ !!! Указатель продвигается на следующее слово.
function          fSmartScanZ(var Ptr : pointer) : string;
// Функция записывает слово в поток.
procedure         fPrint(var Stream : TStream;s : AnsiString);
// Функция записывает поток строку - разделитель.
procedure         Divider(var Stream : TStream);
// Функция устанавливает строку - разделитель.
procedure         SetDivider(Str:string);
// Функция возвращает системное время
function          GetSystemTimeStr:string;
// Функция возвращает системную дату
function          GetSystemDateStr:string;
// Немедленная остановка процесса
procedure         KillMe;
// Очистка очереди сообщений
procedure         RemoveMessages(Handle : HWND);
procedure         RemoveMessage(Handle:HWND;MsgId:UINT);
// =======================================================================

implementation

uses StringInp, IntegerInp, FloatInp;

// -----------------------------------------------------------------------
// CustomMsg
// -----------------------------------------------------------------------
function CustomMsg(Msg:string;Flags:LongInt):Integer;
begin
  Result:=Application.MessageBox(
    PChar(Msg),PChar(StrAppName),Flags);
end;
// ----------------------------------------------------------------------
// Info
// -----------------------------------------------------------------------
function Info(Msg:string):Integer;
begin
  Result:=CustomMsg(Msg,MB_ICONINFORMATION or MB_OK);
end;
// -----------------------------------------------------------------------
// Warning
// -----------------------------------------------------------------------
function Warning(Msg:string):Integer;
begin
  Result:=CustomMsg(Msg,MB_ICONEXCLAMATION or MB_OK);
end;
// -----------------------------------------------------------------------
// Error
// -----------------------------------------------------------------------
function Error(Msg:string):Integer;
begin
  Result:=CustomMsg(Msg,MB_ICONHAND or MB_OK);
end;
// -----------------------------------------------------------------------
// AskYN
// -----------------------------------------------------------------------
function AskYN(Msg:string):Integer;
begin
  Result:=CustomMsg(Msg,MB_ICONEXCLAMATION or MB_YESNO);
end;
// -----------------------------------------------------------------------
// AskYNC
// -----------------------------------------------------------------------
function AskYNC(Msg:string):Integer;
begin
  Result:=CustomMsg(Msg,MB_ICONEXCLAMATION or MB_YESNOCANCEL);
end;
// -----------------------------------------------------------------------
// StubMessage
// -----------------------------------------------------------------------
procedure StubMessage;
begin
  Error('В текущей версии эта функция не поддерживается.');
end;
// -----------------------------------------------------------------------
// MessageFromSystem
// -----------------------------------------------------------------------
function MessageFromSystem;
var
  Buffer : array[0..511] of char;
begin
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,GetLastError,
    0,@Buffer,511,nil);
  Result:=String(Buffer);
end;
// -----------------------------------------------------------------------
// StripLeadingFast
// -----------------------------------------------------------------------
procedure StripLeadingFast(Dest,Src : PChar);assembler;register;
asm
  // EAX - Dest
  // EDX - Src
  or   eax, eax
  je   @@NothingToDo
  or   edx, edx
  je   @@NothingToDo
  mov  byte ptr [eax], 00h
  cmp  byte ptr [edx], 00h
  je   @@NothingToDo
  cmp  byte ptr [edx], 20h
  ja   @@Str
@@Lead:
  inc  edx
  cmp  byte ptr [edx], 00h
  je   @@NothingToDo
  cmp  byte ptr [edx], 20h
  jbe  @@Lead
@@Str:
  call StrCopy
@@NothingToDo:
end;
// -----------------------------------------------------------------------
// StripTrailingFast
// -----------------------------------------------------------------------
procedure StripTrailingFast(Dest,Src : PChar);register;
begin
  asm
    // EAX - Dest
    // EDX - Src
    or   eax, eax
    je   @@NothingToDo
    or   edx, edx
    je   @@NothingToDo
    mov  byte ptr [eax], 00h
    cmp  byte ptr [edx], 0
    je   @@NothingToDo
    push eax
    push edx
    mov  eax, edx
    call StrEnd
    mov  ecx, eax
    pop  edx
    pop  eax
    // ECX -> завершающий нуль - символ в Src
  @@Trail:
    cmp  ecx, edx
    je   @@NothingToDo
    dec  ecx
    cmp  byte ptr [ecx], 20h
    jbe  @@Trail
    // ECX -> последний символ в Src, не являющийся пробелом
    push ebx
    mov  bl,byte ptr ecx[1]
    push bx
    push ecx
    mov  byte ptr ecx[1], 0
    call StrCopy
    pop  ecx
    pop  bx
    mov  byte ptr ecx[1], bl
    pop  ebx
  @@NothingToDo:
  end;
end;
// -----------------------------------------------------------------------
// StripBackslashesFast
// -----------------------------------------------------------------------
procedure StripAllBlanksFast(Dest,Src:PChar);assembler;register;
asm
  // EAX -> Dest
  // EDX -> Src
  or   eax, eax
  je   @@NothingToDo
  or   edx, edx
  je   @@NothingToDo
  mov  byte ptr [eax], 00h
  cmp  byte ptr [edx], 0
  je   @@NothingToDo
@@NextCh:
  cmp  byte ptr [edx], 0
  je   @@Bye
  cmp  byte ptr [edx], 20h
  ja   @@Good
  inc  edx
  jmp  @@NextCh
@@Good:
  mov  cl, byte ptr [edx]
  mov  byte ptr [eax], cl
  inc  eax
  inc  edx
  jmp  @@NextCh
@@Bye:
  mov  byte ptr [eax], 0
@@NothingToDo:
end;
// -----------------------------------------------------------------------
// StripBackslashesFast
// -----------------------------------------------------------------------
procedure StripBackslashesFast(Dest,Src:PChar);assembler;register;
asm
  // EAX -> Dest
  // EDX -> Src
  or   eax, eax
  je   @@NothingToDo
  or   edx, edx
  je   @@NothingToDo
  mov  byte ptr [eax], 00h
  cmp  byte ptr [edx], 0
  je   @@NothingToDo
@@NextCh:
  cmp  byte ptr [edx], 0
  je   @@Bye
  cmp  byte ptr [edx], '\'
  jne  @@Good
  inc  edx
  jmp  @@NextCh
@@Good:
  mov  cl, byte ptr [edx]
  mov  byte ptr [eax], cl
  inc  eax
  inc  edx
  jmp  @@NextCh
@@Bye:
  mov  byte ptr [eax], 0
@@NothingToDo:
end;
// -----------------------------------------------------------------------
// StripBackslashesAndBlanksFast
// -----------------------------------------------------------------------
procedure StripBackslashesAndBlanksFast(Dest,Src:PChar);assembler;register;
asm
  // EAX -> Dest
  // EDX -> Src
  or   eax, eax
  je   @@NothingToDo
  or   edx, edx
  je   @@NothingToDo
  mov  byte ptr [eax], 00h
  cmp  byte ptr [edx], 0
  je   @@NothingToDo
@@NextCh:
  cmp  byte ptr [edx], 0
  je   @@Bye
  cmp  byte ptr [edx], '\'
  jne  @@IsBlank
  inc  edx
  jmp  @@NextCh
@@IsBlank:
  cmp  byte ptr [edx], 20h
  ja   @@Good
  inc  edx
  jmp  @@NextCh
@@Good:
  mov  cl, byte ptr [edx]
  mov  byte ptr [eax], cl
  inc  eax
  inc  edx
  jmp  @@NextCh
@@Bye:
  mov  byte ptr [eax], 0
@@NothingToDo:
end;
// -----------------------------------------------------------------------
// StripLeadingAndTrailing
// -----------------------------------------------------------------------
procedure StripLeadingAndTrailing;
var
  TempStr1,TempStr2 : PChar;
begin
  TempStr1:=StrAlloc(Length(Str)+1);
  TempStr2:=StrAlloc(Length(Str)+1);
  StripLeadingFast(TempStr1,PChar(Str));
  StripTrailingFast(TempStr2,TempStr1);
  Str:=Copy(String(TempStr2),1,StrLen(TempStr2));
  StrDispose(TempStr1);
  StrDispose(TempStr2);
end;
// -----------------------------------------------------------------------
// SplitFileName
// -----------------------------------------------------------------------
procedure SplitFileName(FileName:string;var Name,Ext:string);
var
  c : char;
begin
  Name:=FileName;
  Ext:='';
  while(Name<>'') do
  begin
    c:=Name[Length(Name)];
    if(c<>'.') then
      Insert(c,Ext,1)
    else
    begin
      Delete(Name,Length(Name),1);
      break;
    end;
    Delete(Name,Length(Name),1);
  end;
  if(Name='') then
  begin
    Ext:='';
    Name:=FileName;
  end;
end;
// -----------------------------------------------------------------------
// SplitPath
// -----------------------------------------------------------------------
procedure SplitPath;
var
  NameExt : string;
begin
  DriveDir:=ExtractFilePath(FullPath);
  NameExt:=ExtractFileName(FullPath);
  SplitFileName(NameExt,Name,Ext);
end;
// -----------------------------------------------------------------------
// MakePath
// -----------------------------------------------------------------------
function MakePath;
var
  FullPath : string;
begin
  FullPath:=DriveDir;
  if(FullPath[Length(FullPath)]<>'\') then FullPath:=FullPath+'\';
  FullPath:=FullPath+Name;
  if(FullPath[Length(FullPath)]<>'.') then FullPath:=FullPath+'.';
  Result:=FullPath+Ext;
end;
// -----------------------------------------------------------------------
// memSetMemory
// -----------------------------------------------------------------------
procedure memSetMemory;
asm
  push   edi                 //  Индекс приемника - в стек
  push   ebx                 //  В чужой компилатор со своим кодом ...
  or     eax, eax            //  Флаги по адресу
  je     @@Bye               //  Если нулевой указатель - на выход
  mov    edi, eax            //  Установить индекс приемника
  or     ecx, ecx            //  Флаги по счетчику
  jbe    @@Bye               //  Если неположительный - до свидания
  mov    dh, dl              //  Заполнить байтом младшее слово EDX
  mov    ax, dx              //  Заполнить байтом младшее слово EAX
  shl    eax, 16             //  Сдвинуть в старшее слово EAX
  mov    ax, dx              //  Заполнить байтом оба слова EAX
  mov    ebx, ecx            //  Сохранить счетчик
  shr    ecx, 2              //  И уменьшить его в четыре раза
  rep    stosd               //  Тиражировать двойное слово
  mov    ecx, ebx            //  Какой там был счетчик - ?
  and    ecx, 3              //  Берем остаток от деления на 4
  rep    stosb               //  Тиражируем байт
@@Bye:
  pop    ebx
  pop    edi                 //  Не портим индекс приемника
end;
// -----------------------------------------------------------------------
// memZeroMemory
// -----------------------------------------------------------------------
procedure memZeroMemory;
asm
  push   edi                 //  Индекс приемника - в стек
  push   ebx
  or     eax, eax            //  Флаги по адресу
  je     @@Bye               //  Если нулевой указатель - на выход
  or     edx, edx            //  Флаги по счетчику
  jbe    @@Bye               //  Если неположительный - до свидания
  mov    edi, eax            //  Установить индекс приемника
  xor    eax, eax            //  Заполнять будем нулями
  mov    ecx, edx            //  Значение годится - в счетчик его
  shr    ecx, 2              //  И уменьшить его в четыре раза
  rep    stosd               //  Тиражировать двойное слово из нулей
  mov    ecx, edx            //  Какой там был счетчик - ?
  and    ecx, 3              //  Берем остаток от деления на 4
  rep    stosb               //  Тиражируем нулевой байт
@@Bye:
  pop    ebx
  pop    edi                 //  Не портим индекс приемника
end;
// -----------------------------------------------------------------------
// memCopyMemory
// -----------------------------------------------------------------------
procedure memCopyMemory;
asm
  push   edi
  push   esi
  push   ebx
  mov    edi, eax
  mov    esi, edx
  or     edi, edi
  je     @@Bye
  or     esi, esi
  je     @@Bye
  or     ecx, ecx
  jbe    @@Bye
  mov    ebx, ecx
  shr    ecx, 2
  rep    movsd
  mov    ecx, ebx
  and    ecx, 3
  rep    movsb
@@Bye:
  pop    ebx
  pop    esi
  pop    edi
end;
// -----------------------------------------------------------------------
// memCompareMemory
// -----------------------------------------------------------------------
function memCompareMemory;
asm
  push   edi
  push   esi
  push   ebx
  mov    esi, eax
  xor    eax, eax            // Презумпция неравенства
  mov    edi, edx
  or     edi, edi
  je     @@Bye
  or     esi, esi
  je     @@Bye
  or     ecx, ecx
  jbe    @@Bye
  mov    ebx, ecx
  shr    ecx, 2
  repe   cmpsd
  jne    @@Bye
  mov    ecx, ebx
  and    ecx, 3
  repe   cmpsb
  jne    @@Bye
  inc    eax                 // Если неправы - единицу в аккумулятор
@@Bye:
  pop    ebx
  pop    esi
  pop    edi
end;
// -----------------------------------------------------------------------
// ContainDouble
// -----------------------------------------------------------------------
function ContainDouble;
begin
  Result:=False;
  try
    dV:=StrToFloat(Text);
    Result:=True;
    exit;
  except
    on EConvertError do
    begin
      if(EditName<>'') then
        Warning(Format('Поле "%s" должно содержать действительное число.',
          [EditName]))
      else
        Warning('Поле должно содержать действительное число.');
      dV:=0.0;
      exit;
    end;
  end;
end;
// -----------------------------------------------------------------------
// WriteStr
// -----------------------------------------------------------------------
procedure WriteStr;
var
  n : dword;
  sz : PChar;
begin
  n:=Length(Str);
  sz:=PChar(Str);
  Stream.WriteBuffer(n,sizeof(dword));
  Stream.WriteBuffer(sz^,n);
end;
// -----------------------------------------------------------------------
// ReadStr
// -----------------------------------------------------------------------
var
  ReadStrBuffer : array[0..65535] of char;
function ReadStr;
var
  n : dword;
begin
  Result:='';
  Stream.ReadBuffer(n,sizeof(dword));
  if((n<=0)or(n>=65534)) then exit;
  Stream.ReadBuffer(ReadStrBuffer,n);
  ReadStrBuffer[n]:=#0;
  Result:=Copy(string(ReadStrBuffer),1,n);
end;
// -----------------------------------------------------------------------
// fSmartScan
// -----------------------------------------------------------------------
function fSmartScan;
var
  c,cp : char;
begin
  Result:='';
  try
    with Stream do
    begin
      ReadBuffer(c,sizeof(c));
      while(
        (Position<Size)and((c=' ')or(c=#9)or(c=chr($0D))or(c=chr($0A)))) do
        ReadBuffer(c,sizeof(c));
      if(c='/') then
      begin
        ReadBuffer(cp,sizeof(cp));
        if(cp='/') then
        begin
          while((Position<Size)and(c<>chr($0D))and(c<>chr($0A))) do
            ReadBuffer(c,sizeof(c));
          exit;
        end
        else
          Seek(-1,soFromCurrent);
      end;
      if(c<>'"') then
      begin
        while((Position<Size)and(c<>' ')and(c<>#9)and(c<>chr($0D))
          and(c<>chr($0A))) do
        begin
          Result:=Result+c;
          Stream.ReadBuffer(c,sizeof(c));
        end;
      end
      else
      begin
        ReadBuffer(c,sizeof(c));
        while((Position<Size)and(c<>'"')) do
        begin
          Result:=Result+c;
          Stream.ReadBuffer(c,sizeof(c));
        end
      end;
    end;
  except
    on EReadError do
    begin
      Error('Ошибка чтения из потока.');
      exit;
    end;
  end;
end;
// -----------------------------------------------------------------------
// CharFromPtr
// -----------------------------------------------------------------------
function CharFromPtr(var ptr:pointer):char;register;
begin
  Result:=PChar(ptr)^;
  if(Result<>#0) then
    DWORD(ptr):=DWORD(ptr)+1;
end;
// -----------------------------------------------------------------------
// fSmartScanZ
// -----------------------------------------------------------------------
function fSmartScanZ;
var
  c : char;
begin
  Result := '';
  c:=CharFromPtr(ptr);
  while((c<>#0)and((c=' ')or(c=#9)or(c=chr($0D))or(c=chr($0A)))) do
    c:=CharFromPtr(ptr);
  if(c<>'"') then
  begin
    while((c<>#0)and(c<>' ')and(c<>#9)and(c<>chr($0D))and(c<>chr($0A))) do
    begin
      if(c=#0) then exit;
      Result:=Result+c;
      c:=CharFromPtr(ptr);
    end;
  end
  else
  begin
    c:=CharFromPtr(ptr);
    while((c<>#0)and(c<>'"')) do
    begin
      if(c=#0) then exit;
      Result:=Result+c;
      c:=CharFromPtr(ptr);
    end
  end;
end;
// -----------------------------------------------------------------------
// fPrint
// -----------------------------------------------------------------------
procedure fPrint;
begin
  Stream.WriteBuffer(s[1],Length(s));
end;
// -----------------------------------------------------------------------
// SetDivider & Divider
// -----------------------------------------------------------------------
const
  SimpleDeco: string = '// =================  * * * '+
  '======================= * * * ================';
var DividerString:string;
procedure SetDivider(Str:string);
begin
  DividerString:=Str;
end;
procedure Divider;
begin
  if(DividerString<>'') then
    fPrint(Stream,DividerString+#13);
end;
// -----------------------------------------------------------------------
// GetSystemTimeStr
// -----------------------------------------------------------------------
function          GetSystemTimeStr:string;
var
  str : array[0..127] of char;
begin
  Windows.GetTimeFormat(LOCALE_USER_DEFAULT,0,
    nil,nil,str,15);
  Result:=string(str);
end;
// -----------------------------------------------------------------------
// GetSystemDateStr
// -----------------------------------------------------------------------
function          GetSystemDateStr:string;
var
  str : array[0..127] of char;
begin
  Windows.GetDateFormat(LOCALE_USER_DEFAULT,DATE_SHORTDATE,
    nil,nil,str,49);
  Result:=string(str);
end;
// -----------------------------------------------------------------------
// KillMe
// -----------------------------------------------------------------------
procedure KillMe;
begin
  Windows.ExitProcess(0);
end;
// -----------------------------------------------------------------------
// RemoveMessages
// -----------------------------------------------------------------------
procedure RemoveMessages;
var
  Msg : TMsg;
begin
  while PeekMessage(Msg,Handle,0,0,PM_REMOVE) do;
end;
procedure RemoveMessage;
var
  Msg : TMsg;
begin
  while PeekMessage(Msg,Handle,MsgId,MsgId,PM_REMOVE) do;
end;
// -----------------------------------------------------------------------
// CheckSpinContens
// -----------------------------------------------------------------------
function CheckSpinContens;
var
  n : integer;
  mm : Boolean;
  s : string;
begin
  mm := Edit.MinValue <> Edit.MaxValue;
  try
    n:=StrToint(Edit.Text);
    if(mm) then
    begin
      if((n<Edit.MinValue)or(n>Edit.MaxValue)) then
        Raise EConvertError.Create('Число вне допустимого диапазона.');
    end;
    Result:=True;
  except
    on EConvertError do
    begin
      if(mm) then
      begin
        s:='число от '+IntToStr(Edit.MinValue)+' до '+
          IntToStr(Edit.MaxValue)+'.';
        Edit.Value:=Edit.MinValue;
      end
      else
      begin
        s:='целое число';
      end;
      if(FieldName<>'') then
        Warning('Поле "'+FieldName+'" должно содержать'+#13+s)
      else
        Warning('Поле должно содержать'+#13+s);
      Result:=False;
    end;
  end;
end;
// -----------------------------------------------------------------------
// ValidDouble
// -----------------------------------------------------------------------
function ValidDouble(Text:string):string;
begin
  try
    StrToFloat(Text);
    Result:=Text;
  except
    on EConvertError do
    // #warning
      Result:='0';
  end;
end;
// -----------------------------------------------------------------------
// ValidInteger
// -----------------------------------------------------------------------
function ValidInteger(Edit:TSpinEdit):integer;
var
  n : integer;
  mm : Boolean;
begin
  mm := Edit.MinValue <> Edit.MaxValue;
  try
    n:=StrToInt(Edit.Text);
    if(mm) then
    begin
      if((n<Edit.MinValue)or(n>Edit.MaxValue)) then
        Raise EConvertError.Create('Число вне допустимого диапазона.');
    end;
    Result:=n;
  except
    on EConvertError do
    begin
      if(mm) then
      begin
        Result:=Edit.MinValue;
      end
      else
      begin
        Result:=0;
      end;
    end;
  end;
end;
// -----------------------------------------------------------------------
// ValidateByResult
// -----------------------------------------------------------------------
function ValidateByResult;
begin
  case ModalResult of
    mrOk:
    begin
      if(@Validator<>nil) then
        Result:=Validator
      else
        Result:=True;
    end;
    mrCancel:
    begin
      if(@Cleaner<>nil) then Cleaner;
      Result:=True;
    end;
  else
    Result:=True;
  end;
end;
// -----------------------------------------------------------------------
// ChooseResult
// -----------------------------------------------------------------------
function ChooseResult;
begin
  if((ModalResult<>mrOk)and(ModalResult<>mrCancel)) then
  begin
    case Key of
      VK_RETURN: Result:=mrOk;
      VK_ESCAPE: Result:=mrCancel;
    else         Result:=ModalResult;
    end;
  end
    else Result:=ModalResult;
end;
// -----------------------------------------------------------------------
// DlgGetString
// -----------------------------------------------------------------------
function DlgGetString;
begin
  if(Caption<>'') then
    StringInputDlg.Caption:=Caption;
  StringInputDlg.Edit.Text:=Def;
  Result:=StringInputDlg.ShowModal<>mrCancel;
  if(Result) then S:=StringInputDlg.Edit.Text;
end;
// -----------------------------------------------------------------------
// DlgGetDouble
// -----------------------------------------------------------------------
function DlgGetDouble;
begin
  if(Caption<>'') then
    FloatInputDlg.Caption:=Caption;
  FloatInputDlg.Edit.Text:=Def;
  Result:=FloatInputDlg.ShowModal<>mrCancel;
  if(Result) then X:=FloatInputDlg.Result;
end;
// -----------------------------------------------------------------------
// DlgGetInteger
// -----------------------------------------------------------------------
function DlgGetInteger;
begin
  if(Caption<>'') then
    IntInputDlg.Caption:=Caption;
  IntInputDlg.SEdit.Text:=Def;
  Result:=IntInputDlg.ShowModal<>mrCancel;
  if(Result) then V:=IntInputDlg.Result;
end;
// -----------------------------------------------------------------------
// Initialization
// -----------------------------------------------------------------------
begin
  DividerString:=SimpleDeco;
end.

