function MakeSpellCode(stText: string; iMode, iCount: Integer): string;
var
i, Index: integer;
APy: string;
fFlag1, fFlag2, fFlag3: Boolean;
begin
fFlag1 := (iMode and $0001) = 1;
fFlag2 := (iMode and $0002) = 2;
fFlag3 := (iMode and $0004) = 4;
Result := '';
if iMode < 0 then Exit;
i := 1;
while (i <= Length(stText)) do
begin
if (Ord(stText[i]) >= 129) and (Ord(stText[i + 1]) >= 64) then
begin
// 是否为 GBK 字符
case Ord(stText[i]) of
163: // 全角 ASCII
begin
APy := Chr(Ord(stText[i + 1]) - 128);
// 控制不能输出非数字, 字母的字符
if not fFlag3 and not (APy[1] in ['a'..'z', 'A'..'Z', '0'..'9']) then
APy := '';
end;
162: // 罗马数字
if Ord(stText[i + 1]) > 160 then
APy := CharIndex[Ord(stText[i + 1]) - 160] else
// 在罗马数字区, 不能翻译的字符非罗马数字
if fFlag2 then APy := '?' else APy := '';
166: // 希腊字母
if Ord(stText[i + 1]) in [$A1..$B8] then
APy := UpperCase(CharIndex2[Ord(stText[i + 1]) - $A0])
else if Ord(stText[i + 1]) in [$C1..$D8] then
APy := UpperCase(CharIndex2[Ord(stText[i + 1]) - $C0]);
else // 一般汉字
begin
// 获得拼音索引
Index := PyCodeIndex[Ord(stText[i]) - 128, Ord(stText[i + 1]) - 63];
if Index = 0 then // 无此汉字, 不能翻译的字符, GBK 保留
if fFlag2 then APy := '?' else APy := ''
else if not fFlag1 then // iFlag1 = False, 是单拼音
APy := Copy(Uppercase(PyMusicCode[Index]), 1, 1) else
APy := Copy(Uppercase(PyMusicCode[Index]), 1, 6);
end;
end;
Result := Result + APy;
Inc(i, 2);
end else
begin // 在 GBK 字符集外, 即半角字符
if fFlag3 or (stText[i] in ['a'..'z', 'A'..'Z', '0'..'9']) then
Result := Result + UpperCase(stText[i]);
Inc(i);
end;
end;
Result := Copy(Result, 1, iCount);
end;
先声明,下述程序只能将汉字转换为它拼音的首写字母,
function GetPYIndexChar( hzchar:string):char;
begin
case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
$B0A1..$B0C4 : result := 'A';
$B0C5..$B2C0 : result := 'B';
$B2C1..$B4ED : result := 'C';
$B4EE..$B6E9 : result := 'D';
$B6EA..$B7A1 : result := 'E';
$B7A2..$B8C0 : result := 'F';
$B8C1..$B9FD : result := 'G';
$B9FE..$BBF6 : result := 'H';
$BBF7..$BFA5 : result := 'J';
$BFA6..$C0AB : result := 'K';
$C0AC..$C2E7 : result := 'L';
$C2E8..$C4C2 : result := 'M';
$C4C3..$C5B5 : result := 'N';
$C5B6..$C5BD : result := 'O';
$C5BE..$C6D9 : result := 'P';
$C6DA..$C8BA : result := 'Q';
$C8BB..$C8F5 : result := 'R';
$C8F6..$CBF9 : result := 'S';
$CBFA..$CDD9 : result := 'T';
$CDDA..$CEF3 : result := 'W';
$CEF4..$D188 : result := 'X';
$D1B9..$D4D0 : result := 'Y';
$D4D1..$D7F9 : result := 'Z';
else
result := char(32);
end;
end;
procedure TMainForm.btnConvertClick(Sender: TObject);
var
I: Integer;
PY: string;
s: string;
begin
s := '' ;
I := 1;
while I <= Length(ChineseEdt.Text) do
begin
PY := Copy(ChineseEdt.Text, I , 1);
if PY >= Chr(128) then
begin
Inc(I);
PY := PY + Copy(ChineseEdt.Text, I , 1);
s := s + GetPYIndexChar(PY);
end
else
s := s + PY;
Inc(I);
end;
PYEdt.Text := s;
end;