您的位置:首页 > 其它

控件设计:自动下拉的 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
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: