对 COMBOBOX 的外科手术：解决 COMBOBOX 处理回退键的 BUG
From 广联达林超.
对 COMBOBOX 的外科手术：解决 COMBOBOX 处理回退键的 BUG
版本：1.0.0
作者：林超
日期：2007年12月18日
前言
这是昨天晚上在加考虑了很长时间的一个问题，写下来省的忘了。也欢迎大家拍砖 ...
BTW：
- 这篇东东很长，都是代码的分析和实现，如果你不关心过程可以直接下载演示例子。（其实两个方案的代码都很短 :）
- 阅读本文需要对 VCL 框架有一定的了解。
- 文中引用一些项目、控件或者书本的内容没有过的讲述，感兴趣可以 Google 一下。
o(∩_∩)o...
背景
Delphi 的 ComboBox 控件在相应处理“BackSpace”键删除当前选中或光标前的内容时，如果当前内容是中文删除后光标位置定位错误或内容显示为乱码。
这是一个非常“著名”的 Bug！Google 一下网上讨论这个的很多，如大富翁中：
http://www.Delphibbs.com/keylife/iblog_show.asp?xid=21259
对此有详细的描述，文中作者提出“不要使用 XP 风格”以绕开此 BUG。
网上比较积极的解决问题方法在：
http://www.hlib.cn/zhidao/show.asp?topicid=4694673
基本上这是最简单的、不需要修改任何代码的解决办法：设置 AutoComplete 属性为 False，绕开出问题的代码。
至于通过修改重新编译 StdCtrls.pas 的方法有：
在李维的官方 blog 论坛中有大侠谈到在 TCustomComboBox.KeyPress 中通过用 widesting 修改这个 bug（现在只能通过 Google 快照浏览了？）：
http://liwei.csdn.net/forum/topic.aspx?topicid=1589
还有就是以前 hanxm 的修改版本（直接修噶 pas 而 Exit 屏蔽之）。
BTW：比较郁闷的是这个 BUG 自 D7 开始被人发现，一直到最新的 D2007 也还没有被修复！
分析
归根结底，这个问题是由于使用了不同版本的 ComCtl32.dll 所致：
- Delphi 编译的 exe 在没有带 XPMan.pas 时，使用的 ComCtl32.dll 是 5.x 之前的版本，这是 ansi 版本
- 启用配置单资源（XPMan.pas）或文件之后的 exe，在如 Windows XP 上使用的是 6.0 版本的 ComCtl32.dll，这是 unicode 版本。
procedure TCustomComboBox.KeyPress(var Key: Char);
function HasSelectedText(var StartPos, EndPos: DWORD): Boolean;
begin
SendMessage(Handle, CB_GETEDITSEL, Integer(@StartPos), Integer(@EndPos));
Result := EndPos > StartPos;
end;
procedure DeleteSelectedText;
var
StartPos, EndPos: DWORD;
OldText: String;
begin
OldText := Text;
SendMessage(Handle, CB_GETEDITSEL, Integer(@StartPos), Integer(@EndPos));
Delete(OldText, StartPos + 1, EndPos - StartPos);
SendMessage(Handle, CB_SETCURSEL, -1, 0);
Text := OldText;
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(StartPos, StartPos));
end;
var
StartPos: DWORD;
EndPos: DWORD;
OldText: String;
SaveText: String;
Msg : TMSG;
LastByte: Integer;
begin
inherited KeyPress(Key);
if not AutoComplete then exit;
if Style in [csDropDown, csSimple] then
FFilter := Text
else
begin
if GetTickCount - FLastTime >= 500 then
FFilter := '';
FLastTime := GetTickCount;
end;
case Ord(Key) of
VK_ESCAPE: exit;
VK_TAB:
if FAutoDropDown and DroppedDown then
DroppedDown := False;
VK_BACK:
begin
if HasSelectedText(StartPos, EndPos) then
DeleteSelectedText
else
if (Style in [csDropDown, csSimple]) and (Length(Text) > 0) then
begin
SaveText := Text;
LastByte := StartPos;
while ByteType(SaveText, LastByte) = mbTrailByte do Dec(LastByte);
OldText := Copy(SaveText, 1, LastByte - 1);
SendMessage(Handle, CB_SETCURSEL, -1, 0);
Text := OldText + Copy(SaveText, EndPos + 1, MaxInt);
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(LastByte - 1, LastByte - 1));
FFilter := Text;
end
else
begin
while ByteType(FFilter, Length(FFilter)) = mbTrailByte do
Delete(FFilter, Length(FFilter), 1);
Delete(FFilter, Length(FFilter), 1);
end;
Key := #0;
Change;
end;
else // case
if FAutoDropDown and not DroppedDown then
DroppedDown := True;
if HasSelectedText(StartPos, EndPos) then
SaveText := Copy(FFilter, 1, StartPos) + Key
else
SaveText := FFilter + Key;
if Key in LeadBytes then
begin
if PeekMessage(Msg, Handle, 0, 0, PM_NOREMOVE) and (Msg.Message = WM_CHAR) then
begin
if SelectItem(SaveText + Char(Msg.wParam)) then
begin
PeekMessage(Msg, Handle, 0, 0, PM_REMOVE);
Key := #0
end;
end;
end
else
if SelectItem(SaveText) then
Key := #0
end; // case
end;其中的
SendMessage(Handle, CB_GETEDITSEL, Integer(@StartPos), Integer(@EndPos)); 之类的，在处理如“中文测试”在 ansi 版本的 ComCtl32.dll 返回的结果是 8，而 unicode 返回的结果却是 4！
于是有了网上“通过 WideString 修改“的方法：
if ThemeServices.ThemesEnabled then
OldText := Copy(WideString(SaveText), 1, LastByte - 1)
else OldText := Copy(SaveText, 1, LastByte - 1);不过值得注意的是：其实上面的修改方式或网上所有的修改，基本上分为两种：
- 通过修改项目代码，或接管 OnKeyPress 事件或设置 AutoComplete 属性或放弃 XPMan 或派生新的 ComboBox 控件等方法绕开 bug
- 或者，直接修改代码，重新编译 link StdCtrls.pas。
而在项目组的带包编译环境中，StdCtrls.pas 被包含在 vcl.bpl 中，除非重新编译这个 Delphi 的 runtime bpl，否则只能老老实实的“绕开”这个“拦路虎”！
那究竟有没有一种不需要动任何代码（项目代码和 Delphi VCL 代码）而又处理了该 Bug 的方法呢？或者说，仅仅动态的给 COMBOBOX 实施“外科手术”而达到我们的目的？
实现
基于 AOP 思想的 win32 hook inject 技术，就是这样的一种手段。它的核心就是通过动态修改原执行代码（提供横切面），改变原执行流程而不需要修改原来的二进制代码集合。
这方面 MS 开源项目 Detours 和 Delphi 的 MadCollection 都提供了非常好的技术实现！
首当其冲的是，能不能通过 Hook 的方法把我对 procedure TCustomComboBox.KeyPress(var Key: Char); 函数修改的代码“补丁”上去？类似于平时在项目组中改 Bug，不过不同之处在于，项目组该 Bug 在源代码基础上直接修改的，而我们现在要求能动态修改这些执行代码。
这的 KeyPress 是 protected 的 virtual 的方法，只能通过遍历 VMT 方法表定位函数地址（遍历的这个 index 一定不变？）。再仔细看这段代码，其中牵扯非常复杂的判断流程，不能简单的处理掉我们关心的环节然后 CallBack 或者 Trampoline：需要访问不少 TCustomComboBox 的私有成员。这也是一个坎。貌似困难重重啊！
但，其实仔细分析上面的代码可以发现，ansi 版本的代码没有问题儿 unicode 的出问题了，那我能不能“接管” TCustomComboBox 和 ComCtrl32.dll 的交互，把 unicode 的结果翻译成 ansi 的？
Delphi 的 TCustomComboBox 说白了只是一个“套”，liwei 一再强调 VCL 众多控件都是“原生控件”，是因为 VCL 中没有“创造”这些控件，他们本质上就是对 Win32 控件的封装。而这个封装过程就是通过 Handle 和 Windows 原生控件进行互动的。
这个 TCustomComboBox 也不例外！没错，互动的方式就是 Windows 操作系统的根源：消息。Delphi VCL 中处理的 API 就是 SendMessage(A)!
分析 KeyPress 的代码，其中的 SendMessage 只用到 CB_GETEDITSEL 和 CB_SETEDITSEL 消息，我们对其进行拦截即可。
思路初步明朗后问题集中在“unicode 和 ansi 参数的转换”的“业务问题”上了，设计两个函数：
function ByteToWideIndex(const AText: string; AIndex: Word): Word;function WideToByteIndex(const AText: string; AIndex: DWORD): DWORD;分别用于 ansi 版本的 AText 字符串中 AIndex 位置和成 unicode 版本的 AText 字符串中位置的转换。之后新的 SendMessage 可以使用如下示意代码：
function NewSendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
if IsUniCode and (Msg = CB_GETEDITSEL) and (hWnd is TCustomComboBox's Handle) then
begin
Result := OldSendMessage(hWnd, Msg, wParam, lParam);
{ 负责 Unicode 到 Ansi 参数的转换 }
else if IsUniCode and (Msg = CB_SETEDITSEL) and (hWnd is TCustomComboBox's Handle) then
begin
{ 负责 Ansi 到 Unicode 参数的转换 }
Result := OldSendMessage(hWnd, Msg, wParam, lParam);
else Result := OldSendMessage(hWnd, Msg, wParam, lParam); {CB_SETEDITSEL ... }
end;剩下就是利用 api hook 的支持，把 SendMessage 补丁掉了。这个 Detours 和 MadCollection 都有详尽的说明文档和参考代码，不再细说。
最终的代码在 Delphi 的带包或不带包两种情况下工作的非常好，完美的解决了这个 Bug 而没有动 VCL 或项目组的任何代码（唯一做的，及时“引用”这个 SendMessagePatch.pas 单元）。
BTW：后来想想，其实还有两种方法，可以实现这个思路：
- Windows 编程指南中说的 SubClass，通过 SetWindowLong 可以方便的替换控件的消息循环 WndProc，达到拦截的效果
- 利用 SetWindowsHook 也可以挂接控件的消息循环。
不过这些方法需要“运行时”修补，不是很爽。或者，直接 Patch 掉 TCustomComboBox 的 WndProc ...
再来
本来觉得这样解决问题的方式已经非常完美了。不过其中不爽的一点是，难道我们做不到：
把对 procedure TCustomComboBox.KeyPress(var Key: Char); 函数修改的代码“补丁”上去？
VCL 对这个声明称 Virtual 和 Protect 就是这个用意：你可以在自己的派生类中覆盖这个方法实现自己的目标。
注意：在 Delphi 中由一个同名类的使用技巧：你实现一个自己的 My.TComboBox = class(StdCtrls.TComboBox)，这个定义只要在 StdCtrls 之前被 pas 编译到，那么你可以做带设计期时使用了 StdCtrls.TComboBox，而真正运行的是 My.TComboBox！基本上不需要修改代码！
但如果我不想派生呢 ？这是一个纯技术探讨，和上面的 Bug 修改没有多大关系。
由上面的分析知道，我们至少需要解决下面两个问题：
- 如何获取 KeyPress 这个函数的地址？就是说，补丁打到什么地方？
- 处理流程中如何 CallBack 或者 Trampoline？因为这个 KeyPress 涉及太多的细节和流程，不能简单的处理掉我们关心的环节然后 CallBack 或者 Trampoline
对问题 1，传统的方法是 GExperts 的 \gexperts\ExternalSource\VMTUtils.pas 的 GetVirtualMethodCount/GetVirtualMethod/SetVirtualMethod 的功能，重点是这个 KeyPress 在虚方法表中的位置（索引）。
其实为了获取这个地址，我们有一种更加直接的方法：动态创建相应的对象，然后让它自己返回函数地址：
function GetKeyPressAddress: Pointer;
var
C: TCustomComboBox;
P: procedure (var Key: Char) of object;
begin
C := TCustomComboBox.Create(nil);
with C do
try
P := TComboBoxAccess(C).KeyPress;
Result := @P;
finally
Free;
end;
end;其中的 TComboBoxAccess 是 VCL 内部广泛使用的 liwei 称之为 Hack 的方法：
type
TComboBoxAccess = class(TCustomCombo)
end;对于问题 2，没有办法简单替换，只能重新实现一把 KeyPress。但这需要直接访问对象的私有成员变量，这是 OO 中最大的禁地。
根据 aimingoo 的“Delphi 内核源码分析”和 liwei 的“inside vcl”，我们对 Delphi 对象的内存结构可以有一个非常直观的认识。其实 private 之类的说白了，都是编译器制定的一套“规则”，他限制了“private 的东东我们不能存取”（根据 Delphi 的访问规则，上面的 Hack 方法也只能访问 protected 以上的东东）。
好像某人说过，“规则是用来被打破的”。既然我们知道了 Delphi 对象的内存分布，其实我们可以声明一个 TComBoxAccess 类，他的结构和 TCustomComboBox 一致，然后强制类型转换就可以访问了！
还有一个问题，在 procedure TCustomComboBox.KeyPress(var Key: Char); 的代码中有 inherited KeyPress(Key); 的访问，它调用的是 TCustomCombo 的 KeyPress 方法，同样，我们可以在我们的 TComBoxAccess 中实现 SuperKeyPress：
type
TComboBoxAccess = class(TCustomCombo)
private
{$HINTS OFF}
FAutoComplete: Boolean;
{$HINTS ON}
FAutoDropDown: Boolean;
FLastTime: Cardinal;
FFilter: String;
private
procedure SuperKeyPress(var Key: Char);
end;他的实现代码很简单：
{ TComboBoxAccess }
procedure TComboBoxAccess.SuperKeyPress(var Key: Char);
begin
inherited KeyPress(Key);
end;根据前面的分析，现在我们已经具备了把这个 TCustomComboBox.KeyPress 代码抠出来，进行修改，然后再补回去的条件。现看看新的 KeyPress 的实现（我使用 Delphi 7 进行编译，这段代码由 Delphi 2007 中直接 Copy 过来的）：
{ TComboBoxFix }
procedure TComboBoxFix.KeyPress(var Key: Char);
function HasSelectedText(var StartPos, EndPos: DWORD): Boolean;
begin
if Style in [csDropDown, csSimple] then
begin
SendMessage(Handle, CB_GETEDITSEL, Integer(@StartPos), Integer(@EndPos));
Result := EndPos > StartPos;
end
else
Result := False;
end;
procedure DeleteSelectedText;
var
StartPos, EndPos: DWORD;
OldText: String;
begin
OldText := Text;
SendMessage(Handle, CB_GETEDITSEL, Integer(@StartPos), Integer(@EndPos));
Delete(OldText, StartPos + 1, EndPos - StartPos);
SendMessage(Handle, CB_SETCURSEL, -1, 0);
Text := OldText;
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(StartPos, StartPos));
end;
var
StartPos: DWORD;
EndPos: DWORD;
OldText: String;
SaveText: String;
Msg : TMSG;
LastByte: Integer;
begin
{
inherited KeyPress(Key);
}
TComboBoxAccess(Self).SuperKeyPress(Key);
if not AutoComplete then exit;
if Style in [csDropDown, csSimple] then
TComboBoxAccess(Self).FFilter := Text
else
begin
if GetTickCount - TComboBoxAccess(Self).FLastTime >= 500 { FAutoCompleteDelay } then
TComboBoxAccess(Self).FFilter := '';
TComboBoxAccess(Self).FLastTime := GetTickCount;
end;
case Ord(Key) of
VK_ESCAPE: exit;
VK_TAB:
if TComboBoxAccess(Self).FAutoDropDown and DroppedDown then
DroppedDown := False;
VK_BACK:
begin
if HasSelectedText(StartPos, EndPos) then
DeleteSelectedText
else
if (Style in [csDropDown, csSimple]) and (Length(Text) > 0) then
begin
SaveText := Text;
LastByte := StartPos;
while ByteType(SaveText, LastByte) = mbTrailByte do Dec(LastByte);
OldText := Copy(SaveText, 1, LastByte - 1);
SendMessage(Handle, CB_SETCURSEL, -1, 0);
Text := OldText + Copy(SaveText, EndPos + 1, MaxInt);
SendMessage(Handle, CB_SETEDITSEL, 0, MakeLParam(LastByte - 1, LastByte - 1));
TComboBoxAccess(Self).FFilter := Text;
end
else
begin
while ByteType(TComboBoxAccess(Self).FFilter, Length(TComboBoxAccess(Self).FFilter)) = mbTrailByte do
Delete(TComboBoxAccess(Self).FFilter, Length(TComboBoxAccess(Self).FFilter), 1);
Delete(TComboBoxAccess(Self).FFilter, Length(TComboBoxAccess(Self).FFilter), 1);
end;
Key := #0;
Change;
end;
else // case
if TComboBoxAccess(Self).FAutoDropDown and not DroppedDown then
DroppedDown := True;
if HasSelectedText(StartPos, EndPos) then
SaveText := Copy(TComboBoxAccess(Self).FFilter, 1, StartPos) + Key
else
SaveText := TComboBoxAccess(Self).FFilter + Key;
if Key in LeadBytes then
begin
if PeekMessage(Msg, Handle, 0, 0, PM_NOREMOVE) and (Msg.Message = WM_CHAR) then
begin
if SelectItem(SaveText + Char(Msg.wParam)) then
begin
PeekMessage(Msg, Handle, 0, 0, PM_REMOVE);
Key := #0
end;
end;
end
else
if SelectItem(SaveText) then
Key := #0
end; // case
end;其中的 TComboBoxAccess 起了重要的作用！
现在再回到“解决 COMBOBOX 处理回退键的 BUG”这个问题，我们的思路是处理其中 SendMessage 过程，现在好办了，只要在 TComboBoxFix 中重新声明实现一个 SendMessage，根据 Delphi 同名函数访问规则，上面的 KeyPress 调用的就是这个新的 SendMessage（旧的可以通过 Windows.SendMessage 调用！）
type
TComboBoxFix = class(TCustomComboBox)
private
function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT;
procedure KeyPress(var Key: Char); reintroduce;
end;因为我们不需要原来的 CallBack 或者 Trampoline，那么我们可以直接借用 FastCode 项目的 FastcodePatch.pas 中的 FastcodeAddressPatch 函数实现我们的“补丁”（范例中的 CodeAddressPatch 就是拿的 FastCode 的代码）：
initialization
UseComCtrls := GetComCtlVersion >= ComCtlVersionIE6;
CodeAddressPatch(GetKeyPressAddress, @TComboBoxFix.KeyPress);当然，关于 FastcodeAddressPatch 类似的功能，在 Delphi 不少开源的项目中有非常广泛的实现和应用，诸如 TntUnicodeControls、GNU GetText 等等。
