delphi - Firemonkey 编辑/组合自动完成/打字时自动建议

如何使用 Delphi/Firemonkey 在 Windows/Android 平台以及 MacOS 和 iOS 上实现自动完成或自动建议？

示例

当用户在 Google 搜索框中输入文本时 - 会显示一些快速建议。

有很多带有 IAutoComplete 的 VCL 实现，但 FMX 的实现较少。需要的是 - FMX

最佳答案

我做了一些研究，并从不同的来源编译了以下内容。我已经在 XE7/XE8 上对此进行了测试与 Firemonkey 。完美运行于 Win32 , Android非常确定MacOS .

我曾经在计时器内调用建议，但下面的代码没有计时器。调用定时器或线程的过程是 TStyledSuggestEdit.DropDownRecalc 。

unit FMX.Edit.Suggest2;

interface

uses
  FMX.Edit.Style, FMX.Controls.Presentation, FMX.Controls.Model, FMX.Presentation.Messages, FMX.Edit,
  FMX.Controls, FMX.ListBox, System.Classes, System.Types;

const
  PM_DROP_DOWN = PM_EDIT_USER + 10;
  PM_PRESSENTER = PM_EDIT_USER + 11;
  PM_SET_ITEMINDEX = PM_EDIT_USER + 12;
  PM_GET_ITEMINDEX = PM_EDIT_USER + 13;
  PM_GET_SELECTEDITEM = PM_EDIT_USER + 14;
  PM_SET_ITEMCHANGE_EVENT = PM_EDIT_USER + 15;
  PM_GET_ITEMS = PM_EDIT_USER + 16;

type
  TSelectedItem = record
    Text: String;
    Data: TObject;
  end;

  TStyledSuggestEdit = class(TStyledEdit)
  private
    FItems: TStrings;
    FPopup: TPopup;
    FListBox: TListBox;
    FDropDownCount: Integer;
    FOnItemChange: TNotifyEvent;
    FItemIndex: integer;
    FDontTrack: Boolean;
    FLastClickedIndex: Integer;
    function _GetIndex: Integer;
    procedure _SetIndex(const Value: Integer);
    procedure _SetItems(const Value: TStrings);
  protected
    procedure CheckIfTextMatchesSuggestions; // used to find out if a typed text matches any of suggestions and then do select
    function GetListBoxIndexByText(const AText: string): Integer;
    procedure OnItemClick(const Sender: TCustomListBox; const Item: TListBoxItem);
    procedure PMDropDown(var AMessage: TDispatchMessage); message PM_DROP_DOWN;
    procedure MMDataChanged(var AMessage: TDispatchMessageWithValue<TDataRecord>); message MM_DATA_CHANGED;
    procedure PMSetSize(var AMessage: TDispatchMessageWithValue<TSizeF>); message PM_SET_SIZE;
    procedure PMGetItemIndex(var AMessage: TDispatchMessageWithValue<Integer>); message PM_GET_ITEMINDEX;
    procedure PMSetItemIndex(var AMessage: TDispatchMessageWithValue<Integer>); message PM_SET_ITEMINDEX;
    procedure PMGetItems(var AMessage: TDispatchMessageWithValue<TStrings>); message PM_GET_ITEMS;
    procedure PMGetSelectedItem(var AMEssage: TDispatchMessageWithValue<TSelectedItem>); message PM_GET_SELECTEDITEM;
    procedure PMSetItemChangeEvent(var AMessage: TDispatchMessageWithValue<TNotifyEvent>); message PM_SET_ITEMCHANGE_EVENT;
    procedure PMPressEnter(var AMessage: TDispatchMessage); message PM_PRESSENTER;
    procedure DoChangeTracking; override;
    procedure RebuildSuggestionList(AText: String);
    procedure RecalculatePopupHeight;
    procedure KeyDown(var Key: Word; var KeyChar: Char; Shift: TShiftState); override;
    procedure DropDownRecalc(ByText: string; Delay: integer = 100); //Delay parameter is a preparation for calling by a thread or a timer
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function _SelectedItem: TSelectedItem;
    property _Items: TStrings read FItems write _SetItems;
    property _ItemIndex: Integer read _GetIndex write _SetIndex;
    property _OnItemChange: TNotifyEvent read FOnItemChange write FOnItemChange;
  end;

  TStyleSuggestEditProxy = class(TPresentationProxy)
  protected
    function CreateReceiver: TObject; override;
  end;

  TEditSuggestHelper = class helper for TEdit
  public type
  private
    function GetIndex: Integer;
    procedure SetIndex(const Value: Integer);
    procedure SetOnItemChange(const Value: TNotifyEvent);
    function GetItems: TStrings;
  public
    procedure AssignItems(const S: TStrings);
    procedure ForceDropDown;
    procedure PressEnter;
    function SelectedItem: TSelectedItem;
    property OnItemChange: TNotifyEvent write SetOnItemChange;
    property ItemIndex: Integer read GetIndex write SetIndex;
    property Items: TStrings read GetItems;
  end;

