|            
在使用电脑编辑文档的时候,输入汉语拼音再加上它的声调,是一件令人头痛的事情,特别对于那些经常接触拼音的教师、家长和孩子。虽然 Office XP中已经加入了自动标注汉语拼音的功能,不过,Office XP要####.00元哦。对于没有用上Office XP的人来说,难道就没有办法享受到这种便利吗?好在我们学习了编程,就自己动手吧! 
    这篇文章不仅仅是说明如何实现自动标注汉语拼音编程的,我的主要目的是演示解决问题的一般步骤。 
    就本问题来说,你是不是有种不知如何下手的感觉?想一想我们在编写汉字GB-BIG5相互转化时的做法:把每一个汉字的GB码、BIG5码都列出来,并一一对应。我们可以仿照这种方法,把每一个汉字(至少6763 个!!!)对应的拼音都列出来,然后就可以查询了。 
    不过,我相信你和我一样是懒惰的,懒惰的人通常会花费几倍的时间去找个可以懒惰的办法来。最懒惰的办法是……捡个现成的!先到网上问问看,就选大富翁论坛吧。这里不是大富翁游戏爱好者交流经验的论坛,而是专门讨论Delphi编程的地方,人气也好。登录http://www.delphibbs. com,免费注个册,问问看有没有谁知道如何编,或者能提供个组件什么的。记住要选邮件通知,如果有人回答问题,论坛会自动发邮件通知你,然后你就等着吧。 
    闲着也是闲着,在等待的时候我们也该做点什么。首先,应该想到 MSDN,它可是程序员必备的编程参考书(软件)。在MSDN中输入spell 或phoneticize查一下,看看有没有我们想要的信息。你就沿着这条思路试试吧。 
  还可以想一想,我们以前使用电脑接触到有拼音的地方。输入法!对了,就是拼音输入法!输入拼音我们可以得到汉字。我们能不能通过一种逆运算,输入汉字得到这个汉字的拼音?回答当然是肯定的,这也是本文推荐的方法。 
  这种方法实际上就是得到汉字的字根。我们仍然可以上论坛去询问,到 MSDN中查找,不过问题要改为“如何得到汉字的字根”。不用说,你已经可以解决本问题了。实际上,此编程主要用到三个函数: 
  GetKeyboardLayoutList:得到当台计算机中存在的输入法列表; 
  ImmEscape :得到输入法的名称; 
  ImmGetConversionList: 看看这个输入法是否支持Reverse Conversion功能,如果支持则继续使用此函数,可取得组字字根信息。 
  现在简单了,打开Delphi 6,添加两个TEdit控件、三个TBitBtn控件、一个TOpenDialog控件以及若干 Label控件以示说明,窗体设计如图1所示。接着输入下面的源代码,编译通过就可以使用了。主要的地方我已经加了注释。在编译之前,请确定你安装了微软拼音输入法。 
 
  程序代码如下:
  unit Unit1; 
 
  interface 
 
  uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
 
  StdCtrls, ExtCtrls, Buttons, IMM; 
  type 
  TForm1 = class(TForm) 
  OpenDialog1: TOpenDialog; 
  BitBtn2: TBitBtn; 
  BitBtn3: TBitBtn; 
  Edit2: TEdit; 
  Edit1: TEdit; 
  Label5: TLabel; 
  Label1: TLabel; 
  BitBtn1: TBitBtn; 
  procedure BitBtn1Click(Sender: TObject); 
  procedure FormCreate(Sender: TObject); 
  procedure BitBtn3Click(Sender: TObject); 
  procedure BitBtn2Click(Sender: TObject); 
  public 
  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 
 
  StdCtrls, ExtCtrls, Buttons, IMM; 
  type 
  TForm1 = class(TForm) 
  OpenDialog1: TOpenDialog; 
  BitBtn2: TBitBtn; 
  BitBtn3: TBitBtn; 
  Edit2: TEdit; 
  Edit1: TEdit; 
  Label5: TLabel; 
  Label1: TLabel; 
  BitBtn1: TBitBtn; 
  procedure BitBtn1Click(Sender: TObject); 
  procedure FormCreate(Sender: TObject); 
  procedure BitBtn3Click(Sender: TObject); 
  procedure BitBtn2Click(Sender: TObject); 
  public 
  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.BitBtn1Click(Sender: TObject); 
  begin 
  OpenDialog1.Title := '选择需要转换的文件'; 
  if OpenDialog1.Execute then 
  Edit1.Text := OpenDialog1.FileName; 
  Edit2.Text := ChangeFileExt(OpenDialog1.FileName, '.py'); 
  end; 
 
  // 拼音文件保存到 
  procedure TForm1.BitBtn3Click(Sender: TObject); 
  begin 
  OpenDialog1.Title := '转换到:'; 
  if OpenDialog1.Execute then 
  Edit2.Text := OpenDialog1.FileName; 
  end; 
 
  procedure TForm1.BitBtn2Click(Sender: TObject); 
  var 
  f1 ,f2 :textfile; 
  ch1,ch2,ch11 :Char; 
  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; 
  if not FileExists(Edit1.text)then 
  begin 
  ShowMessage('请你选定一个文件或你'#13#10'选择的文件不存在!'); 
  exit; 
  end; 
 
  AssignFile(F1, edit1.Text); 
  Reset(F1); 
  AssignFile(F2, edit2.Text); 
  Rewrite(F2); 
 
  while not Eof(F1) do 
  begin 
  alr:=0; 
  Read(F1, Ch1); 
  if not IsDBCSLeadByte(byte(ch1)) then 
  begin 
  Write(F2, Ch1); 
  continue; 
  end; //if 
  Read(F1, Ch11); 
  ch2str:= QueryCompStr(pList[ii], ch1+ch11); 
  if (ch2str[1]=#0)then 
  begin 
  Write(F2, Ch1); 
  Write(F2, Ch11); 
  continue; 
  end; 
 
  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; 
 
  for J:=1 to 8 do 
  begin 
 
  end; //if 
  if (ch2='o') and (alr=0) and (py[1]<>1) then 
  begin 
  alr:=1; 
  Write(F2, pych[2][tmp]); 
  continue; 
  end; 
 
  if (ch2='e') then 
  begin 
  alr:=1; Write(F2, pych[3][tmp]); 
  continue; 
  end; 
 
  if (ch2='i')and (alr=0) and (py[1]<>1) and (py[2]<>1) and (py[3]<>1) and (py[4]=1) then 
  begin 
  alr:=1; 
  Write(F2, pych[4][tmp]); 
  continue; 
  end; 
 
  if (ch2='u')and (alr=0) and (py[1]<>1) and (py[2]<>1) and (py[3]<>1) and (py[5]=1) then 
  begin 
  alr:=1; 
  Write(F2, pych[5][tmp]); 
  continue; 
  end; 
 
  if (ch2='ü')and (alr=0)and (py[3]<>1) then 
  begin 
  alr:=1; 
  Write(F2, pych[6][tmp]); 
  continue; 
  end; 
 
  Write(F2, Ch2); 
  end; //for 
  write(f2,' '); 
  end; //while 
  CloseFile(F2); 
  CloseFile(F1); 
  ShowMessage('转换完毕!'); 
  end; 
  end.  
 
    程序中判断加拼音的位置的方法有些笨拙,所幸还能用。如果你写出了更有效率的代码,希望能和大家一起分享。有一个要注意的地方,程序还不能处理多音字。另外,你可以在程序中添加进度条,以了解程序的进度。程序在Delphi6 + Windows98下调试通过。  
 |