(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTDBIndexLookup;

interface

uses SysUtils, Windows, Messages, Classes, Controls,StdCtrls, 
     DB, DBTables,AHMStdClass;

type
  TAHMDBDisplayType = (dtDisplayLabel,dtFieldName,dtIndexName);
  TAHMDBIndexLookup = class;
  TAHMIndexDataLink = class(TDataLink)
  private
    FILookup: TAHMDBIndexLookup;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
  public
    constructor Create(ALookup: TAHMDBIndexLookup);
    destructor Destroy; override;
  end;
  TAHMDBIndexLookup = class(TCustomComboBox)
  private
    FDataLink: TAHMIndexDataLink;
    FUpdate: Boolean;
    FAboutStr : TAHMAboutSControlStr;
    FNoIndexItem: PString;
    FEnableNoIndex: Boolean;
    FDisplayType: TAHMDBDisplayType;
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    function GetIndexFieldName: string;
    procedure SetNoIndexItem(const Value: string);
    function GetNoIndexItem: string;
    procedure SetEnableNoIndex(Value: Boolean);
    procedure SetDisplayType(Value: TAHMDBDisplayType);
    procedure ActiveChanged;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
    procedure FillIndexList(List: TStrings);
    procedure Change; override;
    procedure UpdateList; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property NoIndexItemName: string read GetNoIndexItem write SetNoIndexItem;
    property NoIndexEnabled: Boolean read FEnableNoIndex write SetEnableNoIndex default False;
    property DisplayType: TAHMDBDisplayType read FDisplayType write SetDisplayType default dtDisplayLabel;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Color;
    property Ctl3D;
    property DropDownCount;
    property Font;
    property ItemHeight;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
  end;

implementation

constructor TAHMIndexDataLink.Create(ALookup: TAHMDBIndexLookup);
begin
  inherited Create;
  FILookup := ALookup;
end;

destructor TAHMIndexDataLink.Destroy;
begin
  FILookup := nil;
  inherited Destroy;
end;

procedure TAHMIndexDataLink.ActiveChanged;
begin
  if FILookup <> nil then FILookup.ActiveChanged;
end;

procedure TAHMIndexDataLink.DataSetChanged;
begin
  if FILookup <> nil then FILookup.ActiveChanged;
end;

constructor TAHMDBIndexLookup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TAHMIndexDataLink.Create(Self);
  Style := csDropDownList;
  FUpdate := False;
  FNoIndexItem := NullStr;
  FEnableNoIndex := False;
end;

destructor TAHMDBIndexLookup.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  DisposeStr(FNoIndexItem);
  FNoIndexItem := NullStr;
  inherited Destroy;
end;

procedure TAHMDBIndexLookup.SetNoIndexItem(const Value: string);
begin
  if Value <> FNoIndexItem^ then
  begin
    AssignStr(FNoIndexItem, Value);
    if not (csLoading in ComponentState) then ActiveChanged;
  end;
end;

procedure TAHMDBIndexLookup.SetEnableNoIndex(Value: Boolean);
begin
  if FEnableNoIndex <> Value then
  begin
    FEnableNoIndex := Value;
    if not (csLoading in ComponentState) then ActiveChanged;
  end;
end;

procedure TAHMDBIndexLookup.SetDisplayType(Value: TAHMDBDisplayType);
begin
  if (Value <> FDisplayType) then
  begin
    FDisplayType := Value;
    if not (csLoading in ComponentState) then UpdateList;
  end;
end;

function TAHMDBIndexLookup.GetNoIndexItem: string;
begin
  Result := FNoIndexItem^;
end;

function TAHMDBIndexLookup.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TAHMDBIndexLookup.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
  if not (csLoading in ComponentState) then ActiveChanged;
end;

procedure TAHMDBIndexLookup.ActiveChanged;
begin
  if not (Enabled and FDataLink.Active and DataSource.DataSet.InheritsFrom(TTable)) then
  begin
    Clear;
    ItemIndex := -1;
  end else UpdateList;
end;

procedure TAHMDBIndexLookup.Loaded;
begin
  inherited Loaded;
  ActiveChanged;
end;

procedure TAHMDBIndexLookup.Notification(AComponent: TComponent;Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation=opRemove) and (FDataLink<>nil) and (AComponent=DataSource) then DataSource := nil;
end;

procedure TAHMDBIndexLookup.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if not (csLoading in ComponentState) then ActiveChanged;
end;

function TAHMDBIndexLookup.GetIndexFieldName: string;
begin
  if ItemIndex >= 0 then
  begin
    if NoIndexEnabled and (Items[ItemIndex] = NoIndexItemName) then Result := ''
                      else Result := TIndexDef(Items.Objects[ItemIndex]).Fields;
  end else Result := '';
end;

procedure TAHMDBIndexLookup.FillIndexList(List: TStrings);
var AFld: string;
    Pos: Integer;
    I: Integer;
begin
  List.Clear;
  with DataSource.DataSet as TTable do
  begin
    for I := 0 to IndexDefs.Count - 1 do with IndexDefs[I] do
    if not (ixExpression in Options) then
    begin
      if FDisplayType = dtIndexName then AFld := Name else
      begin
        AFld := '';
        Pos := 1;
        while Pos <= Length(Fields) do
        begin
          if AFld <> '' then AFld := AFld + '; ';
          case FDisplayType of
            dtDisplayLabel: AFld:=AFld+FieldByName(ExtractFieldName(Fields, Pos)).DisplayLabel;
            dtFieldName: AFld := AFld + FieldByName(ExtractFieldName(Fields, Pos)).FieldName;
          end;
        end;
      end;
      if List.IndexOf(AFld) < 0 then List.AddObject(AFld, IndexDefs[I]);
    end;
  end;
  if NoIndexEnabled then if List.IndexOf(NoIndexItemName)<0 then List.AddObject(NoIndexItemName, nil);
end;

procedure TAHMDBIndexLookup.Change;
var ABookmark: TBookmark;
begin
  if Enabled and FDataLink.Active and DataSource.DataSet.InheritsFrom(TTable) and
             not (csLoading in ComponentState) then
  begin
    ABookmark := nil;
    with DataSource.DataSet as TTable do
    begin
      if Database.IsSQLBased then ABookmark := GetBookmark;
      try
        IndexFieldNames := GetIndexFieldName;
        if ABookmark <> nil then Self.DataSource.DataSet.GotoBookmark(ABookmark);
      finally
        if ABookmark <> nil then FreeBookmark(ABookmark);
      end;
    end;
  end;
  inherited Change;
end;

procedure TAHMDBIndexLookup.UpdateList;
function FindIndex(const IndexFields: string): Integer;
var I: Integer;
begin
  if NoIndexEnabled then Result := Items.IndexOf(NoIndexItemName) else Result := -1;
  for I := 0 to Items.Count - 1 do
  begin
    if (Items.Objects[I] <> nil) and
       (AnsiCompareText(TIndexDef(Items.Objects[I]).Fields, IndexFields) = 0) then
    begin
      Result := I;
      Break;
    end;
  end;
end;
begin
  if Enabled and FDataLink.Active then
  begin
    Items.BeginUpdate;
    try
      if DataSource.DataSet.InheritsFrom(TTable) then
      begin
        with (DataSource.DataSet as TTable) do
        begin
          IndexDefs.Update;
          FillIndexList(Items);
          ItemIndex := FindIndex(IndexFieldNames);
        end
      end else Items.Clear;
    finally
      Items.EndUpdate;
    end;
  end;
end;

end.
