rm_pgtfunction.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 862 行 · 第 1/2 页

function Ascii(const Keychr: string): Byte;
var
  I, ReturnAscii: Byte;
begin
  ReturnAscii := 0;
  for I := 0 to 255 do
  begin
    if Chr(I) = KeyChr then
    begin
      ReturnAscii := I;
      Break;
    end;
  end;
  Ascii := ReturnAscii;
end;

function PGTFormatDate(Format: string; DateTime: TDateTime): string; //自定义日期转换为字符串
var
  TmpStr, TmpForMat: string;
  MonType, i, at: Integer;
  FindStr: string;
  Bstr, eStr, EnMon: string;
  UType: Integer; //大小写类型
  c: string;
begin
  TmpForMat := '';
  for i := 1 to Length(Format) do
  begin
    if UpperCase(ForMat[i]) = 'M' then
      c := LowerCase(Format[i])
    else
      c := Format[i];
    TmpForMat := TmpForMat + C;
  end;
  TmpFormat := Trim(TmpForMat);
  TmpStr := FormatDateTime(tmpFormat, DateTime);
  if Pos('MMMM', UpperCase(ForMat)) <> 0 then
    MonType := 2 //月份是完整的
  else
    Montype := 1; //否则为短格式月份
  if Pos('MMM', ForMat) <> 0 then
    UType := 1 //全部大写
  else if Pos('Mmm', ForMat) <> 0 then
    UType := 2 //首字母大写
  else if Pos('mmm', ForMat) <> 0 then
    UType := 3 //全部小写
  else
    Utype := 0; //默认  首字母大写

  FindStr := '';
  for i := 11 downto 0 do
  begin
    FindStr := CnNum[i] + '月';
    at := Pos(FindStr, TmpStr); //检查中文月份是否在值中
    if at <> 0 then
    begin
      Bstr := LeftStr(TmpStr, At - 1);
      estr := RightStr(TmpStr, Length(TmpStr) - at - Length(FindStr) + 1);
      if Montype = 2 then
        EnMon := LongMon[i]
      else
        EnMon := ShortMon[i];
      case uType of
        1: enMon := UpperCase(enMon);
        2: enMon := LeftUpper(enMon);
        3: enMon := LowerCase(enMon);
      end;
      TmpStr := bStr + enMon + estr;
      Break;
    end;
  end;
  Result := TmpStr;
end;


function CutInt(v: Variant): Variant; //提取小数点左边数值
var
  V_str, V_Bgn: string;
begin
  try
    V_str := Trim(ForMatFloat('####.00', V));
    V_Bgn := V_Str;
    if Pos('.', V_Str) <> 0 then
    begin
      V_Bgn := Trim(Leftstr(V_Str, Pos('.', V_Str) - 1));
    end;
    Result := StrToInt(V_Bgn);
  except
    Result := v;
  end;
end;


function NumToEn(V: Variant): string; //数字转换为英文大写
var
  V_Str, V_Bgn, V_End: string;
  Split, I: Integer;
  TmpNum: string;
  Re_str, Dec_str: string;
