如何取系统当前输入法！

Question

用 Screen.Imes[i] 等函数 都只能取到输入法的名称 怎么取当前选择的输入法呢？

Answer 1

var zz:hkl;i:integer;
begin
zz:=getkeyboardlayout(0);
for i:=0 to screen.Imes.Count-1 do
if hkl(screen.Imes.Objects[i])=zz then showmessage(screen.Imes.Strings[i]);
end;
win2000+d6下测试通过

Answer 2

如果你只是想要得到其他程序是什么输入法，那很容易只要你调用TID := GetWindowThreadProcessID(GetForegroundWindow,@PID);MyHkl := GetKeyBoardLayout(TID);就可以得到当前窗口的输入法，如果MyHkl mod 65536 <>1033 （可能记错了，你查帮助吧！）就是中文输入法。

Answer 3

下面更精点 (* -------------------------------------------------- *) 
(* Chien's IME Tool Library(* ========================(* 环境需求:(* Windows 95 中文版 + Delphi 2(*(* Updated on 1996.11.12(*(* 特别声明: 本单元可以免费自由应用与散播, 条件如下:(* 1. 请发一封 E-Mail 给我, 以便日后版本修订时能通知到您(* 2. 由于是免费的单元且原始程序已公开, 所以我并不负担您(* 程序除错维护或资料损失的任何责任.(*(* 作者: 钱达智(Wolfgang Chien)(* E-Mail: [email protected](* -------------------------------------------------- *)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[I], szImeFileName, MAX_PATH);sImeFileName := AnsiUpperCase(StrPas(szImeFileName));if sImeFileName = sWanted thenbeginbInstalled := True;Break;end;end;// 如果这个输入法已安装了, 让那个输入法的键盘分布(KeyLayout)作用if bInstalled thenbeginActivateKeyboardLayout(pList[i], 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;

Answer 4

接上面// 转换成半/全角输入模式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[i]);// SendMessage(hFocus, WM_CHAR, ch, 0); // 这样子不行if Windows.IsDBCSLeadByte(ch) thenbeginInc(i);SendMessage(hFocus, WM_IME_CHAR, MakeWord(byte(sSend[i]), 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// 显示某一输入法的设定对话盒