unit MCAD_DateTime;

interface
  uses
    Windows, McadUserTypes, McadUserEx;

// Получение Даты системных часов
function GetDateTime(var FuncResult:COMPLEXARRAY;
                 const DateType:COMPLEXSCALAR
                 ):LRESULT; cdecl;

function DecodeDate(var FuncResult:COMPLEXARRAY;
                    const Date:COMPLEXSCALAR
                    ):LRESULT; cdecl;

function EncodeDate(var FuncResult:COMPLEXSCALAR;
                    const YMD:COMPLEXARRAY
                    ):LRESULT; cdecl;

function DecodeTime(var FuncResult:COMPLEXARRAY;
                 const Time:COMPLEXSCALAR
                 ):LRESULT; cdecl;

function EncodeTime(var FuncResult:COMPLEXSCALAR;
                    const HMSMS:COMPLEXARRAY
                   ):LRESULT; cdecl;

function Delay(var FuncResult:COMPLEXSCALAR;
                  const DelayMS:COMPLEXSCALAR
                 ):LRESULT; cdecl;

implementation
  Uses MCAD_MiscFuncs, SysUtils, MCAD_MI1201_Errors, MCAD_MI1201_RangeCheck;

const
  DecodeDateInfo:FUNCTIONINFO=(
    lpstrName:'msDecodeDate';
    lpstrParameters:'Date';
    lpstrDescription:'Декодирует дату в массив (Год, Месяц, День).';
    lpfnMyCFunction:NIL;
    returnType:COMPLEX_ARRAY;
    nArgs:1;
    argType:(COMPLEX_SCALAR,0,0,0,0,0,0,0,0,0)
  );

  DecodeTimeInfo:FUNCTIONINFO=(
    lpstrName:'msDecodeTime';
    lpstrParameters:'Time';
    lpstrDescription:'Декодирует время в массив (Час, Минута, Секунда, МиллиСекунда).';
    lpfnMyCFunction:NIL;
    returnType:COMPLEX_ARRAY;
    nArgs:1;
    argType:(COMPLEX_SCALAR,0,0,0,0,0,0,0,0,0)
  );

  EncodeDateInfo:FUNCTIONINFO=(
    lpstrName:'msEncodeDate';
    lpstrParameters:'d';
    lpstrDescription:'Кодирует дату из массива d=(Год, Месяц, День).';
    lpfnMyCFunction:NIL;
    returnType:COMPLEX_SCALAR;
    nArgs:1;
    argType:(COMPLEX_ARRAY,0,0,0,0,0,0,0,0,0)
  );

  EncodeTimeInfo:FUNCTIONINFO=(
    lpstrName:'msEncodeTime';
    lpstrParameters:'t';
    lpstrDescription:'Кодирует время из массива t=(Час, Минута, Секунда, МиллиСекунда).';
    lpfnMyCFunction:NIL;
    returnType:COMPLEX_SCALAR;
    nArgs:1;
    argType:(COMPLEX_ARRAY,0,0,0,0,0,0,0,0,0)
  );

  DelayInfo:FUNCTIONINFO=(
    lpstrName:'msDelay';
    lpstrParameters:'t';
    lpstrDescription:'Задержка на t мс.';
    lpfnMyCFunction:NIL;
    returnType:COMPLEX_SCALAR;
    nArgs:1;
    argType:(COMPLEX_SCALAR,0,0,0,0,0,0,0,0,0)
  );

  GetDateTimeInfo:FUNCTIONINFO=(
    lpstrName:'msDateTime';
    lpstrParameters:'N';
    lpstrDescription:'Возвращает текущую дату с системных часов '+
                     'N=0 (Год, Месяц, День, Час, Минута, Секунда, Миллисекунда);'+
                     'N=1 (Год, Месяц, День);'+
                     'N=2 (Час, Минута, Секунда, Миллисекунда).';
    lpfnMyCFunction:NIL;
    returnType:COMPLEX_ARRAY;
    nArgs:1;
    argType:(COMPLEX_SCALAR,0,0,0,0,0,0,0,0,0)
  );

function DecodeDate;
  var Y,M,D:word;
