pinyin.pas

我自己用的Delphi函数单元 具体说明见打包文件的HELP目录下面

//——————————————————————————————————————————————//
//    s := '中文拼音,chinese pinyin';
//    if InitializePinYin(Self.Handle) then
//    begin
//    	with Memo.Lines do
//    	begin
//        	clear();
//        	add(GetPinYin(s));
//        end;
//    end;
//——————————————————————————————————————————————//

unit PinYin;

interface

uses IMM;

type
	function InitializePinYin(hWindow: THandle) : Boolean;
	function GetPinYin(sChinese :String;bCaptial:Boolean = True) : String;

var
	//如果没有调用InitializePinYin初始化，则GetPinYin无效。
  	bPinYinReady : Boolean = False;

implementation

var
  hPinYin  : HKL;
  hIME     : hIMC;

function QueryCompStr(hKB: HKL; hIME:HIMC; const sChinese: AnsiString): string;
const
    MAX_CONVERSION_BUFFER = 255;
var
  dwGCL: DWORD;
  szBuffer: array[0..MAX_CONVERSION_BUFFER-1] of char;
  iMaxKey, iStart, i: integer;
begin
  Result := '';
  iMaxKey := ImmEscape(hKB, hIME, IME_ESC_MAX_KEY, nil);
  if iMaxKey <= 0 then exit;

  dwGCL := ImmGetConversionList(hKB,hIME,pchar(sChinese),nil,0,GCL_REVERSECONVERSION);
  if dwGCL <= 0 then Exit;

  dwGCL := ImmGetConversionList(hKB,hIME,pchar(sChinese),@szBuffer,MAX_CONVERSION_BUFFER,GCL_REVERSECONVERSION);
  if dwGCL > 0 then
  begin
    iStart := byte(szBuffer[24]);
    for i := iStart to iStart + iMaxKey * 2 do
      AppendStr(Result, szBuffer[i]);
  end;
  Result :=String(PChar(Result));
end;

function InitializePinYin(hWindow: THandle) : Boolean;
const
	HKL_LIST_SIZE = 20;
var
    i,n: integer;
    szImeName: array[0..254] of char;
    pList: array[1..HKL_LIST_SIZE] of HKL;
begin
    bPinYinReady := False;
    hIME:=ImmGetContext(hWindow);
    n := GetKeyboardLayoutList(HKL_LIST_SIZE, pList);
    for i := 1 to n do
        if (ImmEscape(pList[i], hIME, IME_ESC_IME_NAME, @szImeName) > 0) and (szImeName = '全拼') then
        begin
            hPinYin := pList[i];
            bPinYinReady := True;
            break;
        end;
    Result := bPinYinReady;
end;

function GetPinYin(sChinese :String;bCaptial:Boolean = True) : String;
var
    sWide : WideString;
    sAnsi : AnsiString;
    i,n   : Integer;
    bAnsi : Boolean;
begin
    Result := '';
    if not bPinYinReady then Exit; //必须初始化

    bAnsi  := False;
    sWide  := sChinese;
    n      := Length(sWide);
    for i:= 1 to n do
    begin
        sAnsi := sWide[i];
        if Length(sAnsi) > 1 then
        begin
           sAnsi := QueryCompStr(hPinYin, hIME,sAnsi);
           if bCaptial then sAnsi := UpperCase(sAnsi)
           else sAnsi := LowerCase(sAnsi);
           if bAnsi then Result := Result + ' ';
           Result := Result + sAnsi+ ' ';
           bAnsi := False;
        end
        else
        begin
            //if not bAnsi then Result := Result + ' ';
            Result := Result + sAnsi;
            bAnsi := True;
        end;
    end;
    Result := Trim(Result);
end;