有没有像浏览器输入地址栏地控件

Question

有没有像浏览器输入地址栏地控件，输入字符自动列出包含该字符地列表

Answer 1

unit AutoListDBComboBox;interfaceuses
  Windows, SysUtils, Classes, LabelDBComboBox, DB,
  Controls;type
  TAutoListDBComboBox = class(TLabelDBComboBox)
  private
    { Private declarations }
    FIntrinsic, SText: String;
    FAutoListDataSet: TDataSet;
    FAutoListDataFields: TStrings;
    procedure SetAutoListDataSet(Value: TDataSet);
    procedure SetAutoListDataFields(Value: TStrings);
    procedure SetStrings;
    procedure SetIntrinsic(Value: String);
    function GetDataSetType(DataSet: TDataSet): Integer;
    function GetDataFieldType(DataField: TField): Integer;
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure KeyPress(var Key: Char); override;   
    procedure Change; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
    property AutoListDataSet: TDataSet read FAutoListDataSet write SetAutoListDataSet;
    property AutoListDataFields: TStrings read FAutoListDataFields write SetAutoListDataFields;
    property Intrinsic: String read FIntrinsic write SetIntrinsic;
  end;procedure Register;implementationuses FunAndProc_String, Messages;procedure Register;
begin
  RegisterComponents('Data ExControls', [TAutoListDBComboBox]);
end;{ TAutoListDBComboBox }constructor TAutoListDBComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AutoComplete := false;
  FAutoListDataFields := TStringList.Create;
end;procedure TAutoListDBComboBox.SetAutoListDataSet(Value: TDataSet);
begin
  if GetDataSetType(Value) = -1 then
  begin
    MessageBox(0,PChar('AutoListDataSet必须是TTable、TADOTable或者TADOQuery类型。'),
      '错误',MB_ICONERROR+MB_OK);
  end else
  begin
    FAutoListDataSet := Value;
    SetStrings;
  end;
end;procedure TAutoListDBComboBox.SetAutoListDataFields(Value: TStrings);
begin
  if Assigned(FAutoListDataFields) then
    FAutoListDataFields.Assign(Value)
  else
    FAutoListDataFields := Value;
  if Assigned(FAutoListDataFields) then
    TrimStrings(FAutoListDataFields);
end;procedure TAutoListDBComboBox.SetStrings;
var
  I: Integer;
begin
  if (not (csDesigning in ComponentState)) or
     (not Assigned(FAutoListDataSet)) or
     (FAutoListDataFields.Count > 0) then Exit;
  for I := 0 to FAutoListDataSet.FieldCount-1 do
    if GetDataFieldType(FAutoListDataSet.Fields.Fields[I]) > 0 then
      FAutoListDataFields.Add(FAutoListDataSet.Fields.Fields[I].FieldName);
end;procedure TAutoListDBComboBox.SetIntrinsic(Value: String);
begin
  FIntrinsic := Trim(Value);
end;function TAutoListDBComboBox.GetDataSetType(DataSet: TDataSet): Integer;
begin
  if not Assigned(DataSet) then
  begin
    Result := 0;
  end else
  begin
    if DataSet.ClassName = 'TTable' then Result := 1
    else if DataSet.ClassName = 'TADOTable' then Result := 2
    else if DataSet.ClassName = 'TADOQuery' then Result := 3
    else Result := -1;
  end;
end;function TAutoListDBComboBox.GetDataFieldType(DataField: TField): Integer;
var
  FieldClassName: String;
begin
  if not Assigned(DataField) then
  begin
    Result := 0;
  end else
  begin
    FieldClassName := DataField.ClassName;
    if (FieldClassName = 'TIntegerField') or
       (FieldClassName = 'TAutoIncField') or
       (FieldClassName = 'TSmallintField') or
       (FieldClassName = 'TLargeintField') or
       (FieldClassName = 'TCurrencyField') or
       (FieldClassName = 'TFloatField') or
       (FieldClassName = 'TWordField') or
       (FieldClassName = 'TBytesField') or
       (FieldClassName = 'TBinaryField') or
       (FieldClassName = 'TBCDField') or
       (FieldClassName = 'TDateField') or
       (FieldClassName = 'TDateTimeField') or
       (FieldClassName = 'TTimeField') or
       (FieldClassName = 'TSQLTimeStampField') or
       (FieldClassName = 'TBooleanField') then Result := 1
    else if
       (FieldClassName = 'TStringField') or
       (FieldClassName = 'TWideStringField') then Result := 2
    else Result := -1;
  end;
