uappstringutilts.pas

从文本文件象Oracle数据库导入数据

{==========================================================================
                            字符串相关的公用函数单元
===========================================================================}

unit uAppStringUtilts;

interface

uses Windows, Messages, SysUtils, classes, stdctrls, comctrls;

type
  TFillStringMode = (fsmLeft, fsmRight, fsmBoth);

function GetCodeFromString_Bracket(AString: string; ADefault: string=''): string;
{ 功    能：获得包含在括号中的编号
  入    参：AString：必须，包含编号和括号的字符串
            ADefault: 可无，当找不到结点中包含的编号时返回的默认值
  返回结果：代表编号的字符串，如“(12)ABC”返回“12”
}
function GetCodeFromTreeNode(ANode: TTreeNode; ADefault: string=''): string;
{ 功    能：根据树形节点文本内容截取其中包含的编号，编号应包含在括号中
  入    参：ANode：必须，树形列表控件当前的结点
            ADefault: 可无，当找不到结点中包含的编号时返回的默认值
  返回结果：代表编号的字符串，如节点文本为“(12)ABC”返回“12”
}
function GetCodeFromString_Dot(AString: string; ADefault: string=''): string;
{ 功    能：获得字符串中第一个小数点前的编号
  入    参：AString：必须，包含编号和小数点的字符串
            ADefault: 可无，当找不到结点中包含的编号时返回的默认值
  返回结果：代表编号的字符串，如“12.ABD类别”返回“12”
}
function GetCodeFromComboItem(AComboBox: TComboBox; ADefault: string=''): string;
{ 功    能：根据下拉组合框文本内容截取其中包含的编号，编号应在最前，后跟点号
  入    参：AComboBox：必须，下拉组合框控件
            ADefault: 可无，当找不到文本中包含的编号时返回的默认值
  返回结果：代表编号的字符串，如当前项为“12.ABC”返回“12”
}

function IsKeyAlpha(Key: Word; Shift: TShiftState): Boolean;
{ 功    能：检查按键值是否为字母(A..Z或a..z)
  入    参：Key: 必须，按键的键值
            Shift：必须，shift键的状态
  返回结果：字母返回True,否则返回False
}

function IsKeyNumberic(Key: Word; Shift: TShiftState): Boolean;
{ 功    能：检查按键值是否为数字(0..9)
  入    参：Key: 必须，按键的键值
            Shift：必须，shift键的状态
  返回结果：数字返回True,否则返回False
}
function FillString(ASrcStr: string; AAddStr: string; AWholeLength: Integer;
         AFillMode: TFillStringMode; AForceLength: Boolean=True): string;
{ 功    能：用指定的字符填充字符串
  入    参：srcStr：必须，目标字符串
            AddStr: 必须，指定字符
            WholeLength: 必须，填充后字符串应该达到的长度
            FillMode: 必须，填充模式
                      0:左侧填充
                      1:右侧侧填充
                      2:两端填充
            ForceLength: 可无，源字符串超过指定长度时，是否强制截取为指定长度，默认为是
  返回结果：目标字符串填充指定字符后的字符串
}
function InsertEnter(sStr: WideString; iCharNumPerLine: Integer): string;
{ 功能：在一个字符串中指定位置插入换行符
  参数：sStr: 原字符串
        iCharNumPerLine：每行字符串字符个数
  返回：插入换行符后的字符串
}

procedure SplitStringToList(AStr, ASeperator: string; AList: TStrings; AClear: Boolean=True);
{ 功能：将一个由指定的字符分隔的字符串拆分到字符串列表中
  参数：AStr: 原字符串
        ASeprator: 分隔符
        AList: 字符列表
        AClear: 是否清空原列表
}

function ContractListToString(AList: TStrings; ASeprator: string): string;
{ 功能：将一个字符串列表合并到由指定的字符分隔的字符串中
  参数：AList: 字符列表
        ASeprator: 分隔符
  返回值：合并后的字符串
}
procedure AssignStringList(const ASrcStrList: TStringList; var ADestStrList: TStringList);
{ 功能：将一个字符串列表复制到一个字符串列表
  参数：ASrcStrList: 源字符串列表
        ADestStrList: 目标字符串列表
}
function ReplaceString(AStr, ASrcStr, ADestStr: string; ASensitive: Boolean = False;
         AStartPos: Integer = 0; ACount: Integer = 0): string;
{ 功能：将一个字符串中的子串替换为另外子串
  参数：AStr: 源字符串列表
        ASrcStr: 被替换的子串
        ADestStr: 替换后的子串
        ASensitive: 是否区分大小写
        AStartPos: 查找的起始位置
        ACount: 替换个数，0为替换所有
  返回值：被替换后的字符串
}
function GetHzPy(const AHzStr: string): string;
function GetHzBiHua(chnstr:string):integer;

function NumberToChinese(ANumber: string; AHideZeros: Boolean = False): string;
{ 功能：将一个数字转换成中文大写
  参数：ANumber: 代表原数字的字符串
        AHideZeros: 当数字是零是是否返回空
  返回值：代表中文大写数字的字符串
}
function MoneyToWord(ANumber: string): String;
{功能：将一个数字转换成中文大写的货币数
  参数：ANumber: 代表原数字的字符串
  返回值：代表中文大写数字货币数的字符串
}

