jsautocomplete.pas

销售软件

unit JSAutoComplete;

interface

uses
  SysUtils,
  Windows,
  Classes,
  Controls,
  Forms,
  ActiveX,
  ComObj,
  StdCtrls;

const
  IID_IAutoComplete: TGUID = '{00bb2762-6a77-11d0-a535-00c04fd7d062}';
  IID_IAutoComplete2: TGUID = '{EAC04BC0-3791-11d2-BB95-0060977B464C}';
  CLSID_IAutoComplete: TGUID = '{00BB2763-6A77-11D0-A535-00C04FD7D062}';
  IID_IACList: TGUID = '{77A130B0-94FD-11D0-A544-00C04FD7d062}';
  IID_IACList2: TGUID = '{470141a0-5186-11d2-bbb6-0060977b464c}';
  CLSID_ACLHistory: TGUID = '{00BB2764-6A77-11D0-A535-00C04FD7D062}';
  CLSID_ACListISF: TGUID = '{03C036F1-A186-11D0-824A-00AA005B4383}';
  CLSID_ACLMRU: TGUID = '{6756a641-de71-11d0-831b-00aa005b4383}';

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

const
  ACLO_NONE = 0;
  ACLO_CURRENTDIR = 1;
  ACLO_MYCOMPUTER = 2;
  ACLO_DESKTOP = 4;
  ACLO_FAVORITES = 8;
  ACLO_FILESYSONLY = 16;

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
  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
    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;
    function StringList: TStringList; stdcall;
    {VCL}
    constructor Create( const sl: TStringList = nil );
    destructor Destroy; override;
  end;

  TACOption = ( acAutoAppend, acAutoSuggest, acUseArrowKey );
  TACOptions = set of TACOption;
  TACSource = ( acsList, acsHistory, acsMRU, acsShell );

type
  TJSAutoComplete = class( TObject )
  private
    m_bEnabled: Boolean;
    m_iac: IAutoComplete;
    m_es: TEnumString;
    m_aco: TACOptions;
    m_acs: TACSource;

    function GetEnabled: Boolean;
    procedure SetEnabled( Value: Boolean );
    function GetOptions: TACOptions;
    function GetSource: TACSource;
    procedure SetOptions( Value: TACOptions );
    procedure SetSource( Value: TACSource );
  public
    procedure AddString( const Value: string );
    procedure ClearStrings;
    procedure SetACEnabled( const Value: boolean );
    procedure SetACOptions( const Value: TACOptions );
    procedure SetACSource( const Value: TACSource );
    property Enagled: Boolean read GetEnabled write SetEnabled;
    property Options: TACOptions read GetOptions write SetOptions;
    property Source: TACSource read GetSource write SetSource;

    constructor Create( hWnd: THandle; acsInit: TACSource = acsList );
    destructor Destroy; override;
  end;

//procedure Register;

implementation

//procedure Register;
//begin
//  RegisterComponents( 'Jerk System', [ TJSAutoComplete ] );
//end;

destructor TJSAutoComplete.Destroy;
begin
  if m_iac <> nil then
  begin
    m_iac.Enable( False );
    m_iac := nil;
  end;
  if m_es <> nil then
    FreeAndNil( m_es );

  inherited;
end;

procedure TJSAutoComplete.AddString( const Value: string );
begin
  if m_es <> nil then
    m_es.StringList.Add( Value );
end;

(*procedure TJSAutoComplete.Bind(hWnd: THandle);
var
  unk: IUnknown;
  Strings: IEnumString;
begin
  Unbind;

  m_es := TEnumString.Create;
  m_bEnabled := True;
  m_aco := [acAutoAppend, acAutoSuggest, acUseArrowKey];

  unk := CreateComObject(CLSID_IAutoComplete);
  if (unk <> nil) and (unk.QueryInterface(IID_IAutoComplete, m_iac) =
    S_OK) then
  begin
    case m_acs of
      acsHistory:
        Strings := IEnumString(CreateComObject(CLSID_ACLHistory));
      acsMRU:
        Strings := IEnumString(CreateComObject(CLSID_ACLMRU));
      acsShell:
        Strings := IEnumString(CreateComObject(CLSID_ACListISF));
    else
      if m_es = nil then
        m_es := TEnumString.Create;

      Strings := IEnumString(m_es);
    end;

    if S_OK = m_iac.Init(hWnd, Strings, nil, nil) then
    begin
      SetACEnabled(m_bEnabled);
      SetACOptions(m_aco);
    end;
  end;

end;*)

