用Delphi自動標注漢語拼音 - Delphi K.Top 討論區

發表時間：2003-03-30 19:47:42

IP:211.76.xxx.xxx 未訂閱

http://www.pconline.com.cn/pcedu/empolder/gj/delphi/10203/42545.html 用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下調試通過。 ======================= 二星級新手，問基礎問題請勿見笑 ^^ 發表人 - bookworm 於 2003/03/30 19:50:54