{ Intentionally simple DISQLite3 / ClientDataSet demo project.

  Delphi 4 does not have IProviderSupport which is required by this demo.
  Please compile with a later version for full update functionality!

  Visit the DISQLite3 Internet site for latest information and updates:

    http://www.yunqa.de

  Copyright (c) 2005-2021 Ralf Junker, Yunqa <delphi@yunqa.de>

------------------------------------------------------------------------------ }

unit DISQLite3_ClientDataSet_Grid_Form_Main;

{$I DICompilers.inc}
{$I DISQLite3.inc}

interface

uses
  {$IFDEF HAS_UNITSCOPE}
  System.Classes, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls, Vcl.ComCtrls,
  Vcl.ExtCtrls, Vcl.Grids, Vcl.DBCtrls, Vcl.DBGrids, Data.DB, Datasnap.Provider,
  Datasnap.DBClient, // Provider.dcu needs Delphi Professional, Client/Server, or Enterprise.
  {$ELSE HAS_UNITSCOPE}
  Classes, Controls, Forms, StdCtrls, ComCtrls, ExtCtrls, Grids, DBGrids,
  DB, Provider, DBClient, // Provider.dcu needs Delphi Professional, Client/Server, or Enterprise.
  {$ENDIF HAS_UNITSCOPE}
  DISQLite3Database, DISQLite3DataSet;

type
  TfrmMain = class(TForm)
    DISQLite3Database: TDISQLite3Database;
    DISQLite3UniDirQuery: TDISQLite3UniDirQuery;
    DataSource: TDataSource;
    ClientDataSet: TClientDataSet;
    DataSetProvider: TDataSetProvider;
    pnlNavigation: TPanel;
    DbGrid: TDBGrid;
    btnInsert: TButton;
    btnDelete: TButton;
    StatusBar: TStatusBar;
    btnApplyUpdates: TButton;
    btnCancelUpdates: TButton;
    btnRefresh: TButton;
    btnPrev: TButton;
    btnNext: TButton;
    btnFilter: TButton;
    btnClearFilter: TButton;
    edtFilter: TEdit;
    procedure Form_Create(Sender: TObject);
    procedure btnInsert_Click(Sender: TObject);
    procedure btnDelete_Click(Sender: TObject);
    procedure btnCancelUpdates_Click(Sender: TObject);
    procedure btnApplyUpdates_Click(Sender: TObject);
    procedure Form_CloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnRefresh_Click(Sender: TObject);
    procedure DISqlite3UniDirQueryInitFieldDef(const AColumn: TDISQLite3Column; const AFieldDef: TFieldDef);
    procedure ClientDataSet_Modified(DataSet: TDataSet);
    procedure ClientDataSet_NewRecord(DataSet: TDataSet);
    procedure btnPrev_Click(Sender: TObject);
    procedure btnNext_Click(Sender: TObject);
    procedure ClientDataSet_AfterScroll(DataSet: TDataSet);
    procedure btnFilter_Click(Sender: TObject);
    procedure btnClearFilter_Click(Sender: TObject);
  private
    FID: Integer;
    procedure OpenDatabase(const Filter: string = '');
  end;

const
  APP_TITLE = 'DISQLite3 Demo: ClientDataSet';

var
  frmMain: TfrmMain;

implementation

uses
  {$IFDEF HAS_UNITSCOPE}
  System.SysUtils, Vcl.Dialogs,
  {$ELSE HAS_UNITSCOPE}
  SysUtils, Dialogs,
  {$ENDIF HAS_UNITSCOPE}
  { Compile MidasLib into the application if supported by Delphi version.
    This removes all dependencies against midas.dll and turns projects into
    fully standalone applications. }
  {$IFDEF COMPILER_6_UP}MidasLib, {$ENDIF}
  DISQLite3Api;

{$R *.dfm}

procedure TfrmMain.Form_Create(Sender: TObject);
{$IFNDEF COMPILER_6_UP}
var
  i: Integer;
  {$ENDIF COMPILER_6_UP}
