unit ime95;// 这些函式, 我通常是在 edit 的 ondblclick 事件中呼叫测试interfaceuseswindows, messages, sysutils, imm,classes, graphics, controls, forms;// 请注意, imm.pas 必须置于与本单元同一目录或// 主选单 tools | options | library path 中的任一个目录// imm.pas 可在 delphi 2.0 的 source目录中找到constnhkl_list = 20;typetimeuiwindow = class(tcustomcontrol)privateprocedure cmtextchanged(var message: tmessage); message cm_textchanged;protectedprocedure createparams(var params: tcreateparams); override;procedure paint; override;publicconstructor create(aowner: tcomponent); override;procedure showcomposition(ptwhere: tpoint; const shint: string); virtual;// function ishintmsg(var msg: tmsg): boolean; virtual;// procedure releasehandle;property caption;property canvas;property color;end;// 显示某一输入法的设定对话盒function showimeconfigdialog(hkb: hkl): bool; far;// 指定某一窗口的中英输入模式procedure tochinese(hwindows: thandle; bchinese: boolean); far;// 下一个输入法(等于仿真预设的 ctrl + shift)procedure nextime; far;// 侦测目前作用中的输入法文件名称function getimefilename: string; far;// 切换到指定的输入法function setactivateime(swanted: string): boolean; far;// 切断到中文输入法, 同时指定全/半角function imefullshape(hwindow: hwnd; btofullshape: bool): bool; far;// 送入一段字符串到指定的窗口procedure senddbcsstring(hfocus: hwnd; const ssend: string); far;// 取得目前的拆字字根function getimecompositonstring(hwindow: hwnd): string; far;// 取得目前的拆字结果function getimecompositonresult(hwindow: hwnd): string; far;// 取消某次的组字过程procedure cancelcomposition(hwindow: thandle); far;// 设定组字字根procedure setimecompositonstring(hwindow: thandle; const scompstr: string); far;// 显示/不显示屏幕小键盘function showsoftkeyboard(hwindow: hwnd; bshowit: bool): bool; far;// 要不要相关字词功能function phrasepredict(hwindow: hwnd; bpredict: bool): bool; far;// 查询某字的组字字根function querycompstr(hkb: hkl; const schinese: ansistring): string; far;// --------------------------------------------------// --------------------------------------------------implementation// --------------------------------------------------// 指定某一窗口的中英输入模式// tochinese(true); ==> 切换到中文输入法// tochinese(false); ==> 切换到英数输入模式// [注意事项]// 1. 同一个 tread 共享同一个 input context// 2. 可能的话, 最好应在呼叫完本程序的下一列写上:// application.processmessages;// --------------------------------------------------procedure tochinese(hwindows: thandle; bchinese: boolean);beginif immisime(getkeyboardlayout(0)) <> bchinese thenimmsimulatehotkey(hwindows, ime_thotkey_ime_nonime_toggle);end;// --------------------------------------------------// 下一个输入法(等于仿真预设的 ctrl + shift)////// --------------------------------------------------procedure nextime;beginactivatekeyboardlayout(hkl_next, 0);end;// --------------------------------------------------// 切换到指定的输入法//// setactivateime(‘chajei.ime‘); ==> 切换到仓额输入法// setactivateime(‘phon.ime‘); ==> 切换到注音输入法// 传入空字符串时, 切换到英数输入法// --------------------------------------------------function setactivateime(swanted: string): boolean;varihandlecount : integer;plist : array[1..nhkl_list] of hkl;szimefilename : array[0..max_path] of char;simefilename : string;binstalled : boolean;i : integer;beginresult := false;swanted := ansiuppercase(swanted);// 传入空字符串, 切成英数输入模式if length(swanted) = 0 thenbegintochinese(0, false);result := true;exit;end;// 看看是否安装了这个输入法binstalled := false;ihandlecount := getkeyboardlayoutlist(nhkl_list, plist);for i := 1 to ihandlecount dobeginimmgetimefilename(plist, szimefilename, max_path);simefilename := ansiuppercase(strpas(szimefilename));if simefilename = swanted thenbeginbinstalled := true;break;end;end;// 如果这个输入法已安装了, 让那个输入法的键盘分布(keylayout)作用if binstalled thenbeginactivatekeyboardlayout(plist, 0);result := true;end;end; { of setactivateime }// --------------------------------------------------// 侦测目前作用中的输入法文件名称// 传回值为空字符串时, 表示英数输入模式//// --------------------------------------------------function getimefilename: string;varszimefilename : array[0..max_path] of char;beginif immgetimefilename(getkeyboardlayout(0), szimefilename, max_path) <> 0 thenresult := ansiuppercase(strpas(szimefilename))elseresult := ‘‘;end;// --------------------------------------------------// 切换成中文输入法, 并且指定使用半/全角输入模式// 传回值: true: 成功 / false 切换失败// 使用示例: imefullshape(form1.handle, true); // 全角// imefullshape(form1.handle, false); // 半角// --------------------------------------------------(*这个函数也可以用以下的方式来作作看:if not immisime(getkeyboardlayout(0)) thenimmsimulatehotkey(hwindow, ime_thotkey_ime_nonime_toggle);application.processmessages;immsimulatehotkey(hwindow, ime_thotkey_shape_toggle);*)function imefullshape(hwindow: hwnd; btofullshape: bool): bool;varhic : himc;conversion, sentence: dword;msgpeekresult : tmsg;beginresult := false;if hwindow = 0 then hwindow := getfocus;if hwindow = 0 then exit;// 切换成中文输入法if not immisime(getkeyboardlayout(0)) thenimmsimulatehotkey(hwindow, ime_thotkey_ime_nonime_toggle);while peekmessage(msgpeekresult, hwindow, 0, 0, pm_remove) dobegintranslatemessage(msgpeekresult);dispatchmessage(msgpeekresult);end;// 转换成半/全角输入模式hic := immgetcontext(hwindow);if hic = 0 then exit;tryif not immgetconversionstatus(hic, conversion, sentence) then exit;if btofullshape thenconversion := conversion or ime_cmode_fullshapeelseconversion := conversion and (not ime_cmode_fullshape);if not immsetconversionstatus(hic, conversion, sentence) then exit;result := true;finallyimmreleasecontext(hwindow, hic);end;end; { of imefullshape }// --------------------------------------------------// 送入一段字符串到指定的窗口// 例如: senddbcsstring(edit1.handle, ‘测试‘);//// 若第一个自变量为零, 则送往目前作用中的控件// 例:// edit1.setfocus;// senddbcsstring(0, ‘测试‘);// --------------------------------------------------procedure senddbcsstring(hfocus: hwnd; const ssend: string);varhactivecontrol : hwnd;i : integer;ch : byte;beginif hfocus = 0 then hfocus := getfocus;if hfocus = 0 then exit;i := 1;while i <= length(ssend) dobeginch := byte(ssend);// sendmessage(hfocus, wm_char, ch, 0); // 这样子不行if windows.isdbcsleadbyte(ch) thenbegininc(i);sendmessage(hfocus, wm_ime_char, makeword(byte(ssend), ch), 0);endelsesendmessage(hfocus, wm_ime_char, word(ch), 0);inc(i);end;end; { of senddbcsstring }// --------------------------------------------------// 取得目前的拆字字根////// --------------------------------------------------function getimecompositonstring(hwindow: hwnd): string;varhic : himc;pbuf : pchar;dwbuflen : dword;beginresult := ‘‘;hic := immgetcontext(hwindow); // 取得目前 thread 的 input contextif hic = 0 then exit;// 查一下 buffer 需要多大的内存才能容纳dwbuflen := immgetcompositionstring(hic, gcs_compstr, nil, 0);if dwbuflen <= 0 then exit;trygetmem(pbuf, dwbuflen + 1); // 配置内存 if immgetcompositionstring(hic, gcs_compstr, pbuf, dwbuflen) > 0 thenresult := string(strlcopy(pbuf, pbuf, dwbuflen));finallyfreemem(pbuf, dwbuflen + 1);immreleasecontext(hwindow, hic);end;end;// --------------------------------------------------// 取得拆字结果////// --------------------------------------------------function getimecompositonresult(hwindow: hwnd): string;varhic : himc;pbuf : pchar;dwbuflen : dword;beginresult := ‘‘;hic := immgetcontext(hwindow); // 取得目前 thread 的 input contextif hic = 0 then exit;// 查一下 buffer 需要多大的内存才能容纳dwbuflen := immgetcompositionstring(hic, gcs_resultstr, nil, 0);if dwbuflen <= 0 then exit;trygetmem(pbuf, dwbuflen + 1); // 配置内存if immgetcompositionstring(hic, gcs_resultstr, pbuf, dwbuflen) > 0 thenresult := string(strlcopy(pbuf, pbuf, dwbuflen));// lblcomposition.caption := strlcopy(pbuf, pbuf, dwbuflen);finallyfreemem(pbuf, dwbuflen + 1);immreleasecontext(hwindow, hic);end;end;// --------------------------------------------------// 取消某次的组字过程////// --------------------------------------------------procedure cancelcomposition(hwindow: thandle);varhic : himc;beginif hwindow = 0 then hwindow := getfocus;if hwindow = 0 then exit;hic := immgetcontext(hwindow);if hic <> 0 then immnotifyime(hic, ni_compositionstr, cps_cancel, 0);immreleasecontext(hwindow, hic);end;// --------------------------------------------------// 设定组字字根//// setimecompositonstring(0, ‘金戈戈‘);// --------------------------------------------------procedure setimecompositonstring(hwindow: thandle; const scompstr: string);varhic : himc;beginif hwindow = 0 then hwindow := getfocus;if hwindow = 0 then exit;hic := immgetcontext(hwindow);immsetcompositionstring(hic, scs_setstr,pchar(scompstr), length(scompstr), nil, 0);immreleasecontext(hwindow, hic);end;function showsoftkeyboard(hwindow: hwnd; bshowit: bool): bool;varhic : himc;conversion, sentence: dword;msgpeekresult : tmsg;beginresult := false;if hwindow = 0 then hwindow := getfocus;if hwindow = 0 then exit;// 切换成中文输入法if not immisime(getkeyboardlayout(0)) thenimmsimulatehotkey(hwindow, ime_thotkey_ime_nonime_toggle);while peekmessage(msgpeekresult, hwindow, 0, 0, pm_remove) dobegintranslatemessage(msgpeekresult);dispatchmessage(msgpeekresult);end;// 要不要显示屏幕小键盘hic := immgetcontext(hwindow);if hic = 0 then exit;tryif not immgetconversionstatus(hic, conversion, sentence) then exit;if bshowit thenconversion := conversion or ime_cmode_softkbdelseconversion := conversion and (not ime_cmode_softkbd);if not immsetconversionstatus(hic, conversion, sentence) then exit;result := true;finallyimmreleasecontext(hwindow, hic);end;end; { of showsoftkeyboard }// --------------------------------------------------// 显示某一输入法的设定对话盒////// --------------------------------------------------function showimeconfigdialog(hkb: hkl): bool;begin// 显示某一输入法的设定对话盒result := immconfigureime(hkb, 0, ime_config_general, nil);end;// --------------------------------------------------// 要不要相关字词功能////// --------------------------------------------------function phrasepredict(hwindow: hwnd; bpredict: bool): bool;varhic : himc;conversion, sentence: dword;msgpeekresult : tmsg;beginresult := false;if hwindow = 0 then hwindow := getfocus;if hwindow = 0 then exit;// 切换成中文输入法if not immisime(getkeyboardlayout(0)) thenimmsimulatehotkey(hwindow, ime_thotkey_ime_nonime_toggle);while peekmessage(msgpeekresult, hwindow, 0, 0, pm_remove) dobegintranslatemessage(msgpeekresult);dispatchmessage(msgpeekresult);end;// 要不要相关字词功能hic := immgetcontext(hwindow);if hic = 0 then exit;tryif not immgetconversionstatus(hic, conversion, sentence) then exit;if bpredict thensentence := sentence or ime_smode_phrasepredictelsesentence := sentence and (not ime_smode_phrasepredict);if not immsetconversionstatus(hic, conversion, sentence) then exit;result := true;finallyimmreleasecontext(hwindow, hic);end;end; { of phrasepredict }// --------------------------------------------------// 查询某字的组字字根////// --------------------------------------------------function querycompstr(hkb: hkl; const schinese: ansistring): string;vardwgcl : dword;szbuffer : array[0..254] of char;imaxkey, istart, i: integer;beginresult := ‘‘;imaxkey := immescape(hkb, 0, ime_esc_max_key, nil);if imaxkey <= 0 then exit;// 看看这个输入法是否支持 reverse conversion 功能// 同时, 侦测需要多大的空间容纳取得的信息// comment: 下次修改时可以改成动态配置内存的方式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 thenbegin// 为什么是 24?{tcandidatelist = recorddwsize: dword;dwstyle: dword;dwcount: dword;dwselection: dword;dwpagestart: dword;dwpagesize: dword; 24-th bytedwoffset: array[1..1] of dword;end;}istart := byte(szbuffer[24]);for i := istart to istart + imaxkey * 2 doappendstr(result, szbuffer);end;end;// --------------------------------------------------// { timeuiwindow }//// --------------------------------------------------constructor timeuiwindow.create(aowner: tcomponent);begininherited create(aowner);// color := $80ffff;color := clsilver;with canvas dobeginfont.name := ‘细明体‘;font.size := 12;brush.style := bsclear;end;end;procedure timeuiwindow.createparams(var params: tcreateparams);begininherited createparams(params);with params dobegin// style := ws_popup or ws_border or ws_disabled;style := ws_popup or ws_disabled;windowclass.style := windowclass.style or cs_savebits;if newstylecontrols then exstyle := ws_ex_toolwindow;end;end;procedure timeuiwindow.paint;varrttext, r : trect;beginrttext := clientrect;inc(rttext.left, 5);inc(rttext.top, 5);canvas.font.color := clgray;drawtext(canvas.handle, pchar(caption), -1, rttext, dt_left or dt_noprefix ordt_wordbreak);rttext := clientrect;inc(rttext.left, 4);inc(rttext.top, 4);canvas.font.color := clwhite;drawtext(canvas.handle, pchar(caption), -1, rttext, dt_left or dt_noprefix ordt_wordbreak);r := clientrect;canvas.pen.color := clgray;canvas.rectangle(r.left + 2, r.top + 2, r.right, r.bottom);canvas.pen.color := clwhite;canvas.rectangle(r.left + 1, r.top + 1, r.right - 1, r.bottom - 1);end;procedure timeuiwindow.cmtextchanged(var message: tmessage);begininherited;width := canvas.textwidth(caption) + 9;height := canvas.textheight(caption) + 9;end;procedure timeuiwindow.showcomposition(ptwhere: tpoint; const shint: string);begincaption := shint;if ptwhere.y + height > screen.height thenptwhere.y := screen.height - height;if ptwhere.x + width > screen.width thenptwhere.x := screen.width - width;setwindowpos(handle, hwnd_topmost, ptwhere.x, ptwhere.y, 0,0, swp_showwindow or swp_noactivate or swp_nosize);end;end.

评论