unit uMetafile;

interface

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

var
  cMetafile, cMetafileCanvas: Tvalue;

function ap_cMetafile: Tvalue;
function ap_iMetafile(real: TMetafile; owner: Tvalue): Tvalue;
procedure Init_Metafile;

implementation

uses 
  Windows, 
  Classes, uDefUtils, uIntern, uAlloc, uProp, uPhi, uGraphic, 
  uCanvas, uConv;

function ap_cMetafile: Tvalue;
begin
  result := cMetafile;
end;

function Metafile_alloc(klass: Tvalue; real: TMetafile): Tvalue;
begin
  result := TmpAlloc(klass, real);
end;

function ap_iMetafile(real: TMetafile; owner: Tvalue): Tvalue;
begin
  result := Metafile_alloc(cMetafile, real);
  ap_owner(result, owner);
end;

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

  ap_obj_call_init(result, 0, nil);
end;

function Metafile_load(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMetafile;
  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 Metafile_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMetafile;
  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 Metafile_assign(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMetafile;
  source: TPersistent;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TPersistent, source);
  real.Assign(source);
  result := v;
end;

function ap_zombie(obj: Tvalue): Tvalue; cdecl;
begin
  PRData(obj)^.data := nil;
  result := Qnil;
end;

function ap_zombie_iv(obj: Tvalue; name: PChar): Tvalue; cdecl;
var
  iv: Tvalue;
begin
  iv := rb_iv_get(obj, name);
  ap_zombie(iv);
  rb_iv_set(iv, '@owner', Qnil);
  rb_iv_set(obj, name, Qnil);
  result := Qnil;
end;

function Metafile_canvas(This: Tvalue): Tvalue; cdecl;
var
  real: TMetafile;
  canvas: TMetafileCanvas;
  obj: Tvalue;
begin
  real := ap_data_get_struct(This);
  canvas := TMetafileCanvas.Create(real, 0);
  obj := TmpAlloc(cMetafileCanvas, canvas);
  Canvas_setup(obj, canvas);
  ap_obj_call_init(obj, 0, nil);
  try
    result := rb_yield(obj);
  finally
    ap_zombie_iv(obj, '@font');
    ap_zombie_iv(obj, '@brush');
    ap_zombie_iv(obj, '@pen');
    ap_zombie(obj);
    canvas.free;
  end;
end;

// tk 2003-11-09
function Metafile_get_mm_width(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Integer(TMetafile(ap_data_get_struct(This)).MMWidth);
end;
function Metafile_set_mm_width(This,v: Tvalue): Tvalue; cdecl;
begin
  result := v;
  TMetafile(ap_data_get_struct(This)).MMWidth := dl_Integer(v);
end;
function Metafile_get_mm_height(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_Integer(TMetafile(ap_data_get_struct(This)).MMHeight);
end;
function Metafile_set_mm_height(This,v: Tvalue): Tvalue; cdecl;
begin
  result := v;
  TMetafile(ap_data_get_struct(This)).MMHeight := dl_Integer(v);
end;

procedure Init_Metafile;
begin
  cMetafile := rb_define_class_under(mPhi, 'Metafile', cGraphic);
  OutputProp(cMetafile, TMetafile);

  rb_define_singleton_method(cMetafile, 'new', @Metafile_new, 0);
  rb_define_method(cMetafile, 'load', @Metafile_load, 1);
  rb_define_method(cMetafile, 'save', @Metafile_save, 1);
  rb_define_method(cMetafile, 'assign', @Metafile_assign, 1);

  cMetafileCanvas := rb_define_class_under(mPhi, 'MetafileCanvas', cCanvas);
  OutputProp(cMetafileCanvas, TMetafileCanvas);

  rb_define_method(cMetafile, 'canvas', @Metafile_canvas, 0);

  // tk 2003-11-09
  DefineAttrGet(cMetafile, 'mm_width', Metafile_get_mm_width);
  DefineAttrSet(cMetafile, 'mm_width', Metafile_set_mm_width);
  DefineAttrGet(cMetafile, 'mm_height', Metafile_get_mm_height);
  DefineAttrSet(cMetafile, 'mm_height', Metafile_set_mm_height);

end;

end.
