{*******************************************************}
{                                                       }
{        Midas RemoteDataModule Pooler Demo             }
{                                                       }
{*******************************************************}

unit clntfrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBClient, Db, Grids, DBGrids, StdCtrls, MConnect, Variants;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    DBGrid1: TDBGrid;
    ClientDataSet1: TClientDataSet;
    RemoteServer1: TDCOMConnection;
    DataSource1: TDataSource;
//    CDSClone: TClientDataSet;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Button4: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure ClientDataSet1BeforeGetRecords(Sender: TObject;
      var OwnerData: OleVariant);
    procedure Button2Click(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure CheckButtonActive(DataSet: TDataSet);
    procedure Button3Click(Sender: TObject);
    procedure RemoteServer1BeforeDisconnect(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure ClientDataSet1BeforeGetParams(Sender: TObject;
      var OwnerData: OleVariant);
    procedure ClientDataSet1AfterGetParams(Sender: TObject;
      var OwnerData: OleVariant);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{
Build the group project to generate server.exe and client.exe.
Run the server first by selecting server.exe and Run Without
Debugging, or execute server.exe outside of Delphi.  Then run
client.exe.  Click "Run SQL" first, then "GetNextPacket".
}

procedure TForm1.ClientDataSet1AfterGetParams(Sender: TObject;
  var OwnerData: OleVariant);
begin
//  ListBox1.Items.Add('AfterGetParams called');
end;

procedure TForm1.ClientDataSet1BeforeGetParams(Sender: TObject;
  var OwnerData: OleVariant);
begin
//  ListBox1.Items.Add('BeforeGetParams called');
end;

procedure TForm1.ClientDataSet1BeforeGetRecords(Sender: TObject; var OwnerData: OleVariant);
var
  LastValue: OleVariant;
  CDSClone: TClientDataSet;
begin
  if ClientDataSet1.Active then
  begin
    CDSClone := TClientDataSet.Create(Form1);
    try
      CDSClone.CloneCursor(ClientDataSet1, True);
      { turn off FetchOnDemand so that the clone only fetches
        the last LOCAL record }
      CDSClone.FetchOnDemand := False;
      CDSClone.Last;
      LastValue := CDSClone.Fields[0].AsString;
      CDSClone.Close;
    finally
      CDSClone.Free;
    end;
  end else
    LastValue := NULL;
  OwnerData := VarArrayOf([Memo1.Lines.Text, LastValue]);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ClientDataSet1.PacketRecords := StrToInt(Edit1.Text);
  ClientDataSet1.GetNextPacket;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  if not RemoteServer1.Connected then
    RemoteServer1.Connected := True;
  ClientDataSet1.Close;
  with RemoteServer1 do
  begin
    for I := 0 to DataSetCount - 1 do
      DataSets[I].EnableControls;
  end;
  ClientDataSet1.Open;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  I: Integer;
begin
  ClientDataSet1.Close;
  RemoteServer1.Connected := False;
  with RemoteServer1 do
  begin
    for I := 0 to DataSetCount - 1 do
      DataSets[I].DisableControls;
  end;
end;

// BeginExample: FetchPooler
// Mathod: DBClient.TCustomClientDataSet.FetchParams
// Property: DBClient.TCustomClientDataSet.Params
// Property: DB.TParams.Items
// Property: DB.TParam.DataType
// Property: DB.TParam.AsBCD
// Property: DB.TParam.AsBoolean
// Property: DB.TParam.AsCurrency
// Property: DB.TParam.AsDate
// Property: DB.TParam.AsDateTime
// Property: DB.TParam.AsFloat
// Property: DB.TParam.AsInteger
// Property: DB.TParam.AsSmallInt
// Property: DB.TParam.AsString
// Property: DB.TParam.AsTime
// Property: DB.TParam.AsWord

// BeginCode
{
This example fills in the parameters of a client dataset
from the entries of a list box.
} 
procedure TForm1.Button4Click(Sender: TObject);
var
  I: Integer;
  ListItem: string;
begin
  { Call FetchParams to ensure parameters reflect server metadata }
  ClientDataSet1.FetchParams;
  with ClientDataSet1.Params do
  begin
    for I := 0 to Count - 1 do
    begin
      ListItem := ListBox1.Items[I];
      case Items[I].DataType of
        ftString:
          Items[I].AsString := ListItem;
        ftSmallInt:
          Items[I].AsSmallInt := StrToIntDef(ListItem, 0);
        ftInteger:
          Items[I].AsInteger := StrToIntDef(ListItem, 0);
        ftWord:
          Items[I].AsWord := StrToIntDef(ListItem, 0);
        ftBoolean:
          begin
            if ListItem = 'True' then
              Items[I].AsBoolean := True
            else
              Items[I].AsBoolean := False;
          end;
        ftFloat:
          Items[I].AsFloat := StrToFloat(ListItem);
        ftCurrency:
          Items[I].AsCurrency := StrToFloat(ListItem);
        ftBCD:
          Items[I].AsBCD := StrToCurr(ListItem);
        ftDate:
          Items[I].AsDate := StrToDate(ListItem);
        ftTime:
          Items[I].AsTime := StrToTime(ListItem);
        ftDateTime:
          Items[I].AsDateTime := StrToDateTime(ListItem);
      end;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Items.Add('Here is a string');
  ListBox1.Items.Add('4');
  ListBox1.Items.Add('3456789');
  ListBox1.Items.Add('34');
  ListBox1.Items.Add('0');
  ListBox1.Items.Add('12.56');
  ListBox1.Items.Add('4.23');
  ListBox1.Items.Add('99.5');
  ListBox1.Items.Add('4/12/53');
  ListBox1.Items.Add('7:45:00');
  ListBox1.Items.Add('4/12/53 7:45:00');

end;
// EndCode
// EndExample: FetchPooler

procedure TForm1.CheckButtonActive(DataSet: TDataSet);
begin
  Button1.Enabled := not ClientDataSet1.Active;
  Button2.Enabled := ClientDataSet1.Active;
  Button3.Enabled := ClientDataSet1.Active;
end;

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

procedure TForm1.RemoteServer1BeforeDisconnect(Sender: TObject);
begin
  if (ClientDataSet1.ChangeCount > 0) then 
    ClientDataSet1.ApplyUpdates(-1);
end;

end.
