// 选择需要标注拼音的文件: 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下调试通过。 |
正在阅读:用Delphi 6编程实现自动标注汉语拼音用Delphi 6编程实现自动标注汉语拼音
2004-02-14 09:34
出处:电脑爱好者
责任编辑:zwg
键盘也能翻页,试试“← →”键