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.
文章整理：西部数码--专业提供域名注册、虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息，谢谢!