begin
  Caption := APP_TITLE;

  { Open the database. }
  DISQLite3Database.DatabaseName := 'Test.db3';
  try
    DISQLite3Database.Open;
  except
    on e: ESQLite3 do
      if e.ErrorCode = SQLITE_CANTOPEN then
        begin
          { If database does not yet exist, create it now ... }
          DISQLite3Database.CreateDatabase;
          DISQLite3Database.Execute(
            'CREATE TABLE IF NOT EXISTS Products(' +
            '"ID" INTEGER PRIMARY KEY,' +
            '"Name" TEXT)');
          { ... and add some sample data. }
          DISQLite3Database.Execute('INSERT INTO Products (Name) VALUES (''Software'')');
          DISQLite3Database.Execute('INSERT INTO Products (Name) VALUES (''Hardware'')');
          DISQLite3Database.Execute('INSERT INTO Products (Name) VALUES (''Book'')');
          DISQLite3Database.Execute('INSERT INTO Products (Name) VALUES (''Compact Disc'')');
          DISQLite3Database.Execute('INSERT INTO Products (Name) VALUES (''Digital Versatile Disc'')');
        end
      else
        raise
    else
      raise;
  end;

  OpenDatabase;
end;

procedure TfrmMain.OpenDatabase(const Filter: string = '');
const
  PARAM_NAME = 'Param';
var
  Param: TParam;
begin
  btnClearFilter.Enabled := Filter <> '';

  if ClientDataSet.Active then
    ClientDataSet.Close;

  { Set the select of the unerlying TDISQLite3UniDirQuery. }
  if Filter = '' then
    begin
      DISQLite3UniDirQuery.SelectSQL := 'SELECT ID, Name FROM Products';
    end
  else
    begin
      { A filter was passed. This is implemented via TDataSet.Params.
        TDISQLite3UniDirQuery creates a TParam for named SQL parameters
        which match the ':VVV' template where VVV represents an alphanumeric
        identifier which becomes the TParam.Name. }
      DISQLite3UniDirQuery.SelectSQL :=
        'SELECT ID, Name FROM Products WHERE Name LIKE :' + PARAM_NAME;
      { Find the auto-created TParam and assign the filter value to it. }
      Param := DISQLite3UniDirQuery.Params.FindParam(PARAM_NAME);
      if Assigned(Param) then
        Param.Value := Filter
      else
        raise Exception.CreateFmt('Parameter %s not found', [PARAM_NAME]);
    end;

  { When DISQLite3UniDirQuery set up, open the ClientDataSet. In turn,
    this automatically opens the underlying TDISQLite3UniDirQuery. }
  ClientDataSet.Open;

  {$IFNDEF COMPILER_6_UP}
  { Bug in Delphi 5 and lower: TClientDataSet does not copy
    TField.ProviderFlags, so do it here manually. See comment on
    TfrmMain.ClientDataSet_NewRecord for why this is needed. }
  DISQLite3UniDirQuery.Open;
  try
    for i := 0 to DISQLite3UniDirQuery.Fields.Count - 1 do
      ClientDataSet.Fields[i].ProviderFlags :=
        DISQLite3UniDirQuery.Fields[i].ProviderFlags;
  finally
    DISQLite3UniDirQuery.Close;
  end;
  {$ENDIF !COMPILER_6_UP}
end;

//------------------------------------------------------------------------------

{ When inserting new records, TClientDataSet does not fill in ftAutoInc fields
  automatically. This requires us to jump in and fill them with distinct values.
  Negative, decreasing numbers work well here since DISQLite3 uses positive
  PRIMARY KEYs only.

  Since TClientDataSet automatically sets ftAutoInc fields to ReadOnly, we must
  remove this protection before we can write the custom value. }

procedure TfrmMain.ClientDataSet_NewRecord(DataSet: TDataSet);
var
  f: TField;
  i: Integer;
  OldReadonly: Boolean;
begin
  Dec(FID);
  for i := 0 to DataSet.Fields.Count - 1 do
    begin
      f := DataSet.Fields[i];
      if f.DataType = ftAutoInc then
        begin
          DataSet.DisableControls;
          OldReadonly := f.ReadOnly;
          try
            f.ReadOnly := False;
            f.AsInteger := FID;
          finally
            f.ReadOnly := OldReadonly; // Restore previous ReadOnly value.
            DataSet.EnableControls;
          end;
        end;
    end;
end;

//------------------------------------------------------------------------------

procedure TfrmMain.DISqlite3UniDirQueryInitFieldDef(
  const AColumn: TDISQLite3Column;
  const AFieldDef: TFieldDef);
