(* 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, Provider, DBTables;

type
  TForm1 = class(TForm)
    ClientDataSet1: TClientDataSet;
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    IndexOnComboBox: TComboBox;
    ScanBtn: TButton;
    FindKeyBtn: TButton;
    FindNearestBtn: TButton;
    GotoNearestBtn: TButton;
    LocateBtn: TButton;
    LookupBtn: TButton;
    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;
    OpenDialog1: TOpenDialog;
    Close1: TMenuItem;
    DataSource1: TDataSource;
    ScanForEdit: TEdit;
    GotoKeyBtn: TButton;
    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 IndexOnComboBoxChange(Sender: TObject);
    procedure ScanBtnClick(Sender: TObject);
    procedure FindKeyBtnClick(Sender: TObject);
    procedure FindNearestBtnClick(Sender: TObject);
    procedure GotoKeyBtnClick(Sender: TObject);
    procedure GotoNearestBtnClick(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure LocateBtnClick(Sender: TObject);
    procedure ClearGridBtnClick(Sender: TObject);
    procedure LookupBtnClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    procedure LoadClientDataSet(FileName: String);
    procedure Done;
    procedure Start;
    function GetKeyFields(var FieldStr: String): Integer;
    function GetKeyValues(Size: Integer): Variant;
    function GetResultFields: 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.Cells[0,0] := 'Search in Field';
  StringGrid1.Cells[1,0] := 'Search For (in Field)';
  StringGrid1.Cells[2,0] := 'Return Field (Lookup only)';
end;

procedure TForm1.LoadClientDataSet(FileName: String);
begin
  ClientDataSet1.FileName := FileName;
  ClientDataSet1.Open;
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('CDSSearch (c) 2002 Cary Jensen, Jensen Data Systems, Inc. '
  + #10#13
  + #10#13 + 'Demonstration of how to search a ClientDataSet for 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
  Close1.Enabled := True;
  Open1.Enabled := False;
  for i := 0 to Pred(Self.ComponentCount) do
    if Self.Components[i] is TButton then
      TButton(Components[i]).Enabled := True;
  ClientDataSet1.Fields.GetFieldNames(IndexOnComboBox.Items);
  IndexOnComboBox.ItemIndex := 0;
end;

procedure TForm1.ClientDataSet1AfterClose(DataSet: TDataSet);
var
  i: Integer;
begin
  Close1.Enabled := False;
  Open1.Enabled := True;
  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;
end;

procedure TForm1.IndexOnComboBoxChange(Sender: TObject);
begin
  ClientDataSet1.IndexFieldNames :=
    IndexOnComboBox.Text;
end;

procedure TForm1.ScanBtnClick(Sender: TObject);
var
  Found: Boolean;
begin
  Found := False;
  ClientDataSet1.DisableControls;
  Start;
  try
    ClientDataSet1.First;
    while not ClientDataSet1.Eof do
    begin
      if ClientDataSet1.Fields[IndexOnComboBox.ItemIndex].Value =
        ScanForEdit.Text then
        begin
          Found := True;
          Break;
        end;
      ClientDataSet1.Next;
    end;
    Done;
  finally
    ClientDataSet1.EnableControls;
  end;
  if Found then StatusBar1.Panels[3].Text :=
    ScanForEdit.Text + ' found at record '
    + IntToStr(ClientDataSet1.RecNo)
  else
    StatusBar1.Panels[3].Text :=
      ScanForEdit.Text + ' not found';
end;

procedure TForm1.FindKeyBtnClick(Sender: TObject);
begin
  Start;
  if ClientDataSet1.FindKey([ScanForEdit.Text]) then
  begin
    Done;
    StatusBar1.Panels[3].Text := ScanForEdit.Text +
      ' found at record ' +
      IntToStr(ClientDataSet1.RecNo);
  end
  else
  begin
    Done;
    StatusBar1.Panels[3].Text :=
      ScanForEdit.Text + ' not found';
  end;
end;

procedure TForm1.FindNearestBtnClick(Sender: TObject);
begin
  Start;
  ClientDataSet1.FindNearest([ScanForEdit.Text]);
  Done;
  StatusBar1.Panels[3].Text := 'The nearest match to ' +
    ScanForEdit.Text + ' found at record ' +
    IntToStr(ClientDataSet1.RecNo);
end;

procedure TForm1.GotoKeyBtnClick(Sender: TObject);
begin
  Start;
  ClientDataSet1.SetKey;
  ClientDataSet1.Fields[IndexOnComboBox.ItemIndex].AsString :=
    Trim(ScanForEdit.Text);
  if ClientDataSet1.GotoKey then
  begin
    Done;
    StatusBar1.Panels[3].Text := ScanForEdit.Text +
      ' found at record ' +
      IntToStr(ClientDataSet1.RecNo);
  end
  else
  begin
    Done;
    StatusBar1.Panels[3].Text :=
      ScanForEdit.Text + ' not found';
  end;
end;

procedure TForm1.GotoNearestBtnClick(Sender: TObject);
begin
  Start;
  ClientDataSet1.SetKey;
  ClientDataSet1.Fields[IndexOnComboBox.ItemIndex].AsString :=
    ScanForEdit.Text;
  ClientDataSet1.GotoNearest;
  Done;
  StatusBar1.Panels[3].Text := 'The nearest match to ' +
    ScanForEdit.Text + ' found at record ' +
    IntToStr(ClientDataSet1.RecNo);
end;

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

procedure TForm1.LocateBtnClick(Sender: TObject);
var
  FieldList: String;
  Count: Integer;
  SearchArray: Variant;
begin
  FieldList := '';
  Count := GetKeyFields(FieldList);
  SearchArray := GetKeyValues(Count);
  Start;
  if ClientDataSet1.Locate(FieldList, SearchArray, []) then
  begin
    Done;
    StatusBar1.Panels[3].Text :=
      'Match located at record ' +
      IntToStr(ClientDataSet1.RecNo);
  end
  else
  begin
    Done;
    StatusBar1.Panels[3].Text := 'No match located';
  end;
end;

function TForm1.GetKeyFields(var FieldStr: String): Integer;
const
  FieldsColumn = 0;
var
  i : Integer;
  Count: Integer;
begin
  Count := 0;
  for i := 1 to 20 do
  begin
    if StringGrid1.Cells[FieldsColumn,i] <> '' then
    begin
      if FieldStr = '' then FieldStr :=
        StringGrid1.Cells[FieldsColumn,i]
      else
        FieldStr := FieldStr + ';' +
          StringGrid1.Cells[FieldsColumn,i];
      inc(Count);
    end
    else
      Break;
  end;
  Result := Count;
end;

function TForm1.GetKeyValues(Size: Integer): Variant;
const
  SearchColumn = 1;
var
  i: Integer;
begin
  Result := VarArrayCreate([0,Pred(Size)], VarVariant);
  for i := 0 to Pred(Size) do
    Result[i] := StringGrid1.Cells[SearchColumn, Succ(i)];
end;

function TForm1.GetResultFields: String;
const
  ReturnColumn = 2;
var
  i: Integer;
begin
  for i := 1 to Succ(StringGrid1.RowCount) do
    if StringGrid1.Cells[ReturnColumn, i] <> '' then
      if Result = '' then
        Result := StringGrid1.Cells[ReturnColumn, i]
      else
        Result := Result + ';' +
          StringGrid1.Cells[ReturnColumn, i]
    else
      Break;
end;

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

procedure TForm1.LookupBtnClick(Sender: TObject);
var
  ResultFields: Variant;
  KeyFields: String;
  KeyValues: Variant;
  ReturnFields: String;
  Count, i: Integer;
  DisplayString: String;
begin
  Count := GetKeyFields(KeyFields);
  DisplayString := '';
  KeyValues := GetKeyValues(Count);
  ReturnFields := GetResultFields;
  Start;
  ResultFields := ClientDataSet1.Lookup(KeyFields,
    KeyValues, ReturnFields);
  Done;
  if VarIsNull(ResultFields) then
    DisplayString := 'Lookup record not found'
  else
    if VarIsArray(ResultFields) then
      for i := 0 to VarArrayHighBound(ResultFields,1) do
        if i = 0 then
          DisplayString := 'Lookup result: ' +
            VarToStr(ResultFields[i])
        else
          DisplayString := DisplayString +
            ';' + VarToStr(ResultFields[i])
    else
      DisplayString := VarToStr(ResultFields);
  StatusBar1.Panels[3].Text := DisplayString
end;

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

end.
