unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls,IMM;
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    BitBtn2: TBitBtn;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Edit3: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    iHandleCount: integer;
    pList : array[1..20] of HKL;
    szImeName : array[0..254] of char;
    II : integer;
  end;
const
pych: array[1..6,1..5] of string[2]=
(('ā', 'á','ǎ','à','a'),('ō', 'ó','ǒ','ò','o'),
('ē', 'é','ě','è','e'),('ī', 'í','ǐ','ì','i'),
('ū', 'ú','ǔ','ù','u'),('ǖ', 'ǘ','ǚ','ǜ','ü'));

var
  Form1: TForm1;

implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  II := 0;
  //retrieves the keyboard layout handles corresponding to the current set of input locales in the system.
  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
          begin
            ii := i;
            exit;
          end;
    end;
  ShowMessage('請你安裝"微軟拼音輸入法"!');
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
  i:integer;
  charstr1,charstr2:char;
  szm,pin,zm,x:string;
  restr,str:string;
  b:integer;
  ch1,ch2:string;
  ch2Str :string;
  j ,alr , tmp :integer;
  py : array[1..6] of integer;
  function QueryCompStr(hKB: HKL; const sChinese: AnsiString): string;
  var
    dwGCL: DWORD;
    szBuffer: array[0..254] of char;
    iMaxKey, iStart, i: integer;
  begin
    Result := '';
    iMaxKey := ImmEscape(hKB, 0, IME_ESC_MAX_KEY, nil);
    if iMaxKey <= 0 then exit;
    // 看看這個輸入法是否支持Reverse Conversion功能，同時, 偵測需要多大的空間容納取得的信息
    dwGCL := ImmGetConversionList(hKB, 0, pchar(sChinese),nil, 0, GCL_REVERSECONVERSION);
    if dwGCL <= 0 then Exit; // 該輸入法不支持Reverse Conversion功能
    // 取得組字字根信息, dwGCL的值必須用上次呼叫ImmGetConversionList得到的返回值作為參數
    dwGCL := ImmGetConversionList(hKB,0,pchar(sChinese),@szBuffer, dwGCL,GCL_REVERSECONVERSION);
    if dwGCL > 0 then
      begin
        iStart := byte(szBuffer[24]);
        for i := iStart to iStart + iMaxKey * 2 do
          AppendStr(Result, szBuffer[i]);
      end;
  end;
begin
  tmp:=0;b:=1;
  str:= edit1.text;
  for I:=1 to length(str) do
    begin
      if (ord(str[I])>=33)and(ord(str[I])<=126) then
        begin
          pin:=pin+ansiuppercase(str[i]);
          szm:=szm+ansiuppercase(str[i]);
        end
      else
        if (ord(str[I])>=127) then
          begin
            if b=0 then
              begin
                ch1:='';
                charstr1:=str[I-1];
                charstr2:=str[I];
                ch2:=charstr1+charstr2;
                ch2str:=QueryCompStr(pList[ii], ch2);
                x:=ch2str[1];
                if x<>#$a1 then
                  begin
                    szm:=szm+ansiuppercase(ch2str[1]);
                    for J:=1 to 8 do
                      begin
                        if (ch2str[j]<'6')and (ch2str[j]>'0') then
                          tmp:=strtoint(ch2str[j]);
                      end;
                    for j:=1 to 6 do
                      py[j]:=0;
                    //以下是判斷加拼音的位置，注意ui和iu加聲調的方式
                    for j:=8 downto 1 do
                      begin
                        if ch2str[j]='a' then py[1]:=1;
                        if ch2str[j]='o' then py[2]:=1;
                        if ch2str[j]='e' then py[3]:=1;
                        if (ch2str[j]='i') and (py[5]<>1)then py[4]:=1;
                        if (ch2str[j]='u') and (py[4]<>1) then py[5]:=1;
                        if ch2str[j]='ü' then py[6]:=1;
                      end;
                    alr:=0;
                    for J:=1 to 8 do
                      begin
                        zm:= ch2str[j];
                        if (zm<'6')and (zm>'0') then
                          Break;
                        if (zm='a') and (alr=0) and (py[2]<>1) then
                          begin
                            alr:=1;
                            ch1:=ch1+pych[1][tmp];
                            continue;
                          end;
                        if (zm='o') and (alr=0) and (py[1]<>1) then
                          begin
                            alr:=1;
                            ch1:=ch1+pych[2][tmp];
                            continue;
                          end;
                        if (zm='e') then
                          begin
                            alr:=1;
                            ch1:=ch1+pych[3][tmp];
                            continue;
                          end;
                        if (zm='i')and (alr=0) and (py[1]<>1) and (py[2]<>1) and (py[3]<>1) and (py[4]=1) then
                          begin
                            alr:=1;
                            ch1:=ch1+pych[4][tmp];
                            continue;
                          end;
                        if (zm='u')and (alr=0) and (py[1]<>1) and (py[2]<>1) and (py[3]<>1) and (py[5]=1) then
                          begin
                            alr:=1;
                            ch1:=ch1+pych[5][tmp];
                            continue;
                          end;
                        if (zm='ü')and (alr=0)and (py[3]<>1) then
                          begin
                            alr:=1;
                            ch1:=ch1+pych[6][tmp];
                            continue;
                          end;
                        ch1:=ch1+zm;
                      end;//for
                  end;
                ch1:=ch1+' ';
                pin:=pin+ch1;
                b:=1;
              end
            else
              b:=0;
          end;
    end;
  edit2.Text:=pin;
  edit3.Text:=szm;
end;
end.