cndigits.pas

cnupper131货币及日期转换大写组件

begin
  //获得整数部分
  IntPart := Abs(AValue) div 100;
  //获得两位小数部分
  FracPart := Abs(AValue) mod 100;
  //格式化整数部分
  rs := LzhFmtInt(IntPart) + CrNa[1];
  Jiao := FracPart div 10 mod 10;
  Fen := FracPart mod 10;
  //如果个位为零且大于零，则补零
  if (IntPart mod 10 = 0) and (IntPart > 0) and (FracPart >= 10) then
    rs := rs + DP[1];
  if (IntPart = 0) and (FracPart <> 0)  then rs := '';
  if FracPart >= 10 then
  begin
    if FracPart mod 10 = 0 then
      rs := rs + DP[Jiao + 1] + CrNa[2] + CrNa[4]
    else
      rs := rs + DP[Jiao + 1] + CrNa[2] + DP[Fen + 1] + CrNa[3];
  end
  else if FracPart > 0 then
  begin
    if IntPart = 0 then
      rs := rs + DP[Fen + 1] + CrNa[3]
    else
      rs := rs + DP[1] + DP[Fen + 1] + CrNa[3];
  end
  else
  begin
    rs := rs + CrNa[4];
  end;
  if AValue < 0 then rs := DP[12] + rs;
  Result := rs;
end;

class function TCnDigits.LzhFmtDate(AValue: TDate;
  DigitsYear: Boolean): String;
var
  yy, mm, dd: Word;
  ys: WideString;
  rs: WideString;
begin
  DecodeDate(AValue, yy, mm, dd);
  if DigitsYear then
    ys := LzhFmtDigits(IntToStr(yy)) + DtNa[1]
  else
    ys := LzhFmtInt(yy, True) + DtNa[1];
  rs := ys + LzhFmtInt(mm) + DtNa[2] + LzhFmtInt(dd) + DtNa[3];
  Result := rs;
end;

class function TCnDigits.LzhFmtDateTime(AValue: TDateTime;
  DigitsYear: Boolean): String;
var
  dt: TDate;
  tm: TTime;
begin
  dt := AValue;
  tm := AValue;
  Result := LzhFmtDate(dt, DigitsYear) + LzhFmtTime(tm);
end;

class function TCnDigits.LzhFmtDigits(Digits: String): String;
var
  i, len: Integer;
  rs: WideString;
begin
  len := Length(Digits);
  for i := 1 to len do
  begin
    if (Digits[i] >= '0') and (Digits[i] <= '9') then
    begin
      rs := rs + DP[(Ord(Digits[i]) - (Ord('0'))) mod 10 + 1];
    end
    else if Digits[i] = '.' then
    begin
      rs := rs + DN[1];
    end
    else
    begin
      rs := '';
      Break;
    end;
  end;
  Result := rs;
end;

class function TCnDigits.LzhFmtFloat(FloatValue: Extended;
  RoundPos: Integer): String;
var
  IntPart: Int64;
  FraPart: Int64;
  Digits: String;
  len, rps: Integer;
  beit: Extended;
  rs: WideString;
begin
  if (FloatValue > 1e15) or (FloatValue < -1e15) then
  begin
    //超出数的预定义范围，则直接返回空值
    Result := '';
    Exit;
  end;
  IntPart := Trunc(Abs(FloatValue));
  rps := Abs(RoundPos);
  if rps > 16 then rps := 16;
  beit := IntPower(10, rps);
  FraPart := Round(Frac(FloatValue) * beit);
  rs := LzhFmtInt(IntPart);
  if FraPart > 0 then
  begin
    Digits := IntToStr(FraPart);
    len := Length(Digits);
    while (len > 0) and (Digits[len] = '0') do len := len - 1;
    Digits := Copy(Digits, 1, len);
    rs := rs + DN[1] + LzhFmtDigits(Digits);
  end;
  if FloatValue < 0 then rs := DP[12] + rs;
  Result := rs;
end;

class function TCnDigits.LzhFmtInt(IntValue: Int64;
  IsYear: Boolean; SoftTone: Boolean): String;
var
  i, n, t: Integer;
  bi: WideString;
  LastBt: WideChar;
  rs: WideString;
  reach: Boolean;
  LastHit: Integer;
begin
  //限制为18位数
  if IntValue < 0 then rs := DP[12];
  IntValue := Abs(IntValue);
  //输入的数值应小于800兆，也就是8e18;
  if IntValue > 8000000000000000000 then
  begin
    Result := '';
    Exit;
  end;
  bi := IntToStr(IntValue);
  //格式化为
  bi := StringOfChar('0', 20 - Length(bi)) + bi;
  //从左侧开始格式化
  LastBt := ' ';
  LastHit := 0;
  reach := False;
  for i := 1 to 20 do
  begin
    //如果非0
    if (bi[i] >= '1') and (bi[i] <= '9') then
    begin
      //如果前一位是0,又不到分界位，补零
      if reach and (LastBt = '0') and (i mod 4 <> 1) then
      begin
        rs := rs + DP[1];
      end;
      reach := True;
      //转换数字,如果是十位，且前一位为0
      if SoftTone and (i mod 4 = 3) and (LastBt = '0')
        and ((not reach) or (bi[i] = '1')) then
      else
      begin
        rs := rs + DP[(Ord(bi[i]) - Ord('0')) mod 10 + 1];
      end;
      //添加位名
      n := (20 - i) mod 20 + 1;
      if n > 1 then
      begin
        rs := rs + DN[n];
      end;
      LastHit := 20 - i;
    end;
    //分界名
    if (bi[i] = '0') and (i mod 4 = 0) and reach then
    begin
      //特殊分界处的显示原则，8位前为空的不显示分界名
      //不是8位处的，4位前为空不显示分界名
      n := (20 - i) mod 20 + 1;
      t := n - 1;
      if (n > 1) and ( ((t mod 8 = 0) and (LastHit - t < 8))
        or (((t - 12) mod 8 = 0) and (LastHit - t < 4))) then
      begin
        rs := rs + DN[n];
      end;
    end;
    LastBt := bi[i];
  end;
  if rs = '' then rs := DP[1];
  if IsYear and (IntValue div 1000 = 2) then
    rs[1] := DP[11];
  Result := rs;
