如何得到汉字的拼音,500俸上,非常感谢大家的解答!!!!!

Question

如何通过一个汉字得到它的拼音,不要通过建库,通过字库来解决.我已经有一个通过汉字找到它的首字母的程序,可是只能认3000多汉字,就是一级字库的汉字,如何得到完整的拼音呢?希望大家帮我解决一下，非常感谢!!!

Answer 1

是用的以下这个？
---- 原理很简单，找出汉字表中拼音首字符分别为“A”至“Z”的汉字内码范围，这样，对于要检索的汉字只需要检查它的内码位于哪一个首字符的范围内，就可以判断出它的拼音首字符。 ---- 程序更简单，包括3个控件：一个列表存放着所有待检索的信息；一个列表用于存放检索后的信息；一个编辑框用于输入检索关键字（即拼音首字符序列）。详细如下： ---- 1．进入Delphi创建一个新工程：Project1 ---- 2．在Form1上创建以下控件并填写属性： 控件类型      属性名称  属性值
Edit           Name      Search
ListBox        Name      SourceList
Items      输入一些字符串，如姓名等，用于提供检索数据
ListBox        Name      ResultList
　---- 3．键入以下两个函数 // 获取指定汉字的拼音索引字母，如：“汉”的索引字母是“H”
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(0);
  end;
end;// 在指定的字符串列表SourceStrs中检索符合拼音索引字符串
PYIndexStr的所有字符串，并返回。
function SearchByPYIndexStr
( SourceStrs:TStrings;
 PYIndexStr:string):string;
label NotFound;
var
  i, j   :integer;
  hzchar :string;
begin
  for i:=0 to SourceStrs.Count-1 do
    begin
      for j:=1 to Length(PYIndexStr) do
        begin
          hzchar:=SourceStrs[i][2*j-1] 
+ SourceStrs[i][2*j];
          if (PYIndexStr[j]<>'?') and
 (UpperCase(PYIndexStr[j]) <>
 GetPYIndexChar(hzchar)) then goto NotFound;
        end;
      if result='' then result := SourceStrs[i]
      else result := result + Char
(13) + SourceStrs[i];
NotFound:
    end;
end;4．增加编辑框Search的OnChange事件：
procedure TForm1.SearchChange(Sender: TObject);
var ResultStr:string;
begin
  ResultStr:='';
  ResultList.Items.Text := SearchByPYIndexStr
(Sourcelist.Items, Search.Text);
end; 
　---- 5．编译运行后，在编辑框Search中输入要查询字符串的拼音首字符序列，检索结果列表ResultList就会列出检索到的信息，检索中还支持“？”通配符，对于难以确定的的文字使用“？”替代位置，可以实现更复杂的检索。 

Answer 2