begin
  Result:=CheckCS_R(Date,1);
  if Result<>0 then
    Exit;
  Result:=Ord(xMathcadArrayAllocate(FuncResult,3,1,TRUE,FALSE));
  if Result<>0 then
    Exit;
  SysUtils.DecodeDate(Date.real, Y, M, D);
  FuncResult.hReal[0,0]:=Y;
  FuncResult.hReal[0,1]:=M;
  FuncResult.hReal[0,2]:=D;
end;

function EncodeDate;
begin
  if YMD.hImag<>NIL then begin
    Result:=MakeLResult(Ord(ecMUST_BE_REAL),1);
    Exit;
  end;
  if (YMD.cols<>1) or (YMD.rows<>3) then begin
    Result:=MakeLResult(Ord(ecINVALID_DIMENSION),1);
    Exit;
  end;
  Result:=CheckS_IMP(YMD.hReal[0,0],High(word),1);
  if Result<>0 then
    Exit;
  Result:=CheckS_IMP(YMD.hReal[0,1],12,1);
  if Result<>0 then
    Exit;
  Result:=CheckS_IMP(YMD.hReal[0,2],31,1);
  if Result<>0 then
    Exit;
  FuncResult.real:=SysUtils.EncodeDate(TRUNC(YMD.hReal[0,0]),
                                       TRUNC(YMD.hReal[0,1]),
                                       TRUNC(YMD.hReal[0,2]));
end;

function DecodeTime;
  var H,M,S,MS:word;
begin
  Result:=CheckCS_R(Time,1);
  if Result<>0 then
    Exit;
  Result:=Ord(xMathcadArrayAllocate(FuncResult,4,1,TRUE,FALSE));
  if Result<>0 then
    Exit;
  SysUtils.DecodeTime(Time.real, H,M,S,MS);
  FuncResult.hReal[0,0]:=H;
  FuncResult.hReal[0,1]:=M;
  FuncResult.hReal[0,2]:=S;
  FuncResult.hReal[0,3]:=MS;
end;

function EncodeTime;
begin
  if HMSMS.hImag<>NIL then begin
    Result:=MakeLResult(Ord(ecMUST_BE_REAL),1);
    Exit;
  end;
  if (HMSMS.cols<>1) or (HMSMS.rows<>4) then begin
    Result:=MakeLResult(Ord(ecINVALID_DIMENSION),1);
    Exit;
  end;
  Result:=CheckS_IMP(HMSMS.hReal[0,0],24,1);
  if Result<>0 then
    Exit;
  Result:=CheckS_IMP(HMSMS.hReal[0,1],60,1);
  if Result<>0 then
    Exit;
  Result:=CheckS_IMP(HMSMS.hReal[0,2],60,1);
  if Result<>0 then
    Exit;
  Result:=CheckS_IMP(HMSMS.hReal[0,3],1000,1);
  if Result<>0 then
    Exit;
  FuncResult.real:=SysUtils.EncodeTime(TRUNC(HMSMS.hReal[0,0]),
                                       TRUNC(HMSMS.hReal[0,1]),
                                       TRUNC(HMSMS.hReal[0,2]),
                                       TRUNC(HMSMS.hReal[0,3]));
end;

function Delay;
  var lDelayMS:word; StartTimer:dword;
begin
  StartTimer:=GetTickCount;
  Result:=CheckCS_RIMP(DelayMS,High(lDelayMS),1);
  if Result<>0 then
    Exit;
  lDelayMS:=Trunc(DelayMS.real);
  if lDelayMS=0 then exit;
  Sleep(lDelayMS);
  FuncResult.real:=GetTickCount-StartTimer;
end;

type
  tDateOrTime=(fDateTime, fDate, fTime, fYear, fMonth, fDay, fHour, fMin, fSec, fMsec);
  tDateOrTimeSet=set of tDateOrTime;


procedure FillDateTimeArray(var DateTimeArray:COMPLEXARRAY; DateTime:tDateTime;
                            Rows,Cols:uint; DateOrTime:tDateOrTimeSet);
 var
   DTArr:array[fYear..fMsec] of word;
   i:tDateOrTime;
