unit uDBGrid;

interface

uses
  DB,
{$IFDEF VCL}
  DBGrids,
{$ELSE}
  QDBGrids,
{$ENDIF}
  Rubies;

type
  TPhi_DBGrid = class(TDBGrid)
  published
    property OnMouseWheel;
    property OnMouseWheelUp;
    property OnMouseWheelDown;
  end;

var
  cDBGrid: Tvalue;

function ap_iDBGrid(real: TPhi_DBGrid; owner: Tvalue): Tvalue;
procedure Init_DBGrid;

implementation

uses
  SysUtils,
{$IFDEF VCL}
  StdCtrls,
{$ELSE}
  QStdCtrls,
{$ENDIF}
  uDefUtils, Pythia, uRDB, uColumn, uField;

procedure DBGrid_setup(obj: Tvalue; real: TPhi_DBGrid);
begin
//  rb_iv_set(obj, '@columns', ap_iColumns(real.Columns, obj));
  rb_iv_set(obj, '@canvas', ap_iCanvas(real.Canvas, obj));
  rb_iv_set(obj, '@font', ap_iFont(real.Font, obj));
  rb_iv_set(obj, '@title_font', ap_iFont(real.TitleFont, obj));
  rb_iv_set(obj, '@constraints', ap_iSizeConstraints(real.constraints, obj));
//    AssignPropMethod(real, [Handle, PhiGetHandle]);
end;

function DBGrid_event_handle(This, name: Tvalue): Tvalue; cdecl;
begin
  EventHandle(This, name, [Handle, PhiGetHandle]);
  result := Qnil;
end;

function DBGrid_alloc(This: Tvalue; real: TPhi_DBGrid): Tvalue;
begin
  result := ChildAlloc(This, real);
  DBGrid_setup(result, real);
  ap_obj_call_init(result, 0, nil);
end;

function ap_iDBGrid(real: TPhi_DBGrid; owner: Tvalue): Tvalue;
begin
  result := DBGrid_alloc(cDBGrid, real);
  ap_owner(result, owner);
end;

function ap_iDBGrid_v(var AControl; owner: Tvalue): Tvalue;
begin
  result := ap_iDBGrid(TPhi_DBGrid(AControl), owner)
end;

function DBGrid_new(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  real := TPhi_DBGrid.Create(nil);
  result := CompoAlloc(This, real);
  CompoSetup(argc, argv, real);
  DBGrid_setup(result, real);
  ap_obj_call_init(result, argc, argv);
end;

function DBGrid_get_columns(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  real := ap_data_get_struct(This);
  result := ap_iColumns(real.Columns, This);
end;

function DBGrid_set_data_source(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
  DataSource: TDataSource;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TDataSource, DataSource);
  real.DataSource := DataSource;
  rb_iv_set(This, '@data_source', v);
  result := v;
end;

function DBGrid_get_field_count(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.FieldCount);
end;

function DBGrid_get_fields(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
  i:integer;
begin
  real := ap_data_get_struct(This);
  result := rb_ary_new;
  try
    for i := 0 to real.FieldCount-1 do
    begin
      rb_ary_push(result, ap_iField(real.Fields[i], This));
    end;
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
end;

function DBGrid_get_selected_field(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  result := Qnil;
  real := ap_data_get_struct(This);
  try
    result := ap_iField(real.SelectedField, This);
  except
    on E: Exception do
      ap_raise(ap_eDatabaseError, E.message);
  end;
end;

function DBGrid_get_left_col(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.LeftCol);
end;

function DBGrid_set_left_col(This,v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  real := ap_data_get_struct(This);
  result := v;
  real.LeftCol := dl_Integer(v);
end;

function DBGrid_get_scroll_bars(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(ord(real.ScrollBars));
end;

function DBGrid_set_scroll_bars(This,v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  real := ap_data_get_struct(This);
  try
    real.ScrollBars := TScrollStyle(dl_Integer(v));
  except
    ap_raise(ap_eArgError, sOut_of_range);
  end;
  result := v;
end;

function DBGrid_get_selected_index(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(ord(real.SelectedIndex));
end;

function DBGrid_set_selected_index(This,v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_DBGrid;
begin
  real := ap_data_get_struct(This);
  try
    real.SelectedIndex := dl_Integer(v);
  except
    ap_raise(ap_eArgError, sOut_of_range);
  end;
  result := v;
end;

procedure Init_DBGrid;
begin
  DefineConstSetType(mRDB, TypeInfo(TDBGridOption));

  cDBGrid := DefinePersistentClass(mRDB, TPhi_DBGrid, ap_cCustomGrid, ap_iDBGrid_v);
  rb_define_method(cDBGrid, 'event_handle', @DBGrid_event_handle, 1);
  DefineSingletonMethod(cDBGrid, 'new', DBGrid_new);
  DefineAttrGet(cDBGrid, 'columns', DBGrid_get_columns);
  DefineAttrSet(cDBGrid, 'data_source', DBGrid_set_data_source);
  DefineAttrGet(cDBGrid, 'field_count', DBGrid_get_field_count);
  DefineAttrGet(cDBGrid, 'fields', DBGrid_get_fields);
  DefineAttrGet(cDBGrid, 'selected_field', DBGrid_get_selected_field);
//  rb_define_attr(cDBGrid, 'columns', 1, 0);
  rb_define_attr(cDBGrid, 'canvas', 1, 0);
//  rb_define_attr(cDBGrid, 'font', 1, 0);
  DefineAttrGet(cDBGrid, 'left_col', DBGrid_get_left_col);
  DefineAttrSet(cDBGrid, 'left_col', DBGrid_set_left_col);
  DefineAttrGet(cDBGrid, 'scroll_bars', DBGrid_get_scroll_bars);
  DefineAttrSet(cDBGrid, 'scroll_bars', DBGrid_set_scroll_bars);
  DefineAttrGet(cDBGrid, 'selected_index', DBGrid_get_selected_index);
  DefineAttrSet(cDBGrid, 'selected_index', DBGrid_set_selected_index);
end;

end.