end;

class function TCnDigits.LzhFmtTime(AValue: TTime;
  HasSecond: Boolean): String;
var
  hh, mm, ss, ms: Word;
  rs: WideString;
begin
  DecodeTime(AValue, hh, mm, ss, ms);
  rs := LzhFmtInt(hh, False, True) + DtNa[4] +
    LzhFmtInt(mm, False, True) + DtNa[5];
  if HasSecond then
    rs := rs + LzhFmtInt(ss, False, True) + DtNa[6];
  Result := rs;
end;

procedure TCnDigits.SetCurrVa(const Value: Currency);
begin
  FCurrVa := Value;
  FCnUpDigits := LzhFmtCurrency(Value);
end;

function TCnDigits.ChineseUpper(Curr: Currency): String;
begin
  Result := LzhFmtCurrency(Curr);
end;

function TCnDigits.ChineseDate(ADate: TDate; DigitsYear: Boolean): String;
begin
  Result := LzhFmtDate(ADate, DigitsYear);
end;

function TCnDigits.ChineseTime(ATime: TTime; HasSecond: Boolean): String;
begin
  Result := LzhFmtTime(ATime, HasSecond);
end;

procedure TCnDigits.SetAlias(const Value: TStrings);
begin
  FAlias.Assign(Value);
  TStringList(FAlias).Sorted := True;
  TStringList(FAlias).Duplicates := dupIgnore;
end;

function TCnDigits.StrToAlias(S: String): String;
var
  Ws: WideString;
  i: Integer;
  t: Integer;
begin
  Ws := S;
  for i := 1 to Length(Ws) do
  begin
    t := TStringList(FAlias).IndexOfName(Ws[i]);
    if t >= 0 then
      if Result = '' then
        Result := FAlias.Values[Ws[i]]
      else
        Result := Result + ',' + FAlias.Values[Ws[i]]
    else
      if Result = '' then
        Result := Ws[i]
      else
        Result := Result + Ws[i];
  end;
end;

function TCnDigits.StrToAlias2(S: String): String;
var
  Ws: WideString;
  i: Integer;
  t: Integer;
begin
  Ws := S;
  for i := 1 to Length(Ws) do
  begin
    t := TStringList(FAlias).IndexOfName(Ws[i]);
    if t >= 0 then
      Result := Result + FAlias.Values[Ws[i]]
    else
      Result := Result + Ws[i];
  end;
end;

constructor TCnDigits.Create(AOwner: TComponent);
begin
  inherited;
  FAlias := TStringList.Create;
  TStringList(FAlias).Sorted := True;
  TStringList(FAlias).Duplicates := dupIgnore;
end;

destructor TCnDigits.Destroy;
begin
  FAlias.Free;
  inherited;
end;

procedure TCnDigits.SetDA(const Value: Boolean);
var
  Ws: WideString;
  i: Integer;
  sv: String;
begin
  if Value then
  begin
    Ws := DP + DN + CrNa + DtNa;
    for i := 1 to Length(Ws) do
    begin
      sv := Ws[i];
      FAlias.Add(sv + '=' + FAlias.Values[Ws[i]]);
    end;
  end
  else
  begin
    for i := FAlias.Count - 1 downto 0 do
    begin
      sv := FAlias[i];
      if Trim(sv) = '' then
        FAlias.Delete(i)
      else
      if (Length(sv) > 0) and (sv[Length(sv)] = '=') then
        FAlias.Delete(i);
    end;
  end;
  Fda := Value;
end;

procedure TCnDigits.SetCnUP(const Value: String);
begin
  //FCnUpDigits := Value;
end;

class function TCnDigits.StdFmtDate(AValue: TDate;
  DigitsYear: Boolean): String;
var
  yy, mm, dd: Word;
  ys: WideString;
  rs: WideString;
begin
  DecodeDate(AValue, yy, mm, dd);
  if DigitsYear then
    ys := LzhFmtDigits(IntToStr(yy)) + DtNa[1]
  else
    ys := LzhFmtInt(yy, True) + DtNa[1];
  rs := ys;
  if (mm <= 2) or (mm = 10) then
    rs := rs + DP[1];
  rs := rs + LzhFmtInt(mm) + DtNa[2];
  if (dd < 10) or (dd mod 10 = 0) then
    rs := rs + DP[1];
  rs := rs + LzhFmtInt(dd) + DtNa[3];
  Result := rs;
end;

class function TCnDigits.StdFmtDateTime(AValue: TDateTime;
  DigitsYear: Boolean): String;
var
  dt: TDate;
  tm: TTime;
begin
  dt := AValue;
  tm := AValue;
  Result := StdFmtDate(dt, DigitsYear) + LzhFmtTime(tm);
end;

end.