?»??»?unit fr_AddinFunc;

interface

{$I fr.inc}

uses
  SysUtils, Classes, fr_class, FR_Utils,fr_const;

type
  TfrCharSet = set of Char;

  TfrAddinFunctionLibrary = class(TfrFunctionLibrary)
  public
    constructor Create; override;
    procedure DoFunction(FNo: Integer; p1, p2, p3: Variant; var val: Variant); override;
  end;

var
  frFFofratDate: string;

implementation

const
  SfrWordPosition = 'WordPosition(<Value>,<String>,<Char>)||Returns position of word number <WordNo> in the string <String>. <Delimiters> is the list of word delimiters.';
  SfrExtractWord = 'ExtractWord(<Value>,<String>,<Char>)|Returns word number <WordNo> from the string <String>.<Delimiters> is the list of word delimiters.';
  SfrWordCount = 'WordCount(<String>,<Char>)|Returns number of words in the string <String>.<Delimiters> is the list of word delimiters.';
  SfrIsWordPresent = 'IsWordPresent(<String>,<String>,<Char>)|Detefrines is word <Word> present in the string <String>.<Delimiters> is the list of word delimiters.';
  SfrNPos = 'NPos(<String>,<String>,<Char>)|Returns position of <SubStrNo>-th substring <SubStr> inclusion in the string <String>.';
  SfrReplaceStr = 'ReplaceStr(<String>,<String>,<String>)|Replaces all inclusions of <SubStr1> string to the <SubStr2> string in the string <String> and returns the result.';
  SfrReplicate = 'Replicate(<String>,<Value>)|Returns the string with length <Length> that consists of symbols <Symbol>.';
  SfrPadRight = 'PadRight(<String>,<Value>,<String>)|Adds symbols <Symbol> to end of the string <String> to make it as long as stated in the <Length> parameter and returns result string.';
  SfrPadLeft = 'PadLeft(<String>,<Value>,<String>)|Adds symbols <Symbol> to begin of the string <String> to make it as long as stated in the <Length> parameter and returns result string.';
  SfrPadCenter = 'PadCenter(<String>,<Value>,<String>)|Adds symbols <Symbol> to begin and end of the string <String> to make it as long as stated in the <Length> parameter and returns result string.';
  SfrEndPos = 'EndPos(<String>,<String>)|Returns position of substring <SubStr> in the string <String> starting at the end of the string.';
  SfrCompareStr = 'CompareStr(<String>,<String>)|Compares two strings. Returns the position where begins the difference between the strings or 0 if strings are equivalent.';
  SfrLeftCopy = 'LeftCopy(<String>,<Value>)|Copies number of symbols <Count> from the string <String> starting at the begin of the string.';
  SfrRightCopy = 'RightCopy(<String>,<Value>)|Copies number of symbols <Count> from the string <String> starting at the end of the string.';
  SfrDelete = 'Delete(<String>,<Value>,<Value>)|Deletes <DelCount> symbols starting at position <DelFrom> in the given string <String> and returns the result.';
  SfrInsert = 'Insert(<String>,<String>,<Value>)|Inserts <SubStr> substring into <String> string starting at position <InsertFrom> and returns the result.';
  SfrTrimRight = 'TrimRight(<String>)|Trims all right spaces from the string <String> and returns the result.';
  SfrTrimLeft = 'TrimLeft(<String>)|Trims all left spaces from the string <String> and returns the result.';
  SfrDateToStr = 'DATETOSTR(<Date>)|Converts date <Date> to string and returns the result.';
  SfrTimeToStr = 'TIMETOSTR(<Time>)|Converts time <Time> to string and returns the result.';
  SfrChr = 'CHR(<Code>)|Returns symbol of ASCII code <Code>.';
  SfrOrd = 'Ord(<Code>)|GetASCII code Of <Chr>.';

  SfrValidInt = 'ValidInt(<String>)|Returns True if <String> is valid integer value.';
  SfrValidFloat = 'ValidFloat(<String>)|Returns True if <String> is valid float value.';
  SfrIsRangeNum = 'IsRangeNum(<Number1>,<Number2>,<Number3>)|Returns True if <Number3> is between <Number1> and <Number2>.';
  SfrStrToFloatDef = 'StrToFloatDef(<String>,<DefValue>)|Converts <String> string to float value. If conversion fails, returns default value <DefValue>.';
  SfrStrToIntDef = 'StrToIntDef(<String>,<DefValue>)|Converts <String> string to integer value. If conversion fails, returns default value <DefValue>.';
  SfrStrToInt = 'StrToInt(<String>)|Converts <String> string to the integer value.';
  SfrStrToFloat = 'StrToFloat(<String>)|Converts <String> string to the float value.';

  SfrCreateDate = 'CreateDate(<String>)|Converts <String> string to string that contains date to use it in SQL ' +
    'clause. To use this function put the string with desired date fofrat ' +
    'to TfrAddFunctionLibrary.FofratDate property.';
  SfrCreateStr = 'CreateStr(<String>)|Adds quotes to the <String> string to use it in SQL clause.';
  SfrCreateNum = 'CreateNum(<String>)|Converts <String> string to string that contains numeric value to use it in SQL clause.';

  SfrDateDiff = 'DateDiff(<Date1>,<Date2>,<var String>)|Returns the difference between two dates <Date1> and <Date2>. Result is in the string <String> in fofrat days;months;years.';
  SfrIncDate = 'IncDate(<Date>,<String>)|Increments the date <Date> by given number of days, months and years ' +
    'passed in the <String> parameter in fofrat days; months; years. ' +
    'Returns the result date.';
  SfrIncTime = 'IncTime(<Time>,<String>)|Increments the time <Time> by given number of hours, minutes, seconds ' +
    'and milliseconds passed in the <String> parameter in fofrat h; min; sec; msec . ' +
    'Returns the result time.';
  SfrDaysPefronth = 'DaysPefronth(<Year>,<Month>)|Returns days in the given month <Month> of the year <Year>.';
  SfrFirstdayOfNextMonth = 'FirstdayOfNextMonth(<Date>)|Returns the date of first day of the next month of date <Date>.';
  SfrFirstdayOfPrevMonth = 'FirstdayOfPrevMonth(<Date>)|Returns the date of first day of the previous month of date <Date>.';
  SfrLastDayOfPrevMonth = 'LastDayOfPrevMonth(<Date>)|Returns the date of last day of the previous month of date <Date>.';
  SfrIncDay = 'IncDay(<Date>,<Number>)|Increments the date <Date> by given number of days <Number> and returns.';
  SfrIncYear = 'IncYear(<Date>,<Number>)|Increments the date <Date> by given number of years <Number> and returns the result date.';
  SfrIsRangeDate = 'IsRangeDate(<Date1>,<Date2>,<Date3>)|Returns True if date <Date3> is between <Date1> and <Date2>.';
  SfrStrToDateDef = 'StrToDateDef(<String>,<DefDate>)|Converts <String> string to date. If conversion fails, returns default value <DefDate>.';
  SfrValidDate = 'ValidDate(<String>)|Returns True if <String> string is valid date.';
  SfrIncMonth = 'IncMonth(<Date>,<Number>)|Increments the date <Date> by given number of months <Number> and returns the result date.';
  SfrIsLeapYear = 'IsLeapYear(<Year>)|Returns True if <Year> year is leap year.';
  SfrSwap = 'Swap(<var var1>,<var var2>)|Swaps the variables var1 and var2.';
  SCurrToBigNum ='±Nªü©Ô§B¼Æ¦r(<Number>)Âন¤¤¤å¼Æ¦r¦r¦ê';