begin
  Re_str := '';
  TmpNum := '';
  Split := 0;
  V_str := Trim(ForMatFloat('#,##0.00', v));
  V_Bgn := V_Str;
  V_End := '';
  if Pos('.', V_Str) <> 0 then
  begin
    V_Bgn := Leftstr(V_Str, Pos('.', V_Str) - 1);
    V_End := RightStr(V_Str, Length(V_str) - Pos('.', V_Str));
  end;
  if Length(Trim(V_Bgn)) = 0 then
    V_Bgn := '0';
  if Length(Trim(V_End)) = 0 then
    V_End := '0';
  for I := Length(V_Bgn) downto 1 do
  begin
    if V_Bgn[I] <> ',' then
    begin
      TmpNum := V_Bgn[i] + TmpNum;
    end
    else
    begin
      Split := Split + 1;
      case Split of
        1: Re_str := SmallNum(StrToInt(TmpNum)) + Re_str;
        2: Re_str := SmallNum(StrToInt(TmpNum)) + ' THOUSAND ' + Re_Str;
        3: Re_str := SmallNum(StrToInt(TmpNum)) + ' MILLION ' + Re_Str;
      else
        begin
          Re_str := '超出设计范围';
          Break;
        end;
      end;
      TmpNum := '';
    end;
  end;
  if TmpNum <> '' then
  begin
    Split := Split + 1;
    case Split of
      1: Re_str := SmallNum(StrToInt(TmpNum)) + Re_str;
      2: Re_str := SmallNum(StrToInt(TmpNum)) + ' THOUSAND ' + Re_Str;
      3: Re_str := SmallNum(StrToInt(TmpNum)) + ' MILLION ' + Re_Str;
    else
      begin
        Result := '超出设计范围';
        Exit;
      end;
    end;
  end;
  if StrToInt(V_End) <> 0 then
  begin
    Dec_Str := SmallNum(StrToIntDef(V_END, 0));
    Re_str := Re_str + ' AND ' + DEC_STR + ' CENT';
  end;
  Result := Re_Str;
end;

function NumToMoney(V: Variant; SDollar: Variant; SCent: Variant): string; //数字转换为美元大写
var
  V_Str, V_Bgn, V_End: string;
  Split, I: Integer;
  TmpNum: string;
  Re_str, Dec_str: string;
  CanD: Boolean;
  Dollar, Cent: string;
begin
  Re_str := '';
  TmpNum := '';
  try Dollar := VartoStr(SDollar); except Dollar := 'DOLLAR'; end;
  try Cent := VartoStr(SCent); except Cent := 'CENT'; end;

  Split := 0;
  V_str := Trim(ForMatFloat('#,##0.00', V));
  V_Bgn := V_Str;
  V_End := '';
  if Pos('.', V_Str) <> 0 then
  begin
    V_Bgn := Leftstr(V_Str, Pos('.', V_Str) - 1);
    V_End := RightStr(V_Str, Length(V_str) - Pos('.', V_Str));
  end;
  if Length(Trim(V_Bgn)) = 0 then
    V_Bgn := '0';
  if Length(Trim(V_End)) = 0 then
    V_End := '0';
  for I := Length(V_Bgn) downto 1 do
  begin
    if V_Bgn[I] <> ',' then
    begin
      TmpNum := V_Bgn[i] + TmpNum;
    end
    else
    begin
      Split := Split + 1;
      case Split of
        1: Re_str := SmallNum(StrToInt(TmpNum)) + Re_str;
        2: Re_str := SmallNum(StrToInt(TmpNum)) + ' THOUSAND ' + Re_Str;
        3: Re_str := SmallNum(StrToInt(TmpNum)) + ' MILLION ' + Re_Str;
      else
        begin
          Re_str := '超出设计范围';
          Break;
        end;
      end;
      TmpNum := '';
    end;
  end;
  if TmpNum <> '' then
  begin
    Split := Split + 1;
    case Split of
      1: Re_str := SmallNum(StrToInt(TmpNum)) + Re_str;
      2: Re_str := SmallNum(StrToInt(TmpNum)) + ' THOUSAND ' + Re_Str;
      3: Re_str := SmallNum(StrToInt(TmpNum)) + ' MILLION ' + Re_Str;
    else
      begin
        Result := '超出设计范围';
        Exit;
      end;
    end;
  end;
  Dollar := UpperCase(Dollar);
  if (Trunc(V) > 1) and (Ascii(Dollar[1]) < 128) then
  begin
    if Rightstr(Dollar, 1) = 'Y' then
      Dollar := LeftStr(Dollar, Length(Dollar) - 1) + 'IES'
    else
      Dollar := Dollar + 'S';
  end;
  Re_str := Re_str + ' ' + Dollar;
  if StrToInt(V_End) <> 0 then
  begin
    Dec_Str := SmallNum(StrToInt(V_END));
    TmpNum := Cent;

    if StrToInt(V_End) > 1 then
    begin
      CanD := True; // 可以变复数
      for i := 1 to Length(cent) do
      begin
        if Ascii(Cent[i]) >= 128 then
        begin
          Cand := False;
          Break;
        end;
      end;
      Cent := UpperCase(Cent);
      if Cand then
      begin
        if RightStr(Cent, 1) = 'Y' then
          Cent := LeftStr(Cent, Length(Cent) - 1) + 'IES'
        else
          Cent := Cent + 'S';
      end;
    end;

    if Pos('>', Cent) > 0 then
    begin // 去除>符号 如果有>符号,则美分置右
      Cent := '';
      for i := 1 to Length(TmpNum) do
      begin
        if Tmpnum[i] <> '>' then
          Cent := Cent + TmpNum[i];
      end;
    end;
    if Pos('>', TmpNum) = 0 then
      Re_str := Re_str + ' AND ' + Trim(CENT) + ' ' + DEC_STR
    else
      Re_str := Re_str + ' AND ' + DEC_STR + ' ' + Trim(CENT);
  end;
  Result := UpperCase(Re_Str);