implementation

function NumberToChinese(ANumber: string; AHideZeros: Boolean = False): string;
const
  cWords: WideString = '零壹贰叁肆伍陆柒捌玖';
  cUnits1: WideString = '个拾佰仟';
  cUnits2: WideString = '亿万';
var
  sResult: string;
  sNumber, stNumber, siNumber, sfNumber, sTemp: string;
  I, J, iNumLen, iDotPos: Integer;

  function ToChinese(sNumber: string): WideString;
  var
    iaDigits: array[1..4] of Integer;
    sResult: WideString;
    I, iTemp: Integer;
  begin
    try
      iTemp := StrToInt(sNumber);
    except
      Result := '';
      Exit;
    end;
    iTemp := Abs(iTemp mod 10000);
    iaDigits[1] := iTemp mod 10;
    iTemp := iTemp div 10;
    iaDigits[2] := iTemp mod 10;
    iTemp := iTemp div 10;
    iaDigits[3] := iTemp mod 10;
    iTemp := iTemp div 10;
    iaDigits[4] := iTemp mod 10;
    iTemp := iTemp div 10;
    if iaDigits[1] <> 0 then
      sResult := cWords[iaDigits[1] + 1]
    else
      sResult := '';
    if iaDigits[2] <> 0 then
    begin
      sResult := cUnits1[2] + sResult;
      sResult := cWords[iaDigits[2] + 1] + sResult;
    end
    else if (iaDigits[3] <> 0) and (sResult <> '') then
      sResult := cWords[1] + sResult;
    if iaDigits[3] <> 0 then
    begin
      sResult := cUnits1[3] + sResult;
      sResult := cWords[iaDigits[3] + 1] + sResult;
    end
    else if (iaDigits[4] <> 0) and (sResult <> '') then
      sResult := cWords[1] + sResult;
    if iaDigits[4] <> 0 then
    begin
      sResult := cUnits1[4] + sResult;
      sResult := cWords[iaDigits[4] + 1] + sResult;
    end
    else if (sResult <> '') then
      sResult := cWords[1] + sResult;
    Result := sResult;
  end;
begin
  if (ANumber = '') then
  begin
    if AHideZeros then
      Result := ''
    else
      Result := '零';
    Exit;
  end
  else
  begin
    if Length(ANumber) > 30 then
    begin
      Result := '超大无比的数';
      Exit;
    end;
    try
      if (StrToFloat(ANumber) = 0) then
      begin
        if AHideZeros then
          Result := ''
        else
          Result := '零';
        Exit;
      end;
    except
      if AHideZeros then
        Result := ''
      else
        Result := '零';
      Exit;
    end;
  end;
  if ANumber[1] = '-' then
  begin
    I := 2;
    iNumLen := Length(ANumber) - 1;
  end
  else
  begin
    I := 1;
    iNumLen := Length(ANumber);
  end;
  //去掉字符中的逗号(千位符，例如123,456.00)
  sNumber := '';
  for I := 1 to Length(ANumber) do
  begin
    if ANumber[I] in ['0','1','2','3','4','5','6','7','8','9','.'] then
      sNumber := sNumber + ANumber[I];
  end;
  iDotPos := Pos('.', sNumber);
  if iDotPos > 0 then
  begin
    siNumber := Copy(sNumber, 1, iDotPos - 1);
    sfNumber := Copy(sNumber, iDotPos + 1, iNumLen - iDotPos);
  end
  else
  begin
    siNumber := sNumber;
    sfNumber := '';
  end;
  sResult := '';
  I := Length(siNumber);
  J := 0;
  while I > 0 do
  begin
    if I > 4 then
      stNumber := Copy(siNumber, I - 4 + 1, 4)
    else
      stNumber := Copy(siNumber, 1, I);
    sTemp := ToChinese(stNumber);
    if sTemp <> '' then
    begin
      if J > 0 then
        sResult := sTemp + cUnits2[J mod 2 + 1] + sResult
      else
        sResult := sTemp + sResult;
    end;
    I := I - 4;
    Inc(J);
  end;
  if Copy(sResult, 1, 2) = cWords[1] then
    sResult := Copy(sResult, 3, Length(sResult));
  if sfNumber <> '' then
  begin
    if sResult = '' then
      sResult := cWords[1];
    sResult := sResult + '点';
    for I := 1 to Length(sfNumber) do
    begin
      sResult := sResult + cWords[StrToInt(sfNumber[I]) + 1];
    end;
  end;
  if ANumber[1] = '-' then
    sResult := '负' + sResult;
  Result := sResult;
end;

function MoneyToWord(ANumber: string): String;
var
  Words: array[0..9] of string;
  Units: array[0..9] of string;
  iMoney, fMoney, Jiao, Fen: integer;
  i: integer;
  Digits: array[0..9] of integer;
  rTemp: real;
  Money: Real;
  sNumber: string;