function IsChineseText(const AStr:{$IFDEF UNICODE}string{$ELSE}WideString{$ENDIF};
const OutCharecterCountValAddr: PInteger = nil;
const OutWideCharCountValAddr: PInteger = nil;
const CheckAllChar: Boolean = False;
const IncludeCharacters: Boolean = True;
const IncludeRadicals: Boolean = False;
const IncludePUAParts: Boolean = False;
const IncludeStrokes: Boolean = False;
const IncludePhoneticNotation: Boolean = False;
const IncludeAllCharacters: Boolean = False): Boolean;
var
I, F, C: Integer;
IsHasNext,
IsDoubleWideChar,
IsNoCheckNext,
IsFound,
IsAllTrue: Boolean;
UTF32: DWORD;
FFindCoundMode: Boolean;
begin
Result := False;
FFindCoundMode := ((OutCharecterCountValAddr <> nil) or (OutWideCharCountValAddr <> nil));
IsAllTrue := Length(AStr) <> 0;
{$IFDEF UNICODE}
F := Low(AStr);
C := High(AStr);
{$ELSE}
F := 1;
C := Length(AStr);
{$ENDIF}
IsNoCheckNext := False;
for I := F to C do
begin
IsHasNext := I < C;
if IsNoCheckNext then Continue;
IsNoCheckNext := False;
IsDoubleWideChar := False;
if ((AStr[I] >= #$D800) and (AStr[I] <= #$DFFF)) and IsHasNext then
begin
UTF32 := (Cardinal(AStr[I]) and $000003FF) shl 10 or (Cardinal(AStr[I + 1]) and $000003FF) + $00010000;
IsDoubleWideChar := True;
IsNoCheckNext := True;
end
else
UTF32 := Ord(AStr[I]);
//https://www.qqxiuzi.cn/zh/hanzi-unicode-bianma.php
//字符集 字数 Unicode 编码
//基本汉字 20902字 4E00-9FA5
//基本汉字补充 38字 9FA6-9FCB
//扩展A 6582字 3400-4DB5
//扩展B 42711字 20000-2A6D6
//扩展C 4149字 2A700-2B734
//扩展D 222字 2B740-2B81D
//康熙部首 214字 2F00-2FD5
//部首扩展 115字 2E80-2EF3
//兼容汉字 477字 F900-FAD9
//兼容扩展 542字 2F800-2FA1D
//PUA(GBK)部件 81字 E815-E86F
//部件扩展 452字 E400-E5E8
//PUA增补 207字 E600-E6CF
//汉字笔画 36字 31C0-31E3
//汉字结构 12字 2FF0-2FFB
//汉语注音 22字 3105-3120
//注音扩展 22字 31A0-31BA
//〇 1字 3007
//http://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=UnicodeHexCode
IsFound := False;
if (not IsFound) and IncludeCharacters then
begin
IsFound := (UTF32 >= $4E00) and (UTF32 <= $9FA5);
end;
if (not IsFound) and IncludeCharacters then
begin
IsFound := (UTF32 >= $9FA6) and (UTF32 <= $9FCB);
end;
if (not IsFound) and IncludeCharacters then
begin
IsFound := (UTF32 >= $3400) and (UTF32 <= $4DB5);
end;
if (not IsFound) and IncludeCharacters then
begin
IsFound := (UTF32 >= $20000) and (UTF32 <= $2A6D6);
end;
if (not IsFound) and IncludeCharacters then
begin
IsFound := (UTF32 >= $2A700) and (UTF32 <= $2B734);
end;
if (not IsFound) and IncludeCharacters then
begin
IsFound := (UTF32 >= $2B740) and (UTF32 <= $2B81D);
end;
if (not IsFound) and IncludeRadicals then
begin
IsFound := (UTF32 >= $2F00) and (UTF32 <= $2FD5);
end;
if (not IsFound) and IncludeRadicals then
begin
IsFound := (UTF32 >= $2E80) and (UTF32 <= $2EF3);
end;
if (not IsFound) and IncludeCharacters then
begin
IsFound := (UTF32 >= $F900) and (UTF32 <= $FAD9);
end;
if (not IsFound) and IncludeCharacters then
begin
IsFound := (UTF32 >= $2F800) and (UTF32 <= $2FA1D);
end;
if (not IsFound) and IncludePUAParts then
begin
IsFound := (UTF32 >= $E815) and (UTF32 <= $E86F);
end;
if (not IsFound) and IncludePUAParts then
begin
IsFound := (UTF32 >= $E400) and (UTF32 <= $E5E8);
end;
if (not IsFound) and IncludePUAParts then
begin
IsFound := (UTF32 >= $E600) and (UTF32 <= $E6CF);
end;
if (not IsFound) and IncludeStrokes then
begin
IsFound := (UTF32 >= $31C0) and (UTF32 <= $31E3);
end;
if (not IsFound) and IncludeStrokes then
begin
IsFound := (UTF32 >= $2FF0) and (UTF32 <= $2FFB);
end;
if (not IsFound) and IncludePhoneticNotation then
begin
IsFound := (UTF32 >= $3105) and (UTF32 <= $3120);
end;
if (not IsFound) and IncludePhoneticNotation then
begin
IsFound := (UTF32 >= $31A0) and (UTF32 <= $31BA);
end;
if (not IsFound) and IncludeCharacters then
begin
IsFound := (UTF32 = $3007)
end;
if (not IsFound) and IncludeAllCharacters then
begin
IsFound := (UTF32 >= $0391) and (UTF32 <= $FFE5);
end;
if IsFound then
begin
if (not CheckAllChar) then
begin
Result := True;
end;
if (OutCharecterCountValAddr <> nil) then
begin
Inc(OutCharecterCountValAddr^);
end;
if (OutWideCharCountValAddr <> nil) then
begin
Inc(OutWideCharCountValAddr^);
if IsDoubleWideChar then
Inc(OutWideCharCountValAddr^);
end;
if (not CheckAllChar) and (not FFindCoundMode) then
begin
Break;
end;
end
else
IsAllTrue := False;
end;
if CheckAllChar then
Result := IsAllTrue;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if IsChineseText('dfafa中国dfas') then
begin
text:='包含';
end
else
begin
text:='不包含';
end;
end;