unit PY;interface
uses sysutils;// 获取汉字的拼音首字符,这个函数将用在GetPYIndexStr 中.
function GetPYIndexChar(strChinese: string; bUpCase: Boolean = True): char;// 获取多个汉字的拼音首字符组成的字符串.
function GetPYIndexStr(strChinese: string; bUpCase: Boolean = True): string;implementationfunction GetPYIndexChar(strChinese: string;bUpCase: Boolean = True): char;
begin
// 根据汉字表中拼音首字符分别为"A"至"Z"的汉字内码范围，
// 要检索的汉字只需要检查它的内码位于哪一个首字符的范围内，
// 就可以判断出它的拼音首字符。
  case WORD(strChinese[1]) shl 8 + WORD(strChinese[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(0);
  end;
  if not bUpCase then
  begin // 转换为小写
    result := Chr(Ord(result)+32);
  end;
end;////////////////////////////////////////////////////////////////////////////
// 函数: GetPYIndexStr(strChinese: string;bUpCase: Boolean = True): string;
//
// 函数功能:获取多个汉字的拼音首字符组成的字符串.
// 例: GetPYIndexStr('程') 将返回'C'.
//     GetPYIndexStr('程序')将返回'CX'.
//
// 第二个参数决定返回大写还是小写 , 缺省为大写 .
////////////////////////////////////////////////////////////////////////////
function GetPYIndexStr(strChinese: string;bUpCase: Boolean = True): string;
var
  strChineseTemp : string;
  cTemp : Char;
begin
  result := '';
  strChineseTemp := strChinese;
  while strChineseTemp<>'' do
  begin
    cTemp := GetPYIndexChar(strChineseTemp);
    if not bUpCase then
    begin // 转换为小写
      cTemp := Chr(Ord(cTemp)+32);
    end;
    result := result + string(cTemp);
    strChineseTemp := Copy(strChineseTemp,3,Length(strChineseTemp));
  end;
end;

Answer 3

这里还有一个：
unit HzSpell;interfaceuses
  Windows, Messages, SysUtils, Classes;type
  THzSpell = class(TComponent)
  protected
    FHzText: String;
    FSpell: String;
    FSpellH: String;
    procedure SetHzText(const Value: String);
    function GetHzSpell: String;
    function GetPyHead: String;
  public
    class function PyOfHz(Hz: String): String;
    class function PyHeadOfHz(Hz: String): String;
  published
    property HzText: String read FHzText write SetHzText;
    property HzSpell: String read GetHzSpell;
    property PyHead: String read GetPyHead;
  end;{$I HzSpDat2.inc}procedure Register;function GetHzPy(HzChar: PChar; Len: Integer): String;
function GetHzPyFull(HzChar: String): String;
function GetHzPyHead(HzChar: PChar; Len: Integer): String;
function GetPyChars(HzChar: String): String;implementationprocedure Register;
begin
  RegisterComponents('System', [THzSpell]);
end;function GetHzPy(HzChar: PChar; Len: Integer): String;
var
  C: Char;
  Index: Integer;
begin
  Result := '';
  if (Len > 1) and (HzChar[0] >= #129) and (HzChar[1] >= #64) then
  begin
    //是否为 GBK 字符
    case HzChar[0] of
      #163:  // 全角 ASCII
      begin
        C := Chr(Ord(HzChar[1]) - 128);
        if C in ['a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']'] then
          Result := C
        else
          Result := '';
      end;
      #162: // 罗马数字
      begin
        if HzChar[1] > #160 then
          Result := CharIndex[Ord(HzChar[1]) - 160]
        else
          Result := '';
      end;
      #166: // 希腊字母
      begin
        if HzChar[1] in [#$A1..#$B8] then
          Result := CharIndex2[Ord(HzChar[1]) - $A0]
        else if HzChar[1] in [#$C1..#$D8] then
          Result := CharIndex2[Ord(HzChar[1]) - $C0]
        else
          Result := '';
      end;
      else
      begin  // 获得拼音索引
        Index := PyCodeIndex[Ord(HzChar[0]) - 128, Ord(HzChar[1]) - 63];
        if Index = 0 then
          Result := ''
        else
          Result := PyMusicCode[Index];
      end;
    end;
  end
  else if Len > 0 then
  begin
    //在 GBK 字符集外, 即半角字符
    if HzChar[0] in ['a'..'z', 'A'..'Z', '0'..'9', '(', ')', '[', ']'] then
      Result := HzChar[0]
    else
      Result := '';
  end;
end;function GetHzPyFull(HzChar: String): String;
var
  i, len: Integer;
  Py: String;
  function IsDouByte(C: Char): Boolean;
  begin
    Result := C >= #129;
  end;
begin
  Result := '';
  i := 1;
  while i <= Length(HzChar) do
  begin
    if IsDouByte(HzChar[i]) and (Length(HzChar) - i > 0) then
      len := 2
    else
      len := 1;
    Py := GetHzPy(@HzChar[i], len);
    Inc(i, len);
    if (Result <> '') and (Py <> '') then
      Result := Result + ' ' + Py           // + ' '
    else
      Result := Result + Py;
  end;
end;function GetHzPyHead(HzChar: PChar; Len: Integer): String;
begin
  Result := Copy(GetHzPy(HzChar, Len), 1, 1);
end;function GetPyChars(HzChar: String): String;
var
  i, len: Integer;
  Py: String;
  function IsDouByte(C: Char): Boolean;
  begin
    Result := C >= #129;
  end;
begin
  Result := '';
  i := 1;
  while i <= Length(HzChar) do
  begin
    if IsDouByte(HzChar[i]) and (Length(HzChar) - i > 0) then
      len := 2
    else
      len := 1;
    Py := GetHzPyHead(@HzChar[i], len);
    Inc(i, len);
    Result := Result + Py;
  end;
end;{ THzSpell }function THzSpell.GetHzSpell: String;
begin
  if FSpell = '' then
  begin
    Result := GetHzPyFull(FHzText);
    FSpell := Result;
  end
  else Result := FSpell;
end;function THzSpell.GetPyHead: String;
begin
  if FSpellH = '' then
  begin
    Result := GetPyChars(FHzText);
    FSpellH := Result;
  end
  else Result := FSpellH;
end;class function THzSpell.PyHeadOfHz(Hz: String): String;
begin
  Result := GetPyChars(Hz);
end;class function THzSpell.PyOfHz(Hz: String): String;
begin
  Result := GetHzPyFull(Hz);
end;procedure THzSpell.SetHzText(const Value: String);
begin
  FHzText := Value;
  FSpell := '';
  FSpellH := '';
end;end.