今天写了个控件，希望对大家实际工作中能有所帮助(在ComboBox中输入拼音首字母或汉字，下拉列表中显示相匹配的条目) (1分)

很久没有上来过了，今天写了个控件，希望对大家实际工作中能有所帮助
用途：在编程工作中，经常有要输入姓名或从一大堆的姓名或者分类中选择一个的情况。
使用方法：在AllList中定义下拉框中的内容，在ComboBox中输入拼音首字母或汉字，下拉列表中显示相匹配的条目

代码：
//**********************
//Author:朱红波
//Email:4719373@163.com
//Time:2004-06-03
//**********************
unit ComboBoxPY;

interface

uses
Windows,Messages,SysUtils,Classes,Controls,StdCtrls,DBCtrls;

function SearchByPY(SourceStr:TStringList;PYStr:string):string;
//***********************************
type
TComboBoxPY=class(TComboBox)
private
FAllList:TStringList;
procedure SetAllList(Value:TStringList);

protected
procedure Change; override;

public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;

published
property AllList:TStringList read FAllList write SetAllList;
end;
//end type TComboBoxPY
//***********************************
type
TDBComboBoxPY=class(TDBComboBox)
private
FAllList:TStringList;
procedure SetAllList(Value:TStringList);

protected
procedure Change; override;

public
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;

published
property AllList:TStringList read FAllList write SetAllList;
end;
//end type TDBComboBoxPY

procedure Register;

implementation

function SearchByPY(SourceStr:TStringList;PYStr:string):string;
function GetPYIndexChar(hzchar:string):char;
begin
case WORD(hzchar[1])shl 8+WORD(hzchar[2]) of
$B0A1..$B0C4:result:='A';$B0C5..$B2C0:result:='B';
$B2C1..$B4ED:result:='C';$B4EE..$B6E9:result:='D';
$B6EA..$B7A1:result:='E';$B7A2..$B8C0:result:='F';
$B8C1..$B9FD:result:='G';$B9FE..$BBF6:result:='H';
$BBF7..$BFA5:result:='J';$BFA6..$C0AB:result:='K';
$C0AC..$C2E7:result:='L';$C2E8..$C4C2:result:='M';
$C4C3..$C5B5:result:='N';$C5B6..$C5BD:result:='O';
$C5BE..$C6D9:result:='P';$C6DA..$C8BA:result:='Q';
$C8BB..$C8F5:result:='R';$C8F6..$CBF9:result:='S';
$CBFA..$CDD9:result:='T';$CDDA..$CEF3:result:='W';
$CEF4..$D188:result:='X';$D1B9..$D4D0:result:='Y';
$D4D1..$D7F9:result:='Z';
else
result:=char(0);
end;
end;
label NotFound;
var
i,j:integer;
hzchar:string;
begin
for i:=0 to SourceStr.Count-1 do
begin
for j:=1 to Length(PYStr) do
begin
hzchar:=SourceStr[2*j-1]+SourceStr[2*j];
if (PYStr[j]<>'?')and(UpperCase(PYStr[j])<>GetPYIndexChar(hzchar)) then
goto NotFound;
end;
if Result='' then Result:=SourceStr
else Result:=Result+Char(13)+SourceStr;
NotFound:
end;
end;

//TComboBoxPY*********************************************************

constructor TComboBoxPY.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FAllList:=TStringList.Create;
Self.Sorted:=True;
Self.AutoDropDown:=True;
end;

destructor TComboBoxPY.Destroy;
begin
FAllList.Free;
inherited Destroy;
end;

procedure TComboBoxPY.SetAllList(Value:TStringList);
begin
if AllList.Text<>Value.Text then
begin
AllList.Text:=Value.Text;
Items.Text:=Value.Text;
end;
end;

procedure TComboBoxPY.Change;
begin
Self.DropDownCount:=8;
Self.AutoDropDown:=False;
if ByteType(Self.Text,1)=mbSingleByte then //mbLeadByte then
begin
Self.Items.Text:=SearchByPY(AllList,Self.Text);
keybd_event(VK_END,0,0,0);
end;
Self.AutoDropDown:=True;
inherited;
end;

//TDBComboBoxPY*********************************************************

constructor TDBComboBoxPY.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FAllList:=TStringList.Create;
Self.Sorted:=True;
Self.AutoDropDown:=True;
end;

