delphi - 是否可以向 Delphi 的 TButtonedEdit 添加历史列表下拉列表?

标签 delphi delphi-xe2 tbuttonededit tcombobox

我正在使用 Delphi XE2 的 TButtonedEdit,但我想为历史添加一个下拉列表(如 TComboBox)。我知道 TComboBox 是一个美化的 TEdit,那么我可以向 TButtonedEdit 发送一条消息来添加此功能吗?谢谢。

最佳答案

您可以使用IAutoComplete2完成此任务的接口(interface)。

根据 TButtonedEdit 中的这个答案 ( Auto append/complete from text file to an edit box delphi ) 检查此示例代码(适用于 Ken White 和 Delphi XE2)

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,  Vcl.ExtCtrls, Winapi.ActiveX,  Winapi.ShlObj,
  Vcl.Mask, Vcl.ImgList;


type
  IACList = interface(IUnknown)
  ['{77A130B0-94FD-11D0-A544-00C04FD7d062}']
    function Expand(pszExpand : POLESTR) : HResult; stdcall;
  end;

const
  //options for IACList2
  ACLO_NONE = 0;          // don't enumerate anything
  ACLO_CURRENTDIR = 1;    // enumerate current directory
  ACLO_MYCOMPUTER = 2;    // enumerate MyComputer
  ACLO_DESKTOP = 4;       // enumerate Desktop Folder
  ACLO_FAVORITES = 8;     // enumerate Favorites Folder
  ACLO_FILESYSONLY = 16;  // enumerate only the file system

type
  IACList2 = interface(IACList)
  ['{470141a0-5186-11d2-bbb6-0060977b464c}']
    function SetOptions(dwFlag: DWORD): HResult; stdcall;
    function GetOptions(var pdwFlag: DWORD): HResult; stdcall;
  end;

  IAutoComplete = interface(IUnknown)
  ['{00bb2762-6a77-11d0-a535-00c04fd7d062}']
    function Init(hwndEdit: HWND; const punkACL: IUnknown;
      pwszRegKeyPath, pwszQuickComplete: POLESTR): HResult; stdcall;
    function Enable(fEnable: BOOL): HResult; stdcall;
  end;

const
  //options for IAutoComplete2
  ACO_NONE = 0;
  ACO_AUTOSUGGEST = $1;
  ACO_AUTOAPPEND = $2;
  ACO_SEARCH = $4;
  ACO_FILTERPREFIXES = $8;
  ACO_USETAB = $10;
  ACO_UPDOWNKEYDROPSLIST = $20;
  ACO_RTLREADING = $40;

type
  IAutoComplete2 = interface(IAutoComplete)
  ['{EAC04BC0-3791-11d2-BB95-0060977B464C}']
    function SetOptions(dwFlag: DWORD): HResult; stdcall;
    function GetOptions(out pdwFlag: DWORD): HResult; stdcall;
  end;

  TEnumString = class(TInterfacedObject, IEnumString)
  private
    type
     TPointerList = array[0..0] of Pointer; //avoid bug of Classes.pas declaration TPointerList = array of Pointer;
    var
    FStrings: TStringList;
    FCurrIndex: integer;
  public
    //IEnumString
    function Next(celt: Longint; out elt;
        pceltFetched: PLongint): HResult; stdcall;
    function Skip(celt: Longint): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out enm: IEnumString): HResult; stdcall;
    //VCL
    constructor Create;
    destructor Destroy;override;
  end;

  TACOption = (acAutoAppend, acAutoSuggest, acUseArrowKey);
  TACOptions = set of TACOption;

  TACSource = (acsList, acsHistory, acsMRU, acsShell);


  TButtonedEdit = class(Vcl.ExtCtrls.TButtonedEdit)
  private

    FACList: TEnumString;
    FAutoComplete: IAutoComplete;
    FACEnabled: boolean;
    FACOptions: TACOptions;
    FACSource: TACSource;
    function GetACStrings: TStringList;
    procedure SetACEnabled(const Value: boolean);
    procedure SetACOptions(const Value: TACOptions);
    procedure SetACSource(const Value: TACSource);
    procedure SetACStrings(const Value: TStringList);
  protected
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ACEnabled: boolean read FACEnabled write SetACEnabled;
    property ACOptions: TACOptions read FACOptions write SetACOptions;
    property ACSource: TACSource read FACSource write SetACSource;
    property ACStrings: TStringList read GetACStrings write SetACStrings;
  end;


  TForm1 = class(TForm)
    ButtonedEdit1: TButtonedEdit;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm5;

implementation

{$R *.dfm}


uses
  System.Win.ComObj;


procedure TForm1.FormCreate(Sender: TObject);
begin
  ButtonedEdit1.ACEnabled:=True;
  ButtonedEdit1.ACOptions:=[acAutoAppend, acAutoSuggest, acUseArrowKey];
  ButtonedEdit1.ACSource:=acsList;
  ButtonedEdit1.ACStrings.Add('string 1');
  ButtonedEdit1.ACStrings.Add('string 2');
  ButtonedEdit1.ACStrings.Add('string 3');
  ButtonedEdit1.ACStrings.Add('string 4');
end;

{ TEnumString }

function TEnumString.Clone(out enm: IEnumString): HResult;
begin
  Result := E_NOTIMPL;
  Pointer(enm) := nil;
end;

