Création d'indexes à la volée

Description

- 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

Source / Exemple :


//
// 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.

Conclusion :


Cette source est utile à ceux qui souhaitent afficher les données d'une table dans l'ordre de la colonne cliquée sans avoir à créer, au préalable, autant d'index secondaires qu'il y a de champs dans la table visualisée.

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.