{*********************************************************************}
{ Advanced lookup editor component : TAdvLUEdit                       }
{ for Delphi & C++Builder                                             }
{ version 1.4                                                         }
{                                                                     }
{ written by                                                          }
{  TMS Software                                                       }
{  copyright © 2000 - 2005                                            }
{  Email : info@tmssoftware.com                                       }
{  Web : http://www.tmssoftware.com                                   }
{                                                                     }
{ The source code is given as is. The author is not responsible       }
{ for any possible damage done due to the use of this code.           }
{ The component can be freely used in any application. The source     }
{ code remains property of the author and may not be distributed      }
{ freely as such.                                                     }
{*********************************************************************}

unit advlued;

{$I TMSDEFS.INC}

interface

uses
  Windows, Registry, Stdctrls, Classes, Messages, Controls, SysUtils,
  IniFiles, AdvEdit;

const
  MAJ_VER = 1; // Major version nr.
  MIN_VER = 4; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 0; // Build nr.

type
  TAutoCompleteEvent = procedure(Sender: TObject;const UsrStr:string; var AutoAdd:string;idx:integer) of object;
  TEnterAcceptEvent = procedure(Sender: TObject;const Str:string;idx:integer;var accept:boolean) of object;

  TAddToHistoryEvent = procedure(Sender: TObject; const Str:string) of object;

  TLUPersist = class(TPersistent)
     private
      FEnable:boolean;
      FLocation : TPersistenceLocation;
      FKey : string;
      FSection : string;
      FCount : integer;
      FMaxCount:boolean;
     published
      property Enable:boolean read fEnable write fEnable;
      property Location:TPersistenceLocation read fLocation write fLocation;
      property Key:string read fKey write fKey;
      property Section:string read fSection write fSection;
      property Count:integer read fCount write fCount;
      property MaxCount:boolean read fMaxCount write fMaxCount;
  end;

  TAdvLUEdit = class(TAdvEdit)
  private
    workmode:boolean;
    {$IFNDEF TMSDOTNET}
    FLookupItems:TStringList;
    {$ENDIF}
    {$IFDEF TMSDOTNET}
    FLookupItems:TStrings;
    {$ENDIF}
    FAutoComplete:TAutoCompleteEvent;
    FOnAddToHistory:TAddToHistoryEvent;
    FAutoHistory:boolean;
    FAutoSynchronize:boolean;
    FEnterAccept:TEnterAcceptEvent;
    FFileLookup:boolean;
    FLUPersist:TLUPersist;
    FMatchCase:boolean;
    FChanged:boolean;
    {$IFNDEF TMSDOTNET}
    procedure SetLookupItems(value:tstringlist);
    {$ENDIF}
    {$IFDEF TMSDOTNET}
    procedure SetLookupItems(value:TStrings);
    {$ENDIF}
    procedure SetLUPersist(value:TLUPersist);
    procedure WMDestroy(var Msg:TMessage); message wm_Destroy;
  protected
    function GetVersionNr: Integer; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure DoExit; override;
    procedure LookupText;
  public
    procedure Change; override;
    constructor Create(aOwner:tComponent); override;
    destructor Destroy; override;
    procedure SavePersist; override;
    procedure LoadPersist; override;
    procedure Loaded; override;
  published
    {$IFNDEF TMSDOTNET}
    property LookupItems:TStringList read fLookupItems write SetLookupItems;
    {$ENDIF}
    {$IFDEF TMSDOTNET}
    property LookupItems:TStrings read fLookupItems write SetLookupItems;
    {$ENDIF}
    property AutoComplete:TAutoCompleteEvent read FAutoComplete write FAutoComplete;
    property OnAddToHistory:TAddToHistoryEvent read FOnAddToHistory write FOnAddToHistory;
    property Accept:TEnterAcceptEvent read FEnterAccept write FEnterAccept;
    property AutoHistory:boolean read FAutoHistory write FAutoHistory;
    property AutoSynchronize:boolean read fAutoSynchronize write fAutoSynchronize;
    property FileLookup:boolean read fFileLookup write fFileLookup;
    property LookupPersist:TLUPersist read fLUPersist write SetLUPersist;
    property MatchCase:boolean read FMatchCase write FMatchCase;
  end;

implementation

function upstr(s:string;docase:boolean):string;
begin
  if docase then
    Result := s
  else
    Result := AnsiUpperCase(s);
end;

function ncpos(su,s:string):integer;
begin
  su := upstr(su,false);
  s := upstr(s,false);
  Result := pos(su,s);
end;

{$IFNDEF TMSDOTNET}
procedure TAdvLUEdit.SetLookupItems(value:tstringlist);
{$ENDIF}
{$IFDEF TMSDOTNET}
procedure TAdvLUEdit.SetLookupItems(value:TStrings);
{$ENDIF}
begin
  if Assigned(value) then fLookupItems.Assign(value)
end;

procedure TAdvLUEdit.DoExit;
var
 allowexit:boolean;
 i:integer;
 lu:TAdvLUEdit;
begin
 allowexit:=true;
 if Assigned(FEnterAccept) then
   begin
    FEnterAccept(self,text,fLookupItems.IndexOf(Text),allowexit);
  end;
 if allowexit and fautohistory and (text<>'') then
   begin
    if (flookupitems.indexof(text)=-1) then
     begin
       flookupitems.Add(text);
       if assigned(fOnAddToHistory) then fOnAddToHistory(self,text);

       if fAutoSynchronize then
       for I := 0 to Owner.ComponentCount - 1 do
         begin
           if (Owner.Components[I] is TAdvLUEdit) and (Owner.Components[I]<>self) then
            begin
             lu:=Owner.Components[I] as TAdvLUEdit;
             if (lu.AutoHistory) and (lu.LookupPersist.key=self.LookupPersist.Key) and (lu.AutoSynchronize) and
                (lu.LookupPersist.Section=self.LookupPersist.Section) then
                 lu.LookupItems.Assign(self.LookupItems);
             end;
         end;
     end;
   end;
 if allowexit then inherited DoExit else self.SetFocus;
end;

procedure TAdvLUEdit.LookupText;
var
 c:string;
 i:integer;
 UsrStr,AutoAdd:string;
 searchrec:tsearchrec;

begin
// inherited Change;

 if csDesigning in ComponentState then exit;

 if not workmode then exit;

 c:=upstr(Text,fMatchCase);
 c:=copy(c,1,selstart);

 if (fLookupItems.count>0) then
  for i:=0 to fLookupItems.count-1 do
    begin
     if pos(c,upstr(fLookupItems.Strings[i],fMatchCase))=1 then
      begin
       UsrStr:=copy(text,1,length(c));
       AutoAdd:=copy(fLookupItems.Strings[i],length(c)+1,255);
       if assigned(FAutoComplete) then
         begin
          FAutoComplete(self,UsrStr,AutoAdd,i);
         end;

       Text:=UsrStr+AutoAdd;
       Modified := True;
       SendMessage(Handle,EM_SETSEL,length(c)+length(Prefix),length(text)+length(Prefix));
       Exit;
      end;
   end;

 if (fLookupItems.count=0) and (length(self.text)>0) and (fFileLookup) then
  begin
   if findfirst(self.text+'*' ,faAnyfile,searchrec)=0 then
    begin
     c:=text;
     usrstr:='';
     while (pos(':',c)>0) do
       begin
        usrstr:=usrstr+copy(c,1,pos(':',c));
        delete(c,1,pos(':',c));
       end;
     while (pos('\',c)>0) do
       begin
        usrstr:=usrstr+copy(c,1,pos('\',c));
        delete(c,1,pos('\',c));
       end;

     if ((ncpos(c,searchrec.name)=1) or (c=''))
        and (ncpos('.',searchrec.name)<>1) then
      begin
       c:=text;
       text:=usrstr+searchrec.name;
       Modified := True;
       SendMessage(Handle,EM_SETSEL,length(c),length(text));
      end;
    end;
   findclose(searchrec);
  end;
end;

procedure TAdvLUEdit.Change;
begin
 inherited;
 fChanged:=true;
end;

procedure TAdvLUEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
 case Key of
 vk_back,vk_delete:workmode:=false;
 vk_return:begin
             if (fLookupItems.IndexOf(Text)<>-1) then
              begin
               text:=fLookupItems.Strings[fLookupItems.IndexOf(Text)];
               self.Change;
              end;
             end;
 else workmode:=true;
 end;
 inherited KeyDown(key,shift);
end;


constructor TAdvLUEdit.Create(aOwner:tComponent);
begin
 inherited Create(aOwner);
 fLookupItems:=tStringList.Create;
 fLUPersist:=TLUPersist.Create;
 workmode:=true;
end;


destructor TAdvLUEdit.Destroy;
begin
  FLookupItems.Free;
  FLookupItems := nil;
  FLUPersist.Free;
  FLUPersist := nil;
 inherited Destroy;
end;

procedure TAdvLUEdit.SetLUPersist(value: TLUPersist);
begin
 fLUPersist.Assign(value);
end;

procedure TAdvLUEdit.Loaded;
begin
 inherited Loaded;
 if not (csDesigning in ComponentState) then LoadPersist;
end;

procedure TAdvLUEdit.WMDestroy(var Msg: TMessage);
begin
 if not (csDesigning in ComponentState) then SavePersist;
 DefaultHandler(msg);
end;

procedure TAdvLUEdit.LoadPersist;
var
  Inifile: TCustomInifile;
  i: Integer;
  s: string;
begin
  inherited LoadPersist;
  if FLUPersist.Enable then
  begin
    if (FLUPersist.Location = plInifile) then
      Inifile := TInifile.Create(self.FLUPersist.Key)
    else
      Inifile := TRegistryInifile.Create(self.FLUPersist.Key);

    LookupItems.Clear;
    i := 1;
    repeat
      s := Inifile.ReadString(FLUPersist.Section,'Item'+IntToStr(i),'');
      Inc(i);
      if s <> '' then self.LookupItems.Add(s);
    until s = '';
    Inifile.Free;
  end;
end;

procedure TAdvLUEdit.SavePersist;
var
  Inifile: TCustomInifile;
  i,j,k: Integer;
begin
  inherited SavePersist;

  if Assigned(FLUPersist) and FLUPersist.Enable and Assigned(LookupItems) then
  begin
    if FLUPersist.Location = plInifile then
      Inifile := TInifile.Create(fLUPersist.Key)
    else
      Inifile := TRegistryInifile.Create(FLUPersist.Key);

    j := 0;
    k := LookupItems.Count;
    if FLUPersist.MaxCount then
      k := FLUPersist.Count;

    if FLUPersist.MaxCount and (LookupItems.Count > FLUPersist.Count) then
      j := LookUpItems.Count - FLuPersist.Count;

    for i := 1 to k do
    begin
      if (i + j <= LookUpItems.Count) then
        Inifile.WriteString(FLUPersist.Section,'Item'+IntToStr(i),LookupItems.Strings[i+j-1])
      else
        Inifile.WriteString(FLUPersist.Section,'Item'+IntToStr(i),'');
    end;
    Inifile.Free;
  end;
end;


procedure TAdvLUEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if FChanged and not (key in [vk_back,vk_delete]) then LookupText;
  FChanged := False;
  inherited;
end;

function TAdvLUEdit.GetVersionNr: Integer;
begin
  Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;

end.
