(* Copyright (c) 2011. Cary Jensen, Jensen Data Systems, Inc.
   This code sample is intended for the readers of
   "Delphi in Depth: ClientDataSets" by Cary Jensen

   No guarantees or warranties are expressed or implied concerning
   the applicability of techniques or code included in this example
   or in the accompanying book. If you wish to use techniques or
   code included in this example or described in the book, it is
   your responsibility to test and certify any code, techniques,
   or design you adopt.

   For information on consulting or training services, please visit:
   http://www.JensenDataSystems.com

   For more information about "Delphi in Depth: ClientDataSets"
   by Cary Jensen, including links to order the book, please visit:
   http://www.JensenDataSystems.com/cdsbook
*)
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls, Menus, ComCtrls, DBGrids, DB,
  DBClient, DBCtrls;

type
  TForm1 = class(TForm)
    ClientDataSet1: TClientDataSet;
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Label1: TLabel;
    Splitter2: TSplitter;
    Panel3: TPanel;
    DBNavigator1: TDBNavigator;
    Panel4: TPanel;
    StringGrid1: TStringGrid;
    DBGrid1: TDBGrid;
    ClearGridBtn: TButton;
    File1: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    VisitwwwDephiDevelperDayscom1: TMenuItem;
    VisitwwwJensenDataSystemscom1: TMenuItem;
    N3: TMenuItem;
    About1: TMenuItem;
    Close1: TMenuItem;
    DataSource1: TDataSource;
    IndexFieldNamesEdit: TEdit;
    SelectIndexBtn: TButton;
    SetRangeBtn: TButton;
    ApplyRangeBtn: TButton;
    Label2: TLabel;
    ApplyFilterExpressionBtn: TButton;
    FirstBtn: TButton;
    PriorBtn: TButton;
    NextBtn: TButton;
    LastBtn: TButton;
    CancelRangeBtn: TButton;
    GroupBox1: TGroupBox;
    CaseInsCheckBox: TCheckBox;
    NoPartialCheckBox: TCheckBox;
    FilterExpressionEdit: TEdit;
    ApplyDropFilterBtn: TButton;
    KeyExclusiveCheckBox: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure VisitwwwDephiDevelperDayscom1Click(Sender: TObject);
    procedure VisitwwwJensenDataSystemscom1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure ClientDataSet1AfterOpen(DataSet: TDataSet);
    procedure ClientDataSet1AfterClose(DataSet: TDataSet);
    procedure Close1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure ClearGridBtnClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure SelectIndexBtnClick(Sender: TObject);
    procedure IndexFieldNamesEditChange(Sender: TObject);
    procedure SetRangeBtnClick(Sender: TObject);
    procedure ApplyRangeBtnClick(Sender: TObject);
    procedure CancelRangeBtnClick(Sender: TObject);
    procedure CaseInsCheckBoxClick(Sender: TObject);
    procedure NoPartialCheckBoxClick(Sender: TObject);
    procedure ApplyFilterExpressionBtnClick(Sender: TObject);
    procedure FirstBtnClick(Sender: TObject);
    procedure PriorBtnClick(Sender: TObject);
    procedure NextBtnClick(Sender: TObject);
    procedure LastBtnClick(Sender: TObject);
    procedure ApplyDropFilterBtnClick(Sender: TObject);
    procedure KeyExclusiveCheckBoxClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
  private
    procedure LoadClientDataSet(FileName: String);
    procedure Done;
    procedure Start;
    function GetMaxRangeItems: Integer;
    procedure UpdateGridLabels;
    function GetTemporaryIndexFromUser(CurrentIndex: String): String;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses ShellAPI,  //For ShellExecute
     MMSystem;  //For TickGetTick;

var
  StartTick, EndTick: DWord;


procedure TForm1.FormCreate(Sender: TObject);
begin
  ClientDataSet1.FileName := ExtractFilePath(Application.ExeName) +
    '\..\bigcds\bigcds.cds';
  if not FileExists(ClientDataSet1.FileName) then
  begin
    ShowMessage('BigCDS.cds not found. This project requires this ' +
      'file, and expects to find it in the folder named BigCDS, ' +
      'which should be located in the folder directly above ' +
      ExtractFilePath(Application.ExeName) + '. Cannot continue.');
    Abort;
  end;
  ClientDataSet1.Open;
  StringGrid1.RowCount := 2;
  StringGrid1.ColCount := 3;
  StringGrid1.Cells[0,0] := 'Field Name';
  StringGrid1.Cells[1,0] := 'Start Range';
  StringGrid1.Cells[2,0] := 'End Range';
  StringGrid1.FixedRows := 1;
  StringGrid1.FixedCols := 1;
