unit uForm;

interface

uses Classes, DirectForm, Rubies, uDefUtils, Pythia, uDirect;

var
  cForm: Tvalue;

function dx_cForm: Tvalue;
function dx_iForm(real: TDirectForm; owner: Tvalue): Tvalue;
procedure Init_Form;

implementation

function dx_cForm: Tvalue;
begin
  result := cForm;
end;

procedure Form_setup(obj: Tvalue; real: TDirectForm);
var
  ceo: Tvalue;
begin
  rb_iv_set(obj, '@canvas', ap_iCanvas(real.Canvas, obj));
  rb_iv_set(obj, '@font', ap_iFont(real.Font, obj));
  rb_iv_set(obj, '@constraints', ap_iSizeConstraints(real.Constraints, obj));
  ceo := ap_vScreen;
  rb_iv_set(obj, '@parent', ceo);
//    AssignPropMethod(real, [PhiGetHandle]);
end;

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

function Form_alloc(This: Tvalue; real: TDirectForm): Tvalue;
begin
  result := ChildAlloc(This, real);
  Form_setup(result, real);
end;

function dx_iForm(real: TDirectForm; owner: Tvalue): Tvalue;
begin
  result := Form_alloc(cForm, real);
  ap_owner(result, owner);
end;

function dx_iForm_v(var AControl; owner: Tvalue): Tvalue;
begin
  result := dx_iForm(TDirectForm(AControl), owner)
end;

procedure FormSetParent(real: TDirectForm; name: string);
var
  obj, ceo: Tvalue;
begin
  obj := real.tag;
  ceo := ap_vScreen; // rb_iv_get(obj, '@parent');
  rb_iv_set(ceo, PChar('@'+name), obj);
  rb_define_attr(rb_singleton_class(ceo), PChar(name), 1, 0);
  real.name := name;
end;

function Form_new(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TDirectForm;
  args: array of Tvalue;
begin
  SetLength(args, argc);
  args := argv;

  real := TDirectForm.Create(nil);
  real.width  := 320;
  real.height := 200;
//  real.left := (Screen.width  - real.width ) div 2;
//  real.top  := (Screen.height - real.height) div 2;

  result := FormAlloc(This, real);
  Form_setup(result, real);

  if argc > 0 then
    FormSetParent(real, dl_caption(args[0]));

  if argc > 1 then
    rb_funcall2(result, rb_intern('caption='), 1, @args[1]);

  ap_obj_call_init(result, argc, argv);
end;

procedure Init_Form;
begin
  RegisterClass(TDirectForm);
  PhiAllocFuncList.AddObject('TDirectForm', @dx_iForm_v);
  cForm := rb_define_class_under(mDirect, 'Form', ap_cForm);
  DefineProp(cForm, TDirectForm);
  rb_define_method(cForm, 'event_handle', @Form_event_handle, 1);
  DefineSingletonMethod(cForm, 'new', Form_new);
end;

exports
  dx_cForm,
  dx_iForm;

end.
