控件设计：自动下拉的 ComboBox（类似 IE 地址栏）

旧作，经修改 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.