ucharacter.pas

来自「uEncoding字符串UNICODE处理单元 用于处理unicode国际通用」· PAS 代码 · 共 1,130 行 · 第 1/3 页

      ucUppercaseLetter, ucUppercaseLetter,
      ucUppercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucMathSymbol,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter,
      ucLowercaseLetter, ucLowercaseLetter
     );  

function InternalGetLatin1Category(C: WideChar): TUnicodeCategory; inline;
begin
  Result := Latin1Categories[Byte(C)];
end;

procedure CheckStringRange(const S: Widestring; Index: Integer); inline;
begin
  if (Index > Length(S)) or (Index < 1) then
    raise EArgumentOutOfRangeException.CreateResFmt(@sArgumentOutOfRange_StringIndex, [Index, Length(S)]);
end;

class function TCharacter.CheckLetter(uc: TUnicodeCategory): Boolean;
begin
  case uc of
    ucUppercaseLetter,
    ucLowercaseLetter,
    ucTitlecaseLetter,
    ucModifierLetter,
    ucOtherLetter: Result := True;
  else
    Result := False;
  end;
end;

class function TCharacter.CheckLetterOrDigit(uc: TUnicodeCategory): Boolean;
begin
  case uc of
    ucUppercaseLetter,
    ucLowercaseLetter,
    ucTitlecaseLetter,
    ucModifierLetter,
    ucOtherLetter,
    ucDecimalNumber: Result := True;
  else
    Result := False;
  end;
end;

class function TCharacter.CheckNumber(uc: TUnicodeCategory): Boolean;
begin
  case uc of
    ucOtherNumber,
    ucLetterNumber,
    ucDecimalNumber: Result := True;
  else
    Result := False;
  end;
end;

class function TCharacter.CheckPunctuation(uc: TUnicodeCategory): Boolean;
begin
  case uc of
    ucConnectPunctuation,
    ucDashPunctuation,
    ucClosePunctuation,
    ucFinalPunctuation,
    ucInitialPunctuation,
    ucOtherPunctuation,
    ucOpenPunctuation: Result := True;
  else
    Result := False;
  end;
end;

class function TCharacter.CheckSeparator(uc: TUnicodeCategory): Boolean;
begin
  case uc of
    ucLineSeparator,
    ucParagraphSeparator,
    ucSpaceSeparator: Result := True;
  else
    Result := False;
  end;
end;

class function TCharacter.CheckSymbol(uc: TUnicodeCategory): Boolean;
begin
  case uc of
    ucCurrencySymbol,
    ucModifierSymbol,
    ucMathSymbol,
    ucOtherSymbol: Result := True;
  else
    Result := False;
  end;
end;

class function TCharacter.IsLatin1(C: WideChar): Boolean;
begin
  Result := Integer(C) <= $FF;
end;

class function TCharacter.IsLetter(C: WideChar): Boolean;
begin
  if not IsLatin1(C) then
    Result := CheckLetter(InternalGetUnicodeCategory(UCS4Char(C)))
  else if not IsAscii(C) then
    Result := CheckLetter(InternalGetLatin1Category(C))
  else
  begin
    C := WideChar(Integer(C) or Ord(' '));
    Result := (C >= 'a') and (C <= 'z');
  end;
end;

class function TCharacter.IsLetter(const S: Widestring; Index: Integer): Boolean;
begin
  CheckStringRange(S, Index);
  Result := IsLetter(S[Index]);
end;

class function TCharacter.IsLetterOrDigit(const S: Widestring; Index: Integer): Boolean;
var
  C: WideChar;
begin
  CheckStringRange(S, Index);
  C := S[Index];
  if IsLatin1(C) then
    Result := CheckLetterOrDigit(InternalGetLatin1Category(C))
  else
    Result := CheckLetterOrDigit(GetUnicodeCategory(S, Index));
end;

class function TCharacter.IsLetterOrDigit(C: WideChar): Boolean;
begin
  if IsLatin1(C) then
    Result := CheckLetterOrDigit(InternalGetLatin1Category(C))
  else
    Result := CheckLetterOrDigit(InternalGetUnicodeCategory(UCS4Char(C)));
end;

class function TCharacter.IsAscii(C: WideChar): Boolean;
begin
  Result := Integer(C) <= $7F;
end;

class function TCharacter.IsControl(const S: Widestring; Index: Integer): Boolean;
var
  C: WideChar;