implementation

uses
  FMX.Presentation.Factory, FMX.Types, System.SysUtils, System.Math, System.Rtti, uDsTimers.FMX, {$IFDEF MSWINDOWS}Winapi.Windows,{$ENDIF}
  System.UITypes;

{ TStyleSuggestEditProxy }

function TStyleSuggestEditProxy.CreateReceiver: TObject;
begin
  Result := TStyledSuggestEdit.Create(nil);
end;

{ TStyledSuggestEdit }

procedure TStyledSuggestEdit.CheckIfTextMatchesSuggestions;
var I: integer;
begin
  if FItemIndex = -1 then
  begin
    I := self.GetListBoxIndexByText(Edit.Text);
    if I <> -1 then
    try
      OnItemClick(nil, FListBox.ListItems[I]); //try-except: maybe missing items if calling from a timer event or within a thread
      FListBox.RemoveObject(FListBox.ListItems[I]);
      RecalculatePopupHeight;
    except
    end;
  end;
end;

constructor TStyledSuggestEdit.Create(AOwner: TComponent);
begin
  inherited;
  FItems := TStringList.Create;
  FItemIndex := -1;
  FPopup := TPopup.Create(self);
  FPopup.Parent := Self;
  FPopup.PlacementTarget := Self;
  FPopup.Placement := TPlacement.Bottom;
  FPopup.Width := Width;
  FListBox := TListBox.Create(self);
  FListBox.Parent := FPopup;
  FListBox.Align := TAlignLayout.Client;
  FListBox.OnItemClick := OnItemClick;
  FDropDownCount := 5;
  FListBox.Width := Self.Width;
  FPopup.Width := Self.Width;
  FLastClickedIndex := -1;
end;

destructor TStyledSuggestEdit.Destroy;
begin
  FPopup := nil;
  FListBox := nil;
  FItems.Free;
  inherited;
end;

procedure TStyledSuggestEdit.DoChangeTracking;
begin
  inherited;
  if Edit.Text <> _SelectedItem.Text then
    FLastClickedIndex := -1;
  if not FDontTrack and (FLastClickedIndex = -1) then
  begin
    _ItemIndex := -1;
    DropDownRecalc(Edit.Text);
  end;
end;

function TStyledSuggestEdit.GetListBoxIndexByText(const AText: string): Integer;
begin
  for Result := 0 to FListBox.Count - 1 do
    if FListBox.ListItems[Result].Text.ToLower = AText.ToLower  then
      Exit;
  Result := -1;
end;

function TStyledSuggestEdit._GetIndex: Integer;
begin
  Result := FItemIndex;
end;