procedure TJSAutoComplete.ClearStrings;
begin
  if m_es <> nil then
    m_es.StringList.Clear;
end;

constructor TJSAutoComplete.Create( hWnd: THandle; acsInit: TACSource = acsList
  );
var
  unk: IUnknown;
  Strings: IEnumString;
begin
  //inherited Create;

  m_es := TEnumString.Create;
  m_bEnabled := True;
  m_aco := [ acAutoAppend, acAutoSuggest, acUseArrowKey ];
  m_acs := acsInit;
  unk := CreateComObject( CLSID_IAutoComplete );
  if ( unk <> nil ) and ( unk.QueryInterface( IID_IAutoComplete, m_iac ) =
    S_OK ) then
  begin
    case m_acs of
      acsHistory:
        Strings := IEnumString( CreateComObject( CLSID_ACLHistory ) );
      acsMRU:
        Strings := IEnumString( CreateComObject( CLSID_ACLMRU ) );
      acsShell:
        Strings := IEnumString( CreateComObject( CLSID_ACListISF ) );
    else
      if m_es = nil then
        m_es := TEnumString.Create;
      Strings := IEnumString( m_es );
    end;

    if S_OK = m_iac.Init( hWnd, Strings, nil, nil ) then
    begin
      SetACEnabled( m_bEnabled );
      SetACOptions( m_aco );
    end;
  end;
end;

(*procedure TJSAutoComplete.Unbind;
begin
  if m_iac <> nil then
  begin
    m_iac.Enable(False);
    m_iac := Unassigned;
  end;

  if m_es <> nil then
    m_es := Unassigned;
end; *)

function TJSAutoComplete.GetEnabled: Boolean;
begin
  Result := m_bEnabled;
end;

procedure TJSAutoComplete.SetEnabled( Value: Boolean );
begin
  SetACEnabled( Value );
end;

function TJSAutoComplete.GetOptions: TACOptions;
begin
  Result := m_aco;
end;

function TJSAutoComplete.GetSource: TACSource;
begin
  Result := m_acs;
end;

procedure TJSAutoComplete.SetOptions( Value: TACOptions );
begin
  m_aco := Value;
  SetACOptions( m_aco );
end;

procedure TJSAutoComplete.SetSource( Value: TACSource );
begin
  m_acs := Value;
end;

procedure TJSAutoComplete.SetACEnabled( const Value: boolean );
begin
  if ( m_iac <> nil ) then
  begin
    m_iac.Enable( m_bEnabled );
  end;
  m_bEnabled := Value;
end;

procedure TJSAutoComplete.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 ( m_iac <> nil ) then
    if S_OK = m_iac.QueryInterface( IID_IAutoComplete2, AC2 ) then
    begin
      Opt := ACO_NONE;
      for Option := Low( Options ) to High( Options ) do
      begin
        if ( Option in m_aco ) then
          Opt := Opt or DWORD( Options[ Option ] );
      end;
      AC2.SetOptions( Opt );
    end;
  m_aco := Value;
end;

procedure TJSAutoComplete.SetACSource( const Value: TACSource );
begin

end;

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

constructor TEnumString.Create( const sl: TStringList = nil );
begin
  inherited Create;
  if sl = nil then
    FStrings := TStringList.Create
  else
    FStrings := sl;
  FCurrIndex := 0;
end;

destructor TEnumString.Destroy;
begin
  if FStrings <> nil then
    FreeAndNil( FStrings );
  inherited;
end;

function TEnumString.StringList: TStringList;
begin
  StringList := FStrings;
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;

end.