end;

function DateToShortStr(V: Variant; StrLx: Integer): string; //日期转换为英文短日期格式
var
  MonthStr: string;
  Month: string;
begin
  Month := Trim(FormatDateTime('m', V));
  if Length(Month) = 0 then
  begin
    Result := FormatDateTime('dd mmm yyyy', V);
    Exit;
  end;
  MOnthStr := '';
  case StrToInt(Month) of
    1: MonthStr := 'Jan';
    2: MonthStr := 'Feb';
    3: MonthStr := 'Mar';
    4: MonthStr := 'Apr';
    5: MonthStr := 'May';
    6: MonthStr := 'Jun';
    7: MonthStr := 'Jul';
    8: MonthStr := 'Aug';
    9: MonthStr := 'Sep';
    10: MonthStr := 'Oct';
    11: MonthStr := 'Nov';
    12: MonthStr := 'Dec';
  else
    MonthStr := '***';
  end;
  case StrLx of
    7: Result := UpperCase(MonthStr) + FormatDateTime(' dd', V) + FormatDateTime(' yyyy', V);
    8: Result := UpperCase(MonthStr) + '.' + FormatDateTime(' dd,', V) + FormatDateTime(' yyyy', V);
  else
    Result := UpperCase(MonthStr) + FormatDateTime(' dd', V) + FormatDateTime(' yyyy', V);
  end;
end;

function DateToLongStr(V: Variant): string; //日期转换为英文长日期格式
var
  MonthStr: string;
  Month: string;
begin
  Month := Trim(FormatDateTime('m', V));
  if Length(Month) = 0 then
  begin
    Result := FormatDateTime('dd mmm yyyy', V);
    Exit;
  end;
  MOnthStr := '';
  case StrToInt(Month) of
    1: MonthStr := 'January';
    2: MonthStr := 'February';
    3: MonthStr := 'March';
    4: MonthStr := 'April';
    5: MonthStr := 'May';
    6: MonthStr := 'June';
    7: MonthStr := 'July';
    8: MonthStr := 'August';
    9: MonthStr := 'September';
    10: MonthStr := 'October';
    11: MonthStr := 'November';
    12: MonthStr := 'December';
  else
    MonthStr := '***';
  end;
  Result := UpperCase(MonthStr) + FormatDateTime(' dd,', V) + FormatDateTime(' yyyy', V);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMPGTAddinFunction}

