unit uIcon;

interface

uses
  Classes,
{$IFDEF VCL}
  Graphics,
{$ELSE}
  QGraphics,
{$ENDIF}
  Rubies;

var
  cIcon: Tvalue;

function ap_cIcon: Tvalue;
function ap_iIcon(real: TIcon; owner: Tvalue): Tvalue;
procedure Init_Icon;

implementation

uses uConv, uDefUtils, uIntern, uAlloc, uProp, uPhi, uGraphic;

function ap_cIcon: Tvalue;
begin
  result := cIcon;
end;

function Icon_alloc(klass: Tvalue; real: TIcon): Tvalue;
begin
  result := TmpAlloc(klass, real);
end;

function ap_iIcon(real: TIcon; owner: Tvalue): Tvalue;
begin
  result := Icon_alloc(cIcon, real);
  ap_owner(result, owner);
end;

function Icon_new(This: Tvalue): Tvalue; cdecl;
var
  real: TIcon;
begin
  real := TIcon.Create;
  result := ObjAlloc(This, real);

  ap_obj_call_init(result, 0, nil);
end;

function Icon_load(This, v: Tvalue): Tvalue; cdecl;
var
  real: TIcon;
  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:
    try
      ap_data_get_object(v, TStream, stream);
      real.LoadFromStream(stream);
    except
      on E: EReadError do;
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  result := This;
end;

function Icon_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TIcon;
  stream: TStream;
begin
  real := ap_data_get_struct(This);
  case RTYPE(v) of
  T_STRING:
    try
      real.SaveToFile(dl_String(v));
    except
      on E: EFCreateError do
        ap_raise(ap_eIOError, E.message);
    end;
  T_DATA:
    try
      ap_data_get_object(v, TStream, stream);
      real.SaveToStream(stream);
    except
      on E: EWriteError do;
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  result := v;
end;

function Icon_assign(This, v: Tvalue): Tvalue; cdecl;
var
  real: TIcon;
  source: TPersistent;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TPersistent, source);
  real.Assign(source);
  result := v;
end;

procedure Init_Icon;
begin
  cIcon := rb_define_class_under(mPhi, 'Icon', ap_cGraphic);
  OutputProp(cIcon, TIcon);

  rb_define_singleton_method(cIcon, 'new', @Icon_new, 0);
  rb_define_method(cIcon, 'load', @Icon_load, 1);
  rb_define_method(cIcon, 'save', @Icon_save, 1);
  rb_define_method(cIcon, 'assign', @Icon_assign, 1);
end;

end.
