unit ime95;
// 这些函式, 我通常是在 edit 的 ondblclick 事件中呼叫测试
interface
uses
windows, messages, sysutils, imm,
classes, graphics, controls, forms;
// 请注意, imm.pas 必须置于与本单元同一目录或
// 主选单 tools | options | library path 中的任一个目录
// imm.pas 可在 delphi 2.0 的 source目录中找到
const
nhkl_list = 20;
type
timeuiwindow = class(tcustomcontrol)
private
procedure cmtextchanged(var message: tmessage); message cm_textchanged;
protected
procedure createparams(var params: tcreateparams); override;
procedure paint; override;
public
constructor 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);
begin
if immisime(getkeyboardlayout(0)) <> bchinese then
immsimulatehotkey(hwindows, ime_thotkey_ime_nonime_toggle);
end;
// --------------------------------------------------
// 下一个输入法(等于仿真预设的 ctrl + shift)
//
//
// --------------------------------------------------
procedure nextime;
begin
activatekeyboardlayout(hkl_next, 0);
end;
// --------------------------------------------------
// 切换到指定的输入法
//
// setactivateime(‘chajei.ime‘); ==> 切换到仓额输入法
// setactivateime(‘phon.ime‘); ==> 切换到注音输入法
// 传入空字符串时, 切换到英数输入法
// --------------------------------------------------
function setactivateime(swanted: string): boolean;
var
ihandlecount : integer;
plist : array[1..nhkl_list] of hkl;
szimefilename : array[0..max_path] of char;
simefilename : string;
binstalled : boolean;
i : integer;
begin
result := false;
swanted := ansiuppercase(swanted);
// 传入空字符串, 切成英数输入模式
if length(swanted) = 0 then
begin
tochinese(0, false);
result := true;
exit;
end;
// 看看是否安装了这个输入法
binstalled := false;
ihandlecount := getkeyboardlayoutlist(nhkl_list, plist);
for i := 1 to ihandlecount do
begin
immgetimefilename(plist, szimefilename, max_path);
simefilename := ansiuppercase(strpas(szimefilename));
if simefilename = swanted then
begin
binstalled := true;
break;
end;
end;
// 如果这个输入法已安装了, 让那个输入法的键盘分布(keylayout)作用
if binstalled then
begin
activatekeyboardlayout(plist, 0);
result := true;
end;
end; { of setactivateime }
// --------------------------------------------------
// 侦测目前作用中的输入法文件名称
// 传回值为空字符串时, 表示英数输入模式
//
// --------------------------------------------------
function getimefilename: string;
var
szimefilename : array[0..max_path] of char;
begin
if immgetimefilename(getkeyboardlayout(0), szimefilename, max_path) <> 0 then
result := ansiuppercase(strpas(szimefilename))
else
result := ‘‘;
end;
// --------------------------------------------------
// 切换成中文输入法, 并且指定使用半/全角输入模式
// 传回值: true: 成功 / false 切换失败
// 使用示例: imefullshape(form1.handle, true); // 全角
// imefullshape(form1.handle, false); // 半角
// --------------------------------------------------
(*
这个函数也可以用以下的方式来作作看:
if not immisime(getkeyboardlayout(0)) then
immsimulatehotkey(hwindow, ime_thotkey_ime_nonime_toggle);
application.processmessages;
immsimulatehotkey(hwindow, ime_thotkey_shape_toggle);
*)
function imefullshape(hwindow: hwnd; btofullshape: bool): bool;
var
hic : himc;
conversion, sentence: dword;
msgpeekresult : tmsg;
begin
result := false;
if hwindow = 0 then hwindow := getfocus;
if hwindow = 0 then exit;
// 切换成中文输入法
if not immisime(getkeyboardlayout(0)) then
immsimulatehotkey(hwindow, ime_thotkey_ime_nonime_toggle);
while peekmessage(msgpeekresult, hwindow, 0, 0, pm_remove) do
begin
translatemessage(msgpeekresult);
dispatchmessage(msgpeekresult);
end;
// 转换成半/全角输入模式
hic := immgetcontext(hwindow);
if hic = 0 then exit;
try
if not immgetconversionstatus(hic, conversion, sentence) then exit;
if btofullshape then
conversion := conversion or ime_cmode_fullshape
else
conversion := conversion and (not ime_cmode_fullshape);
if not immsetconversionstatus(hic, conversion, sentence) then exit;
result := true;
finally
immreleasecontext(hwindow, hic);
end;
end; { of imefullshape }
// --------------------------------------------------
// 送入一段字符串到指定的窗口
// 例如: senddbcsstring(edit1.handle, ‘测试‘);
//
// 若第一个自变量为零, 则送往目前作用中的控件
// 例:
// edit1.setfocus;
// senddbcsstring(0, ‘测试‘);
// --------------------------------------------------
procedure senddbcsstring(hfocus: hwnd; const ssend: string);
var
hactivecontrol : hwnd;
i : integer;
ch : byte;
begin
if hfocus = 0 then hfocus := getfocus;
if hfocus = 0 then exit;
i := 1;
while i <= length(ssend) do
begin
ch := byte(ssend);
// sendmessage(hfocus, wm_char, ch, 0); // 这样子不行
if windows.isdbcsleadbyte(ch) then
begin
inc(i);
sendmessage(hfocus, wm_ime_char, makeword(byte(ssend), ch), 0);
end
else
sendmessage(hfocus, wm_ime_char, word(ch), 0);
inc(i);
end;
end; { of senddbcsstring }
// --------------------------------------------------
// 取得目前的拆字字根
//
//
// --------------------------------------------------
function getimecompositonstring(hwindow: hwnd): string;
var
hic : himc;
pbuf : pchar;
dwbuflen : dword;
begin
result := ‘‘;
hic := immgetcontext(hwindow); // 取得目前 thread 的 input context
if hic = 0 then exit;
// 查一下 buffer 需要多大的内存才能容纳
dwbuflen := immgetcompositionstring(hic, gcs_compstr, nil, 0);
if dwbuflen <= 0 then exit;
try
getmem(pbuf, dwbuflen + 1); // 配置内存

