unit PY;interface
uses StrUtils,Imm,windows;function GetPY(hz:AnsiString):string;
function GetPyVy(s:AnsiString):string;
function GetPyS(s:AnsiString):string;
function GetPySS(s:AnsiString):string;
function GetPyBZ(s:AnsiString):string;
function initPy:boolean;var
  iHandleCount:integer;
  PList:array [1..20] of HKL;
  pyCode:integer;
  pych: array[1..6,1..5] of string[2]=
    (('ā', 'á','ǎ','à','a'),('ō', 'ó','ǒ','ò','o'),
    ('ē', 'é','ě','è','e'),('ī', 'í','ǐ','ì','i'),
    ('ū', 'ú','ǔ','ù','u'),('ǖ', 'ǘ','ǚ','ǜ','ü'));implementationfunction initPy:boolean;
//------------------------------------------
//初始化拼音获取,判定是否安装微软拼音
//------------------------------------------
var i:integer;
    szImeName:array [0..254] of char;
begin
   PyCode:=0;
   result:=true;
   iHandleCount:=GetKeyboardLayoutList(20,PList);
   for i:=1 to iHandleCount do begin
      if ImmEscape(Plist[i],0,IME_ESC_IME_NAME,@szImeName)>0 then
         if szImeName='微软拼音输入法' then PyCode:=i;
   end;
   if PyCode=0 then begin
      result:=false;
   end;
end;
function GetPY(hz:AnsiString):string;
//------------------------------------------
//获取单个汉字拼音,参数必须是汉字,非汉字直接返回原字符
//------------------------------------------
var dwGcl:DWord;
    szBuffer:array [0..254] of char;
    iStart,i:integer;
begin
   dwGcl:=ImmGetConversionList(PList[PyCode],0,PChar(hz),nil,0,GCL_REVERSECONVERSION);
   if dwGcl=0 then begin
      result:='';  //如果当前微软拼音版本不支持反查拼音,返回空串
      exit;
   end;
  ImmGetConversionList(PList[PyCode],0,PChar(hz),@szBuffer,dwGCL,GCL_REVERSECONVERSION);
   iStart:=byte(szBuffer[24]);
   result:='';
   i:=iStart;
   while szBuffer[i]<>' ' do begin
      result:=result+szBuffer[i];
      inc(i);
   end;
end;
function GetPyVy(s:AnsiString):string;
//-------------------------------------------
// 返回单个汉字注音,参数必须是汉字
//-------------------------------------------
var str:AnsiString;
    i,j:integer;
begin
  str:=GetPY(s);
  i:=1;
  while not (str[i] in ['a','o','e','i','u','v'] ) do inc(i);
  j:=pos(str[i],'aoeiuv');
  result:=leftstr(str,i-1)+pych[j][ord(rightstr(str,1)[1])-ord('0')];
  result:=result+midstr(str,i+1,length(str)-i-1);
end;
function GetPyS(s:AnsiString):string;
//-------------------------------------------
//获取字符串全拼音及音调,非汉字直接返回原字符
//-------------------------------------------
var i:integer;
begin
  i:=1;
  while i<=length(s) do begin
    if not IsDBCSLeadByte(byte(s[i])) then result:=result+s[i]
    else begin
      result:=result+getPy(s[i]+s[i+1]);
      inc(i);
    end;
    inc(i);
  end;
end;
function GetPySS(s:AnsiString):string;
//------------------------------------------
//获取字符串拼音首字母,非汉字直接返回原字符
//------------------------------------------
var i:integer;
begin
  i:=1;
  while i<=length(s) do begin
    if not IsDBCSLeadByte(byte(s[i])) then result:=result+s[i]
    else begin
      result:=result+leftstr(getPy(s[i]+s[i+1]),1);
      inc(i);
    end;
    inc(i);
  end;
end;
function GetPyBZ(s:AnsiString):string;
//------------------------------------------
//获取字符串拼音标注,非汉字直接返回原字符
//------------------------------------------
var i:integer;
begin
  i:=1;
  while i<=length(s) do begin
    if not IsDBCSLeadByte(byte(s[i])) then result:=result+s[i]
    else begin
      result:=result+getPyVy(s[i]+s[i+1]);
      inc(i);
    end;
    inc(i);
  end;
end;
end.