用Delphi 6编程实现自动标注汉语拼音
【打印文章】
在使用电脑编辑文档的时候，输入汉语拼音再加上它的声调，是一件令人头痛的事情，特别对于那些经常接触拼音的教师、家长和孩子。虽然 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下调试通过。
这篇文章不仅仅是说明如何实现自动标注汉语拼音编程的，我的主要目的是演示解决问题的一般步骤。
就本问题来说，你是不是有种不知如何下手的感觉？想一想我们在编写汉字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下调试通过。
本栏文章均来自于互联网，版权归原作者和各发布网站所有，本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )
【编程爱好者论坛】