unit uPicture;

interface

uses
  Windows,  // HPALETTE , Windows must be before Graphics
{$IFDEF VCL}
  Graphics,
{$ELSE}
  QGraphics,
{$ENDIF}
  Rubies;

var
  cPicture: Tvalue;

function ap_cPicture: Tvalue;
function ap_iPicture(real: TPicture; owner: Tvalue): Tvalue;
procedure Init_Picture;

implementation

uses
  Classes,
  uConv, uGraphic, uDefUtils, uIntern, uAlloc, uProp, uPhi, uBitmap,
{$IFDEF VCL}
  uMetafile,
{$ENDIF}
  uIcon;

function ap_cPicture: Tvalue;
begin
  result := cPicture;
end;

function Picture_alloc(This: Tvalue; real: TPicture): Tvalue;
begin
  result := TmpAlloc(This, real);
end;

function ap_iPicture(real: TPicture; owner: Tvalue): Tvalue;
begin
  result := Picture_alloc(cPicture, real);
  ap_owner(result, owner);
end;

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

  ap_obj_call_init(result, 0, nil);
end;

function Picture_load(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
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);
      on E: EInvalidGraphic do
        ap_raise(ap_eIOError, E.message);
    end;
  end;
  result := This;
end;

function Picture_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
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;
  end;
  result := This;
end;

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

function Picture_get_bitmap(This: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
begin
  real := ap_data_get_struct(This);
  result := ap_iBitmap(real.Bitmap, This);
end;

function Picture_set_bitmap(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
  bitmap: TBitmap;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TBitmap, bitmap);
  real.Bitmap := bitmap;
  result := v;
end;

function Picture_get_icon(This: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
begin
  real := ap_data_get_struct(This);
  result := ap_iIcon(real.Icon, This);
end;

function Picture_set_icon(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
  icon: TIcon;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TIcon, icon);
  real.Icon := icon;
  result := v;
end;

{$IFDEF VCL}
function Picture_get_metafile(This: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
begin
  real := ap_data_get_struct(This);
  result := ap_iMetafile(real.Metafile, This);
end;

function Picture_set_metafile(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
  metafile: TMetafile;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TMetafile, metafile);
  real.Metafile := metafile;
  result := v;
end;
{$ENDIF}

function Picture_get_graphic(This: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
  graphic: TGraphic;
begin
  real := ap_data_get_struct(This);
  result := This;
  graphic := real.Graphic;
  if graphic is TBitmap then
    result := ap_iBitmap(real.Bitmap, This)
  else
  if graphic is TIcon then
    result := ap_iIcon(real.Icon, This)
{$IFDEF VCL}
  else
  if real.Graphic is TMetafile then
    result := ap_iMetafile(real.Metafile, This)
{$ENDIF}
  else
    result := ap_iGraphic(real.Graphic, This) //++??
  ;
end;

function Picture_set_graphic(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
  graphic: TGraphic;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TGraphic, graphic);
  real.Graphic := graphic;
  result := v;
end;

function Picture_get_width(This: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.Width);
end;

function Picture_get_height(This: Tvalue): Tvalue; cdecl;
var
  real: TPicture;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.Height);
end;

procedure Init_Picture;
begin
  cPicture := rb_define_class_under(mPhi, 'Picture', ap_cObject);
  OutputProp(cPicture, TPicture);

  rb_define_singleton_method(cPicture, 'new', @Picture_new, 0);
  rb_define_method(cPicture, 'load', @Picture_load, 1);
  rb_define_method(cPicture, 'save', @Picture_save, 1);
  rb_define_method(cPicture, 'assign', @Picture_assign, 1);
  DefineAttrGet(cPicture, 'bitmap', Picture_get_bitmap);
  DefineAttrSet(cPicture, 'bitmap', Picture_set_bitmap);
  DefineAttrGet(cPicture, 'icon', Picture_get_icon);
  DefineAttrSet(cPicture, 'icon', Picture_set_icon);
{$IFDEF VCL}
  DefineAttrGet(cPicture, 'metafile', @Picture_get_metafile);
  DefineAttrSet(cPicture, 'metafile', @Picture_set_metafile);
{$ENDIF}
  DefineAttrGet(cPicture, 'graphic', Picture_get_graphic);
  DefineAttrSet(cPicture, 'graphic', Picture_set_graphic);
  DefineAttrGet(cPicture, 'width',  Picture_get_width);
  DefineAttrGet(cPicture, 'height', Picture_get_height);
end;

end.