constructor TEnumString.Create;
begin
  inherited Create;
  FStrings := TStringList.Create;
  FCurrIndex := 0;
end;

destructor TEnumString.Destroy;
begin
  FStrings.Free;
  inherited;
end;

function TEnumString.Next(celt: Integer; out elt;
  pceltFetched: PLongint): HResult;
var
  I: Integer;
  wStr: WideString;
begin
  I := 0;
  while (I < celt) and (FCurrIndex < FStrings.Count) do
  begin
    wStr := FStrings[FCurrIndex];
    TPointerList(elt)[I] := CoTaskMemAlloc(2 * (Length(wStr) + 1));
    StringToWideChar(wStr, TPointerList(elt)[I], 2 * (Length(wStr) + 1));
    Inc(I);
    Inc(FCurrIndex);
  end;
  if pceltFetched <> nil then
    pceltFetched^ := I;
  if I = celt then
    Result := S_OK
  else
    Result := S_FALSE;
end;

function TEnumString.Reset: HResult;
begin
  FCurrIndex := 0;
  Result := S_OK;
end;

function TEnumString.Skip(celt: Integer): HResult;
begin
  if (FCurrIndex + celt) <= FStrings.Count then
  begin
    Inc(FCurrIndex, celt);
    Result := S_OK;
  end
  else
  begin
    FCurrIndex := FStrings.Count;
    Result := S_FALSE;
  end;
end;

{ TACEdit }

constructor TButtonedEdit.Create(AOwner: TComponent);
begin
  inherited;
  FACList := TEnumString.Create;
  FACEnabled := True;
  FACOptions := [acAutoAppend, acAutoSuggest, acUseArrowKey];
end;

procedure TButtonedEdit.CreateWnd;
var
  Dummy: IUnknown;
  Strings: IEnumString;
begin
  inherited;
  if HandleAllocated then
  begin
    try
      Dummy := CreateComObject(CLSID_AutoComplete);
      if (Dummy <> nil) and
         (Dummy.QueryInterface(IID_IAutoComplete, FAutoComplete) = S_OK) then
      begin
        case FACSource of
          acsHistory: Strings := CreateComObject(CLSID_ACLHistory) as
            IEnumString;
          acsMRU: Strings := CreateComObject(CLSID_ACLMRU) as
            IEnumString;
          acsShell: Strings := CreateComObject(CLSID_ACListISF) as
            IEnumString;
        else
          Strings := FACList as IEnumString;
        end;
        if S_OK = FAutoComplete.Init(Handle, Strings, nil, nil) then
        begin
          SetACEnabled(FACEnabled);
          SetACOptions(FACOptions);
        end;
      end;
    except
      //CLSID_IAutoComplete is not available
    end;
  end;
end;

destructor TButtonedEdit.Destroy;
begin
  FACList := nil;
  inherited;
end;

procedure TButtonedEdit.DestroyWnd;
begin
  if (FAutoComplete <> nil) then
  begin
    FAutoComplete.Enable(False);
    FAutoComplete := nil;
  end;
  inherited;
end;

function TButtonedEdit.GetACStrings: TStringList;
begin
  Result := FACList.FStrings;
end;

procedure TButtonedEdit.SetACEnabled(const Value: Boolean);
begin
  if (FAutoComplete <> nil) then
  begin
    FAutoComplete.Enable(FACEnabled);
  end;
  FACEnabled := Value;
end;

procedure TButtonedEdit.SetACOptions(const Value: TACOptions);
const
  Options : array[TACOption] of integer = (ACO_AUTOAPPEND,
                                           ACO_AUTOSUGGEST,
                                           ACO_UPDOWNKEYDROPSLIST);
var
  Option:TACOption;
  Opt: DWORD;
  AC2: IAutoComplete2;
begin
  if (FAutoComplete <> nil) then
  begin
    if S_OK = FAutoComplete.QueryInterface(IID_IAutoComplete2, AC2) then
    begin
      Opt := ACO_NONE;
      for Option := Low(Options) to High(Options) do
      begin
        if (Option in FACOptions) then
          Opt := Opt or DWORD(Options[Option]);
      end;
      AC2.SetOptions(Opt);
    end;
  end;
  FACOptions := Value;
end;

procedure TButtonedEdit.SetACSource(const Value: TACSource);
begin
  if FACSource <> Value then
  begin
    FACSource := Value;
    RecreateWnd;
  end;
end;

procedure TButtonedEdit.SetACStrings(const Value: TStringList);
begin
  if Value <> FACList.FStrings then
    FACList.FStrings.Assign(Value);
end;

end.

这就是结果。

enter image description here

关于delphi - 是否可以向 Delphi 的 TButtonedEdit 添加历史列表下拉列表?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/11615336/

相关文章:

android - 为以编程方式拍摄的照片禁用自动保存?

windows - 如何在 Windows 上从 USB 设备 VID 和 PID 获取供应商名称和产品名称?

delphi - "pressing"使用键盘的TButtonedEdit按钮

Delphi:ButtonedEdit + Frame = Bug

delphi - SAPI 与 Dephi : Async speech doesn't work

delphi - 如何在paslibvlc视频播放器中禁用事件的音轨

c# - 如何创建 PSafeArray 类型的参数?

delphi - 按下 dbnavigator 删除按钮后,如何根据决策中止删除记录?

delphi - 从资源流加载图标时出现奇怪的 AV