unit FRM_ArrayTest;

{$I IB_Directives.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IB_Components, IB_Session, StdCtrls, IB_Process, IB_Script,
  ExtCtrls, ComCtrls, Grids, IB_Samples,
{$ifdef IBO_VCL60_OR_GREATER}
  Variants,
{$endif}
  IB_ArrayGrid;

type
  TMainForm = class(TForm)
    qr: TIB_Query;
    db: TIB_Database;
    sc: TIB_Script;
    PageControl1: TPageControl;
    tsInstructions: TTabSheet;
    Memo1: TMemo;
    Panel1: TPanel;
    WriteArray: TButton;
    ReadArray: TButton;
    Button1: TButton;
    Button2: TButton;
    tsPricesArray: TTabSheet;
    IB_ArrayGrid1: TIB_ArrayGrid;
    ds: TIB_DataSource;
    tsCostsArray: TTabSheet;
    tsAttribArray: TTabSheet;
    IB_ArrayGrid2: TIB_ArrayGrid;
    IB_ArrayGrid3: TIB_ArrayGrid;
    procedure FormShow(Sender: TObject);
    procedure WriteArrayClick(Sender: TObject);
    procedure ReadArray1Click(Sender: TObject);
    procedure ReadArray2Click(Sender: TObject);
    procedure ReadArray3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure dbAfterConnect(Sender: TIB_Connection);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses
  Registry, IB_Utils;

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  ReadDefaultPath(db,'EmployeePath');
end;

procedure TMainForm.dbAfterConnect(Sender: TIB_Connection);
begin
  WriteDefaultPath;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  try
    qr.Open;
  except
    on E: Exception do
    begin
      if Pos( 'table unknown', LowerCase( E.Message )) > 0 then
      begin
        sc.SQL.Assign( Memo1.Lines );
        sc.Execute;
        qr.Open;
      end
      else
      begin
        MessageDlg( E.Message, mtInformation, [mbOk], 0 );
        Application.Terminate;
      end;
    end;
  end;
end;

procedure TMainForm.WriteArrayClick(Sender: TObject);
var
  TmpPrices, TmpCosts, TmpAttrib: variant;
  N, K: Integer;
begin
  qr.Open;
  TmpPrices := vararraycreate( [1,196,1,14], VarVariant );
  TmpCosts  := vararraycreate( [1,196,1,12], VarVariant );
  TmpAttrib := vararraycreate( [1,196,1, 7], VarVariant );
  for K := 1 to 196 do for N := 1 to 14 do
    TmpPrices[K,N] := K * N;
  for K := 1 to 196 do for N := 1 to 12 do
    TmpCosts[K,N] := N * K;
  for K := 1 to 196 do for N := 1 to 7 do
    TmpAttrib[K,N] := IntToStr( K * N );
  if qr.Locate('ID', 1, []) then
    qr.Edit
  else
    qr.Insert;
  qr['ID'] := 1;
  qr['Updated'] := Now;
  qr['Prices'] := TmpPrices;
  qr['Costs'] := TmpCosts;
  qr['Attrib'] := TmpAttrib;
  qr.Post;
  qr.Refresh;
end;

procedure TMainForm.ReadArray1Click(Sender: TObject);
var
  TmpPrices: variant;
begin
  TmpPrices := qr['Prices'];
end;

procedure TMainForm.ReadArray2Click(Sender: TObject);
var
  TmpArray: TIB_ColumnArray;
  TmpPrices: array[1..196, 1..14] of double;
  TmpSize: LongInt;
  I,J: Integer;
begin
  for I := 1 to 196 do for J := 1 to 14 do TmpPrices[I,J] := 0.0;
  TmpSize := sizeof(TmpPrices);
  TmpArray := qr.Fieldbyname('Prices') as TIB_ColumnArray;
  TmpArray.GetArray( @TmpPrices, @TmpSize );
end;

procedure TMainForm.ReadArray3Click(Sender: TObject);
var
  TmpPrices: variant;
  TmpArray: TIB_ColumnArray;
begin
  TmpArray := qr.Fieldbyname('Prices') as TIB_ColumnArray;
  TmpPrices := TmpArray.GetVarSlice([10, 196, 10, 14]);
end;

end.