end;

procedure TForm1.LoadClientDataSet(FileName: String);
begin
  ClearGridBtnClick(Self);
  if ClientDataSet1.Active then
    ClientDataSet1.Close;
  ClientDataSet1.IndexFieldNames := '';
  ClientDataSet1.Filtered := False;
  ClientDataSet1.Filter := '';
  ClientDataSet1.FileName := FileName;
  ClientDataSet1.Open;
  IndexFieldNamesEdit.ReadOnly := False;
  IndexFieldNamesEdit.Text := ClientDataSet1.Fields[0].FieldName;
  IndexFieldNamesEdit.ReadOnly := True;
end;

procedure TForm1.UpdateGridLabels;
var
  IndexFields: String;
  SList: TStringList;
  i: Integer;
begin
  IndexFields := IndexFieldNamesEdit.Text;
  SList := TStringList.Create;
  SList.Delimiter := ';';
  SList.DelimitedText := IndexFields;
  try
    case SList.Count of
      0     : begin
                StringGrid1.RowCount := 2;
                StringGrid1.Cells[0, 1] := '';
              end;
      1     : StringGrid1.RowCount := 2;
      2..255: StringGrid1.RowCount := Succ(SList.Count);
    end;
    for i := 0 to Pred(SList.Count) do
      StringGrid1.Cells[0, Succ(i)] := SList[i];
  finally
     SList.Free;
  end;
end;

procedure TForm1.Start;
begin
  StartTick := TimeGetTime;
end;

procedure TForm1.Done;
begin
  EndTick := TimeGetTime;
  StatusBar1.Panels[0].Text := 'Starting tick: ' +
    IntToStr(StartTick);
  StatusBar1.Panels[1].Text := 'Ending tick: ' +
    IntToStr(EndTick);
  StatusBar1.Panels[2].Text := 'Duration (in milliseconds): ' +
    IntToStr(EndTick - StartTick);
end;

procedure TForm1.VisitwwwDephiDevelperDayscom1Click(Sender: TObject);
begin
ShellExecute(Application.Handle, 'open',
 'http://www.DelphiDeveloperDays.com', nil, nil, SW_SHOW);
end;

procedure TForm1.VisitwwwJensenDataSystemscom1Click(Sender: TObject);
begin
ShellExecute(Application.Handle, 'open',
 'http://www.JensenDataSystems.com', nil, nil, SW_SHOW);
end;

