unit uImage;

interface

uses
{$IFDEF VCL}
  Controls, ExtCtrls, Imglist,
{$ELSE}
  QControls, QExtCtrls, QImglist,
{$ENDIF}
  Rubies;

var
  cImage, cImageList: Tvalue;

function ap_cImage: Tvalue;
function ap_iImage(real: TImage; owner: Tvalue): Tvalue;
function ap_cImageList: Tvalue;
procedure Init_Image;

implementation

uses
  Classes,
{$IFDEF VCL}
  Graphics,
{$ELSE}
  QGraphics,
{$ENDIF}
  uDefUtils, uIntern, uHandle, uAlloc, uProp, uPhi,
  uSizeConstraints, uCanvas,
  uPersistent, uComponent, uControl, uPicture, uIcon, uBitmap;

function ap_cImage: Tvalue;
begin
  result := cImage;
end;

procedure Image_setup(obj: Tvalue; real: TImage);
begin
  rb_iv_set(obj, '@picture', ap_iPicture(real.Picture, obj));
//    AssignPropMethod(real, [Handle]);
end;

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

function Image_alloc(klass: Tvalue; real: TImage): Tvalue;
begin
  result := CompoAlloc(klass, real);
  Image_setup(result, real);
end;

function ap_iImage(real: TImage; owner: Tvalue): Tvalue;
begin
  result := Image_alloc(cImage, real);
  ap_owner(result, owner);
end;

function ap_iImage_v(var AControl; owner: Tvalue): Tvalue;
begin
  result := ap_iImage(TImage(AControl), owner)
end;

function Image_allocate(This: Tvalue): Tvalue; cdecl;
var
  real: TImage;
begin
  real := TImage.Create(nil);
  result := CompoAlloc(This, real);
  Image_setup(result, real);
end;

function Image_get_canvas(This: Tvalue): Tvalue; cdecl;
var
  real: TImage;
begin
  real := ap_data_get_struct(This);
  if real.Canvas = nil then
    result := Qnil
  else
    result := ap_iCanvas(real.Canvas, This);
end;

function ap_cImageList: Tvalue;
begin
  result := cImageList;
end;

function ImageList_allocate(This: Tvalue): Tvalue; cdecl;
var
  real: TImageList;
begin
  real := TImageList.Create(nil);
  result := CompoAlloc(This, real);
end;

function ImageList_get_count(This: Tvalue): Tvalue; cdecl;
var
  real: TCustomImageList;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.Count);
end;

function ImageList_add(This, vBmap, vMask: Tvalue): Tvalue; cdecl;
var
  real: TCustomImageList;
  Bmap, Mask: TBitmap;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(vBmap, TBitmap, Bmap);
  case RTYPE(vMask) of
  T_DATA:
    begin
      ap_data_get_object(vMask, TBitmap, Mask);
      result := INT2FIX(real.Add(Bmap, Mask));
    end;
  T_FIXNUM:
    begin
      result := INT2FIX(real.AddMasked(Bmap, FIX2INT(Mask)));
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
    result := Qnil; // avoid warning
  end;
end;

{$IFDEF VCL}
function ImageList_add_icon(This, v: Tvalue): Tvalue; cdecl;
var
  real: TCustomImageList;
  Icon: TIcon;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TIcon, Icon);
  result := INT2FIX(real.AddIcon(Icon));
end;
{$ENDIF}

function ImageList_add_images(This, v: Tvalue): Tvalue; cdecl;
var
  real, other: TCustomImageList;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TCustomImageList, other);
  real.AddImages(other);
  result := This;
end;

{$IFDEF VCL}
function ImageList_get_icon(This, v: Tvalue): Tvalue; cdecl;
var
  real: TImageList;
  icon: TIcon;
begin
  real := ap_data_get_struct(This);
  icon := TIcon.Create;
  real.GetIcon(FIX2INT(v), icon);
  result := ap_iIcon(icon, This);
end;
{$ENDIF}

function ImageList_get_bitmap(This, v: Tvalue): Tvalue; cdecl;
var
  real: TImageList;
  bitmap: TBitmap;
begin
  real := ap_data_get_struct(This);
  bitmap := TBitmap.Create;
  real.GetBitmap(FIX2INT(v), bitmap);
  result := ap_iBitmap(bitmap, This);
end;

// [ap-dev:1359] [Delphi:77890] + ImageList#clear

function ImageList_clear(This: Tvalue): Tvalue; cdecl;
var
  real: TImageList;
begin
  real := ap_data_get_struct(This);
  real.Clear;
  result := This;
end;

procedure Init_Image;
begin
  cImage := OutputPersistentClass(mPhi, TImage, cControl, ap_iImage_v);
  rb_define_method(cImage, 'event_handle', @Image_event_handle, 1);
  rb_define_alloc_func(cImage, @Image_allocate);
  DefineAttrGet(cImage, 'canvas', Image_get_canvas);

  cImageList := OutputPersistentClass(mPhi, TImageList, cComponent, nil);
  rb_define_alloc_func(cImageList, @ImageList_allocate);
  DefineAttrGet(cImageList, 'count', ImageList_get_count);
  rb_define_method(cImageList, 'add', @ImageList_add, 2);
{$IFDEF VCL}
  rb_define_method(cImageList, 'add_icon', @ImageList_add_icon, 1);
{$ENDIF}
  rb_define_method(cImageList, 'add_images', @ImageList_add_images, 1);
{$IFDEF VCL}
  rb_define_method(cImageList, 'get_icon', @ImageList_get_icon, 1);
{$ENDIF}
  rb_define_method(cImageList, 'get_bitmap', @ImageList_get_bitmap, 1);

  // [ap-dev:1359] [Delphi:77890] + ImageList#clear
  rb_define_method(cImageList, 'clear', @ImageList_clear, 0);
end;

end.
