用Delphi 6编程实现自动标注汉语拼音

// 选择需要标注拼音的文件：

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下调试通过。