end;procedure TAutoListDBComboBox.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = AutoListDataSet then AutoListDataSet := nil;
  end;
end;procedure TAutoListDBComboBox.Change;
var
  I,ISelStart: Integer;
  IWidth,MaxWidth,IndexMaxWidth: Integer;
  SItem,SFilter: String;
  FField: TField;
begin
  inherited Change;
  if ReadOnly then Exit;
  if (GetDataSetType(FAutoListDataSet) < 1) or //数据集不存在或者是不支持类型
     (FAutoListDataFields.Count = 0) or        //字段个数为0
     (GetDataFieldType(FAutoListDataSet.FindField(FAutoListDataFields[0])) <> 2)
     then Exit;                                //第一个字段不是字符串类型  SText := Copy(Text,1,Pos(';',Text)-1);
  if SText = '' then SText := Text;  if (Items.IndexOf(Text) <> -1) then
  begin
    Field.Text := SText;
    Text := SText;
    Exit;
  end;  ISelStart := SelStart;
  MaxWidth := 0;
  IndexMaxWidth := -1;
  if (SText = '') then
  begin
    FAutoListDataSet.Filter := FIntrinsic;
    FAutoListDataSet.Filtered := FIntrinsic <> '';
  end else
  begin
    case GetDataSetType(FAutoListDataSet) of
      1: SFilter := FAutoListDataFields[0] + ' = ''' + SText + '*''';
      2,3: SFilter := FAutoListDataFields[0] + ' Like ''' + SText + '%''';
    end;
    if FIntrinsic <> '' then SFilter := '(' + FIntrinsic + ') and (' + SFilter + ')';
    if FAutoListDataSet.Filtered and (SFilter = FAutoListDataSet.Filter) then Exit;
    try
      FAutoListDataSet.Filter := SFilter;
      FAutoListDataSet.Filtered := true;
    except
      FAutoListDataSet.Filter := FIntrinsic;
      FAutoListDataSet.Filtered := FIntrinsic <> '';
    end;
  end;
  Items.Clear;
  FAutoListDataSet.DisableControls;
  FAutoListDataSet.First;
  while not FAutoListDataSet.Eof do
  begin
    SItem := '';
    for I := 0 to FAutoListDataFields.Count-1 do
    begin
      FField := FAutoListDataSet.FindField(FAutoListDataFields[I]);
      if Assigned(FField) then
        SItem := SItem + '; ' + FField.AsString;
    end;
    Delete(SItem,1,2);
    Items.Add(SItem);
    IWidth := Length(SItem);
    if IWidth > MaxWidth then
    begin
      MaxWidth := IWidth;
      Inc(IndexMaxWidth);
    end;
    FAutoListDataSet.Next;
  end;
  for I := 1 to 8-Items.Count do
    Items.Add('');
  Perform(CB_SETDROPPEDWIDTH,Canvas.TextWidth(Items[IndexMaxWidth])+10,0);
  if not DroppedDown then
    DroppedDown := true;
  Text := SText;
  SelStart := ISelStart;
  FAutoListDataSet.EnableControls;
end;
procedure TAutoListDBComboBox.KeyPress(var Key: Char);
var
  I: Integer;
begin
  if (not ReadOnly) and
     (not (Ord(Key) in [VK_ESCAPE,VK_RETURN])) and
     (not ((Ord(Key) =3) and ((GetKeyState(VK_CONTROL) and $80) = $80))) then
  begin
    for I := 1 to 8-Items.Count do
      Items.Add('');
    if not DroppedDown then
      DroppedDown := true;
  end;
  inherited;
end;end.

Answer 2

使用IAutoComplete,IAutoComplete2接口可以自己做一个