rm_addinfunc.pas

胜天进销存源码,国产优秀的进销存

    Count := RMWordCount(S, WordDelims);
    for I := 1 to Count do
    begin
      if RMExtractWord(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 := RMPadLeft(cStr, (Length(cStr) + nPerSide), cChar);
    Result := RMPadRight(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 RMValidDate(cDate) then
      val := 'null'
    else
      val := CHR(39) + FormatDateTime(RMFFormatDate, 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 := RMReplaceStr(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, RMDaysPerMonth(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(RMExtractWord(1, cDelta, [';']));
    nMonth := StrToInt(RMExtractWord(2, cDelta, [';']));
    nYear := StrToInt(RMExtractWord(3, cDelta, [';']));
    Result := RMIncDate(dDate, nDay, nMonth, nYear);
  end;

  function _IncTimeEx(dTime: TDateTime; cDelta: string): TDateTime;
  var
    nHours, nMinutes, nSeconds, nMSecs: Integer;
  begin
    nHours := StrToInt(RMExtractWord(1, cDelta, [';']));
    nMinutes := StrToInt(RMExtractWord(2, cDelta, [';']));
    nSeconds := StrToInt(RMExtractWord(3, cDelta, [';']));
    nMSecs := StrToInt(RMExtractWord(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 := RMFirstDayOfPrevMonth(dDate);
    DecodeDate(D, Year, Month, Day);
    Day := RMDaysPerMonth(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 := RMWordPosition(aParser.Calc(p[0]), aParser.Calc(p[1]), RMConvCS(aParser.Calc(p[2])));
    1: // ExtractWord
      val := RMExtractWord(aParser.Calc(p[0]), aParser.Calc(p[1]), RMConvCS(aParser.Calc(p[2])));
    2: // WordCount
      val := RMWordCount(aParser.Calc(p[0]), RMConvCS(aParser.Calc(p[1])));
    3: // IsWordPresent
      val := _IsWordPresent(aParser.Calc(p[0]), aParser.Calc(p[1]), RMConvCS(aParser.Calc(p[1])));
    4: // NPos
      val := _NPos(aParser.Calc(p[0]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    5: // ReplaceStr
      val := RMReplaceStr(aParser.Calc(p[0]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    6: // Replicate
      val := RMReplicate(aParser.Calc(p[0]), aParser.Calc(p[1]));
    7: // PadLeft
      val := RMPadLeft(aParser.Calc(p[2]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    8: // PadRight
      val := RMPadRight(aParser.Calc(p[2]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    9: // PadCenter
      val := _PadCenter(aParser.Calc(p[0]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    10: // EndPos
      val := _EndPos(aParser.Calc(p[0]), aParser.Calc(p[1]));
    11: // LeftCopy
      begin
        liCount := aParser.Calc(p[1]);
        val := Copy(aParser.Calc(p[0]), 1, liCount);
      end;
    12: // RightCopy
      begin
        val := '';
        str := aParser.Calc(p[0]);
        liCount := aParser.Calc(p[1]);
        if liCount > Length(Str) then Exit;
        val := Copy(Str, (Length(Str) - liCount + 1), Length(Str));
      end;
    13: // Delete
      val := _Delete(aParser.Calc(p[0]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    14: // Insert
      val := _Insert(aParser.Calc(p[0]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    15: // CompareStr
      val := _CompareStr(aParser.Calc(p[0]), aParser.Calc(p[1]));
    16: // TrimRight
      val := TrimRight(aParser.Calc(p[0]));
    17: // TrimLeft
      val := TrimLeft(aParser.Calc(p[0]));
    18: // DatetoStr
      val := DateToStr(aParser.Calc(p[0]));
    19: // TimeToStr
      val := TimeToStr(aParser.Calc(p[0]));
    20: // Chr
      val := Chr(Byte(aParser.Calc(p[0])));
    21: // ValidInt
      begin
        val := True;
        try
          StrToInt(aParser.Calc(p[0]));
        except
          val := False;
        end;
      end;
    22: // ValidFloat
      begin
        val := True;
        try
          StrToFloat(aParser.Calc(p[0]));
        except
          val := False;
        end;
      end;
    23: // IsRangeNum
      val := _IsRangeNum(aParser.Calc(p[0]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    24: // StrToFloatDef
      begin
        try
          val := StrToFloat(aParser.Calc(p[0]));
        except
          val := aParser.Calc(p[1]);
        end;
      end;
    25: // StrToIntDef
      val := StrToIntDef(aParser.Calc(p[0]), aParser.Calc(p[1]));
    26: // StrToInt
      val := StrToInt(aParser.Calc(p[0]));
    27: // StrToFloat
      val := StrToFloat(aParser.Calc(p[0]));
    28: // CreateDate
      val := _CreateDate(aParser.Calc(p[0]));
    29: // CreateStr
      val := _CreateStr(aParser.Calc(p[0]));
    30: // CreateNum
      val := _CreateNum(aParser.Calc(p[0]));
    31: // DateDiff
      begin
        Str := aParser.Calc(p[2]);
        _DateDiffEx(aParser.Calc(p[0]), aParser.Calc(p[1]), Str);
      end;
    32: // IncDate
      val := _IncDate(aParser.Calc(p[0]), aParser.Calc(p[1]));
    33: // IncTime
      val := _IncTimeEx(aParser.Calc(p[0]), aParser.Calc(p[1]));
    34: // DaysPerMonth
      val := RMDaysPerMonth(aParser.Calc(p[0]), aParser.Calc(p[1]));
    35: // FirstdayOfNextMonth
      val := _FirstDayOfNextMonth(aParser.Calc(p[0]));
    36: // FirstdayOfPrevMonth
      val := RMFirstDayOfPrevMonth(aParser.Calc(p[0]));
    37: // LastDayOfPrevMonth
      val := _LastDayOfPrevMonth(aParser.Calc(p[0]));
    38: // IncDay
      val := aParser.Calc(p[0]) + aParser.Calc(p[1]);
    39: // IncYear
      val := RMIncDate(aParser.Calc(p[0]), 0, 0, aParser.Calc(p[1]));
    40: // IsRangeDate
      val := _IsRangeDate(aParser.Calc(p[0]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    41: // StrToDateDef
      begin
        try
          val := StrToDate(aParser.Calc(p[0]))
        except
          val := aParser.Calc(p[1]);
        end;
      end;
    42: // ValidDate
      begin
        val := True;
        try
          StrToDate(aParser.Calc(p[0]))
        except
          val := False;
        end;
      end;
    43: // IncMonth
      val := RMIncDate(aParser.Calc(p[0]), 0, aParser.Calc(p[1]), 0);
    44: // IsLeapYear
      val := RMIsLeapYear(aParser.Calc(p[0]));
    45: // swap
      begin
      end;
    46: // Ord
      begin
        str := aParser.Calc(p[0]);
        if str <> '' then
        begin
          liChar := str[1];
          val := Ord(liChar);
        end;  
      end;
  end;
end;

initialization
  RMFFormatDate := '';
  RMRegisterFunctionLibrary(TRMAddInFunctionLibrary);

finalization
end.