IME Tool Library

Tags: /超级猛料/IME.Charset.输入法和中文处理/ Date Created:

(* -------------------------------------------------- *)

(* Chien's IME Tool Library

(* ========================

(* 环境需求:

(* Windows 95 中文版 + Delphi 2

(* Updated on 1996.11.12

(* 特别声明: 本单元可以免费自由应用与散播, 条件如下:

(* 1. 请发一封 E-Mail 给我, 以便日后版本修订时能通知到您

(* 2. 由于是免费的单元且原始程序已公开, 所以我并不负担您

(* 程序除错维护或资料损失的任何责任.

(* 作者: 钱达智(Wolfgang Chien)

(* E-Mail: wolfgang@ms2.hinet.net

(* -------------------------------------------------- *)

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\Rtl\Win 目录中找到

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[I], szImeFileName, MAX_PATH);

sImeFileName := AnsiUpperCase(StrPas(szImeFileName));

if sImeFileName = sWanted then

begin

bInstalled := True;

Break;

end;

// 如果这个输入法已安装了, 让那个输入法的键盘分布(KeyLayout)作用

if bInstalled then

begin

ActivateKeyboardLayout(pList[i], 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[i]);

// SendMessage(hFocus, WM_CHAR, ch, 0); // 这样子不行

if Windows.IsDBCSLeadByte(ch) then

begin

Inc(i);

SendMessage(hFocus, WM_IME_CHAR, MakeWord(byte(sSend[i]), 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;

// --------------------------------------------------

// 取得拆字结果

// --------------------------------------------------

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;

// --------------------------------------------------

// 取消某次的组字过程

// --------------------------------------------------

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,

pchar(sChinese),

nil,

GCL_REVERSECONVERSION);

if dwGCL <= 0 then Exit; // 该输入法不支持 Reverse Conversion 功能

// 取得组字字根信息, dwGCL 的值必须以上次呼叫 ImmGetConversionList

// 传回值代入

dwGCL := ImmGetConversionList(

hKB,

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[i]);

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;

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;

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.