控件设计:自动下拉的 ComboBox(类似 IE 地址栏)
2009-10-21 11:28
459 查看
旧作,经修改 Delphi 精要一书中的源码而成。
unit HGYAutoDropComboBox;
interface
uses
SysUtils, Classes, Controls, StdCtrls, Windows, Messages;
type
THGYAutoDropComboBox = class(TComboBox)
private
{ Private declarations }
FText: string;
FAllStrings: TStrings;
procedure PackStrings(Strs: TStrings);
protected
{ Protected declarations }
procedure DoEnter; override;
procedure KeyPress(var Key: Char); override;
procedure Change; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [THGYAutoDropComboBox]);
end;
procedure THGYAutoDropComboBox.PackStrings(Strs: TStrings);
var
i: Integer;
s: string;
begin
if Strs.Count = 0 then
Exit;
Strs.BeginUpdate;
with TStringList(Strs) do
begin
Sort;
s:= Trim(Strs[0]);
i:= 1;
while i < count do
begin
if s = Trim(Strings) then
Delete(i)
else
begin
s:= Strings;
Inc(i);
end;
end; //end while
end; //end with
Strs.EndUpdate;
Items.Assign(Strs);
end;
procedure THGYAutoDropComboBox.DoEnter;
begin
inherited;
FAllStrings.Assign(Items);
if FAllStrings.Count > 1 then
begin
Items.Clear;
PackStrings(FAllStrings);
end;
end;
procedure THGYAutoDropComboBox.Change;
var
i, ISelStart: Integer;
IWidth, MaxWidth, IndexMaxWidth: Integer;
begin
inherited Change;
if Text = '' then
begin
Items.Assign(FAllStrings);
Exit;
end;
//当键入文本能模糊匹配时候,退出,不然会自动加上相近的 Item
if Items.IndexOf(Text) <> -1 then
Exit;
FText:= Text;
ISelStart:= SelStart;
Items.Clear;
MaxWidth:= 0;
IndexMaxWidth:= -1;
for i:= 0 to FAllStrings.Count - 1 do
begin
if Pos(FText, FAllStrings) > 0 then
begin
Items.Add(FAllStrings);
IWidth:= Length(FAllStrings);
if IWidth > MaxWidth then
begin
MaxWidth:= IWidth;
Inc(IndexMaxWidth);
end;
end;
end;
for i:= 1 to 10-Items.Count do
Items.Add('');
Perform(CB_SETDROPPEDWIDTH, Canvas.TextWidth(Items[IndexMaxWidth]) + 10, 0);
if not DroppedDown then
DroppedDown:= True;
Text:= FText;
SelStart:= ISelStart;
end;
constructor THGYAutoDropComboBox.Create(AOwner: TComponent);
begin
inherited;
FAllStrings:= TStringList.Create;
end;
destructor THGYAutoDropComboBox.Destroy;
begin
FreeAndNil(FAllStrings);
inherited;
end;
procedure THGYAutoDropComboBox.KeyPress(var Key: Char);
begin
if not (Ord(Key) in [VK_ESCAPE, VK_RETURN, 3, 22, 24]) then
if not DroppedDown then
DroppedDown:= True;
inherited;
end;
end. 本文出自 “ADelphiCoder” 博客,请务必保留此出处http://adelphicoder.blog.51cto.com/983561/214654
unit HGYAutoDropComboBox;
interface
uses
SysUtils, Classes, Controls, StdCtrls, Windows, Messages;
type
THGYAutoDropComboBox = class(TComboBox)
private
{ Private declarations }
FText: string;
FAllStrings: TStrings;
procedure PackStrings(Strs: TStrings);
protected
{ Protected declarations }
procedure DoEnter; override;
procedure KeyPress(var Key: Char); override;
procedure Change; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [THGYAutoDropComboBox]);
end;
procedure THGYAutoDropComboBox.PackStrings(Strs: TStrings);
var
i: Integer;
s: string;
begin
if Strs.Count = 0 then
Exit;
Strs.BeginUpdate;
with TStringList(Strs) do
begin
Sort;
s:= Trim(Strs[0]);
i:= 1;
while i < count do
begin
if s = Trim(Strings) then
Delete(i)
else
begin
s:= Strings;
Inc(i);
end;
end; //end while
end; //end with
Strs.EndUpdate;
Items.Assign(Strs);
end;
procedure THGYAutoDropComboBox.DoEnter;
begin
inherited;
FAllStrings.Assign(Items);
if FAllStrings.Count > 1 then
begin
Items.Clear;
PackStrings(FAllStrings);
end;
end;
procedure THGYAutoDropComboBox.Change;
var
i, ISelStart: Integer;
IWidth, MaxWidth, IndexMaxWidth: Integer;
begin
inherited Change;
if Text = '' then
begin
Items.Assign(FAllStrings);
Exit;
end;
//当键入文本能模糊匹配时候,退出,不然会自动加上相近的 Item
if Items.IndexOf(Text) <> -1 then
Exit;
FText:= Text;
ISelStart:= SelStart;
Items.Clear;
MaxWidth:= 0;
IndexMaxWidth:= -1;
for i:= 0 to FAllStrings.Count - 1 do
begin
if Pos(FText, FAllStrings) > 0 then
begin
Items.Add(FAllStrings);
IWidth:= Length(FAllStrings);
if IWidth > MaxWidth then
begin
MaxWidth:= IWidth;
Inc(IndexMaxWidth);
end;
end;
end;
for i:= 1 to 10-Items.Count do
Items.Add('');
Perform(CB_SETDROPPEDWIDTH, Canvas.TextWidth(Items[IndexMaxWidth]) + 10, 0);
if not DroppedDown then
DroppedDown:= True;
Text:= FText;
SelStart:= ISelStart;
end;
constructor THGYAutoDropComboBox.Create(AOwner: TComponent);
begin
inherited;
FAllStrings:= TStringList.Create;
end;
destructor THGYAutoDropComboBox.Destroy;
begin
FreeAndNil(FAllStrings);
inherited;
end;
procedure THGYAutoDropComboBox.KeyPress(var Key: Char);
begin
if not (Ord(Key) in [VK_ESCAPE, VK_RETURN, 3, 22, 24]) then
if not DroppedDown then
DroppedDown:= True;
inherited;
end;
end. 本文出自 “ADelphiCoder” 博客,请务必保留此出处http://adelphicoder.blog.51cto.com/983561/214654
相关文章推荐
- 在工具栏(ToolBar)上添加ComboBox控件,为何每次在下拉列表中选择时,都会自动的选中工具栏上的一个按钮?
- comboBox输入自动提示 自动关联(仿ie地址栏)C#
- (转)使用一个下拉框或文本框+列表框的方式实现类似IE地址栏自动完成的功能
- 重写winform 的 ComboBox控件实现自动加载磁盘下拉列表框
- 用C++ Builder 实现类似ie地址栏的ComboBox
- comboBox输入自动提示(仿ie地址栏)C#
- treeView控件应用-IE地址栏下拉列表清理实例
- MFC中控制COMBOBOX控件的下拉框高度
- VB.Net自己写的一个控件:ComboBox下拉列表中显示多列数据(可以绑定数据表)
- delphi自动调整combobox下拉列表宽度
- 在DataGrid中使用下拉列表ComboBox控件
- Silverlight Telerik控件学习:RadComboBox之自动完成(AutoComplete)
- IE自动加载控件的完美解决方案
- 【转】文本框(Textbox)和下拉框(Combobox)自动联想功能的实现
- 在Datagridview 控件DataGridViewComboBoxColumn怎么点两次才下拉下来
- 在DataGrid中使用下拉列表ComboBox控件
- 文本框(Textbox)和下拉框(Combobox)自动联想功能的实现
- VC comboBox控件 关于下拉时鼠标选择时
- IE下自动激活 ActiveX 控件