procedure TStyledSuggestEdit.KeyDown(var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
  inherited;
  case Key of
    vkReturn:
      if FListBox.Selected <> nil then
      begin
        OnItemClick(FListBox, FListBox.Selected);
      end;
    vkEscape: FPopup.IsOpen := False;
    vkDown: begin
      if FListBox.Selected <> nil then
        FListBox.ItemIndex := Min(FListBox.Count - 1, FListBox.ItemIndex + 1)
      else
      if FListBox.Count > 0 then
        FListBox.ItemIndex := 0;
    end;
    vkUp: begin
      if FListBox.Selected <> nil then
        FListBox.ItemIndex := Max(0, FListBox.ItemIndex - 1);
    end;
  end;
  if Assigned(OnKeyDown) then
    OnKeyDown(Edit, Key, KeyChar, Shift);
end;

procedure TStyledSuggestEdit.MMDataChanged(var AMessage: TDispatchMessageWithValue<TDataRecord>);
var
  Data: TDataRecord;
begin
  Data := AMessage.Value;
  if Data.Value.IsType <TStrings> and (Data.Key = 'Suggestions') then
    FItems.Assign(Data.Value.AsType<TStrings>)
end;

procedure TStyledSuggestEdit.OnItemClick(const Sender: TCustomListBox; const Item: TListBoxItem);
begin
  FLastClickedIndex := Item.Tag;
  _ItemIndex := Item.Tag;
  FPopup.IsOpen := Sender = nil; // whenever OnItemClick is being called programmatically `Sender` must be passed as `nil`, 
  Edit.SetFocus;                 // otherwise considered as real-user-click and should close popup
end;

procedure TStyledSuggestEdit.PMPressEnter(var AMessage: TDispatchMessage);
var K: word; KC: Char;
begin
  K := vkReturn;
  KC := #13;
  KeyDown(K, KC, []);
end;

procedure TStyledSuggestEdit.PMDropDown(var AMessage: TDispatchMessage);
begin
  inherited;
  DropDownRecalc('',10);
end;

procedure TStyledSuggestEdit.PMGetItemIndex(var AMessage: TDispatchMessageWithValue<Integer>);
begin
  AMessage.Value := self._ItemIndex;
end;

procedure TStyledSuggestEdit.PMGetItems(var AMessage: TDispatchMessageWithValue<TStrings>);
begin
  AMessage.Value := Self._Items;
end;

procedure TStyledSuggestEdit.PMGetSelectedItem(var AMEssage: TDispatchMessageWithValue<TSelectedItem>);
begin
  AMEssage.Value := self._SelectedItem;
end;

procedure TStyledSuggestEdit.PMSetItemChangeEvent(var AMessage: TDispatchMessageWithValue<TNotifyEvent>);
begin
  FOnItemChange := AMessage.Value;
end;

procedure TStyledSuggestEdit.PMSetItemIndex(var AMessage: TDispatchMessageWithValue<Integer>);
begin
  self._ItemIndex := AMessage.Value;
end;

procedure TStyledSuggestEdit.PMSetSize(var AMessage: TDispatchMessageWithValue<TSizeF>);
begin
  inherited;
  FPopup.Width := Width;
end;

procedure TStyledSuggestEdit.RebuildSuggestionList(AText: String);
var
  i: integer;
  Word: string;
begin
  FListBox.Clear;
  FListBox.BeginUpdate;
  AText := AText.ToLower;
  try
    for i := 0 to FItems.Count - 1 do
      if AText.IsEmpty or FItems[i].ToLower.StartsWith(AText) then
      begin
        FListBox.AddObject(TListBoxItem.Create(FListBox));
        FListBox.ListItems[FListBox.Count - 1].Tag := I;
        FListBox.ListItems[FListBox.Count - 1].Data := FItems.Objects[i];
        FListBox.ListItems[FListBox.Count - 1].Text := FItems[i];
      end;
  finally
    FListBox.EndUpdate;
  end;
end;

procedure TStyledSuggestEdit.RecalculatePopupHeight;
begin
  if FListBox.Items.Count > 0 then
  begin
    FPopup.Height := FListBox.ListItems[0].Height * Min(FDropDownCount, FListBox.Items.Count) + FListBox.BorderHeight;
    FPopup.PopupFormSize := TSizeF.Create(FPopup.Width, FPopup.Height);
  end
  else
  begin
    FPopup.Height := 1; // instead this it's possible to hide FPopup.IsOpen := false;
    FPopup.PopupFormSize := TSizeF.Create(FPopup.Width, FPopup.Height);
  end;
end;

function TStyledSuggestEdit._SelectedItem: TSelectedItem;
begin
  if FItemIndex = -1 then
  begin
    Result.Text := '';
    Result.Data := nil;
  end
  else
  begin
    Result.Text := FItems[FItemIndex];
    Result.Data := FItems.Objects[FItemIndex];
  end;
end;

procedure TStyledSuggestEdit._SetIndex(const Value: Integer);
begin
  if (Value >= -1) and (Value < FItems.Count) and (Value <> FItemIndex) then
  begin
    FDontTrack := true;
    FItemIndex := Value;
    if (FItemIndex >= 0) and (Edit.Text <> _SelectedItem.Text) then
    begin
      Edit.Text := _SelectedItem.Text;
      Edit.GoToTextEnd;
    end;
    if Assigned(FOnItemChange) then
      FOnItemChange(Edit);
    FDontTrack := false;
  end;
end;

procedure TStyledSuggestEdit._SetItems(const Value: TStrings);
begin
  FItems := Value;
  _ItemIndex := -1;
end;

procedure TStyledSuggestEdit.DropDownRecalc(ByText: string; Delay: integer);
begin
  // Here is possible to use a timer call or a call in a thread;
  if not self.FDontTrack then
  begin
    Self.RebuildSuggestionList(ByText);
    Self.RecalculatePopupHeight;
    self.FPopup.IsOpen := self.FListBox.Items.Count > 0;
    CheckIfTextMatchesSuggestions;
  end;
end;

{ TEditHelper }

procedure TEditSuggestHelper.PressEnter;
begin
  if HasPresentationProxy then
    PresentationProxy.SendMessage(PM_PRESSENTER);
end;

function TEditSuggestHelper.SelectedItem: TSelectedItem;
begin
  if HasPresentationProxy then
    PresentationProxy.SendMessageWithResult<TSelectedItem>(PM_GET_SELECTEDITEM, Result);
end;

procedure TEditSuggestHelper.SetIndex(const Value: Integer);
begin
  if HasPresentationProxy then
    PresentationProxy.SendMessage<Integer>(PM_SET_ITEMINDEX, Value);
end;

procedure TEditSuggestHelper.SetOnItemChange(const Value: TNotifyEvent);
begin
  if HasPresentationProxy then
    PresentationProxy.SendMessage<TNotifyEvent>(PM_SET_ITEMCHANGE_EVENT, Value);
end;

procedure TEditSuggestHelper.ForceDropDown;
begin
  if HasPresentationProxy then
    PresentationProxy.SendMessage(PM_DROP_DOWN);
end;

function TEditSuggestHelper.GetIndex: Integer;
begin
  if HasPresentationProxy then
    PresentationProxy.SendMessageWithResult<Integer>(PM_GET_ITEMINDEX, Result);
end;

function TEditSuggestHelper.GetItems: TStrings;
begin
  if HasPresentationProxy then
    PresentationProxy.SendMessageWithResult<TStrings>(PM_GET_ITEMS, Result);
end;

procedure TEditSuggestHelper.AssignItems(const S: TStrings);
begin
  self.Model.Data['Suggestions'] := TValue.From<TStrings>(S);
end;


initialization
  TPresentationProxyFactory.Current.Register('SuggestEditStyle', TStyleSuggestEditProxy);
finalization
  TPresentationProxyFactory.Current.Unregister('SuggestEditStyle');
end.

使用方法如下:

创建多设备应用
在高清表单上常见TEdit组件

定义 TEdit.OnPresentationNameChoosing在“事件”选项卡上显示以下内容:

procedure TForm1.Edit1PresentationNameChoosing(Sender: TObject; var PresenterName: string);
begin
  inherited;
  PresenterName := 'SuggestEditStyle';
end;

将项目添加到您的 sl: TStrings通过:sl.AddObject('Name', TIntObj.Create(10));
分配sl: TStrings到您的编辑:Edit1.AssignItems(sl);
注释掉TStyledSuggestEdit.CheckIfTextMatchesSuggestions如果不需要，请在代码中 Autoselect打字时的能力。

测试Form1

表单引用

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 325
  ClientWidth = 225
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  OnCreate = FormCreate
  DesignerMasterStyle = 0
  object Edit1: TEdit
    Touch.InteractiveGestures = [LongTap, DoubleTap]
    Align = Top
    TabOrder = 0
    OnPresentationNameChoosing = Edit1PresentationNameChoosing
    Position.X = 20.000000000000000000
    Position.Y = 57.000000000000000000
    Margins.Left = 20.000000000000000000
    Margins.Right = 20.000000000000000000
    Size.Width = 185.000000000000000000
    Size.Height = 22.000000000000000000
    Size.PlatformDefault = False
    object Button2: TButton
      Align = Right
      Cursor = crArrow
      Margins.Left = 1.000000000000000000
      Margins.Top = 1.000000000000000000
      Margins.Right = 1.000000000000000000
      Margins.Bottom = 1.000000000000000000
      Position.X = 156.500000000000000000
      Position.Y = 0.500000000000000000
      Scale.X = 0.500000000000000000
      Scale.Y = 0.500000000000000000
      Size.Width = 56.000000000000000000
      Size.Height = 42.000000000000000000
      Size.PlatformDefault = False
      StyleLookup = 'arrowdowntoolbutton'
      TabOrder = 0
      Text = 'Button2'
      OnClick = Button2Click
    end
  end
  object Button1: TButton
    Align = Top
    Margins.Left = 30.000000000000000000
    Margins.Top = 10.000000000000000000
    Margins.Right = 30.000000000000000000
    Position.X = 30.000000000000000000
    Position.Y = 89.000000000000000000
    Size.Width = 165.000000000000000000
    Size.Height = 22.000000000000000000
    Size.PlatformDefault = False
    TabOrder = 1
    Text = 'Set 3rd item'
    OnClick = Button1Click
  end
  object Label1: TLabel
    Align = Top
    Size.Width = 225.000000000000000000
    Size.Height = 57.000000000000000000
    Size.PlatformDefault = False
    Text = 'Label1'
  end
end

代码引用

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.Edit, FMX.Edit.Suggest2, FMX.Layouts, FMX.ListBox,
  FMX.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure esItemChange(Sender: TObject);
    procedure Edit1PresentationNameChoosing(Sender: TObject; var PresenterName: string);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  sl: TStrings;

implementation


{$R *.fmx}

type
  TIntObj = class(TObject)
  private
    FId: integer;
  public
    constructor Create(Id: integer); overload;
    function Value: integer;
  end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.ItemIndex := 3; // force choice as if it was combobox behaviour
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Edit1.ForceDropDown; // add a button inside TEdit and use it as dropdown
end;

procedure TForm1.Edit1PresentationNameChoosing(Sender: TObject; var PresenterName: string);
begin
  inherited;
  PresenterName := 'SuggestEditStyle';
end;

procedure TForm1.esItemChange(Sender: TObject);
begin
  // occurs when ItemIndex is changed
  Label1.Text := TEdit(Sender).SelectedItem.Text + LineFeed + 'idx=' + TEdit(Sender).ItemIndex.ToString + LineFeed + 'data=';
  if TEdit(Sender).SelectedItem.Data <> nil then
    Label1.Text := Label1.Text + TIntObj(TEdit(Sender).SelectedItem.Data).Value.ToString
  else
    Label1.Text := Label1.Text + 'nil';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  sl := TStringList.Create;
  //sl.AddObject('aaa',10); // Segmentation fault 11 under Android
  sl.AddObject('aaa',TIntObj.Create(10));
  sl.AddObject('aaabb',TIntObj.Create(20));
  sl.AddObject('aaabbbcc',TIntObj.Create(30));
  sl.AddObject('aaacc',TIntObj.Create(40));
  sl.AddObject('aaafff',TIntObj.Create(50));
  sl.AddObject('aaaggg',TIntObj.Create(60));
  Edit1.AssignItems(sl);
  Edit1.OnItemChange := esItemChange;
end;

{ TIntObject }

constructor TIntObj.Create(Id: integer);
begin
  inherited Create;
  FId := Id;
end;

function TIntObj.Value: integer;
begin
  Result := FId;
end;

end.

经过测试的 Win32 [Windows 7/8] 和 Android 4.4.4 设备 [MI3W]

希望这有帮助。如有任何进一步的想法和建议，我们将不胜感激。

关于delphi - Firemonkey 编辑/组合自动完成/打字时自动建议，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/39339048/

delphi - Firemonkey 编辑/组合自动完成/打字时自动建议

上一篇：basic - 如何获取 QB64 中驱动器的默认目录

下一篇：Python 显示图像时出错