Fórum Auto Completar No Edit #318252

unit Auto;
interface

uses
  Windows, Messages, ShellApi, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ListBox1: TListBox;
    Label1: TLabel;
    function Procura(Txt: string ): string;
    procedure Edit1Change(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Label2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Label2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  bPAUSA: Boolean; // Variável boleana que se TRUE impede ação do autocompletar

implementation

{$R *.DFM}

function TForm1.Procura(Txt: string): String;
var
  iA: INTEGER;
begin
  WITH ListBox1.ITEMS DO
    if TXT <>´´ THEN
      FOR iA:=0 to PRED(COUNT) do
        IF (LSTRCMP(PCHAR(COPY(STRINGS[iA],1,LENGTH(TXT))),PCHAR(TXT))=0)  OR
           (LSTRCMPI(PCHAR(COPY(STRINGS[iA],1,LENGTH(TXT))),PCHAR(TXT))=0) THEN
          BEGIN
            RESULT:=STRINGS[iA];
            BREAK;
          END;
end;

procedure TForm1.Edit1Change(Sender: TObject);
var
  iA,iB: INTEGER;
begin
  IF NOT bPAUSA AND ACTIVE THEN BEGIN
    IF PROCURA(Edit1.TEXT) <> ´´ THEN
    BEGIN
      iB:=LENGTH(Edit1.TEXT);
      Edit1.TEXT:=PROCURA(Edit1.TEXT);
      Edit1.SELSTART:=iB;
      Edit1.SELLENGTH:=LENGTH(PROCURA(Edit1.TEXT))-iB;
    end;
  END;
  bPAUSA:=FALSE;
  //
  FOR iA := 0 TO ListBox1.ITEMS.COUNT-1 DO
     IF ListBox1.ITEMS.STRINGS[iA] = Edit1.TEXT THEN BEGIN
        ListBox1.ITEMINDEX := iA;
        BREAK;
     END ELSE
        ListBox1.ITEMINDEX := -1;
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  IF (KEY = VK_BACK) OR (KEY = VK_DELETE) THEN  bPAUSA:=TRUE;
  IF KEY = 13 THEN Edit1.SELSTART := LENGTH(Edit1.Text);
  IF KEY = 27 THEN Edit1.CLEAR;
end;

procedure TForm1.Label2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 TLabel(Sender).Font.Color:=clRed;
end;

procedure TForm1.Label2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 TLabel(Sender).Font.Color:=$FF8080;
end;

procedure TForm1.Label2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 TLabel(Sender).Font.Color:=clRed;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 TLabel(Sender).Font.Color:=clWhite;
end;

end.