unit uMenuItem;

interface

uses
  Classes,
{$IFDEF VCL}
  Forms, Menus,
{$ELSE}
  QForms, QMenus,
{$ENDIF}
  Rubies;

var
  cMenuItem: Tvalue;

function ap_cMenuItem: Tvalue;
function ap_iMenuItem(real: TMenuItem; owner: Tvalue): Tvalue;
procedure DefineMenuItem(real: TComponent; Items: TMenuItem);
procedure Init_MenuItem;

implementation

uses
  SysUtils, uConv, uStrUtils,
{$IFDEF VCL}
  ActnList,
{$ELSE}
  QActnList,
{$ENDIF}
  uAction,
  uDefUtils, uIntern, uHandle, uAlloc, uProp, uPhi,
  uBitmap, uScreen,
  uPersistent, uComponent;

function ap_cMenuItem: Tvalue;
begin
  result := cMenuItem;
end;

procedure MenuItem_setup(obj: Tvalue; real: TMenuItem);
begin
  rb_iv_set(obj, '@bitmap', ap_iBitmap(real.Bitmap, obj));
//    AssignPropMethod(real, [Handle]);
end;

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

function MenuItem_alloc(This: Tvalue; real: TMenuItem): Tvalue;
begin
  result := ChildAlloc(This, real);
  MenuItem_setup(result, real);
end;

function ap_iMenuItem(real: TMenuItem; owner: Tvalue): Tvalue;
begin
  result := MenuItem_alloc(cMenuItem, real);
  ap_owner(result, owner);
end;