begin
  case AFieldDef.DataType of
    {$IFNDEF COMPILER_5_UP}
    { TClientDataSet has problems assigning ftLargeInt (Int64) to a
      Variant, so scale it down to ftInteger. }
    ftLargeInt:
      begin
        AFieldDef.DataType := ftInteger;
      end;
    {$ENDIF !COMPILER_5_UP}
    ftWideString:
      begin
        {$IFNDEF COMPILER_5_UP}
        { TClientDataSet in D4 does not support WideStrings. The next
          line works around this problem by changing the ftWideString
          type to ftString. }
        AFieldDef.DataType := ftString;
        {$ENDIF !COMPILER_5_UP}
        { Increase the size for string fields from 20 (the default) to
          32. Depending on your data, you might add even more. }
        AFieldDef.Size := 32;
      end;
  end;
end;

//------------------------------------------------------------------------------

{ All database editing operations now take place on the level of the
  ClientDataSet. The ClientDataSet caches all changes and posts them back to
  TDISQLite3UniDirQuery by calling ClientDataSet.ApplyUpdates. }

procedure TfrmMain.btnPrev_Click(Sender: TObject);
begin
  ClientDataSet.Prior;
end;

procedure TfrmMain.btnNext_Click(Sender: TObject);
begin
  ClientDataSet.Next;
end;

procedure TfrmMain.btnInsert_Click(Sender: TObject);
begin
  ClientDataSet.Append;
end;

procedure TfrmMain.btnDelete_Click(Sender: TObject);
begin
  ClientDataSet.Delete;
end;

//------------------------------------------------------------------------------

{ Callback to update the GUI controls according to the state of the
  ClientDataSet. Again, all operations are on the ClientDataSet level only! }

procedure TfrmMain.ClientDataSet_Modified(DataSet: TDataSet);
var
  ChangesPending: Boolean;
begin
  btnDelete.Enabled :=
    not ClientDataSet.BOF or
    not ClientDataSet.EOF;

  ChangesPending := ClientDataSet.ChangeCount > 0;
  btnApplyUpdates.Enabled := ChangesPending;
  btnCancelUpdates.Enabled := ChangesPending;
  btnRefresh.Enabled := not ChangesPending;
  if ChangesPending then
    StatusBar.SimpleText := IntToStr(ClientDataSet.ChangeCount) + ' change(s) pending'
  else
    StatusBar.SimpleText := '';
end;

procedure TfrmMain.ClientDataSet_AfterScroll(DataSet: TDataSet);
begin
  btnPrev.Enabled := not ClientDataSet.BOF;
  btnNext.Enabled := not ClientDataSet.EOF;

  StatusBar.SimpleText := ClientDataSet.FieldByName('Name').AsString;
end;

//------------------------------------------------------------------------------

{ The ClientDataSet acts as an intermediate data buffer and caches all user
  changes. Not data is written to the TDISQLite3UniDirQuery until either
  ClientDataSet.ApplyUpdates or ClientDataSet.CancelUpdates is called.

  ClientDataSet.ApplyUpdates tries to flush out any pending updates to the
  TDISQLite3UniDirQuery.

  ClientDataSet.CancelUpdates just cancels any updates, nothing is written
  to TDISQLite3UniDirQuery. }

procedure TfrmMain.btnApplyUpdates_Click(Sender: TObject);
var
  i: Integer;
  s: string;
begin
  i := ClientDataSet.ApplyUpdates(-1);
  if i > 0 then
    begin
      s := IntToStr(i) + ' Error(s) during update';
    end
  else
    begin
      s :=
        'Update(s) OK!' +
        #13#10 + #13#10 +
        'Click [Refresh] to load data as saved.';
      FID := 0;
    end;
  ShowMessage(s);
  ClientDataSet_Modified(nil);
end;

procedure TfrmMain.btnCancelUpdates_Click(Sender: TObject);
begin
  ClientDataSet.CancelUpdates;
  ClientDataSet_Modified(nil);
  FID := 0;
end;

procedure TfrmMain.btnRefresh_Click(Sender: TObject);
begin
  ClientDataSet.Refresh;
end;

//------------------------------------------------------------------------------

procedure TfrmMain.btnFilter_Click(Sender: TObject);
begin
  OpenDatabase(edtFilter.Text);
end;

procedure TfrmMain.btnClearFilter_Click(Sender: TObject);
begin
  OpenDatabase('');
end;

//------------------------------------------------------------------------------

{ Security-check to prevent users closing the application with updates pending. }
procedure TfrmMain.Form_CloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := ClientDataSet.ChangeCount = 0;
  if not CanClose then
    ShowMessage('Update or cancel pending updates before closing!');
end;

end.