procedure TForm1.About1Click(Sender: TObject);
begin
ShowMessage('CDSFilter (c) 2002 Cary Jensen, Jensen Data Systems, Inc. '
  + #10#13
  + #10#13 + 'Demonstration of how to filter a ClientDataSet based on its data.'
  + #10#13
  + #10#13 + 'This project is provided for demonstration purposes only.'
  + #10#13
  + #10#13 + 'Visit http://www.JensenDataSystems.com for information about training and consulting services.');
end;

procedure TForm1.ClientDataSet1AfterOpen(DataSet: TDataSet);
var
  i: Integer;
begin
  Open1.Enabled := False;
  Close1.Enabled := True;
  for i := 0 to Pred(Self.ComponentCount) do
    if (Self.Components[i] is TButton) and
      (Components[i].Name <> 'CancelRangeBtn') then
      TButton(Components[i]).Enabled := True;
end;

procedure TForm1.ClientDataSet1AfterClose(DataSet: TDataSet);
var
  i: Integer;
begin
  Open1.Enabled := True;
  Close1.Enabled := False;
  for i := 0 to Pred(Self.ComponentCount) do
    if Self.Components[i] is TButton then
      TButton(Components[i]).Enabled := False;
end;

procedure TForm1.Close1Click(Sender: TObject);
begin
  ClientDataSet1.Close;
  ClearGridBtnClick(Self);
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
  ClientDataSet1.Open;
  ClearGridBtnClick(Self);
end;

procedure TForm1.ClearGridBtnClick(Sender: TObject);
var
  Col, Row: Integer;
begin
for Col := 1 to 2 do
  for Row := 1 to StringGrid1.RowCount do
    StringGrid1.Cells[Col, Row] := '';
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;

type
  EBadFieldInIndex = class(Exception);

function TForm1.GetTemporaryIndexFromUser(CurrentIndex: String): String;
  //local function to verify field list
  function FieldsValid(CDS: TClientDataSet; FieldList: String): Boolean;
  var
    i: Integer;
    SList: TStringList;
  begin
    Result := False;
    SList := TStringlist.Create;
    SList.Delimiter := ';';
    SList.DelimitedText := FieldList;
    try
      if SList.Count = 0 then
      begin
        Result := True;
        Exit;
      end
      else //if SList.Count = 0
          for i := 0 to Pred(SList.Count) do
            if CDS.FindField(SList[i]) = nil then
              Exit;
          Result := True;
    finally
      SList.Free;
    end;
    end; //function FieldsValid

begin
  Result := IndexFieldNamesEdit.Text;
  if InputQuery('Enter index field(s) [ex: field1;field2]',
    'Index on', Result) then
    begin
    while Pos(' ;',Result) <> 0  do
      Result := StringReplace(Result, ' ;', ';', [rfReplaceAll]);
    while Pos('; ',Result) <> 0 do
      Result := StringReplace(Result, '; ', ';', [rfReplaceAll]);
      if not FieldsValid(ClientDataSet1, Result) then
        raise EBadFieldInIndex.Create('IndexFieldNames contains at '+
          'least one invalid field name');
    Result := Result;
    end; //if InputQuery
end;


procedure TForm1.SelectIndexBtnClick(Sender: TObject);
var
  NewIndexFields: String;
begin
  NewIndexFields := GetTemporaryIndexFromUser(IndexFieldNamesEdit.Text);
  if NewIndexFields <> IndexFieldNamesEdit.Text then
  begin
    IndexFieldNamesEdit.ReadOnly := False;
    IndexFieldNamesEdit.Text := NewIndexFields;
    IndexFieldNamesEdit.ReadOnly := True;
    ClearGridBtnClick(Sender);
  end;
end;

procedure TForm1.IndexFieldNamesEditChange(Sender: TObject);
begin
  ClientDataSet1.IndexFieldNames := IndexFieldNamesEdit.Text;
  UpdateGridLabels;
end;

procedure TForm1.SetRangeBtnClick(Sender: TObject);
var
  MaxItems: Integer;
begin
if ClientDataSet1.IndexFieldNames = '' then
  begin
    ShowMessage('Set index field names before trying to set a range');
    Exit;
  end;
  MaxItems := GetMaxRangeItems;
  (* Note: The SetRange method works with n (2+) fields of the index
   * so long as the first n-1 fields define the same start and end
   * value on the range. For example, the following will work:
   * CDS.SetRange([1, 1], [1, 20];
   * but the following will not work:
   *  CDS.SetRange([1, 1], [2, 20];
   *)
  case MaxItems of
  0: ShowMessage('Enter a range');
  1: begin
     Start;
     ClientDataSet1.SetRange(
       [StringGrid1.Cells[1,1]],
       [StringGrid1.Cells[2,1]]);
     Done;
     end;
  2: begin
     Start;
     ClientDataSet1.SetRange(
       [StringGrid1.Cells[1,1],
       StringGrid1.Cells[1,2]],
       [StringGrid1.Cells[2,1],
       StringGrid1.Cells[2,2]]);
     Done;
     end;
  3:  begin
      Start;
      ClientDataSet1.SetRange(
        [StringGrid1.Cells[1,1],
        StringGrid1.Cells[1,2],
        StringGrid1.Cells[1,3]],
        [StringGrid1.Cells[2,1],
        StringGrid1.Cells[2,2],
        StringGrid1.Cells[2,3]]);
      Done;
      end;
  4:  begin
      Start;
      ClientDataSet1.SetRange(
        [StringGrid1.Cells[1,1],
        StringGrid1.Cells[1,2],
        StringGrid1.Cells[1,3],
        StringGrid1.Cells[1,4]],
        [StringGrid1.Cells[2,1],
        StringGrid1.Cells[2,2],
        StringGrid1.Cells[2,3],
        StringGrid1.Cells[2,4]]);
      Done;
      end;
  5:  begin
      Start;
      ClientDataSet1.SetRange(
        [StringGrid1.Cells[1,1],
        StringGrid1.Cells[1,2],
        StringGrid1.Cells[1,3],
        StringGrid1.Cells[1,4],
        StringGrid1.Cells[1,5]],
        [StringGrid1.Cells[2,1],
        StringGrid1.Cells[2,2],
        StringGrid1.Cells[2,3],
        StringGrid1.Cells[2,4],
        StringGrid1.Cells[2,5]]);
      Done;
      end;
  6..MaxInt: ShowMessage('This example project limited to '+
    'a maximum of 5 fields in a range');
  end;
  if MaxItems < 6 then
    CancelRangeBtn.Enabled := True;
end;

procedure TForm1.ApplyRangeBtnClick(Sender: TObject);
var
  MaxItems: Integer;
  i: Integer;
begin
if ClientDataSet1.IndexFieldNames = '' then
  begin
    ShowMessage('Set index field names before trying to set a range');
    Exit;
  end;
  MaxItems := GetMaxRangeItems;
  if MaxItems = 0 then
  begin
    ShowMessage('Enter a range');
    Exit;
  end;
  Start;
  ClientDataSet1.SetRangeStart;
  for i := 1 to MaxItems do
    ClientDataSet1.FieldByName(StringGrid1.Cells[0,i]).Value :=
      Trim(StringGrid1.Cells[1,i]);
  ClientDataSet1.SetRangeEnd;
  for i := 1 to MaxItems do
    ClientDataSet1.FieldByName(StringGrid1.Cells[0,i]).Value :=
      Trim(StringGrid1.Cells[2,i]);
  ClientDataSet1.ApplyRange;
  Done;
  if MaxItems < 6 then
    CancelRangeBtn.Enabled := True;
end;

procedure TForm1.CancelRangeBtnClick(Sender: TObject);
begin
  ClientDataSet1.CancelRange;
  CancelRangeBtn.Enabled := False;
end;

procedure TForm1.CaseInsCheckBoxClick(Sender: TObject);
begin
if CaseInsCheckBox.Checked then
  ClientDataSet1.FilterOptions :=
    ClientDataSet1.FilterOptions + [foCaseInsensitive]
else
  ClientDataSet1.FilterOptions :=
    ClientDataSet1.FilterOptions - [foCaseInsensitive];
end;

procedure TForm1.NoPartialCheckBoxClick(Sender: TObject);
begin
if NoPartialCheckBox.Checked then
  ClientDataSet1.FilterOptions :=
    ClientDataSet1.FilterOptions + [foNoPartialCompare]
else
  ClientDataSet1.FilterOptions :=
    ClientDataSet1.FilterOptions - [foNoPartialCompare];
end;

procedure TForm1.ApplyFilterExpressionBtnClick(Sender: TObject);
begin
  Start;
  ClientDataSet1.Filter := FilterExpressionEdit.Text;
  Done;
end;

procedure TForm1.FirstBtnClick(Sender: TObject);
begin
  Start;
  if not ClientDataSet1.FindFirst then
  begin
    Done;
    ShowMessage('There are no matching records');
  end
  else
    Done;
end;

procedure TForm1.PriorBtnClick(Sender: TObject);
begin
  Start;
  if not ClientDataSet1.FindPrior then
  begin
    Done;
    ShowMessage('No prior record found');
  end
  else
    Done;
end;

procedure TForm1.NextBtnClick(Sender: TObject);
begin
  Start;
  ClientDataSet1.FindNext;
  Done;
  if not ClientDataSet1.Found then
    ShowMessage('No next record found');
end;

procedure TForm1.LastBtnClick(Sender: TObject);
begin
  Start;
  if not ClientDataSet1.FindLast then
  begin
    Done;
    ShowMessage('There are no matching records');
  end
  else
    Done;
end;

procedure TForm1.ApplyDropFilterBtnClick(Sender: TObject);
begin
  Start;
  ClientDataSet1.Filtered := not ClientDataSet1.Filtered;
  Done;
  if ClientDataSet1.Filtered then
    ApplyDropFilterBtn.Caption := 'Drop Filter'
  else
    ApplyDropFilterBtn.Caption := 'Apply Filter';
end;

function TForm1.GetMaxRangeItems: Integer;
var
  i: Integer;
begin
i := 0;
while True do
begin
  if StringGrid1.Cells[1, Succ(i)] <> '' then
    inc(i)
  else
    Break;
end;
Result := i;
i := 0;
while True do
begin
  if StringGrid1.Cells[2, Succ(i)] <> '' then
    inc(i)
  else
    Break;
end;
if Result < i then
  Result := i;
end;

procedure TForm1.KeyExclusiveCheckBoxClick(Sender: TObject);
begin
(* Note: When this project was created, Delphi 6 and Delphi 7
 * ClientDataSets raised an exception when trying to modify
 * the KeyExclusive property. This checkbox is included in this
 * example for testing purposes.
 *)
ClientDataSet1.KeyExclusive := KeyExclusiveCheckBox.Checked;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ClientDataSet1.Filter := 'City = '+ QuotedStr('New*') +
   'and [Last Name] = ' + QuotedStr('M*');
end;

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
StatusBar1.Panels[3].Text := IntToStr(ClientDataSet1.RecNo) +
  ' of ' + IntToStr(ClientDataSet1.RecordCount) + ' records';
end;

end.