function MenuItem_new(This: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
begin
  real := TMenuItem.Create(nil);
  result := CompoAlloc(This, real);
  MenuItem_setup(result, real);
  ap_obj_call_init(result, 0, nil);
end;

function MenuItem_get_parent(This: Tvalue): Tvalue; cdecl;
var
  v: Tvalue;
begin
  v := This;
  repeat
    result := v;
    v := rb_iv_get(v, '@parent');
  until (v = Qnil) or (v = vScreen);
end;

function MenuItem_get_parent_item(This: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
begin
  real := ap_data_get_struct(This);
  if real.Parent = nil then
    result := Qnil
  else
    result := real.Parent.Tag;
end;

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

function MenuItem_aref(This, index: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  n := FIX2INT(index);
  if (n < 0) or (n >= real.Count) then
    ap_raise(ap_eIndexError, sOut_of_range);
  if real[n].Tag = 0 then
    result := ap_iMenuItem(real[n], This)
  else
    result := real[n].Tag;
end;

function MenuItem_each(This: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
  i: Integer;
begin
  real := ap_data_get_struct(This);
  for i := 0 to real.Count-1 do
    rb_yield(real[i].Tag);
  result := This;
end;

procedure DefineMenuItem(real: TComponent; Items: TMenuItem);

  procedure SetParent(real: TComponent; Item: TMenuItem);
  var
    This, obj: Tvalue;
    name: string;
    i: Integer;
  begin
    PhiObjectList.Extract(Item);
    
    This := real.Tag;
    obj := Item.Tag;
    name := LowerCase1(Item.name);
    //[ap-dev:0957]
    if name = '' then
    begin
      name := 'c_' + IntToStr(Item.tag);
      Item.name := name;
    end;
    
    SetParentAttr(obj, This, name);
    rb_iv_set(obj, '@parent', This);
    
    for i := 0 to Item.Count-1 do
      SetParent(Item, Item[i]);
  end;

begin
  SetParent(real, Items);
end;

procedure RemoveMenuItem(real: TComponent; Items: TMenuItem);

  procedure RemoveParent(Item: TMenuItem);
  var
    i: Integer;
  begin
    RemoveParentAttr(Item);
    for i := 0 to Item.Count-1 do
      RemoveParent(Item[i]);
  end;

begin
  RemoveParent(Items);
end;

function MenuItem_add(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real, item: TMenuItem;
  v: Tvalue;
  p: Pvalue;
  i: Integer;
begin
  p := argv;
  real := ap_data_get_struct(This);
  for i := 0 to argc-1 do
  try
    v := p^; inc(p);
    ap_data_get_object(v, TMenuItem, item);
    real.Add(item);
    DefineMenuItem(real, item);
  except
    on E: Exception do
      ap_raise(ap_eArgError, PChar(E.message));
  end;
  result := This;
end;

function MenuItem_insert(This, index, v: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
  n: Integer;
  item: TMenuItem;
begin
  real := ap_data_get_struct(This);
  n := FIX2INT(index);
  if (n < 0) or (n > real.Count) then
    ap_raise(ap_eIndexError, sOut_of_range);
  ap_data_get_object(v, TMenuItem, item);
  real.Insert(n, item);
  DefineMenuItem(real, item);
  result := This;
end;

function MenuItem_delete(This, index: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  n := FIX2INT(index);
  if (n < 0) or (n >= real.Count) then
    ap_raise(ap_eIndexError, sOut_of_range);
  RemoveMenuItem(real, real[n]);
  real.Delete(n);
  result := This;
end;

function MenuItem_remove(This, v: Tvalue): Tvalue; cdecl;
var
  real, item: TMenuItem;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TMenuItem, item);
  RemoveMenuItem(real, item);
  real.Remove(item);
  result := This;
end;

function MenuItem_index_of(This, v: Tvalue): Tvalue; cdecl;
var
  real, item: TMenuItem;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TMenuItem, item);
  result := INT2FIX(real.IndexOf(item));
end;

function MenuItem_menu_index(This: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.MenuIndex);
end;

function MenuItem_click(This: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
begin
  real := ap_data_get_struct(This);
  Handle.NotifyOnClick(real);
  result := This;
end;

function MenuItem_clear(This: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
  i: Integer;
begin
  real := ap_data_get_struct(This);
  for i := 0 to real.Count-1 do
    RemoveMenuItem(real, real.Items[i]);
  real.Clear;
  result := This;
end;

function Phi_new_sub_menu(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  p: Pvalue;
  acap, aname: String;
  items: array of TMenuItem;
  ary: Tvalue;
  ptr: Pvalue;
  len: Integer;
  enabled: Boolean;
  i: Integer;
  real: TMenuItem;
begin
  if argc < 3 then ap_raise(ap_eArgError, sToo_few_args);
  p := argv;

  acap := dl_String(p^); inc(p);
  aname := dl_caption(p^); inc(p);
  ary := p^; inc(p);
  ptr := ap_ary_ptr(ary);
  len := ap_ary_len(ary);
  SetLength(items, len);
  for i := 0 to len-1 do
  begin
    items[i] := TMenuItem(ap_data_get_struct(ptr^));
    Inc(ptr);
  end;
  if argc > 3 then begin
    enabled := RTEST(p^); inc(p);
  end else
    enabled := True;
  real := NewSubMenu(acap, 0, aname, items, enabled);
  result := ChildAlloc(cMenuItem, real);
  MenuItem_setup(result, real);
end;

function Phi_new_item(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  p: Pvalue;
  acap, scut, aname: String;
  checked, enabled: Boolean;
  real: TMenuItem;
begin
  if argc < 3 then ap_raise(ap_eArgError, sToo_few_args);
  p := argv;

  acap := dl_String(p^); inc(p);
  scut := dl_String(p^); inc(p);
  aname := dl_caption(p^); inc(p);
  if argc > 3 then begin checked := RTEST(p^); inc(p); end else checked := False;
  if argc > 4 then begin enabled := RTEST(p^); inc(p); end else enabled := True;
  real := NewItem(acap, TextToShortCut(scut),
    checked, enabled, Handle.NotifyOnClick, 0, aname);
  result := ChildAlloc(cMenuItem, real);
  MenuItem_setup(result, real);
end;

function Phi_new_line(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
begin
  real := NewLine;
  result := ChildAlloc(cMenuItem, real);
  MenuItem_setup(result, real);
end;

function MenuItem_set_action(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
//  action: TAction;
begin
  real := ap_data_get_struct(This);
  real.action := ap_data_get_struct(v);
  result := v;
end;

function MenuItem_get_action(This: Tvalue): Tvalue; cdecl;
var
  real: TMenuItem;
begin
  real := ap_data_get_struct(This);
  result := ap_iBasicAction(real.Action,This);
end;

procedure Init_MenuItem;
begin
  cMenuItem := OutputPersistentClass(mPhi, TMenuItem, cPersistent, nil);

  rb_define_method(cMenuItem, 'event_handle', @MenuItem_event_handle, 1);
  rb_define_singleton_method(cMenuItem, 'new', @MenuItem_new, 0);
  DefineAttrGet(cMenuItem, 'parent', MenuItem_get_parent);
  DefineAttrGet(cMenuItem, 'parent_item', MenuItem_get_parent_item);
  DefineAttrGet(cMenuItem, 'count', MenuItem_get_count);
  rb_define_method(cMenuItem, '[]', @MenuItem_aref, 1);
//  rb_define_method(cMenuItem, 'each', @MenuItem_each, 0);
  DefineMethod(cMenuItem, 'add', MenuItem_add);
  rb_define_method(cMenuItem, 'insert', @MenuItem_insert, 2);
  rb_define_method(cMenuItem, 'delete', @MenuItem_delete, 1);
  rb_define_method(cMenuItem, 'remove', @MenuItem_remove, 1);
  rb_define_method(cMenuItem, 'index_of', @MenuItem_index_of, 1);
  rb_define_method(cMenuItem, 'menu_index', @MenuItem_menu_index, 0);
  rb_define_method(cMenuItem, 'click', @MenuItem_click, 0);
  rb_define_method(cMenuItem, 'clear', @MenuItem_clear, 0);

  DefineModuleFunction(mPhi, 'new_sub_menu', Phi_new_sub_menu);
  DefineModuleFunction(mPhi, 'new_item', Phi_new_item);
  DefineModuleFunction(mPhi, 'new_line', Phi_new_line);

  DefineAttrSet(cMenuItem, 'action', MenuItem_set_action);
  DefineAttrGet(cMenuItem, 'action', MenuItem_get_action);
end;

end.