begin
  CheckStringRange(S, Index);
  C := S[Index];
  if IsLatin1(C) then
    Result := InternalGetLatin1Category(C) = ucControl
  else
    Result := GetUnicodeCategory(S, Index) = ucControl;
end;

class function TCharacter.IsControl(C: WideChar): Boolean;
begin
  if IsLatin1(C) then
    Result := InternalGetLatin1Category(C) = ucControl
  else
    Result := InternalGetUnicodeCategory(UCS4Char(C)) = ucControl;
end;

class function TCharacter.IsDigit(C: WideChar): Boolean;
begin
  if not IsLatin1(C) then
    Result := InternalGetUnicodeCategory(UCS4Char(C)) = ucDecimalNumber
  else
    Result := (C >= '0') and (C <= '9');
end;

class function TCharacter.IsDigit(const S: Widestring; Index: Integer): Boolean;
var
  C: WideChar;
begin
  CheckStringRange(S, Index);
  C := S[Index];
  if not IsLatin1(C) then
    Result := GetUnicodeCategory(S, Index) = ucDecimalNumber
  else
    Result := (C >= '0') and (C <= '9');
end;

class function TCharacter.IsHighSurrogate(C: WideChar): Boolean;
begin
  Result := (Integer(C) >= $D800) and (Integer(C) <= $DBFF);
end;

class function TCharacter.IsLowSurrogate(C: WideChar): Boolean;
begin
  Result := (Integer(C) >= $DC00) and (Integer(C) <= $DFFF);
end;

class function TCharacter.IsSurrogate(Surrogate: WideChar): Boolean;
begin
  Result := (Integer(Surrogate) >= $D800) and (Integer(Surrogate) <= $DFFF);
end;

class function TCharacter.IsSurrogatePair(const HighSurrogate, LowSurrogate: WideChar): Boolean;
begin
  Result := (Integer(HighSurrogate) >= $D800) and (Integer(HighSurrogate) <= $DBFF) and
    (Integer(LowSurrogate) >= $DC00) and (Integer(LowSurrogate) <= $DFFF);
end;

class function TCharacter.GetUnicodeCategory(C: WideChar): TUnicodeCategory;
begin
  if IsLatin1(C) then
    Result := InternalGetLatin1Category(C)
  else
    Result := InternalGetUnicodeCategory(UCS4Char(C));
end;

class function TCharacter.ConvertToUtf32(const S: Widestring; Index: Integer; out CharLength: Integer): UCS4Char;
var
  LowSurrogate, HighSurrogate: Integer;
begin
  CheckStringRange(S, Index);
  CharLength := 1;
  HighSurrogate := Integer(S[Index]) - $D800;
  if (HighSurrogate < 0) or (HighSurrogate > $7FF) then
    Result := UCS4Char(S[Index])
  else
  begin
    if HighSurrogate > $3FF then
      raise EArgumentException.CreateResFmt(@sArgument_InvalidLowSurrogate, [Index]);
    if Index > Length(S) - 1 then
      raise EArgumentException.CreateResFmt(@sArgument_InvalidHighSurrogate, [Index]);
    LowSurrogate := Integer(S[Index + 1]) - $DC00;
    if (LowSurrogate < 0) or (LowSurrogate > $3FF) then
      raise EArgumentException.CreateResFmt(@sArgument_InvalidHighSurrogate, [Index]);
    Inc(CharLength);
    Result := (HighSurrogate * $400) + LowSurrogate + $10000;
  end;
end;

class function TCharacter.ConvertToUtf32(const S: Widestring; Index: Integer): UCS4Char;
var
  CharLength: Integer;
begin
  Result := ConvertToUtf32(S, Index, CharLength);
end;

class function TCharacter.ConvertFromUtf32(C: UCS4Char): Widestring;
begin
  if (C > $10FFFF) or ((C >= $D800) and (C <= $DFFF)) then
    raise EArgumentOutOfRangeException.CreateRes(@sArgumentOutOfRange_InvalidUTF32);
  if C < $10000 then
    Result := WideChar(C)
  else
  begin
    Dec(C, $10000);
    Result := WideChar(C div $400 + $D800) + WideChar(C mod $400 + $DC00);
  end;
end;