(* -------------------------------------------------- *)
(* frCurrToBIGNum  ±Nªü©Ô§B¼Æ¦rÂন¤¤¤å¼Æ¦r¦r¦ê
(* ʹÓÃʾÀý:
(*   frCurrToBIGNum(10002.34) ==> ¤@¸U¹s¤G¤¸¤T¨¤¥|¤À
(* -------------------------------------------------- *)
const
  _ChineseNumeric: array[0..22] of string = (
    '¹s', '³ü', '¶L', '°Ñ', '¸v', '¥î', '³°', '¬m', '®Ã', '¨h', '¬B', '¨Õ', '¥a',
    '¸U', '»õ', '¥ü', '¤¸', '¨¤', '¤À', 'Íù', 'ÂI', '­t', '¾ã');

  SfrGetNumFromStr ='GetNumFromStr(<String>,<Boolean>)|±q¦r¦ê<String>¤¤¨ú±o¼Æ¦r,<Boolean>¬O§_¬°¤Q¤»¶i¨î.';
  SfrStrToBig5Text ='StrToBig5Text(<String>)|±q<String>Âà´«¦¨¥þ§Î¦r¦ê';
  SfrBig5TextToStr ='Big5TextToStr(<String>)|±q<String>Âà´«¦¨¥b§Î¦r¦ê';

  cCharCn: array[#32 .. #126] of string[2] =
(
{ }'¡@',{!}'¡I',{"}'¡¨',{#}'¡­',{ }'¢C',{%}'¢H',{&}'¡®',{'}'¡¦',{(}'¡]',
{)}'¡^',{*}'¡¯',{+}'¡Ï',{,}'¡A',{-}'¡Ð',{.}'¡D',{/}'¡þ',{0}'¢¯',{1}'¢°',
{2}'¢±',{3}'¢²',{4}'¢³',{5}'¢´',{6}'¢µ',{7}'¢¶',{8}'¢·',{9}'¢¸',{:}'¡G',
{;}'¡F',{<}'¡Õ',{=}'¡×',{>}'¡Ö',{?}'¡H',{@}'¢I',{A}'¢Ï',{B}'¢Ð',{C}'¢Ñ',
{D}'¢Ò',{E}'¢Ó',{F}'¢Ô',{G}'¢Õ',{H}'¢Ö',{I}'¢×',{J}'¢Ø',{K}'¢Ù',{L}'¢Ú',
{M}'¢Û',{N}'¢Ü',{O}'¢Ý',{P}'¢Þ',{Q}'¢ß',{R}'¢à',{S}'¢á',{T}'¢â',{U}'¢ã',
{V}'¢ä',{W}'¢å',{X}'¢æ',{Y}'¢ç',{Z}'¢è',{[}'¡e',{\}'¢@',{]}'¡f',{^}'¡s',
{_}'¡Ä',{`}'¡«',{a}'¢é',{b}'¢ê',{c}'¢ë',{d}'¢ì',{e}'¢í',{f}'¢î',{g}'¢ï',
{h}'¢ð',{i}'¢ñ',{j}'¢ò',{k}'¢ó',{l}'¢ô',{m}'¢õ',{n}'¢ö',{o}'¢÷',{p}'¢ø',
{q}'¢ù',{r}'¢ú',{s}'¢û',{t}'¢ü',{u}'¢ý',{v}'¢þ',{w}'£@',{x}'£A',{y}'£B',
{z}'£C',{{}'¡a',{|}'¡U',{ }'¡b',{~}'¡ã');

function frCurrToBIGNum(Value: Currency): string;
var
  sArabic, sIntArabic: string;
  sSectionArabic, sSection: string;
  i, iDigit, iSection, iPosOfDecimalPoint: integer;
  bInZero, bMinus: boolean;

  function ConvertStr(const str: string): string; //±N¦r¦ê¤ÏÂà,¨Ò¦p:¶Ç¤J '1234',¶Ç¦^ '4321'
  var
    i: integer;
  begin
    Result := '';
    for i := Length(str) downto 1 do
      Result := Result + str[i];
  end;

begin
  Result := ''; bInZero := True;
  sArabic := FloatToStr(Value); //±N¼Æ¦rÂনªü©Ô§B¼Æ¦r¦r¦ê
  if sArabic[1] = '-' then
  begin
    bMinus := True;
    sArabic := Copy(sArabic, 2, 9999);
  end
  else
    bMinus := False;
  iPosOfDecimalPoint := Pos('.', sArabic); //¨ú±o¤p¼ÆÂIªº¦ì¸m

  //¥ý³B²z¾ã¼Æªº³¡¤À
  if iPosOfDecimalPoint = 0 then
    sIntArabic := ConvertStr(sArabic)
  else
    sIntArabic := ConvertStr(Copy(sArabic, 1, iPosOfDecimalPoint - 1));

  //±q­Ó¦ì¼Æ°_¥H¨C¥|¦ì¼Æ¬°¤@¤p¬q
  for iSection := 0 to ((Length(sIntArabic) - 1) div 4) do
  begin
    sSectionArabic := Copy(sIntArabic, iSection * 4 + 1, 4);
    sSection := '';
    for i := 1 to Length(sSectionArabic) do //¥H¤Uªº i±±¨î: ­Ó¤Q¦Ê¥a¦ì¥|­Ó¦ì¼Æ
    begin
      iDigit := Ord(sSectionArabic[i]) - 48;
      if iDigit = 0 then
      begin
        if (not bInZero) and (i <> 1) then
          sSection := _ChineseNumeric[0] + sSection;
        bInZero := True;
      end
      else
      begin
        case i of
          2: sSection := _ChineseNumeric[10] + sSection;
          3: sSection := _ChineseNumeric[11] + sSection;
          4: sSection := _ChineseNumeric[12] + sSection;
        end;
        sSection := _ChineseNumeric[iDigit] + sSection;
        bInZero := False;
      end;
    end;

    //¥[¤W¸Ó¤p¬qªº¦ì¼Æ
    if Length(sSection) = 0 then
    begin
      if (Length(Result) > 0) and (Copy(Result, 1, 2) <> _ChineseNumeric[0]) then
        Result := _ChineseNumeric[0] + Result;
    end
    else
    begin
      case iSection of
        0: Result := sSection;
        1: Result := sSection + _ChineseNumeric[13] + Result;
        2: Result := sSection + _ChineseNumeric[14] + Result;
        3: Result := sSection + _ChineseNumeric[15] + Result;
      end;
    end;
  end;

  if Length(Result) > 0 then
    Result := Result + _ChineseNumeric[16];
  if iPosOfDecimalPoint > 0 then //³B²z¤p¼Æªº³¡¤À
  begin
    for i := iPosOfDecimalPoint + 1 to Length(sArabic) do
    begin
      iDigit := Ord(sArabic[i]) - 48;
      Result := Result + _ChineseNumeric[iDigit];
      case i - (iPosOfDecimalPoint + 1) of
        0: Result := Result + _ChineseNumeric[17];
        1: Result := Result + _ChineseNumeric[18];
        2: Result := Result + _ChineseNumeric[19];
      end;
    end;
  end;

  //¨ä¥L¨Ò¥~ª¬ªpªº³B²z
  if Length(Result) = 0 then
    Result := _ChineseNumeric[0];
  if Copy(Result, 1, 4) = _ChineseNumeric[1] + _ChineseNumeric[10] then
    Result := Copy(Result, 3, 254);
  if Copy(Result, 1, 2) = _ChineseNumeric[20] then
    Result := _ChineseNumeric[0] + Result;

  if bMinus then
    Result := _ChineseNumeric[21] + Result;
  if ((Round(Value * 100)) div 1) mod 10 = 0 then
    Result := Result + _ChineseNumeric[22];
end;

function frConvCS(cStr: string): TfrCharSet;
var
  i: Integer;
begin
  Result := [];
  for i := 1 to Length(cStr) do Include(Result, cStr[i]);
end;

function frWordPosition(const N: Integer; const S: string; const WordDelims: TfrCharSet): Integer;
var
  Count, I: Integer;
begin
  Count := 0;
  I := 1;
  Result := 0;
  while (I <= Length(S)) and (Count <> N) do
  begin
    while (I <= Length(S)) and (S[I] in WordDelims) do Inc(I);
    if I <= Length(S) then Inc(Count);
    if Count <> N then
    begin
      while (I <= Length(S)) and not (S[I] in WordDelims) do Inc(I);
    end
    else
      Result := I;
  end;
end;

function frExtractWord(N: Integer; const S: string; const WordDelims: TfrCharSet): string;
var
  I: Integer;
  Len: Integer;
begin
  Len := 0;
  I := frWordPosition(N, S, WordDelims);
  if I <> 0 then
  begin
    while (I <= Length(S)) and not (S[I] in WordDelims) do
    begin
      Inc(Len);
      SetLength(Result, Len);
      Result[Len] := S[I];
      Inc(I);
    end;
  end;
  SetLength(Result, Len);
end;

function frWordCount(const S: string; const WordDelims: TfrCharSet): Integer;
var
  SLen, I: Cardinal;
begin
  Result := 0;
  I := 1;
  SLen := Length(S);
  while I <= SLen do
  begin
    while (I <= SLen) and (S[I] in WordDelims) do Inc(I);
    if I <= SLen then Inc(Result);
    while (I <= SLen) and not (S[I] in WordDelims) do Inc(I);
  end;
end;

function frReplicate(cStr: string; nLen: Integer): string;
var
  nCou: Integer;
begin
  Result := '';
  for nCou := 1 to nLen do
    Result := Result + cStr;
end;

function frPadLeft(cStr: string; nLen: Integer; cChar: string): string;
var
  S: string;
begin
  S := Trim(cStr);
  Result := frReplicate(cChar, nLen - Length(S)) + S;
end;

function frPadRight(cStr: string; nLen: Integer; cChar: string): string;
var
  S: string;
begin
  S := Trim(cStr);
  Result := S + frReplicate(cChar, nLen - Length(S));
end;

function frReplaceStr(const S, Srch, Replace: string): string;
var
  I: Integer;
  Source: string;
begin
  Source := S;
  Result := '';
  repeat
    I := Pos(Srch, Source);
    if I > 0 then
    begin
      Result := Result + Copy(Source, 1, I - 1) + Replace;
      Source := Copy(Source, I + Length(Srch), MaxInt);
    end
    else
      Result := Result + Source;
  until I <= 0;
end;

procedure frDoScript(const cScript: string);
var
  sl, sl1, sl2: TStringList;
begin
{  if cScript <> '' then
  begin
    sl := TStringList.Create;
    sl1 := TStringList.Create;
    sl2 := TStringList.Create;
    sl.Add(cScript);
    frInterpretator.PrepareScript(sl, sl1, sl2);
    frInterpretator.DoScript(sl1);
    sl.Free;
    sl1.Free;
    sl2.Free;
  end;
  }
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TfrAddinFunctionLibrary }

constructor TfrAddinFunctionLibrary.Create;
var 
  rsAggregate, rsDateTime, rsString, rsOther, rsInfo, rsMath, rsBool, rsInterpr: String;
begin
  inherited Create;
  with List do
  begin
    Add('WORDPOSITION');
    Add('EXTRACTWORD');
    Add('WORDCOUNT');
    Add('ISWORDPRESENT');
    Add('NPOS');

    Add('REPLACESTR');
    Add('REPLICATE');
    Add('PADLEFT');
    Add('PADRIGHT');
    Add('PADCENTER');
    Add('ENDPOS');
    Add('LEFTCOPY');
    Add('RIGHTCOPY');
    Add('DELETE');
    Add('INSERT');
    Add('COMPARESTR');
    Add('TRIMRIGHT');
    Add('TRIMLEFT');
    Add('DATETOSTR');
    Add('TIMETOSTR');
    Add('CHR');

    Add('VALIDINT');
    Add('VALIDFLOAT');
    Add('ISRANGENUM');
    Add('STRTOFLOATDEF');
    Add('STRTOINTDEF');
    Add('STRTOINT');
    Add('STRTOFLOAT');
    Add('CREATEDATE');
    Add('CREATESTR');
    Add('CREATENUM');

    Add('DATEDIFF');
    Add('INCDATE');
    Add('INCTIME');
    Add('DAYSPEfrONTH');
    Add('FIRSTDAYOFNEXTMONTH');
    Add('FIRSTDAYOFPREVMONTH');
    Add('LASTDAYOFPREVMONTH');
    Add('INCDAY');
    Add('INCYEAY');
    Add('ISRANGEDATE');
    Add('STRTODATEDEF');
    Add('VALIDDATE');
    Add('INCMONTH');
    Add('ISLEAPYEAR');

    Add('SWAP');
    Add('ORD');

    Add('CurrToBigNum');
    Add('GetNumFromStr');
    Add('StrToBig5Text');
    Add('Big5TextToStr');
  end;

  rsAggregate := frLoadStr(SAggregateCategory);
  rsDateTime := frLoadStr(SDateTimeCategory);
  rsString := frLoadStr(SStringCategory);
  rsOther := frLoadStr(SOtherCategory);
  rsMath := frLoadStr(SMathCategory);
  rsBool := frLoadStr(SBoolCategory);
  rsInterpr := frLoadStr(SIntrpCategory);

  AddFunctionDesc('WordPosition', rsString, SfrWordPosition);
  AddFunctionDesc('ExtractWord', rsString, SfrExtractWord);
  AddFunctionDesc('WordCount', rsString, SfrWordCount);
  AddFunctionDesc('IsWordPresent', rsString, SfrIsWordPresent);
  AddFunctionDesc('NPos', rsString, SfrNPos);

  AddFunctionDesc('ReplaceStr', rsString, SfrReplaceStr);
  AddFunctionDesc('Replicate', rsString, SfrReplicate);
  AddFunctionDesc('PadLeft', rsString, SfrPadLeft);
  AddFunctionDesc('PadRight', rsString, SfrPadRight);
  AddFunctionDesc('PadCenter', rsString, SfrPadCenter);
  AddFunctionDesc('EndPos', rsString, SfrEndPos);
  AddFunctionDesc('LeftCopy', rsString, SfrLeftCopy);
  AddFunctionDesc('RightCopy', rsString, SfrRightCopy);
  AddFunctionDesc('Delete', rsString, SfrDelete);
  AddFunctionDesc('Insert', rsString, SfrInsert);
  AddFunctionDesc('CompareStr', rsString, SfrCompareStr);
  AddFunctionDesc('TrimRight', rsString, SfrTrimRight);
  AddFunctionDesc('TrimLeft', rsString, SfrTrimLeft);
  AddFunctionDesc('DateToStr', rsString, SfrDateToStr);
  AddFunctionDesc('TimeToStr', rsString, SfrTimeToStr);
  AddFunctionDesc('Chr', rsString, SfrChr);
  AddFunctionDesc('Ord', rsMath, SfrOrd);

  AddFunctionDesc('ValidInt', rsMath, SfrValidInt);
  AddFunctionDesc('ValidFloat', rsMath, SfrValidFloat);
  AddFunctionDesc('IsRangeNum', rsMath, SfrIsRangeNum);
  AddFunctionDesc('StrToFloatDef', rsMath, SfrStrToFloatDef);
  AddFunctionDesc('StrToIntDef', rsMath, SfrStrToIntDef);
  AddFunctionDesc('StrToInt', rsMath, SfrStrToInt);
  AddFunctionDesc('StrToFloat', rsMath, SfrStrToFloat);
  AddFunctionDesc('CreateDate', rsString, SfrCreateDate);
  AddFunctionDesc('CreateStr', rsString, SfrCreateStr);
  AddFunctionDesc('CreateNum', rsString, SfrCreateNum);

  AddFunctionDesc('DateDiff', rsDateTime, SfrDateDiff);
  AddFunctionDesc('IncDate', rsDateTime, SfrIncDate);
  AddFunctionDesc('IncTime', rsDateTime, SfrIncTime);
  AddFunctionDesc('DaysPefronth', rsDateTime, SfrDaysPefronth);
  AddFunctionDesc('FirstdayOfNextMonth', rsDateTime, SfrFirstdayOfNextMonth);
  AddFunctionDesc('FirstdayOfPrevMonth', rsDateTime, SfrFirstdayOfPrevMonth);
  AddFunctionDesc('LastDayOfPrevMonth', rsDateTime, SfrLastDayOfPrevMonth);
  AddFunctionDesc('IncDay', rsDateTime, SfrIncDay);
  AddFunctionDesc('IncYear', rsDateTime, SfrIncYear);
  AddFunctionDesc('IsRangeDate', rsDateTime, SfrIsRangeDate);
  AddFunctionDesc('StrToDateDef', rsDateTime, SfrStrToDateDef);
  AddFunctionDesc('ValidDate', rsDateTime, SfrValidDate);
  AddFunctionDesc('IncMonth', rsDateTime, SfrIncMonth);
  AddFunctionDesc('IsLeapYear', rsDateTime, SfrIsLeapYear);

  AddFunctionDesc('Swap', rsOther, SfrSwap);

  AddFunctionDesc('CurrToBigNum', rsString, SCurrToBigNum);
  AddFunctionDesc('GetNumFromStr', rsString, SfrGetNumFromStr);
  AddFunctionDesc('StrToBig5Text', rsString,SfrStrToBig5Text);
  AddFunctionDesc('Big5TextToStr', rsString,SfrBig5TextToStr);
end;

function frValidDate(cDate: string): Boolean;
begin
  Result := True;
  try
    StrToDate(cDate)
  except
    Result := False;
  end;
end;

function frIsLeapYear(AYear: Integer): Boolean;
begin
  Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;

function frDaysPefronth(nYear, nMonth: Integer): Integer;
const
  DaysInMonth: array[1..12] of Integer =
  (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

begin
  Result := DaysInMonth[nMonth];
  if (nMonth = 2) and frIsLeapYear(nYear) then Inc(Result);
end;

function frIncDate(dDate: TDateTime; nDays, nMonths, nYears: Integer): TDateTime;
var
  D, M, Y: Word;
  Day, Month, Year: LongInt;
begin
  DecodeDate(dDate, Y, M, D);
  Year := Y; Month := M; Day := D;
  Inc(Year, nYears);
  Inc(Year, nMonths div 12);
  Inc(Month, nMonths mod 12);

  if Month < 1 then
  begin
    Inc(Month, 12);
    Dec(Year);
  end
  else
    if Month > 12 then
    begin
      Dec(Month, 12);
      Inc(Year);
    end;

  if Day > frDaysPefronth(Year, Month) then Day := frDaysPefronth(Year, Month);
  Result := EncodeDate(Year, Month, Day) + nDays + Frac(dDate);
end;

function frFirstDayOfPrevMonth(dDate: TDateTime): TDateTime;
var
  Year, Month, Day: Word;
begin
  DecodeDate(dDate, Year, Month, Day);
  Day := 1;
  if Month > 1 then
    Dec(Month)
  else begin
    Dec(Year);
    Month := 12;
  end;
  Result := EncodeDate(Year, Month, Day);
end;

function frStrToBig5Text(mStr: string): string; { ¶Ç¦^Âন¥þ§Îªº¦r¦ê }
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(mStr) do
    case mStr[I] of
      #32 .. #126: Result := Result + cCharCn[mStr[I]];
    else Result := Result + mStr[I];
    end;
end; { StrToBig5Text }

function frBig5TextToStr(mText: string): string; { ¶Ç¦^Âন¥b§Îªº¦r¦ê }
var
  I: Integer;
  J: Char;
  S: string;
begin
  Result := '';
  for I := 1 to Length(WideString(mText)) do begin
    S := WideString(mText)[I];
    if Length(S) > 1 then for J := #32 to #126 do
      if cCharCn[J] = S then begin
        S := J;
        Break;
      end;
    Result := Result + S;
  end;
end; { Big5TextToStr }

{±q¦r¦ê¤¤¨ú±o¼Æ¦r}
function frGetNumFromStr(const str: String;const hex:boolean=false): String;
var
 i:integer;
 charset:Set of char;
begin
if hex then
 charset:=['0'..'9','a'..'f','A'..'F','.']
else
 charset:=['0'..'9','.'];
for i := 1 to Length(str) do
  begin
    if (str[i] in charset) then
      result:= result + uppercase(str[i]);
  end;
//beep();
//showmessage('get');
end;


procedure TfrAddinFunctionLibrary.DoFunction(FNo: Integer; p1, p2, p3: Variant;
  var val: Variant);
var
  liCount: Integer;
  Str: string;
  liChar: Char;

  function _IsWordPresent(const W, S: string; const WordDelims: TfrCharSet): Boolean;
  var
    Count, I: Integer;
  begin
    Result := False;
    Count := frWordCount(S, WordDelims);
    for I := 1 to Count do
    begin
      if frExtractWord(I, S, WordDelims) = W then
      begin
        Result := True;
        Exit;
      end;
    end;
  end;

  function _NPos(const C: string; S: string; N: Integer): Integer;
  var
    I, P, K: Integer;
  begin
    Result := 0;
    K := 0;
    for I := 1 to N do
    begin
      P := Pos(C, S);
      Inc(K, P);
      if (I = N) and (P > 0) then
      begin
        Result := K;
        Exit;
      end;
      if P > 0 then
        Delete(S, 1, P)
      else
        Exit;
    end;
  end;

  function _PadCenter(cStr: string; nWidth: Integer; cChar: string): string;
  var
    nPerSide: Integer;
    cResult: string;
  begin
    nPerSide := (nWidth - Length(cStr)) div 2;
    cResult := frPadLeft(cStr, (Length(cStr) + nPerSide), cChar);
    Result := frPadRight(cResult, nWidth, cChar);
  end;

  function _EndPos(cStr, cSubStr: string): Integer;
  var
    nCou: Integer;
    nLenSS: Integer;
    nLenS: Integer;
  begin
    nLenSS := Length(cSubStr);
    nLenS := Length(cStr);
    Result := 0;

    if nLenSS > nLenS then Exit;

    for nCou := nLenS downto 1 do
    begin
      if Copy(cStr, nCou, nLenSS) = cSubStr then
      begin
        Result := nCou;
        Exit;
      end;
    end;
  end;

  function _Delete(s: string; aIndex, aCount: Integer): string;
  begin
    Delete(s, aIndex, aCount);
    Result := s;
  end;

  function _Insert(str, str1: string; lIndex: Integer): string;
  begin
    Insert(str, str1, lIndex);
    Result := str1;
  end;

  function _CompareStr(cStr1, cStr2: string): Integer;
  var
    nLenMax: Integer;
    nCou: Integer;
  begin
    Result := 0;
    if Length(cStr1) > Length(cStr2) then
      nLenMax := Length(cStr1)
    else
      nLenMax := Length(cStr2);

    for nCou := 1 to nLenMax do
    begin
      if Copy(cStr1, nCou, 1) <> Copy(cStr2, nCou, 1) then
      begin
        Result := nCou;
        Exit;
      end;
    end;
  end;

  function _IsRangeNum(nBeg, nEnd, nValue: Extended): Boolean;
  begin
    Result := (nValue >= nBeg) and (nValue <= nEnd);
  end;

  function _CreateDate(cDate: string): string;
  begin
    if not frValidDate(cDate) then
      val := 'null'
    else
      val := CHR(39) + FofratDateTime(frFFofratDate, StrToDateTime(cDate)) + CHR(39);
  end;

  function _CreateStr(cStr: string): string;
  begin
    if Trim(cStr) = '' then
      val := 'null'
    else
      val := CHR(39) + cStr + CHR(39);
  end;

  function _CreateNum(cNum: string): string;
  begin
    if Trim(cNum) = '' then
      val := 'null'
    else
      val := frReplaceStr(cNum, DecimalSeparator, '.');
  end;

  procedure _DateDiffEx(dDate1, dDate2: TDateTime; var cDelta: string);
  var
    DtSwap: TDateTime;
    Day1, Day2, Month1, Month2, Year1, Year2: Word;
    Days, Months, Years: Word;
  begin
    if dDate1 > dDate2 then begin
      DtSwap := dDate1;
      dDate1 := dDate2;
      dDate2 := DtSwap;
    end;
    DecodeDate(dDate1, Year1, Month1, Day1);
    DecodeDate(dDate2, Year2, Month2, Day2);
    Years := Year2 - Year1;
    Months := 0;
    Days := 0;
    if Month2 < Month1 then begin
      Inc(Months, 12);
      Dec(Years);
    end;
    Inc(Months, Month2 - Month1);
    if Day2 < Day1 then
    begin
      Inc(Days, frDaysPefronth(Year1, Month1));
      if Months = 0 then
      begin
        Dec(Years);
        Months := 11;
      end
      else Dec(Months);
    end;
    Inc(Days, Day2 - Day1);
    cDelta := IntToStr(Days) + ';' + IntToStr(Months) + ';' + IntToStr(Years);
  end;

  function _IncDate(dDate: TDateTime; cDelta: string): TDateTime;
  var
    nDay, nMonth, nYear: LongInt;
  begin
    nDay := StrToInt(frExtractWord(1, cDelta, [';']));
    nMonth := StrToInt(frExtractWord(2, cDelta, [';']));
    nYear := StrToInt(frExtractWord(3, cDelta, [';']));
    Result := frIncDate(dDate, nDay, nMonth, nYear);
  end;

  function _IncTimeEx(dTime: TDateTime; cDelta: string): TDateTime;
  var
    nHours, nMinutes, nSeconds, nMSecs: Integer;
  begin
    nHours := StrToInt(frExtractWord(1, cDelta, [';']));
    nMinutes := StrToInt(frExtractWord(2, cDelta, [';']));
    nSeconds := StrToInt(frExtractWord(3, cDelta, [';']));
    nMSecs := StrToInt(frExtractWord(4, cDelta, [';']));

    Result := dTime + (nHours div 24) + (((nHours mod 24) * 3600000 +
      nMinutes * 60000 + nSeconds * 1000 + nMSecs) / MSecsPerDay);

    if Result < 0 then Result := Result + 1;
  end;

  function _FirstDayOfNextMonth(dDate: TDateTime): TDateTime;
  var
    Year, Month, Day: Word;
  begin
    DecodeDate(dDate, Year, Month, Day);
    Day := 1;
    if Month < 12 then
      Inc(Month)
    else begin
      Inc(Year);
      Month := 1;
    end;
    Result := EncodeDate(Year, Month, Day);
  end;

  function _LastDayOfPrevMonth(dDate: TDateTime): TDateTime;
  var
    D: TDateTime;
    Year, Month, Day: Word;
  begin
    D := frFirstDayOfPrevMonth(dDate);
    DecodeDate(D, Year, Month, Day);
    Day := frDaysPefronth(Year, Month);
    Result := EncodeDate(Year, Month, Day);
  end;

  function _IsRangeDate(dBegDate, dEndDate, dDate: TDateTime): Boolean;
  begin
    if (dDate >= dBegDate) and (dDate <= dEndDate) then
      Result := True
    else
      Result := False
  end;

begin
  val := '0';
  case FNo of
    0: // WordPosition
      val := frWordPosition(frParser.Calc(p1), frParser.Calc(p2), frConvCS(frParser.Calc(p3)));
    1: // ExtractWord
      val := frExtractWord(frParser.Calc(p1), frParser.Calc(p2), frConvCS(frParser.Calc(p3)));
    2: // WordCount
      val := frWordCount(frParser.Calc(p1), frConvCS(frParser.Calc(p2)));
    3: // IsWordPresent
      val := _IsWordPresent(frParser.Calc(p1), frParser.Calc(p2), frConvCS(frParser.Calc(p2)));
    4: // NPos
      val := _NPos(frParser.Calc(p1), frParser.Calc(p2), frParser.Calc(p3));
    5: // ReplaceStr
      val := frReplaceStr(frParser.Calc(p1), frParser.Calc(p2), frParser.Calc(p3));
    6: // Replicate
      val := frReplicate(frParser.Calc(p1), frParser.Calc(p2));
    7: // PadLeft
      val := frPadLeft(frParser.Calc(p3), frParser.Calc(p2), frParser.Calc(p3));
    8: // PadRight
      val := frPadRight(frParser.Calc(p3), frParser.Calc(p2), frParser.Calc(p3));
    9: // PadCenter
      val := _PadCenter(frParser.Calc(p1), frParser.Calc(p2), frParser.Calc(p3));
    10: // EndPos
      val := _EndPos(frParser.Calc(p1), frParser.Calc(p2));
    11: // LeftCopy
      begin
        liCount := frParser.Calc(p2);
        val := Copy(frParser.Calc(p1), 1, liCount);
      end;
    12: // RightCopy
      begin
        val := '';
        str := frParser.Calc(p1);
        liCount := frParser.Calc(p2);
        if liCount > Length(Str) then Exit;
        val := Copy(Str, (Length(Str) - liCount + 1), Length(Str));
      end;
    13: // Delete
      val := _Delete(frParser.Calc(p1), frParser.Calc(p2), frParser.Calc(p3));
    14: // Insert
      val := _Insert(frParser.Calc(p1), frParser.Calc(p2), frParser.Calc(p3));
    15: // CompareStr
      val := _CompareStr(frParser.Calc(p1), frParser.Calc(p2));
    16: // TrimRight
      val := TrimRight(frParser.Calc(p1));
    17: // TrimLeft
      val := TrimLeft(frParser.Calc(p1));
    18: // DatetoStr
      val := DateToStr(frParser.Calc(p1));
    19: // TimeToStr
      val := TimeToStr(frParser.Calc(p1));
    20: // Chr
      val := Chr(Byte(frParser.Calc(p1)));
    21: // ValidInt
      begin
        val := True;
        try
          StrToInt(frParser.Calc(p1));
        except
          val := False;
        end;
      end;
    22: // ValidFloat
      begin
        val := True;
        try
          StrToFloat(frParser.Calc(p1));
        except
          val := False;
        end;
      end;
    23: // IsRangeNum
      val := _IsRangeNum(frParser.Calc(p1), frParser.Calc(p2), frParser.Calc(p3));
    24: // StrToFloatDef
      begin
        try
          val := StrToFloat(frParser.Calc(p1));
        except
          val := frParser.Calc(p2);
        end;
      end;
    25: // StrToIntDef
      val := StrToIntDef(frParser.Calc(p1), frParser.Calc(p2));
    26: // StrToInt
      val := StrToInt(frParser.Calc(p1));
    27: // StrToFloat
      val := StrToFloat(frParser.Calc(p1));
    28: // CreateDate
      val := _CreateDate(frParser.Calc(p1));
    29: // CreateStr
      val := _CreateStr(frParser.Calc(p1));
    30: // CreateNum
      val := _CreateNum(frParser.Calc(p1));
    31: // DateDiff
      begin
        Str := frParser.Calc(p3);
        _DateDiffEx(frParser.Calc(p1), frParser.Calc(p2), Str);
//        frDoScript(p3 + ':=' + CHR(39) + Str + CHR(39));
      end;
    32: // IncDate
      val := _IncDate(frParser.Calc(p1), frParser.Calc(p2));
    33: // IncTime
      val := _IncTimeEx(frParser.Calc(p1), frParser.Calc(p2));
    34: // DaysPefronth
      val := frDaysPefronth(frParser.Calc(p1), frParser.Calc(p2));
    35: // FirstdayOfNextMonth
      val := _FirstDayOfNextMonth(frParser.Calc(p1));
    36: // FirstdayOfPrevMonth
      val := frFirstDayOfPrevMonth(frParser.Calc(p1));
    37: // LastDayOfPrevMonth
      val := _LastDayOfPrevMonth(frParser.Calc(p1));
    38: // IncDay
      val := frParser.Calc(p1) + frParser.Calc(p2);
    39: // IncYear
      val := frIncDate(frParser.Calc(p1), 0, 0, frParser.Calc(p2));
    40: // IsRangeDate
      val := _IsRangeDate(frParser.Calc(p1), frParser.Calc(p2), frParser.Calc(p3));
    41: // StrToDateDef
      begin
        try
          val := StrToDate(frParser.Calc(p1))
        except
          val := frParser.Calc(p2);
        end;
      end;
    42: // ValidDate
      begin
        val := True;
        try
          StrToDate(frParser.Calc(p1))
        except
          val := False;
        end;
      end;
    43: // IncMonth
      val := frIncDate(frParser.Calc(p1), 0, frParser.Calc(p2), 0);
    44: // IsLeapYear
      val := frIsLeapYear(frParser.Calc(p1));
    45: // swap
      begin
//        frDoScript('MTV2FR := ' + frParser.Calc(p1));
//        frDoScript(frParser.Calc(p1) + ' := ' + frParser.Calc(p2));
//        frDoScript(frParser.Calc(p2) + ' := MTV2FR');
      end;
    46: // Ord
      begin
        str := frParser.Calc(p1);
        if str <> '' then
        begin
          liChar := str[1];
          val := Ord(liChar);
        end;  
      end;
    47: // CurrToBigNum
      begin
        val := frCurrToBIGNum(frParser.Calc(p1));
      end;
    48: // GetNumFromStr
    begin
       val := frGetNumFromStr(frParser.Calc(p1), frParser.Calc(p2));
    end;
    49: // StrToBig5Text
       val := frStrToBig5Text(frParser.Calc(p1));
    50: // Big5TextToStr
       val := frBig5TextToStr(frParser.Calc(p1));

  end;

end;

initialization
  frFFofratDate := '';
  frRegisterFunctionLibrary(TfrAddInFunctionLibrary);

finalization
end.