unit uColumn;

interface

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

var
  cColumn, cColumns: Tvalue;
  cColumnTitle: Tvalue;            //++

function ap_cColumn: Tvalue;
function ap_cColumnTitle: Tvalue;  //++
function ap_iColumn(real: TColumn; owner: Tvalue): Tvalue;
function ap_iColumns(real: TDBGridColumns; owner: Tvalue): Tvalue;
procedure Init_Column;

implementation

uses Classes, uDefUtils, Pythia, uRDB, uField;

function ap_cColumnTitle: Tvalue;
begin
  result := cColumnTitle;
end;

procedure ColumnTitle_setup(obj: Tvalue; real: TColumnTitle);
begin
  rb_iv_set(obj, '@alignment', rb_int2inum(ord(real.Alignment)));
  rb_iv_set(obj, '@caption', ap_String(real.Caption));
  rb_iv_set(obj, '@color', rb_int2inum(real.Color));
  rb_iv_set(obj, '@font', ap_iFont(real.Font, obj));
//rb_iv_set(obj, '@column', rb_iv_get(obj, '@owner'));
end;

function ColumnTitle_alloc(This: Tvalue; real: TColumnTitle): Tvalue;
begin
  result := TmpAlloc(This, real);
  ColumnTitle_setup(result, real);
end;

function ap_iColumnTitle(real: TColumnTitle; owner: Tvalue): Tvalue;
begin
  result := ColumnTitle_alloc(cColumnTitle, real);
  ap_owner(result, owner);
  rb_iv_set(result, '@column', owner);
end;

function ap_iColumnTitle_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iColumnTitle(TColumnTitle(obj), owner)
end;

function ap_cColumn: Tvalue;
begin
  result := cColumn;
end;

procedure Column_setup(obj: Tvalue; real: TColumn);
begin
  rb_iv_set(obj, '@field', ap_iField(real.Field, obj));
  rb_iv_set(obj, '@font', ap_iFont(real.Font, obj));
  rb_iv_set(obj, '@title', ap_iColumnTitle(real.Title, obj));
  rb_iv_set(obj, '@pick_list', ap_iStrings(real.PickList, obj));
end;

function Column_alloc(This: Tvalue; real: TColumn): Tvalue;
begin
  result := TmpAlloc(This, real);
  Column_setup(result, real);
end;

function ap_iColumn(real: TColumn; owner: Tvalue): Tvalue;
begin
  result := Column_alloc(cColumn, real);
  ap_owner(result, owner);
end;

function ap_iColumn_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iColumn(TColumn(obj), owner)
end;

procedure Columns_setup(obj: Tvalue; real: TDBGridColumns);
begin
  Collection_setup(obj, real);
end;

function Columns_alloc(This: Tvalue; real: TDBGridColumns): Tvalue;
begin
  result := TmpAlloc(This, real);
  Columns_setup(result, real);
end;

function ap_iColumns(real: TDBGridColumns; owner: Tvalue): Tvalue;
begin
  result := Columns_alloc(cColumns, real);
  ap_owner(result, owner);
end;

function ap_iColumns_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iColumns(TDBGridColumns(obj), owner);
end;

function ColumnByName(real: TDBGridColumns; name: string): TColumn;
var
  n: Integer;
begin
  for n := 0 to real.Count-1 do
    if real[n].FieldName = name then
    begin
      result := real[n];
      exit
    end;
  result := nil;
end;

function Columns_aref(This, v: Tvalue): Tvalue; cdecl;
var
  real: TDBGridColumns;
  Column: TColumn;
  S: String;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  Column := nil;

  case RTYPE(v) of
  T_STRING:
    begin
      S := dl_String(v);
      Column := ColumnByName(real, S);
    end;
  T_FIXNUM:
    begin
      n := FIX2INT(v);
      if (n < 0) or (real.Count <= n) then
        ap_raise(ap_eIndexError, sOut_of_range);
      Column := real[n];
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  if Column = nil then
    result := Qnil
  else
    result := Collection_aref(This, ap_Fixnum(Column.Index));
end;

procedure Init_Column;
begin
  cColumnTitle := DefinePersistentClass(mRDB, TColumnTitle, ap_cCollectionItem, ap_iColumnTitle_v);
//Alignment
//Caption
//Color
//Column
//Font
  rb_define_attr(cColumnTitle, 'alignment', 1, 0);
  rb_define_attr(cColumnTitle, 'caption', 1, 0);
  rb_define_attr(cColumnTitle, 'color', 1, 0);
  rb_define_attr(cColumnTitle, 'column', 1, 0);  //??
  rb_define_attr(cColumnTitle, 'font', 1, 0);

  cColumn := DefinePersistentClass(mRDB, TColumn, ap_cCollectionItem, ap_iColumn_v);
  rb_define_attr(cColumn, 'field', 1, 0);
  rb_define_attr(cColumn, 'font', 1, 0);

  cColumns := DefinePersistentClass(mRDB, TDBGridColumns, ap_cCollection, ap_iColumns_v);
  SetCollectionItemClass(cColumns, 'TColumn');
  rb_define_method(cColumns, '[]', @Columns_aref, 1);

  DefineConstSetType(mRDB, TypeInfo(TColumnButtonStyle));
end;

exports
  ap_iColumn;

end.