if immgetcompositionstring(hic, gcs_compstr, pbuf, dwbuflen) > 0 then
result := string(strlcopy(pbuf, pbuf, dwbuflen));
finally
freemem(pbuf, dwbuflen + 1);
immreleasecontext(hwindow, hic);
end;
end;
// --------------------------------------------------
// 取得拆字结果
//
//
// --------------------------------------------------
function getimecompositonresult(hwindow: hwnd): string;
var
hic : himc;
pbuf : pchar;
dwbuflen : dword;
begin
result := ‘‘;
hic := immgetcontext(hwindow); // 取得目前 thread 的 input context
if hic = 0 then exit;
// 查一下 buffer 需要多大的内存才能容纳
dwbuflen := immgetcompositionstring(hic, gcs_resultstr, nil, 0);
if dwbuflen <= 0 then exit;
try
getmem(pbuf, dwbuflen + 1); // 配置内存
if immgetcompositionstring(hic, gcs_resultstr, pbuf, dwbuflen) > 0 then
result := string(strlcopy(pbuf, pbuf, dwbuflen));
// lblcomposition.caption := strlcopy(pbuf, pbuf, dwbuflen);
finally
freemem(pbuf, dwbuflen + 1);
immreleasecontext(hwindow, hic);
end;
end;
// --------------------------------------------------
// 取消某次的组字过程
//
//
// --------------------------------------------------
procedure cancelcomposition(hwindow: thandle);
var
hic : himc;
begin
if 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);
var
hic : himc;
begin
if 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;
var
hic : himc;
conversion, sentence: dword;
msgpeekresult : tmsg;
begin
result := false;
if hwindow = 0 then hwindow := getfocus;
if hwindow = 0 then exit;
// 切换成中文输入法
if not immisime(getkeyboardlayout(0)) then
immsimulatehotkey(hwindow, ime_thotkey_ime_nonime_toggle);
while peekmessage(msgpeekresult, hwindow, 0, 0, pm_remove) do
begin
translatemessage(msgpeekresult);
dispatchmessage(msgpeekresult);
end;
// 要不要显示屏幕小键盘
hic := immgetcontext(hwindow);
if hic = 0 then exit;
try
if not immgetconversionstatus(hic, conversion, sentence) then exit;
if bshowit then
conversion := conversion or ime_cmode_softkbd
else
conversion := conversion and (not ime_cmode_softkbd);
if not immsetconversionstatus(hic, conversion, sentence) then exit;
result := true;
finally
immreleasecontext(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;
var
hic : himc;
conversion, sentence: dword;
msgpeekresult : tmsg;
begin
result := false;
if hwindow = 0 then hwindow := getfocus;
if hwindow = 0 then exit;
// 切换成中文输入法
if not immisime(getkeyboardlayout(0)) then
immsimulatehotkey(hwindow, ime_thotkey_ime_nonime_toggle);
while peekmessage(msgpeekresult, hwindow, 0, 0, pm_remove) do
begin
translatemessage(msgpeekresult);
dispatchmessage(msgpeekresult);
end;
// 要不要相关字词功能
hic := immgetcontext(hwindow);
if hic = 0 then exit;
try
if not immgetconversionstatus(hic, conversion, sentence) then exit;
if bpredict then
sentence := sentence or ime_smode_phrasepredict
else
sentence := sentence and (not ime_smode_phrasepredict);
if not immsetconversionstatus(hic, conversion, sentence) then exit;
result := true;
finally
immreleasecontext(hwindow, hic);
end;
end; { of phrasepredict }
// --------------------------------------------------
// 查询某字的组字字根
//
//
// --------------------------------------------------
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 功能
// 同时, 侦测需要多大的空间容纳取得的信息
// 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 then
begin
// 为什么是 24?
{
tcandidatelist = record
dwsize: dword;
dwstyle: dword;
dwcount: dword;
dwselection: dword;
dwpagestart: dword;
dwpagesize: dword; 24-th byte
dwoffset: array[1..1] of dword;
end;
}
istart := byte(szbuffer[24]);
for i := istart to istart + imaxkey * 2 do
appendstr(result, szbuffer);
end;
end;
// --------------------------------------------------
// { timeuiwindow }
//
// --------------------------------------------------
constructor timeuiwindow.create(aowner: tcomponent);
begin
inherited create(aowner);
// color := $80ffff;
color := clsilver;
with canvas do
begin
font.name := ‘细明体‘;
font.size := 12;
brush.style := bsclear;
end;
end;
procedure timeuiwindow.createparams(var params: tcreateparams);
begin
inherited createparams(params);
with params do
begin
// 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;
var
rttext, r : trect;
begin
rttext := 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 or
dt_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 or
dt_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);
begin
inherited;
width := canvas.textwidth(caption) + 9;
height := canvas.textheight(caption) + 9;
end;
procedure timeuiwindow.showcomposition(ptwhere: tpoint; const shint: string);
begin
caption := shint;
if ptwhere.y + height > screen.height then
ptwhere.y := screen.height - height;
if ptwhere.x + width > screen.width then
ptwhere.x := screen.width - width;
setwindowpos(handle, hwnd_topmost, ptwhere.x, ptwhere.y, 0,
0, swp_showwindow or swp_noactivate or swp_nosize);
end;
end.

评论