constructor TRMPGTAddinFunction.Create;
begin
  inherited Create;
  with List do
  begin
    Add('CutInt');
    Add('DayofLongWeek');
    Add('DayofShortWeek');
    Add('LeftUpper');
    Add('NumToEn');
    Add('NumToMoney');
    Add('SmallNum');
    Add('LeftStr');
    Add('RightStr');
    Add('DateToShortStr');
    Add('DateToLongStr');
    Add('PGTFormatDate');
    Add('Ascii');
    Add('PicExists');
{$IFDEF DM_ADO}
    Add('InitConnectstring');
    Add('GetFieldValue');
{$ENDIF}
  end;

  AddFunctionDesc('CutInt', RMftstring, 'CutInt|(Value)提取小数点左边数值', 'N');
  AddFunctionDesc('DayofLongWeek', rmftDateTime, 'DayofLongWeek(Date)|返回长星期格式', 'D');
  AddFunctionDesc('DayofShortWeek', rmftDateTime, 'DayofShortWeek(Date)|返回短星期格式', 'D');
  AddFunctionDesc('LeftUpper', rmftString, 'LeftUpper(String)|首字大写', 'S');
  AddFunctionDesc('NumToEn', rmftMath, 'NumToEn(Value)|数字转换为英文大写', 'N');
  AddFunctionDesc('NumToMoney', rmftMath, 'NumToMoney(Value, Dollar, Cent)|数字转换为美元大写,如果Cent带">"符号,则CENT置右 ', 'NSS');
  AddFunctionDesc('LeftStr', rmftString, 'LeftStr(String, n)|取左边n位字符', 'SN');
  AddFunctionDesc('RightStr', rmftString, 'RightStr(String, n)|取右边n位字符', 'SN');
  AddFunctionDesc('DateToShortStr', rmftDateTime, 'DateToShortStr(Date, StrLx)|英文短日期格式', 'DN');
  AddFunctionDesc('DateToLongStr', rmftDateTime, 'DateToLongStr(Date)|英文长日期格式', 'D');
  AddFunctionDesc('PGTFormatDate', rmftDateTime, 'PGTFormatDate(Foramt, Date)|自定义日期转换为字符串', 'SD');
  AddFunctionDesc('Ascii', rmftString, 'Ascii(Char)|取字符的Ascii码', 'S');
  AddFunctionDesc('PicExists', rmftBoolean, 'PicExists(FileName)|检查图片文件是否存在', 'S');
{$IFDEF DM_ADO}
  AddFunctionDesc('InitConnectstring', RMftInterpreter, 'InitConnectstring()|初始化数据连接字符串', '');
  AddFunctionDesc('GetFieldValue', rmftMath, 'GetFieldValue(TableName, Where, FieldName)|取得表<Table>中符合<Where>条件的记录的字段<FieldName>的值', 'SSS');
{$ENDIF}
end;

procedure TRMPGTAddinFunction.DoFunction(aParser: TRMParser; FNo: Integer; p: array of Variant;
  var val: Variant);
var
  s: string;
begin
  val := '0';
  case FNo of
    0: Val := CutInt(aParser.Calc(p[0]));
    1: Val := DayofLongWeek(aParser.Calc(p[0]));
    2: Val := DayofShortWeek(aParser.Calc(p[0]));
    3: Val := LeftUpper(aParser.Calc(p[0]));
    4: Val := NumToEn(aParser.Calc(p[0]));
    5: Val := NumToMoney(aParser.Calc(p[0]), aParser.Calc(p[1]), aParser.Calc(p[2]));
    6: Val := SmallNum(aParser.Calc(p[0]));
    7: Val := LeftStr(aParser.Calc(p[0]), aParser.Calc(p[1]));
    8: Val := RightStr(aParser.Calc(p[0]), aParser.Calc(p[1]));
    9: Val := DateToShortStr(aParser.Calc(p[0]), aParser.Calc(p[1]));
    10: Val := DateToLongStr(aParser.Calc(p[0]));
    11: Val := PGTFormatDate(aParser.Calc(p[0]), aParser.Calc(p[1]));
    12: Val := Ascii(aParser.Calc(p[0]));
    13:
      begin
        s := aParser.Calc(p[0]);
        Val := PicExists(s);
      end;
{$IFDEF DM_ADO}
    14: Val := RMPGTInitConnectstring;
    15: Val := RMPGTGetFieldValue(aParser.Calc(p[0]), aParser.Calc(p[1]), aParser.Calc(p[2]));
{$ENDIF}
  end;
end;

initialization
  RMRegisterFunctionLibrary(TRMPGTAddinFunction);

finalization
  RMUnRegisterFunctionLibrary(TRMPGTAddinFunction);

end.