unit uTreeView;

interface

uses
{$IFDEF VCL}
  ComCtrls,
{$ELSE}
  QComCtrls,
{$ENDIF}
  Rubies, uConv;

var
  cTreeView: Tvalue;

function ap_cTreeView: Tvalue;
function ap_iTreeView(real: TTreeView; owner: Tvalue): Tvalue;
procedure Init_TreeView;

implementation

uses
  SysUtils, Classes,
  uDefUtils, uIntern, uHandle, uAlloc, uProp, uPhi, uIO,
  uSizeConstraints, uCanvas, uFont, uTreeNode,
  uPersistent, uComponent, uControl;

function ap_cTreeView: Tvalue;
begin
  result := cTreeView;
end;

procedure TreeView_setup(obj: Tvalue; real: TTreeView);
begin
{$IFDEF VCL}
  rb_iv_set(obj, '@canvas', ap_iCanvas(real.Canvas, obj));
{$ENDIF}
  rb_iv_set(obj, '@font', ap_iFont(real.Font, obj));
  rb_iv_set(obj, '@items', ap_iTreeNodes(real.Items, obj));
//    AssignPropMethod(real, [Handle]);
end;

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

function TreeView_alloc(This: Tvalue; real: TTreeView): Tvalue;
begin
  result := ChildAlloc(This, real);
  TreeView_setup(result, real);
end;

function ap_iTreeView(real: TTreeView; owner: Tvalue): Tvalue;
begin
  result := TreeView_alloc(cTreeView, real);
  ap_owner(result, owner);
end;

function ap_iTreeView_v(var AControl; owner: Tvalue): Tvalue;
begin
  result := ap_iTreeView(TTreeView(AControl), owner);
end;

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

function TreeView_load(This, v: Tvalue): Tvalue; cdecl;
var
  real: TTreeView;
  stream: TStream;
begin
  real := ap_data_get_struct(This);
  case RTYPE(v) of
  T_STRING:
    try
      real.LoadFromFile(dl_String(v));
    except
      on E: EFOpenError do
        ap_raise(ap_eIOError, E.message);
    end;
  T_DATA:
    begin
      ap_data_get_object(v, TStream, stream);
      real.LoadFromStream(stream);
    end;
  end;
  rb_iv_set(This, '@items', ap_iTreeNodes(real.Items, This));
  result := This;
end;

function TreeView_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TTreeView;
  stream: TStream;
begin
  real := ap_data_get_struct(This);
  case RTYPE(v) of
  T_STRING:
    real.SaveToFile(dl_String(v));
  T_DATA:
  begin
    ap_data_get_object(v, TStream, stream);
    real.SaveToStream(stream);
  end;
  end;
  result := v;
end;

function TreeView_get_selected(This: Tvalue): Tvalue; cdecl;
var
  real: TTreeView;
  node: TTreeNode;
begin
  real := ap_data_get_struct(This);
  node := real.Selected;
  if node = nil then
    result := Qnil
  else
    result := ap_TreeNode(node);
  ;
end;

function TreeView_set_selected(This, v: Tvalue): Tvalue; cdecl;
var
  real: TTreeView;
  node: TTreeNode;
begin
  real := ap_data_get_struct(This);
  node := dl_TreeNode(v);
  real.Selected := node;
  result := v;
end;

function TreeView_get_node_at(This, x, y: Tvalue): Tvalue; cdecl;
var
  real: TTreeView;
  node: TTreeNode;
begin
  real := ap_data_get_struct(This);
  node := real.GetNodeAt(FIX2INT(x), FIX2INT(y));
  if node = nil then
    result := Qnil
  else
    result := ap_TreeNode(node);
end;

function TreeView_full_expand(This: Tvalue): Tvalue; cdecl;
var
  real: TTreeView;
begin
  real := ap_data_get_struct(This);
  real.FullExpand;
  result := This;
end;

function TreeView_full_collapse(This: Tvalue): Tvalue; cdecl;
var
  real: TTreeView;
begin
  real := ap_data_get_struct(This);
  real.FullCollapse;
  result := This;
end;

{$IFDEF VCL}
function TreeView_get_hit_test_info_at(This, x, y: Tvalue): Tvalue; cdecl;
var
  real: TTreeView;
  ht: THitTests;
begin
  real := ap_data_get_struct(This);
  ht := real.GetHitTestInfoAt(FIX2INT(x), FIX2INT(y));
  result := ap_Set(ht);
end;
{$ENDIF}

procedure Init_TreeView;
begin
{$IFDEF VCL}
  OutputConstSetType(mPhi, TypeInfo(THitTest));
{$ENDIF}

  cTreeView := OutputPersistentClass(mPhi, TTreeView, cWinControl, ap_iTreeView_v);
  rb_define_method(cTreeView, 'event_handle', @TreeView_event_handle, 1);
  DefineSingletonMethod(cTreeView, 'new', TreeView_new);
  rb_define_method(cTreeView, 'load', @TreeView_load, 1);
  rb_define_method(cTreeView, 'save', @TreeView_save, 1);
  DefineAttrGet(cTreeView, 'selected', TreeView_get_selected);
  DefineAttrSet(cTreeView, 'selected', TreeView_set_selected);
  rb_define_method(cTreeView, 'get_node_at', @TreeView_get_node_at, 2);
  rb_define_method(cTreeView, 'full_expand', @TreeView_full_expand, 0);
  rb_define_method(cTreeView, 'full_collapse', @TreeView_full_collapse, 0);
{$IFDEF VCL}
  rb_define_method(cTreeView, 'get_hit_test_info_at', @TreeView_get_hit_test_info_at, 2);
{$ENDIF}
  rb_define_attr(cTreeView, 'canvas', 1, 0);
  rb_define_attr(cTreeView, 'font', 1, 0);
  rb_define_attr(cTreeView, 'items', 1, 0);
end;

end.