class function TCharacter.ConvertToUtf32(const HighSurrogate, LowSurrogate: WideChar): UCS4Char;
begin
  if not IsHighSurrogate(HighSurrogate) then
    raise EArgumentOutOfRangeException.CreateRes(@sArgumentOutOfRange_InvalidHighSurrogate);
  if not IsLowSurrogate(LowSurrogate) then
    raise EArgumentOutOfRangeException.CreateRes(@sArgumentOutOfRange_InvalidLowSurrogate);
  Result := ((Integer(HighSurrogate) - $D800) * $400) + (Integer(LowSurrogate) - $DC00) + $10000;
end;

constructor TCharacter.Create;
begin
  raise ENoConstructException.CreateResFmt(@sNoConstruct, [ClassName]);
end;

class procedure TCharacter.Initialize;
var
  Res: HRSRC;
  ResData: HGLOBAL;
  Offsets: PDataTableOffsets;
begin
  Res := FindResource(HInstance, PChar('CHARTABLE'), RT_RCDATA);
  if Res = 0 then
    RaiseLastOSError;
  ResData := LoadResource(HInstance, Res);
  if ResData = 0 then
    RaiseLastOSError;
  DataTable := LockResource(ResData);
  if DataTable = nil then
    RaiseLastOSError;
  Offsets := DataTable;
  CatIndexPrimary := Pointer(Integer(DataTable) + Offsets.IndexTable1Offset);
  CatIndexSecondary := Pointer(Integer(DataTable) + Offsets.IndexTable2Offset);
  CategoryTable := Pointer(Integer(DataTable) + Offsets.DataTableOffset);
  NumIndexPrimary := Pointer(Integer(DataTable) + Offsets.NumberIndex1Offset);
  NumIndexSecondary := Pointer(Integer(DataTable) + Offsets.NumberIndex2Offset);
  NumericValueTable := Pointer(Integer(DataTable) + Offsets.NumberDataOffset);
end;

class function TCharacter.GetNumericValue(C: WideChar): Double;
begin
  Result := NumberValue(UCS4Char(C)); 
end;

class function TCharacter.GetNumericValue(const S: Widestring; Index: Integer): Double;
begin
  Result := NumberValue(ConvertToUTF32(S, Index));
end;

class function TCharacter.GetUnicodeCategory(const S: Widestring; Index: Integer): TUnicodeCategory;
begin
  CheckStringRange(S, Index);
  if IsLatin1(S[Index]) then
    Result := InternalGetLatin1Category(S[Index])
  else
    Result := InternalGetUnicodeCategory(ConvertToUtf32(S, Index));
end;

class function TCharacter.IsHighSurrogate(const S: Widestring; Index: Integer): Boolean;
begin
  CheckStringRange(S, Index);
  Result := IsHighSurrogate(S[Index]);
end;

class function TCharacter.IsLower(C: WideChar): Boolean;
begin
  if not IsLatin1(C) then
    Result := InternalGetUnicodeCategory(UCS4Char(C)) = ucLowercaseLetter
  else if not IsAscii(C) then
    Result := InternalGetLatin1Category(C) = ucLowercaseLetter
  else
    Result := (C >= 'a') and (C <= 'z');
end;

class function TCharacter.IsLower(const S: Widestring; Index: Integer): Boolean;
var
  C: WideChar;
begin
  CheckStringRange(S, Index);
  C := S[Index];
  if not IsLatin1(C) then
    Result := GetUnicodeCategory(S, Index) = ucLowercaseLetter
  else if not IsAscii(C) then
    Result := InternalGetLatin1Category(C) = ucLowercaseLetter
  else
    Result := (C >= 'a') and (C <= 'z');
end;

class function TCharacter.IsLowSurrogate(const S: Widestring; Index: Integer): Boolean;
begin
  CheckStringRange(S, Index);
  Result := IsLowSurrogate(S[Index]);
end;

class function TCharacter.IsNumber(C: WideChar): Boolean;
begin
  if not IsLatin1(C) then
    Result := CheckNumber(InternalGetUnicodeCategory(UCS4Char(C)))
  else if not IsAscii(C) then
    Result := CheckNumber(InternalGetLatin1Category(C))
  else
    Result := (C >= '0') and (C <= '9');
end;

class function TCharacter.IsNumber(const S: Widestring; Index: Integer): Boolean;
var
  C: WideChar;
begin
  CheckStringRange(S, Index);
  C := S[Index];