CRÉATION D'INDEXES À LA VOLÉE

//
// Auteur        : Delphiprog
// Email         : delphiprog@fr.fm
// Web           : http://www.delphiprog.fr.fm
// Date création : 09/08/2002
// Date révision :
{  Objet         :
           - création d'index secondaire à la volée en cliquant
             sur le titre de colonne d'un TDbGrid
           - suppression des index créés par l'application à la fermeture
           - visualisation de la colonne indexée par coloration
             des caractères du titre
}
{  remarques     :
}
unit UDbase;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, DBGrids, Db, DBTables;

type
  TForm1 = class(TForm)
    Table1: TTable;
    Table1LAST_NAME: TStringField;
    Table1FIRST_NAME: TStringField;
    Table1ACCT_NBR: TFloatField;
    Table1ADDRESS_1: TStringField;
    Table1CITY: TStringField;
    Table1STATE: TStringField;
    Table1ZIP: TStringField;
    Table1TELEPHONE: TStringField;
    Table1DATE_OPEN: TDateField;
    Table1SS_NUMBER: TFloatField;
    Table1PICTURE: TStringField;
    Table1BIRTH_DATE: TDateField;
    Table1RISK_LEVEL: TStringField;
    Table1OCCUPATION: TStringField;
    Table1OBJECTIVES: TStringField;
    Table1INTERESTS: TStringField;
    Table1IMAGE: TBlobField;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    ListBox1: TListBox;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure DBGrid1TitleClick(Column: TColumn);
    procedure FormDestroy(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumn; State: TGridDrawState);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;
  //Liste des index secondaires disponibles
  IndexList: TStrings;
  //Liste des index secondaires créés à la volée
  CreatedIndexList: TStrings;
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Table1.Open;
  //Récupérer la liste des index déclarés
  //avant le lancement du programme
  Table1.GetIndexNames(IndexList);
  //En faire une copie pour l'afficher et
  //permettre une sélection par l'utilisateur
  ListBox1.Items.Assign(IndexList);
end;

procedure TForm1.DBGrid1TitleClick(Column: TColumn);
begin
  //Vérifie que la colonne affiche des données de la
  //table et non un champ calculé
  if DBGrid1.ValidFieldIndex(Column.Index) then
  begin
    //Un index correspondant à la colonne cliquée existe-t-il ?
    if IndexList.IndexOf(Column.FieldName) <> -1 then
      //Si oui, l'activer
      with TTable(DbGrid1.DataSource.DataSet) do
        IndexFieldNames := Column.FieldName
    else
      //L'index n'existe pas :
      with TTable(DbGrid1.DataSource.DataSet) do
      begin
        Close;
        Exclusive := True;
        //créer un index secondaire correspondant
        //à la colonne cliquée
        try
          AddIndex(Column.FieldName, Column.FieldName, []);
          //rendre actif l'index créé
          IndexFieldNames := Column.FieldName;
          Exclusive := False;
          Open;
          //Réactualiser la liste des index de la table
          GetIndexNames(IndexList);
          //et l'afficher
          ListBox1.Items.Assign(IndexList);
          CreatedIndexList.Assign(IndexList);
        except
          on EDatabaseError do
          begin
            ShowMessageFmt('Impossible de créer un index'#13'sur le champ %s.',
              [Column.FieldName]);
            IndexFieldNames := '';
            Exclusive := False;
            if not Active then
              Open;
          end;
        end;
      end;
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: integer;
begin
  with Table1 do
  begin
    Close;
    Exclusive := True;
    for i := 0 to CreatedIndexList.Count - 1 do
    try
      Table1.DeleteIndex(CreatedIndexList.Strings[i]);
    except
      //
    end;
    Exclusive := False;
    Close;
  end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  //S'il y a au moins un élément dans la liste
  with ListBox1 do
    if Items.Count > 0 then
      //Rendre actif l'index correspondant à
      //l'élément sélectionné
      Table1.IndexFieldNames := Items[ItemIndex];
end;

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  if Column.FieldName = Table1.IndexFieldNames then
    //Colorer en bleu le titre cliqué
    Column.Title.Font.Color := clBlue
  else
    Column.Title.Font.Color := clWindowText;

end;

initialization
  IndexList := TStringList.Create;
  CreatedIndexList := TStringList.Create;

finalization
  IndexList.Free;
  CreatedIndexList.Free;

end.