用什么办法可以实现取汉字的第一个拼音？？

Question

如:中国
   zg

Answer 1

function TForm1.getpy(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';
    $B9C1..$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';
    $D189..$D4D0 : result:='Y';
    $D4D1..$D7F9 : result:='Z';
  else
    result:=char(0);
  end;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  s:string;
begin
  s:=getpy('新')+getpy('闻')+getpy('频')+getpy('道');
  showmessage(s);
end;

Answer 2

有一个现成的dll你可以用，很好用的，搜一搜就可以找到

Answer 3

function GetFirstSpell(aChar: string):Char;
var
HzcharWord:Word;
begin
HzcharWord:=WORD(achar[1]) shl 8 + WORD(achar[2]);
  case HzcharWord 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..$D1B8: Result:='X'; $D1B9..$D4D0: Result:='Y';
    $D4D1..$D7F9: Result:='Z';
    else
    Result := Char(0);
  end;
end;function GetSpellByStr(aStr: string): string;
var I : Integer;
    tmpStr : string;
begin
  result:='';
  I := 1;
  while (I <= Length(aStr)) do
  begin    tmpStr := GetFirstSpell( Copy(aStr, I, 2));
    if tmpStr <> Char(0) then
    begin
      Result := Result + tmpStr;
      I := I + 2;
    end else
    begin
      Result := Result + Copy(aStr,I,1);
      I := I + 1;
    end;
  end;
end;