begin
  SysUtils.DecodeDate(DateTime, DTArr[fYear], DTArr[fMonth], DTArr[fDay]);
  SysUtils.DecodeTime(DateTime, DTArr[fHour], DTArr[fMin], DTArr[fSec], DTArr[fMSec]);
  if (Cols>DateTimeArray.cols) then exit;
  if (Rows>DateTimeArray.rows) then exit;
  if (fDateTime in DateOrTime) then begin
    DateTimeArray.hReal^[0,Rows]:=DateTime;
    Inc(Rows);
  end;
  if (Rows>DateTimeArray.rows) then exit;
  if (fDate in DateOrTime) then begin
    DateTimeArray.hReal^[0,Rows]:=SysUtils.EncodeDate(DTArr[fYear], DTArr[fMonth], DTArr[fDay]);
    Inc(Rows);
  end;
  if (Rows>DateTimeArray.rows) then exit;
  if (fTime in DateOrTime) then begin
    DateTimeArray.hReal^[0,Rows]:=SysUtils.EncodeTime(DTArr[fHour], DTArr[fMin], DTArr[fSec], DTArr[fMSec]);
    Inc(Rows);
  end;
  for i:=fYear to fMSec do begin
    if (Rows>DateTimeArray.rows) then exit;
    if (i in DateOrTime) then begin
      DateTimeArray.hReal^[0,Rows]:=DTArr[i];
      Inc(Rows);
    end;
  end;
end;

procedure FillNowArray(var DateTime:COMPLEXARRAY; Rows:uint; DateOrTime:tDateOrTimeSet);
begin
  FillDateTimeArray(DateTime,Now(),Rows,0,DateOrTime);
end;

function GetDateTime;
  var lDateType:word;
begin
  Result:=CheckCS_RIMP(DateType,2,1);
  if Result<>0 then
    Exit;
  lDateType:=Trunc(DateType.Real);
  case lDateType of
    0:begin // Дата и время
      Result:=Ord(xMathcadArrayAllocate(FuncResult,7,1,TRUE,FALSE));
    end;
    1:begin // Дата
      Result:=Ord(xMathcadArrayAllocate(FuncResult,3,1,TRUE,FALSE));
    end;
    2:begin // Время
      Result:=Ord(xMathcadArrayAllocate(FuncResult,4,1,TRUE,FALSE));
    end;
    3:begin // Дата и время закодированные
      Result:=Ord(xMathcadArrayAllocate(FuncResult,1,1,TRUE,FALSE));
    end;
    else begin
      Result:=Ord(ecINVALID_PARAMETER_VALUE);
    end;
  end;
  if Result<>0 then
    Exit;

  case lDateType of
    0:begin // Дата и время
      FillNowArray(FuncResult,0,[fYear..fMsec]);
    end;
    1:begin // Дата
      FillNowArray(FuncResult,0,[fYear..fDay]);
    end;
    2:begin // Время
      FillNowArray(FuncResult,0,[fHour..fMsec]);
    end;
    3:begin // Дата и время закодированные
      FillNowArray(FuncResult,0,[fDateTime]);
    end;
    else begin
      Result:=Ord(ecINVALID_PARAMETER_VALUE);
    end;
  end;
end;

// регистрирует функции в MathCAD-е
procedure RegisterFunctions;
begin
  GetDateTimeInfo.lpfnMyCFunction:=@GetDateTime;
  CreateUserFunction(SysInit.hInstance, GetDateTimeInfo);

  DecodeDateInfo.lpfnMyCFunction:=@DecodeDate;
  CreateUserFunction(SysInit.hInstance, DecodeDateInfo);

  DecodeTimeInfo.lpfnMyCFunction:=@DecodeTime;
  CreateUserFunction(SysInit.hInstance, DecodeTimeInfo);

  EncodeDateInfo.lpfnMyCFunction:=@EncodeDate;
  CreateUserFunction(SysInit.hInstance, EncodeDateInfo);

  EncodeTimeInfo.lpfnMyCFunction:=@EncodeTime;
  CreateUserFunction(SysInit.hInstance, EncodeTimeInfo);

  DelayInfo.lpfnMyCFunction:=@Delay;
  CreateUserFunction(SysInit.hInstance, DelayInfo);
end;

initialization
  RegisterFunctions;
// finalization
end.