destructor TDBComboBoxPY.Destroy;
begin
FAllList.Free;
inherited Destroy;
end;

procedure TDBComboBoxPY.SetAllList(Value:TStringList);
begin
if AllList.Text<>Value.Text then
begin
AllList.Text:=Value.Text;
Items.Text:=Value.Text;
end;
end;

procedure TDBComboBoxPY.Change;
begin
Self.DropDownCount:=8;
Self.AutoDropDown:=False;
if ByteType(Self.Text,1)=mbSingleByte then
begin
Self.Items.Text:=SearchByPY(AllList,Self.Text);
keybd_event(VK_END,0,0,0);
end;
Self.AutoDropDown:=True;
inherited;
end;

procedure Register;
begin
RegisterComponents('porsche', [TComboBoxPY,TDBComboBoxPY]);
end;

end.

好东西,先收藏,谢谢楼主.

用什么语言编的啊.....VB还是什么啊.

收藏，试用。

楼主真是大好人啊，您提供的东西方便了广大人民群众！

我发现一个小小问题，水平有限，看源码也没看出问题出在哪里，还请楼主指点：
第一次输入拼音，下拉列表自动打开，按退格键删完全部字母后，[red]列表显示全部条目（即DropDownCount:=8）[/red]，按上下键选定一条后，按回车即输入了该条目，并且是全部选定状态，至此都没问题。
此时，再按字母（有这个字母开头的），显示筛选出的条目，再按退格键删完字母后，[red]列表只显示一条，右边出现上下滚动条，（即DropDownCount:=1）[/red]。
此种情况有时出现，有时不出现，要多试几次。我看了源码，没发现DropDownCount什么时候会改为1，请楼主试一试，是否有这种情况，是何原因？

谢谢楼主，收藏

首先这个拼音首字母就有问题，找不准的。

这个拼音码支持的字有限，很多常见字（可能是属于GBK）比如“晖”等都出不来，不知道谁有支持整个GBK集合的编码表？

to hbsxcjp
我也发现有这个问题，估计是ComboBox控件里的问题，没仔细看过ComboBox的代码，这几天很忙，麻烦你帮忙完善一下吧

这不是为难我嘛[]

使用ComboBox控件试了一下，它似乎对退格键没反应，不自动查找条目，不知为什么？
因为对退格键不处理，所以没有上面的问题。

但对这个控件，我们总不能屏蔽“退格键”吧？（删掉字母后同样需要查找的嘛）

我水平太菜，看ComboBox的源码没有看出个名堂，还请楼主或是有心人来完善。[^]

好东东，我收藏

其实可能是
$B0A1..$B0C4:result:='A';$B0C5..$B2C0:result:='B';
$B2C1..$B4ED:result:='C';$B4EE..$B6E9:result:='D';
$B6EA..$B7A1:result:='E';$B7A2..$B8C0:result:='F';
$B8C1..$B9FD:result:='G';$B9FE..$BBF6:result:='H';
$BBF7..$BFA5:result:='J';$BFA6..$C0AB:result:='K';
$C0AC..$C2E7:result:='L';$C2E8..$C4C2:result:='M';
$C4C3..$C5B5:result:='N';$C5B6..$C5BD:result:='O';
$C5BE..$C6D9:result:='P';$C6DA..$C8BA:result:='Q';
$C8BB..$C8F5:result:='R';$C8F6..$CBF9:result:='S';
$CBFA..$CDD9:result:='T';$CDDA..$CEF3:result:='W';
$CEF4..$D188:result:='X';$D1B9..$D4D0:result:='Y';
$D4D1..$D7F9:result:='Z';
的问题，反正“训”这个字找不出来，上次看到有人说，这个只能找“一级字库”和“二级”中的部分汉字，三级根本没有（不常用的）

输入汉字，下拉框没东西
输入拼音，下拉框没东西

楼上，items是要自己动态加载的。

我找到了一个拼音库，应该是比较全的，看明天还是什么时候弄进来看看行不行

[red]http://www.wansoft.com.cn/porsche/comboboxpy.rar
拼音库全了[/red]

谢谢楼主，向你学习！
我先测试...

强烈加猛烈地建议加这个东东加到<<Delphi编程专家门诊>>一书的光盘中
具体请与刀剑如梦联系
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2649258

好东西,赶紧收藏,楼主的名字好熟悉,如果没记错,好像有个自动生成Dll的东西也是楼主的大作吧??