// Декларация пользовательского интерфейса для MathCAD 6.0.
// (импорт из McadUser.dll)
//
// Динамическая загрузка и возможность работать без McadUser.dll
// в последнем случае инициализируются заглушки.
{---------------------------------------------------------------------------
The control program for mass-spectrometer MI1201-AGM
(c) Copyright	 Aleksandrov O.E., 2001

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

Программа управления масс-спектрометром МИ1201-АГМ
(c) Собственность     Александрова О.Е., 2001

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
{$WRITEABLECONST OFF}
unit McadUserEx;

INTERFACE
   Uses Windows, McadUserTypes;

type
//Регистрирует функцию в MathCAD,
//после регистрации функция становится доступной для использования
tCreateUserFunction=function(
  const h:HINST;                // HANDLER для DLL
  var   FInfo:FUNCTIONINFO      // информация про функцию
):pointer; cdecl;  // смысл возвращаемого значения неизвестно

//Регистрирует таблицу текстовых сообщений об ошибках в MathCAD
tCreateUserErrorMessageTable=function(
  const h:HINST;                                // HANDLER для DLL
        nErrorMessages:uint;                    // число сообщений
  const ErrorMessageTable:array of Pchar        // таблица сообщений
):boolean; cdecl;  // возвращает TRUE, если успешно.

// Функции управления памятью
tMathcadAllocate=function(size:uint):pointer; cdecl; // возвращает TRUE, если успешно.
tMathcadFree=procedure(address:pointer); cdecl;

// Функции динамического выделения массива
// - должна использоваться для размещения возвращаемого значения
tMathcadArrayAllocate=function(
  var Complex_Array:COMPLEXARRAY;
      rows:uint;
      cols:uint;
      allocateReal:boolean;
      allocateImag:boolean
):boolean; cdecl; // возвращает TRUE, если успешно.

// Функции динамического освобождения массива
// - должна использоваться для освобождения массива при ошибке
tMathcadArrayFree=procedure(var Complex_Array:COMPLEXARRAY); cdecl;


// Функция сообщения о требовании пользователя прервать счет
// Замедляет выполнение программы - использовать осторожно
TisUserInterrupted=function:boolean; cdecl;

const
 CreateUserFunction:tCreateUserFunction=NIL;
 CreateUserErrorMessageTable:tCreateUserErrorMessageTable=NIL;
 MathcadAllocate:tMathcadAllocate=NIL;
 MathcadFree:tMathcadFree=NIL;
 MathcadArrayAllocate:tMathcadArrayAllocate=NIL;
 MathcadArrayFree:tMathcadArrayFree=NIL;
 isUserInterrupted:TisUserInterrupted=NIL;

procedure DisableMcadUserDLL;
function LoadMcadUserDLL:boolean;
function LoadedMcadUserDLL:boolean;

IMPLEMENTATION

function McadUserDLLLoaded:boolean; forward;
function McadUserDLLDisabled:boolean; forward;

// Заглушки
function xCreateUserFunction(
  const h:HINST;                // HANDLER для DLL
  var   FInfo:FUNCTIONINFO      // информация про функцию
):pointer; cdecl;
begin
  Result:=NIL;
  if McadUserDLLDisabled then Exit;
  Assert(not McadUserDLLLoaded, 'MadUser.dll доступна и загружена . Неверный вызов заглушки xCreateUserFunction.');
//  Assert(TRUE, 'Вызов заглушки xCreateUserFunction.');
end;

function xCreateUserErrorMessageTable(
  const h:HINST;                                // HANDLER для DLL
        nErrorMessages:uint;                    // число сообщений
  const ErrorMessageTable:array of Pchar        // таблица сообщений
):boolean; cdecl;
begin
  Result:=FALSE;
  if McadUserDLLDisabled then Exit;
  Assert(not McadUserDLLLoaded, 'MadUser.dll доступна и загружена . Неверный вызов заглушки xCreateUserErrorMessageTable.');
//  Assert(TRUE, 'Вызов заглушки xCreateUserErrorMessageTable.');
end;

function xMathcadAllocate(size:uint):pointer; cdecl; // возвращает TRUE, если успешно.
begin
  Result:=NIL;
  if McadUserDLLDisabled then Exit;
  Assert(not McadUserDLLLoaded, 'MadUser.dll доступна и загружена . Неверный вызов заглушки xMathcadAllocate.');
//  Assert(TRUE, 'Вызов заглушки xMathcadAllocate.');
end;

procedure xMathcadFree(address:pointer); cdecl;
begin
  if McadUserDLLDisabled then Exit;
  Assert(not McadUserDLLLoaded, 'MadUser.dll доступна и загружена . Неверный вызов заглушки xMathcadFree.');
//  Assert(TRUE, 'Вызов заглушки xMathcadFree.');
end;

function xMathcadArrayAllocate(
  var Complex_Array:COMPLEXARRAY;
      rows:uint;
      cols:uint;
      allocateReal:boolean;
      allocateImag:boolean
):boolean; cdecl; // возвращает TRUE, если успешно.
begin
  Result:=FALSE;
  if McadUserDLLDisabled then Exit;
  Assert(not McadUserDLLLoaded, 'MadUser.dll доступна и загружена . Неверный вызов заглушки xMathcadArrayAllocate.');
//  Assert(TRUE, 'Вызов заглушки xMathcadArrayAllocate.');
end;

// Функции динамического освобождения массива
// - должна использоваться для освобождения массива при ошибке
procedure xMathcadArrayFree(var Complex_Array:COMPLEXARRAY); cdecl;
begin
  if McadUserDLLDisabled then Exit;
  Assert(not McadUserDLLLoaded, 'MadUser.dll доступна и загружена . Неверный вызов заглушки xMathcadArrayFree.');
//  Assert(TRUE, 'Вызов заглушки xMathcadArrayFree.');
end;

function XisUserInterrupted:boolean; cdecl;
begin
  Result:=FALSE;
  if McadUserDLLDisabled then Exit;
  Assert(not McadUserDLLLoaded, 'MadUser.dll доступна и загружена . Неверный вызов заглушки xMathcadFree.');
//  Assert(TRUE, 'Вызов заглушки XisUserInterrupted.');
end;

type
  tFlag=(fDllMcadUserTryLoad, fDllMcadUserLoaded, fDllDllMcadUserDisabled);
  tFlags=set of tFlag;
var
  Flags:tFlags=[];
  CriticalSection:TRTLCriticalSection;

function McadUserDLLLoaded:boolean;
begin
  Result:=fDllMcadUserLoaded in Flags;
end;

function LoadedMcadUserDLL:boolean;
begin
  if not (fDllMcadUserTryLoad in Flags) then
    Result:=LoadMcadUserDLL
  else
    Result:=fDllMcadUserLoaded in Flags;
end;

procedure xFill;
begin
 EnterCriticalSection(CriticalSection);
  CreateUserFunction:=xCreateUserFunction;
  CreateUserErrorMessageTable:=xCreateUserErrorMessageTable;
  MathcadAllocate:=xMathcadAllocate;
  MathcadFree:=xMathcadFree;
  MathcadArrayAllocate:=xMathcadArrayAllocate;
  MathcadArrayFree:=xMathcadArrayFree;
  isUserInterrupted:=XisUserInterrupted;
 LeaveCriticalSection(CriticalSection);
end;

function LoadMcadUserDLL:boolean;
  var
    Handle: THandle;
begin
  Result:=FALSE;
  if McadUserDLLDisabled then Exit;
  if (fDllMcadUserTryLoad in Flags) then begin
    Result:=fDllMcadUserLoaded in Flags;
  end else begin
   EnterCriticalSection(CriticalSection);
    if (fDllMcadUserTryLoad in Flags) then begin
      Result:=fDllMcadUserLoaded in Flags;
    end else begin
      Include(Flags,fDllMcadUserTryLoad);
      Handle := LoadLibrary(cMcadUser);
      Result:=Handle<>0;
      If Result then begin
        CreateUserFunction:=GetProcAddress(Handle, 'CreateUserFunction');
        CreateUserErrorMessageTable:=GetProcAddress(Handle, 'CreateUserErrorMessageTable');
        MathcadAllocate:=GetProcAddress(Handle, 'MathcadAllocate');
        MathcadFree:=GetProcAddress(Handle, 'MathcadFree');
        MathcadArrayAllocate:=GetProcAddress(Handle, 'MathcadArrayAllocate');
        MathcadArrayFree:=GetProcAddress(Handle, 'MathcadArrayFree');
        isUserInterrupted:=GetProcAddress(Handle, 'isUserInterrupted');
        Result:=(@CreateUserFunction<>NIL)
            and (@CreateUserErrorMessageTable<>NIL)
            and (@MathcadAllocate<>NIL)
            and (@MathcadFree<>NIL)
            and (@MathcadArrayAllocate<>NIL)
            and (@MathcadArrayFree<>NIL)
            and (@isUserInterrupted<>NIL)
        ;
      end;
      if Result then
        Include(Flags,fDllMcadUserLoaded)
      else begin
        xFill;
        if Handle<>0 then begin
          FreeLibrary(Handle);
        end;
      end;
    end;
   LeaveCriticalSection(CriticalSection);
  end;
end;

// Начальные значения
function iCreateUserFunction(
  const h:HINST;                // HANDLER для DLL
  var   FInfo:FUNCTIONINFO      // информация про функцию
):pointer; cdecl;
begin
  if LoadMcadUserDLL then
    Result:=CreateUserFunction(h,FInfo)
  else
    Result:=NIL;
end;

function iCreateUserErrorMessageTable(
  const h:HINST;                                // HANDLER для DLL
        nErrorMessages:uint;                    // число сообщений
  const ErrorMessageTable:array of Pchar        // таблица сообщений
):boolean; cdecl;
begin
  if LoadMcadUserDLL then
    Result:=CreateUserErrorMessageTable(h,nErrorMessages,ErrorMessageTable)
  else
    Result:=FALSE;
end;

function iMathcadAllocate(size:uint):pointer; cdecl; // возвращает TRUE, если успешно.
begin
  if LoadMcadUserDLL then
    Result:=MathcadAllocate(size)
  else
    Result:=NIL;
end;

procedure iMathcadFree(address:pointer); cdecl;
begin
  if LoadMcadUserDLL then
    MathcadFree(address);
end;

function iMathcadArrayAllocate(
  var Complex_Array:COMPLEXARRAY;
      rows:uint;
      cols:uint;
      allocateReal:boolean;
      allocateImag:boolean
):boolean; cdecl; // возвращает TRUE, если успешно.
begin
  if LoadMcadUserDLL then
    Result:=MathcadArrayAllocate(Complex_Array,rows,cols,allocateReal,allocateImag)
  else
    Result:=FALSE;
end;

// Функции динамического освобождения массива
// - должна использоваться для освобождения массива при ошибке
procedure iMathcadArrayFree(var Complex_Array:COMPLEXARRAY); cdecl;
begin
  if LoadMcadUserDLL then
    MathcadArrayFree(Complex_Array);
end;

function IisUserInterrupted:boolean; cdecl;
begin
  if LoadMcadUserDLL then
    Result:=IisUserInterrupted
  else
    Result:=false;
end;

function McadUserDLLDisabled:boolean;
begin
  Result:=fDllDllMcadUserDisabled in Flags;
end;

procedure DisableMcadUserDLL;
begin
  Include(Flags,fDllDllMcadUserDisabled);
end;

INITIALIZATION
  InitializeCriticalSection(CriticalSection);
  EnterCriticalSection(CriticalSection);
  CreateUserFunction:=iCreateUserFunction;
  CreateUserErrorMessageTable:=iCreateUserErrorMessageTable;
  MathcadAllocate:=iMathcadAllocate;
  MathcadFree:=iMathcadFree;
  MathcadArrayAllocate:=iMathcadArrayAllocate;
  MathcadArrayFree:=iMathcadArrayFree;
  isUserInterrupted:=IisUserInterrupted;
  LeaveCriticalSection(CriticalSection);
FINALIZATION
  xFill;
END.