unit uShape;

interface

uses
{$IFDEF VCL}
  ExtCtrls,
{$ELSE}
  QExtCtrls,
{$ENDIF}
  Rubies;

var
  cShape: Tvalue;

function ap_cShape: Tvalue;
function ap_iShape(real: TShape; owner: Tvalue): Tvalue;
procedure Init_Shape;

implementation

uses
  Classes,
{$IFDEF VCL}
  Graphics,
{$ELSE}
  QGraphics,
{$ENDIF}
  uDefUtils, uIntern, uHandle, uAlloc, uProp, uSizeConstraints,
  uPersistent, uComponent, uControl, uBrush, uPen, uPhi;

function ap_cShape: Tvalue;
begin
  result := cShape;
end;

procedure Shape_setup(obj: Tvalue; real: TShape);
begin
  rb_iv_set(obj, '@brush', ap_iBrush(real.Brush, obj));
  rb_iv_set(obj, '@pen', ap_iPen(real.Pen, obj));
end;

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

function Shape_alloc(This: Tvalue; real: TShape): Tvalue;
begin
  result := TmpAlloc(This, real);
  Shape_setup(result, real);
end;

function ap_iShape(real: TShape; owner: Tvalue): Tvalue;
begin
  result := Shape_alloc(cShape, real);
  ap_owner(result, owner);
end;

function ap_iShape_v(var AControl; owner: Tvalue): Tvalue;
begin
  result := ap_iShape(TShape(AControl), owner);
end;

function Shape_allocate(This: Tvalue): Tvalue; cdecl;
var
  real: TShape;
begin
  real := TShape.Create(nil);
  result := CompoAlloc(This, real);
  Shape_setup(result, real);
end;

procedure Init_Shape;
begin
  OutputConstSetType(mPhi, TypeInfo(TShapeType));
  cShape := OutputPersistentClass(mPhi, TShape, cControl, ap_iShape_v);
  rb_define_method(cShape, 'event_handle', @Shape_event_handle, 1);
  rb_define_alloc_func(cShape, @Shape_allocate);
end;

end.
