unit PhiHandle;

interface

uses
{$IFDEF LINUX}
  Types,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  SysUtils, Classes,
{$IFDEF VCL}
  Controls, Forms, ComCtrls, Graphics, Grids, Menus,
{$ELSE}
  QControls, QForms, QStdCtrls, QComCtrls, QGraphics, QGrids, QMenus,
{$ENDIF}
  contnrs, Rubies;

type
  TPhiHandle = class(TObject)
  private
    AppDoneThread: TNotifyEvent;
  public
    ExtentList: TObjectList;
    ObjectList: TObjectList;
    AllocFuncList: TStringList;
    EventFuncList: TStringList;
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
    procedure DoneThread(Sender: TObject);
    procedure SetAppDoneThread(Done: TNotifyEvent);
    procedure doNotify(Sender: TObject; name: PChar);
    procedure doKey(Sender: TObject; var Key: Word; Shift: TShiftState; name: PChar);
    procedure doMouse(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; name: PChar);
    procedure doMoved(Sender: TObject; FromIndex, ToIndex: Longint; name: PChar);
    procedure doEndDrag(Sender, Source: TObject; X, Y: Integer; name: PChar);
    procedure doTVExpanded(Sender: TObject; Node: TTreeNode; name: PChar);
    procedure doLVDeleted(Sender: TObject; Item: TListItem; name: PChar);
    procedure doMouseWheelUpDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean; name:String);
  published
    procedure IdleOnIdle(Sender: TObject; var Done: Boolean);
    procedure NotifyOnChange(Sender: TObject);
    procedure NotifyOnChanging(Sender: TObject);
    procedure NotifyOnClose(Sender: TObject);
    procedure NotifyOnEnter(Sender: TObject);
    procedure NotifyOnExit(Sender: TObject);
    procedure NotifyOnClick(Sender: TObject);
    procedure NotifyOnDblClick(Sender: TObject);
    procedure NotifyOnShow(Sender: TObject);
    procedure NotifyOnExecute(Sender: TObject);
    procedure NotifyOnDestroy(Sender: TObject);
    procedure NotifyOnResize(Sender: TObject);
    procedure NotifyOnHint(Sender: TObject);
    procedure NotifyOnCreate(Sender: TObject);
    procedure NotifyOnActivate(Sender: TObject);
    procedure NotifyOnDeactivate(Sender: TObject);
    procedure NotifyOnHide(Sender: TObject);
    procedure NotifyOnPopup(Sender: TObject);
    procedure NotifyOnPaint(Sender: TObject);
    procedure NotifyOnTimer(Sender: TObject);
    procedure NotifyOnTopLeftChanged(Sender: TObject);
    procedure NotifyOnColumnDragged(Sender: TObject);
    procedure NotifyOnSelect(Sender: TObject);
    procedure NotifyOnDropDown(Sender: TObject);
    procedure NotifyOnCloseUp(Sender: TObject);
{$IFDEF VCL}
    procedure NotifyOnCustomized(Sender: TObject);
    procedure NotifyOnCustomizeReset(Sender: TObject);
    procedure NotifyOnCustomizing(Sender: TObject);
{$ENDIF}
    procedure CloseOnClose(Sender: TObject; var Action: TCloseAction);
    procedure ProgressOnProgress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
    procedure KeyOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure KeyOnKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure KeyPressOnKeyPress(Sender: TObject; var Key: Char);
    procedure MouseWheelOnMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
    procedure MouseWheelUpDownOnMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure MouseWheelUpDownOnMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
{$IFDEF VCL}
    procedure DockDropOnDockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
    procedure DockOverOnDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure UnDockOnUnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
{$ENDIF}
    procedure GetSiteInfoOnGetSiteInfo(Sender: TObject; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
    procedure DragDropOnDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure DragOverOnDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure EndDragOnEndDrag(Sender, Source: TObject; X, Y: Integer);
    procedure EndDragOnEndDock(Sender, Source: TObject; X, Y: Integer);
    procedure MouseOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MouseOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MouseMoveOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure MovedOnColumnMoved(Sender: TObject; FromIndex, ToIndex: Longint);
{$IFDEF VCL}
    procedure StartDockOnStartDock(Sender: TObject; var DragObject: TDragDockObject);
{$ENDIF}
    procedure StartDragOnStartDrag(Sender: TObject; var DragObject: TDragObject);
    procedure CanResizeOnCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
    procedure ConstrainedResizeOnConstrainedResize(Sender: TObject; var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer);
    procedure ContextPopupOnContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
    procedure DrawItemOnDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure MeasureItemOnMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
    procedure CloseQueryOnCloseQuery(Sender: TObject; var CanClose: Boolean);
    { TCustomTabControl }
    procedure TabChangingOnChanging(Sender: TObject; var AllowChange: Boolean);
    { TCustomUpDown }
    procedure UDChangingOnChanging(Sender: TObject; var AllowChange: Boolean);
{$IFDEF VCL}
    procedure UDClickOnClick(Sender: TObject; Button: TUDBtnType);
{$ENDIF}
    { TStatusBar }
    procedure DrawPanelOnDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect);
    { TCustomTreeView }
    procedure TVChangedOnChange(Sender: TObject; Node: TTreeNode);
    procedure TVChangingOnChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
    procedure TVExpandedOnExpanded(Sender: TObject; Node: TTreeNode);
    procedure TVExpandedOnCollapsed(Sender: TObject; Node: TTreeNode);
    procedure TVExpandedOnDeletion(Sender: TObject; Node: TTreeNode);
    procedure TVExpandedOnGetImageIndex(Sender: TObject; Node: TTreeNode);
    procedure TVExpandedOnGetSelectedIndex(Sender: TObject; Node: TTreeNode);
    procedure TVExpandingOnExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
    procedure TVCollapsingOnCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean);
    procedure TVEditingOnEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean);
    procedure TVEditedOnEdited(Sender: TObject; Node: TTreeNode; var S: string);
    procedure TVCompareOnCompare(Sender: TObject; Node1, Node2: TTreeNode; Data: Integer; var Compare: Integer);
    { TCustomListView }
    procedure LVSelectItemOnSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
    procedure LVChangeOnChange(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure LVChangingOnChanging(Sender: TObject; Item: TListItem; Change: TItemChange; var AllowChange: Boolean);
    procedure LVColumnClickOnColumnClick(Sender: TObject; Column: TListColumn);
    procedure LVColumnRClickOnColumnRightClick(Sender: TObject; Column: TListColumn; Point: TPoint);
    procedure LVCompareOnCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure LVOwnerDataOnData(Sender: TObject; Item: TListItem);
    procedure LVOwnerDataFindOnDataFind(Sender: TObject; Find: TItemFind; const FindString: string; const FindPosition: TPoint; FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection; Wrap: Boolean; var Index: Integer);
    procedure LVOwnerDataHintOnDataHint(Sender: TObject; StartIndex, EndIndex: Integer);
    procedure LVOwnerDataStateChangeOnDataStateChange(Sender: TObject; StartIndex, EndIndex: Integer; OldState, NewState: TItemStates);
    procedure LVDeletedOnDeletion(Sender: TObject; Item: TListItem);
    procedure LVDrawItemOnDrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
    procedure LVEditedOnEdited(Sender: TObject; Item: TListItem; var S: string);
    procedure LVEditingOnEditing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean);
    procedure LVNotifyOnGetImageIndex(Sender: TObject; Item: TListItem);
    procedure LVSubItemImageOnGetSubItemImage(Sender: TObject; Item: TListItem; SubItem: Integer; var ImageIndex: Integer);
    procedure LVInfoTipOnInfoTip(Sender: TObject; Item: TListItem; var InfoTip: string);
    procedure LVDeletedOnInsert(Sender: TObject; Item: TListItem);
    { TFontDialog }
{$IFDEF MSWINDOWS}
    procedure FDApplyOnApply(Sender: TObject; Wnd: HWND);
{$ENDIF}
    { TDrawGrid }
    procedure DrawCellOnDrawCell(Sender: TObject; ACol, ARow: Longint; Rect: TRect; State: TGridDrawState);
    procedure SelectCellOnSelectCell(Sender: TObject; ACol, ARow: Longint; var CanSelect: Boolean);
    { TStringGrid }
    procedure SetEditOnSetEditText(Sender: TObject; ACol, ARow: Longint; const Value: String);
    {}
    procedure ExceptionOnException(Sender: TObject; E: Exception);
{$IFDEF VCL}
    { TToolBar }
    procedure TTBAdvancedCustomDrawEventOnAdvancedCustomDraw(Sender: TToolBar; const ARect: TRect; Stage: TCustomDrawStage; var DefaultDraw: Boolean);
    procedure TTBAdvancedCustomDrawBtnEventOnAdvancedCustomDrawButton(Sender: TToolBar; Button: TToolButton; State: TCustomDrawState; Stage: TCustomDrawStage; var Flags: TTBCustomDrawFlags; var DefaultDraw: Boolean);
    procedure TTBCustomDrawEventOnCustomDraw(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);
    procedure TTBCustomDrawBtnEventOnCustomDrawButton(Sender: TToolBar; Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure TTBButtonEventOnCustomizeAdded(Sender: TToolBar; Button: TToolButton);
    procedure TTBButtonEventOnCustomizeDelete(Sender: TToolBar; Button: TToolButton);
    procedure TTBCustomizeQueryEventOnCustomizeCanDelete(Sender: TToolBar; Index: Integer; var Allow: Boolean);
    procedure TTBCustomizeQueryEventOnCustomizeCanInsert(Sender: TToolBar; Index: Integer; var Allow: Boolean);
    procedure TTBNewButtonEventOnCustomizeNewButton(Sender: TToolBar; Index: Integer; var Button: TToolButton);
    { TPageScroller }
    procedure TPageScrollEventOnScroll(Sender: TObject; Shift: TShiftState; X, Y: Integer; Orientation: TPageScrollerOrientation; var Delta: Integer);
{$ENDIF}
    { TSplitter }
    procedure NotifyOnMoved(Sender: TObject);
    { TMenu }
    procedure MenuChangeOnChange(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
  end;

implementation

uses
{$IFDEF PHIEMBED}
  PhiMainUnit,
  uAlloc, uConv, uPhi, uApplication, uPoint, uRect,
  uComponent, uControl, uDragObject, uListColumn,
  uCollection,
  uListItem, uMenuItem,
{$ELSE}
  Pythia,
{$ENDIF}
  uStrUtils, uDefUtils, TypInfo;

constructor TPhiHandle.Create(AOwner: TComponent);
begin
  inherited Create;
  ExtentList := TObjectList.Create;
  ObjectList := TObjectList.Create;
  AllocFuncList := TStringList.Create;
end;

destructor TPhiHandle.Destroy;
begin
  AllocFuncList.Free;
  ObjectList.Free;
  ExtentList.Free;
  inherited Destroy;
end;

procedure TPhiHandle.DoneThread(Sender: TObject);
begin
  if @AppDoneThread <> nil then AppDoneThread(Sender);
end;

procedure TPhiHandle.SetAppDoneThread(Done: TNotifyEvent);
begin
  AppDoneThread := Done;
end;

//[ap-dev:0901]
procedure TPhiHandle.IdleOnIdle(Sender: TObject; var Done: Boolean);
var
  recv, data, ret: Tvalue;
begin
  if not PhiAlive then Exit;
  
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_idle'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Done));

  ret := PhiCallProtect(data);
  if ret <> Qnil then Done := RTEST(ret);
end;

procedure TPhiHandle.doNotify(Sender: TObject; name: PChar);
var
  recv, data: Tvalue;
begin
  recv := TComponent(Sender).tag;
  if recv = 0 then Exit;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  PhiCallProtect(data);
end;

procedure TPhiHandle.NotifyOnEnter(Sender: TObject);
begin
  doNotify(Sender, 'on_enter');
end;

procedure TPhiHandle.NotifyOnExit(Sender: TObject);
begin
  doNotify(Sender, 'on_exit');
end;

procedure TPhiHandle.NotifyOnChange(Sender: TObject);
begin
  doNotify(Sender, 'on_change');
end;

procedure TPhiHandle.NotifyOnChanging(Sender: TObject);
begin
  doNotify(Sender, 'on_changing');
end;

procedure TPhiHandle.NotifyOnClose(Sender: TObject);
begin
  doNotify(Sender, 'on_close');
end;

procedure TPhiHandle.NotifyOnClick(Sender: TObject);
begin
  doNotify(Sender, 'on_click');
end;

procedure TPhiHandle.NotifyOnDblClick(Sender: TObject);
begin
  doNotify(Sender, 'on_dbl_click');
end;

procedure TPhiHandle.NotifyOnShow(Sender: TObject);
begin
  doNotify(Sender, 'on_show');
end;

procedure TPhiHandle.NotifyOnExecute(Sender: TObject);
begin
  doNotify(Sender, 'on_execute');
end;

procedure TPhiHandle.NotifyOnDestroy(Sender: TObject);
begin
//
end;

procedure TPhiHandle.NotifyOnCreate(Sender: TObject);
begin
  doNotify(Sender, 'on_create');
end;

procedure TPhiHandle.NotifyOnActivate(Sender: TObject);
begin
  doNotify(Sender, 'on_activate');
end;

procedure TPhiHandle.NotifyOnDeactivate(Sender: TObject);
begin
  doNotify(Sender, 'on_deactivate');
end;

procedure TPhiHandle.NotifyOnHide(Sender: TObject);
begin
  doNotify(Sender, 'on_hide');
end;

procedure TPhiHandle.NotifyOnPopup(Sender: TObject);
begin
  doNotify(Sender, 'on_popup');
end;

procedure TPhiHandle.NotifyOnPaint(Sender: TObject);
begin
  doNotify(Sender, 'on_paint');
end;

procedure TPhiHandle.NotifyOnResize(Sender: TObject);
begin
  doNotify(Sender, 'on_resize');
end;

procedure TPhiHandle.NotifyOnHint(Sender: TObject);
begin
  doNotify(Sender, 'on_hint');
end;

procedure TPhiHandle.NotifyOnTimer(Sender: TObject);
begin
  doNotify(Sender, 'on_timer');
end;

procedure TPhiHandle.NotifyOnTopLeftChanged(Sender: TObject);
begin
  doNotify(Sender, 'on_top_left_changed');
end;

{$IFDEF VCL}
procedure TPhiHandle.NotifyOnCustomized(Sender: TObject);
begin
  doNotify(Sender, 'on_customized');
end;

procedure TPhiHandle.NotifyOnCustomizeReset(Sender: TObject);
begin
  doNotify(Sender, 'on_customize_reset');
end;

procedure TPhiHandle.NotifyOnCustomizing(Sender: TObject);
begin
  doNotify(Sender, 'on_customizing');
end;
{$ENDIF}

procedure TPhiHandle.doKey(Sender: TObject; var Key: Word;
  Shift: TShiftState; name: PChar);
var
  recv, data, ret: Tvalue;
begin
  recv := TComponent(Sender).tag;
  if recv = 0 then Exit;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Key));
  rb_ary_push(data, ap_Set(Shift));
  ret := PhiCallProtect(data);
  if ret <> Qnil then Key := FIX2INT(ret);
end;

procedure TPhiHandle.KeyOnKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  doKey(Sender, Key, Shift, 'on_key_down');
end;

procedure TPhiHandle.KeyOnKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  doKey(Sender, Key, Shift, 'on_key_up');
end;

procedure TPhiHandle.KeyPressOnKeyPress(Sender: TObject; var Key: Char);
var
  recv, data, ret: Tvalue;
begin
  recv := TComponent(Sender).tag;
  if recv = 0 then Exit;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_key_press'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Ord(Key)));
  ret := PhiCallProtect(data);
  if ret <> Qnil then Key := Char(FIX2INT(ret));
end;

procedure TPhiHandle.MouseWheelOnMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  recv, data, ret: Tvalue;
begin
  recv := TComponent(Sender).tag;
  if recv = 0 then Exit;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_mouse_wheel'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Handled));
  rb_ary_push(data, ap_Set(Shift));
  rb_ary_push(data, INT2FIX(WheelDelta));
  rb_ary_push(data, ap_iPoint(MousePos, Qnil));

  ret := PhiCallProtect(data);
  if ret <> Qnil then handled := RTEST(ret);
end;

procedure TPhiHandle.doMouseWheelUpDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean; name:String);
var
  recv, data, ret: Tvalue;
begin
  recv := TComponent(Sender).tag;
  if recv = 0 then Exit;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(PChar(name)));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Handled));
  rb_ary_push(data, ap_Set(Shift));
  rb_ary_push(data, ap_iPoint(MousePos, Qnil));

  ret := PhiCallProtect(data);
  if ret <> Qnil then handled := RTEST(ret);
end;

procedure TPhiHandle.MouseWheelUpDownOnMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  doMouseWheelUpDown(Sender, Shift, MousePos, Handled, 'on_mouse_wheel_up');
end;

procedure TPhiHandle.MouseWheelUpDownOnMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  doMouseWheelUpDown(Sender, Shift, MousePos, Handled, 'on_mouse_wheel_down');
end;

procedure TPhiHandle.CloseOnClose(Sender: TObject; var Action: TCloseAction);
var
  real: TForm;
  recv, data, ret: Tvalue;
  n: Integer;
begin
  real := TForm(Sender);
  recv := real.tag;
  if recv = 0 then Exit;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_close'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Ord(Action)));
  ret := PhiCallProtect(data);

  if ret = Qnil then
    Action := caHide
  else
  begin
    n := FIX2INT(ret);
    if (n < Ord(Low(TCloseAction))) or (Ord(High(TCloseAction)) < n) then
      Action := caHide
    else
      Action := TCloseAction(n);
  end;

  if Action = caFree then
  begin
    RemoveParentAttr(real);
    ClearEvents(real);
    rb_clear_cache;
    Action := caHide;
  end;

  if Action = caHide then real.Hide;
  PhiAliveTest;
end;

procedure TPhiHandle.DragDropOnDragDrop(Sender, Source: TObject; X, Y: Integer);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_drag_drop'));
  rb_ary_push(data, recv);
  rb_ary_push(data, TComponent(Source).tag);
  rb_ary_push(data, INT2FIX(X));
  rb_ary_push(data, INT2FIX(Y));
  PhiCallProtect(data);
end;

procedure TPhiHandle.DragOverOnDragOver(Sender, Source: TObject; X, Y: Integer;  State: TDragState; var Accept: Boolean);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_drag_over'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Ord(Accept)));
  if Source = nil then
    rb_ary_push(data, Qnil)
  else
    rb_ary_push(data, (Source as TComponent).tag);
  rb_ary_push(data, INT2FIX(X));
  rb_ary_push(data, INT2FIX(Y));
  rb_ary_push(data, INT2FIX(Ord(State)));
  ret := PhiCallProtect(data);
  if ret <> Qnil then Accept := RTEST(ret);
end;

procedure TPhiHandle.doEndDrag(Sender, Source: TObject; X, Y: Integer; name: PChar);
var
  recv, data: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  if Source = nil then
    rb_ary_push(data, Qnil)
  else
    rb_ary_push(data, (Source as TComponent).tag);
  rb_ary_push(data, INT2FIX(X));
  rb_ary_push(data, INT2FIX(Y));
  PhiCallProtect(data);
end;

procedure TPhiHandle.EndDragOnEndDrag(Sender, Source: TObject; X, Y: Integer);
begin
  doEndDrag(Sender, Source, X, Y, 'on_end_drag');
end;

procedure TPhiHandle.EndDragOnEndDock(Sender, Source: TObject; X, Y: Integer);
begin
  doEndDrag(Sender, Source, X, Y, 'on_end_dock');
end;

procedure TPhiHandle.doMouse(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer; name: PChar);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Ord(Button)));
  rb_ary_push(data, ap_Set(Shift));
  rb_ary_push(data, INT2FIX(X));
  rb_ary_push(data, INT2FIX(Y));
  PhiCallProtect(data);
end;

procedure TPhiHandle.doMoved(Sender: TObject; FromIndex, ToIndex: Longint; name: PChar);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(FromIndex));
  rb_ary_push(data, INT2FIX(ToIndex));
  PhiCallProtect(data);
end;

procedure TPhiHandle.MouseOnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  doMouse(Sender, Button, Shift, X, Y, 'on_mouse_down');
end;

procedure TPhiHandle.MouseOnMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  doMouse(Sender, Button, Shift, X, Y, 'on_mouse_up');
end;

procedure TPhiHandle.MouseMoveOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_mouse_move'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_Set(Shift));
  rb_ary_push(data, INT2FIX(X));
  rb_ary_push(data, INT2FIX(Y));
  PhiCallProtect(data);
end;

procedure TPhiHandle.MovedOnColumnMoved(Sender: TObject; FromIndex, ToIndex: Longint);
begin
  doMoved(Sender, FromIndex, ToIndex, 'on_column_moved');
end;

{$IFDEF VCL}
procedure TPhiHandle.StartDockOnStartDock(Sender: TObject; var DragObject: TDragDockObject);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_start_dock'));
  rb_ary_push(data, recv);
  if DragObject = nil then
    rb_ary_push(data, Qnil)
  else
    rb_ary_push(data, ap_iDragDockObject(DragObject, recv));
  ret := PhiCallProtect(data);
  if ret <> Qnil then ap_data_get_object(ret, TDragDockObject, DragObject);
end;
{$ENDIF}

procedure TPhiHandle.StartDragOnStartDrag(Sender: TObject; var DragObject: TDragObject);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_start_drag'));
  rb_ary_push(data, recv);
  if DragObject = nil then
    rb_ary_push(data, Qnil)
  else
    rb_ary_push(data, ap_iDragObject(DragObject, recv));
  ret := PhiCallProtect(data);
  if ret <> Qnil then ap_data_get_object(ret, TDragObject, DragObject);
end;

procedure TPhiHandle.DrawItemOnDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  recv, data: Tvalue;
begin
  recv := Control.tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_draw_item'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Index));
  rb_ary_push(data, ap_iRect(Rect, Qnil));
  rb_ary_push(data, ap_Set(State));
  PhiCallProtect(data);
end;

procedure TPhiHandle.MeasureItemOnMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
var
  recv, data, ret: Tvalue;
begin
  recv := Control.tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_measure_item'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Height));
  rb_ary_push(data, INT2FIX(Index));
  ret := PhiCallProtect(data);
  if ret <> Qnil then Height := FIX2INT(ret);
end;

{$IFDEF VCL}
procedure TPhiHandle.DockDropOnDockDrop(Sender: TObject; Source: TDragDockObject;
  X, Y: Integer);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_dock_drop'));
  rb_ary_push(data, recv);
  if Source = nil then
    rb_ary_push(data, Qnil)
  else
    rb_ary_push(data, ap_iDragDockObject(Source, recv));
  rb_ary_push(data, INT2FIX(X));
  rb_ary_push(data, INT2FIX(Y));
  PhiCallProtect(data);
end;

procedure TPhiHandle.DockOverOnDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_dock_over'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Accept));
  if Source = nil then
    rb_ary_push(data, Qnil)
  else
    rb_ary_push(data, ap_iDragDockObject(Source, recv));
  rb_ary_push(data, INT2FIX(X));
  rb_ary_push(data, INT2FIX(Y));
  rb_ary_push(data, INT2FIX(Ord(State)));
  ret := PhiCallProtect(data);
  if ret <> Qnil then Accept := RTEST(ret);
end;
{$ENDIF}

procedure TPhiHandle.TabChangingOnChanging(Sender: TObject; var AllowChange: Boolean);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_changing'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(AllowChange));
  ret := PhiCallProtect(data);
  if ret <> Qnil then AllowChange := RTEST(ret);
end;

procedure TPhiHandle.UDChangingOnChanging(Sender: TObject; var AllowChange: Boolean);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_changing'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(AllowChange));
  ret := PhiCallProtect(data);
  if ret <> Qnil then AllowChange := RTEST(ret);
end;

{$IFDEF VCL}
procedure TPhiHandle.UDClickOnClick(Sender: TObject; Button: TUDBtnType);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_click'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Ord(Button)));
  PhiCallProtect(data);
end;
{$ENDIF}

procedure TPhiHandle.CloseQueryOnCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_close_query'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(CanClose));
  ret := PhiCallProtect(data);
  if ret <> Qnil then CanClose := RTEST(ret);
end;

procedure TPhiHandle.CanResizeOnCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean);
var
  recv, data: Tvalue;
  ary, ret, val: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_can_resize'));
  rb_ary_push(data, recv);
  ary := rb_ary_new;
  rb_ary_push(ary, INT2FIX(NewWidth));
  rb_ary_push(ary, INT2FIX(NewHeight));
  rb_ary_push(ary, ap_bool(Resize));
  rb_ary_push(data, ary);
  ret := PhiCallProtect(data);
  if RTYPE(ret) <> T_ARRAY then Exit;
  val := rb_ary_shift(ret);
  NewWidth := FIX2INT(val);
  val := rb_ary_shift(ret);
  NewHeight := FIX2INT(val);
  val := rb_ary_shift(ret);
  Resize := RTEST(val);
end;

procedure TPhiHandle.ConstrainedResizeOnConstrainedResize(Sender: TObject; var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer);
var
  recv, data: Tvalue;
  ary, ret, val: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_constrained_resize'));
  rb_ary_push(data, recv);
  ary := rb_ary_new;
  rb_ary_push(ary, INT2FIX(MinWidth));
  rb_ary_push(ary, INT2FIX(MinHeight));
  rb_ary_push(ary, INT2FIX(MaxWidth));
  rb_ary_push(ary, INT2FIX(MaxHeight));
  rb_ary_push(data, ary);
  ret := PhiCallProtect(data);
  if RTYPE(ret) <> T_ARRAY then Exit;
  val := rb_ary_shift(ret);
  MinWidth := FIX2INT(val);
  val := rb_ary_shift(ret);
  MinHeight := FIX2INT(val);
  val := rb_ary_shift(ret);
  MaxWidth := FIX2INT(val);
  val := rb_ary_shift(ret);
  MaxHeight := FIX2INT(val);
end;

procedure TPhiHandle.DrawPanelOnDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect);
var
  recv, data: Tvalue;
begin
  recv := StatusBar.tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_draw_panel'));
  rb_ary_push(data, recv);
  // no impl
  PhiCallProtect(data);
end;

procedure TPhiHandle.TVChangedOnChange(Sender: TObject; Node: TTreeNode);
var
  recv, data, vnode: Tvalue;
begin
  if Node.Data = nil then vnode := Qnil else vnode := Tvalue(Node.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_change'));
  rb_ary_push(data, recv);
  rb_ary_push(data, vnode);
  PhiCallProtect(data);
end;

procedure TPhiHandle.TVChangingOnChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
var
  recv, data, ret, vnode: Tvalue;
begin
  if Node.Data = nil then vnode := Qnil else vnode := Tvalue(Node.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_changing'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(AllowChange));
  rb_ary_push(data, vnode);
  ret := PhiCallProtect(data);
  if ret <> Qnil then AllowChange := RTEST(ret);
end;

procedure TPhiHandle.doTVExpanded(Sender: TObject; Node: TTreeNode; name: PChar);
var
  recv, data, vnode: Tvalue;
begin
  if Node.Data = nil then vnode := Qnil else vnode := Tvalue(Node.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  rb_ary_push(data, vnode);
  PhiCallProtect(data);
end;

procedure TPhiHandle.TVExpandedOnExpanded(Sender: TObject; Node: TTreeNode);
begin
  doTVExpanded(Sender, Node, 'on_expanded');
end;

procedure TPhiHandle.TVExpandedOnCollapsed(Sender: TObject; Node: TTreeNode);
begin
  doTVExpanded(Sender, Node, 'on_collapsed');
end;

procedure TPhiHandle.TVExpandedOnDeletion(Sender: TObject; Node: TTreeNode);
begin
  doTVExpanded(Sender, Node, 'on_deletion');
end;

procedure TPhiHandle.TVExpandedOnGetImageIndex(Sender: TObject; Node: TTreeNode);
var
  ev: TTVExpandedEvent;
begin
  ev := TTreeView(Sender).OnGetImageIndex;
  TTreeView(Sender).OnGetImageIndex := nil;
  doTVExpanded(Sender, Node, 'on_get_image_index');
  TTreeView(Sender).OnGetImageIndex := ev;
end;

procedure TPhiHandle.TVExpandedOnGetSelectedIndex(Sender: TObject; Node: TTreeNode);
begin
  doTVExpanded(Sender, Node, 'on_get_selected_index');
end;

procedure TPhiHandle.TVExpandingOnExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
var
  recv, data, ret, vnode: Tvalue;
begin
  if Node.Data = nil then vnode := Qnil else vnode := Tvalue(Node.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_expanding'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(AllowExpansion));
  rb_ary_push(data, vnode);
  ret := PhiCallProtect(data);
  if ret <> Qnil then AllowExpansion := RTEST(ret);
end;

procedure TPhiHandle.TVCollapsingOnCollapsing(Sender: TObject; Node: TTreeNode;  var AllowCollapse: Boolean);
var
  recv, data, ret, vnode: Tvalue;
begin
  if Node.Data = nil then vnode := Qnil else vnode := Tvalue(Node.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_collapsing'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(AllowCollapse));
  rb_ary_push(data, vnode);
  ret := PhiCallProtect(data);
  if ret <> Qnil then AllowCollapse := RTEST(ret);
end;

procedure TPhiHandle.TVEditingOnEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean);
var
  recv, data, ret, vnode: Tvalue;
begin
  if Node.Data = nil then vnode := Qnil else vnode := Tvalue(Node.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_editing'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(AllowEdit));
  rb_ary_push(data, vnode);
  ret := PhiCallProtect(data);
  if ret <> Qnil then AllowEdit := RTEST(ret);
end;

procedure TPhiHandle.TVEditedOnEdited(Sender: TObject; Node: TTreeNode; var S: string);
var
  recv, data, ret, vnode: Tvalue;
begin
  if Node.Data = nil then vnode := Qnil else vnode := Tvalue(Node.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_collapsing'));
  rb_ary_push(data, recv);
  rb_ary_push(data, rb_str_new2(PChar(S)));
  rb_ary_push(data, vnode);
  ret := PhiCallProtect(data);
  if ret <> Qnil then S := dl_String(ret);
end;

procedure TPhiHandle.TVCompareOnCompare(Sender: TObject; Node1, Node2: TTreeNode; Data: Integer; var Compare: Integer);
var
  recv, args, ret, vnode1, vnode2: Tvalue;
begin
  if Node1.Data = nil then vnode1 := Qnil else vnode1 := Tvalue(Node1.Data);
  if Node2.Data = nil then vnode2 := Qnil else vnode2 := Tvalue(Node2.Data);
  recv := (Sender as TComponent).tag;
  args := rb_ary_new;
  rb_ary_push(args, rb_intern('on_collapsing'));
  rb_ary_push(args, recv);
  rb_ary_push(args, INT2FIX(Compare));
  rb_ary_push(args, vnode1);
  rb_ary_push(args, vnode2);
  rb_ary_push(args, rb_int2inum(Data));
  ret := PhiCallProtect(args);
  if ret <> Qnil then Compare := FIX2INT(ret);
end;

procedure TPhiHandle.LVSelectItemOnSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
var
  recv, data, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_select_item'));
  rb_ary_push(data, recv);
  rb_ary_push(data, vitem);
  rb_ary_push(data, ap_bool(Selected));
  PhiCallProtect(data);
end;

{$IFDEF MSWINDOWS}
procedure TPhiHandle.FDApplyOnApply(Sender: TObject; Wnd: HWND);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_apply'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Wnd));
  PhiCallProtect(data);
end;
{$ENDIF}

procedure TPhiHandle.GetSiteInfoOnGetSiteInfo(Sender: TObject; DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_get_site_info'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(CanDock));
  rb_ary_push(data, DockClient.tag);
  rb_ary_push(data, ap_iRect(InfluenceRect, Qnil));
  rb_ary_push(data, ap_iPoint(MousePos, Qnil));
  ret := PhiCallProtect(data);
  if ret <> Qnil then CanDock := RTEST(ret);
end;

{$IFDEF VCL}
procedure TPhiHandle.UnDockOnUnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_un_dock'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Allow));
  rb_ary_push(data, Client.tag);
  rb_ary_push(data, NewTarget.tag);
  ret := PhiCallProtect(data);
  if ret <> Qnil then Allow := RTEST(ret);
end;
{$ENDIF}

procedure TPhiHandle.ProgressOnProgress(Sender: TObject; Stage: TProgressStage;  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
var
  recv, data: Tvalue;
begin
  // xxx: TGraphic, TPicture is not TComponent.
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_progress'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Ord(Stage)));
  rb_ary_push(data, INT2FIX(PercentDone));
  rb_ary_push(data, ap_bool(RedrawNow));
  rb_ary_push(data, ap_iRect(R, Qnil));
  rb_ary_push(data, rb_str_new2(PChar(Msg)));
  PhiCallProtect(data);
end;

procedure TPhiHandle.DrawCellOnDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  recv, data: Tvalue;
  ary: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_draw_cell'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(ACol));
  rb_ary_push(data, INT2FIX(ARow));
  rb_ary_push(data, ap_iRect(Rect, Qnil));
  ary := rb_ary_new;
  if gdSelected in State then rb_ary_push(ary, INT2FIX(0));
  if gdFocused  in State then rb_ary_push(ary, INT2FIX(1));
  if gdFixed    in State then rb_ary_push(ary, INT2FIX(2));
  rb_ary_push(data, ary);
  PhiCallProtect(data);
end;

procedure TPhiHandle.SelectCellOnSelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
var
  recv, data: Tvalue;
  ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_select_cell'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(CanSelect));
  rb_ary_push(data, INT2FIX(ACol));
  rb_ary_push(data, INT2FIX(ARow));
  ret := PhiCallProtect(data);
  if ret <> Qnil then CanSelect := RTEST(ret);
end;

procedure TPhiHandle.SetEditOnSetEditText(Sender: TObject; ACol, ARow: Longint; const Value: String);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_set_edit_text'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(ACol));
  rb_ary_push(data, INT2FIX(ARow));
  rb_ary_push(data, ap_String(Value));
  PhiCallProtect(data);
end;

procedure TPhiHandle.ContextPopupOnContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
var
  recv, data, ret: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_context_popup'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Handled));
  rb_ary_push(data, ap_iPoint(MousePos, Qnil));
  ret := PhiCallProtect(data);
  if ret <> Qnil then Handled := RTEST(ret);
end;

procedure TPhiHandle.LVChangeOnChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
var
  recv, data, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_change'));
  rb_ary_push(data, recv);
  rb_ary_push(data, vitem);
  rb_ary_push(data, INT2FIX(Ord(Change)));
  PhiCallProtect(data);
end;

procedure TPhiHandle.LVChangingOnChanging(Sender: TObject; Item: TListItem;
  Change: TItemChange; var AllowChange: Boolean);
var
  recv, data, ret, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_changing'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(AllowChange));
  rb_ary_push(data, vitem);
  rb_ary_push(data, INT2FIX(Ord(Change)));
  ret := PhiCallProtect(data);
  if ret <> Qnil then AllowChange := RTEST(ret);
end;

procedure TPhiHandle.LVColumnClickOnColumnClick(Sender: TObject;
  Column: TListColumn);
var
  recv, data, obj: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_column_click'));
  rb_ary_push(data, recv);
  obj := rb_iv_get(recv, '@columns');
  if obj = Qnil then ap_fatal('columns not exist');
  rb_ary_push(data, Collection_aref(obj, ap_Fixnum(Column.Index)));
  PhiCallProtect(data);
end;

procedure TPhiHandle.LVColumnRClickOnColumnRightClick(Sender: TObject;
  Column: TListColumn; Point: TPoint);
var
  recv, data, obj: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_column_right_click'));
  rb_ary_push(data, recv);
  obj := rb_iv_get(recv, '@columns');
  if obj = Qnil then ap_fatal('columns not exist');
  rb_ary_push(data, Collection_aref(obj, ap_Fixnum(Column.Index)));
  rb_ary_push(data, ap_iPoint(Point, Qnil));
  PhiCallProtect(data);
end;

procedure TPhiHandle.LVCompareOnCompare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
var
  recv, args, ret, vitem1, vitem2: Tvalue;
begin
  if Item1.Data = nil then vitem1 := Qnil else vitem1 := Tvalue(Item1.Data);
  if Item2.Data = nil then vitem2 := Qnil else vitem2 := Tvalue(Item2.Data);
  recv := (Sender as TComponent).tag;
  args := rb_ary_new;
  rb_ary_push(args, rb_intern('on_compare'));
  rb_ary_push(args, recv);
  rb_ary_push(args, INT2FIX(Compare));
  rb_ary_push(args, vitem1);
  rb_ary_push(args, vitem2);
  rb_ary_push(args, rb_int2inum(Data));
  ret := PhiCallProtect(args);
  if ret <> Qnil then Compare := FIX2INT(ret);
end;

procedure TPhiHandle.doLVDeleted(Sender: TObject; Item: TListItem; name: PChar);
var
  recv, data, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  rb_ary_push(data, vitem);
  PhiCallProtect(data);
end;

procedure TPhiHandle.LVDeletedOnDeletion(Sender: TObject; Item: TListItem);
begin
  doLVDeleted(Sender, Item, 'on_deletion');
end;

procedure TPhiHandle.LVDeletedOnInsert(Sender: TObject; Item: TListItem);
begin
  doLVDeleted(Sender, Item, 'on_insert');
end;

procedure TPhiHandle.LVDrawItemOnDrawItem(Sender: TCustomListView;
  Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
  recv, data, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_draw_item'));
  rb_ary_push(data, recv);
  rb_ary_push(data, vitem);
  rb_ary_push(data, ap_iRect(Rect, Qnil));
  rb_ary_push(data, ap_Set(State));
  PhiCallProtect(data);
end;

procedure TPhiHandle.LVEditedOnEdited(Sender: TObject; Item: TListItem;
  var S: string);
var
  recv, data, ret, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_edited'));
  rb_ary_push(data, recv);
  rb_ary_push(data, rb_str_new2(PChar(S)));
  rb_ary_push(data, vitem);
  ret := PhiCallProtect(data);
  if ret <> Qnil then S := dl_String(ret);
end;

procedure TPhiHandle.LVEditingOnEditing(Sender: TObject; Item: TListItem;
  var AllowEdit: Boolean);
var
  recv, data, ret, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_editing'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(AllowEdit));
  rb_ary_push(data, vitem);
  ret := PhiCallProtect(data);
  if ret <> Qnil then AllowEdit := RTEST(ret);
end;

procedure TPhiHandle.LVInfoTipOnInfoTip(Sender: TObject; Item: TListItem;
  var InfoTip: string);
var
  recv, data, ret, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_info_tip'));
  rb_ary_push(data, recv);
  rb_ary_push(data, rb_str_new2(PChar(InfoTip)));
  rb_ary_push(data, vitem);
  ret := PhiCallProtect(data);
  if ret <> Qnil then InfoTip := dl_String(ret);
end;

procedure TPhiHandle.LVNotifyOnGetImageIndex(Sender: TObject;
  Item: TListItem);
var
  recv, data, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_get_image_index'));
  rb_ary_push(data, recv);
  rb_ary_push(data, vitem);
  PhiCallProtect(data);
end;

procedure TPhiHandle.LVOwnerDataFindOnDataFind(Sender: TObject;
  Find: TItemFind; const FindString: string; const FindPosition: TPoint;
  FindData: Pointer; StartIndex: Integer; Direction: TSearchDirection;
  Wrap: Boolean; var Index: Integer);
begin
// no impl
end;

procedure TPhiHandle.LVOwnerDataHintOnDataHint(Sender: TObject; StartIndex,
  EndIndex: Integer);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_data_hint'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(StartIndex));
  rb_ary_push(data, INT2FIX(EndIndex));
  PhiCallProtect(data);
end;

procedure TPhiHandle.LVOwnerDataOnData(Sender: TObject; Item: TListItem);
var
  recv, data, vitem: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  if Item.Data = nil 
    then vitem := ap_iListItem(Item, recv) 
    else vitem := Tvalue(Item.Data);
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_data'));
  rb_ary_push(data, recv);
  rb_ary_push(data, vitem);
  PhiCallProtect(data);
end;

procedure TPhiHandle.LVOwnerDataStateChangeOnDataStateChange(
  Sender: TObject; StartIndex, EndIndex: Integer; OldState,
  NewState: TItemStates);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_data_state_change'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(StartIndex));
  rb_ary_push(data, INT2FIX(EndIndex));
  rb_ary_push(data, ap_Set(OldState));
  rb_ary_push(data, ap_Set(NewState));
  PhiCallProtect(data);
end;

procedure TPhiHandle.LVSubItemImageOnGetSubItemImage(Sender: TObject; Item: TListItem; SubItem: Integer; var ImageIndex: Integer);
var
  recv, data, ret, vitem: Tvalue;
begin
  if Item.Data = nil then vitem := Qnil else vitem := Tvalue(Item.Data);
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_get_sub_item_image'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(ImageIndex));
  rb_ary_push(data, vitem);
  rb_ary_push(data, INT2FIX(SubItem));
  ret := PhiCallProtect(data);
  if ret <> Qnil then ImageIndex := FIX2INT(ret);
end;

procedure TPhiHandle.NotifyOnColumnDragged(Sender: TObject);
begin
  doNotify(Sender, 'on_column_dragged');
end;

procedure TPhiHandle.NotifyOnSelect(Sender: TObject);
begin
  doNotify(Sender, 'on_select');
end;

procedure TPhiHandle.NotifyOnDropDown(Sender: TObject);
begin
  doNotify(Sender, 'on_drop_down');
end;

procedure TPhiHandle.NotifyOnCloseUp(Sender: TObject);
begin
  doNotify(Sender, 'on_close_up');
end;

procedure TPhiHandle.ExceptionOnException(Sender: TObject; E: Exception);
var
  recv, data: Tvalue;
begin
  recv := ap_vApplication; //(Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_exception'));
  rb_ary_push(data, recv);
  rb_ary_push(data, rb_exc_new2(rb_define_class_under(ap_mPhi, PChar(chopHead(string(E.Classname))), ap_eException), PChar(E.Message)));
//  rb_ary_push(data, ap_String(E.ClassName));
//  rb_ary_push(data, ap_String(E.Message));
  PhiCallProtect(data);
end;

{$IFDEF VCL}
procedure TPhiHandle.TTBAdvancedCustomDrawEventOnAdvancedCustomDraw(Sender: TToolBar; const ARect: TRect; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
var
  recv, data, ret: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_advanced_custom_draw'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(DefaultDraw));
  rb_ary_push(data, ap_iRect(ARect, Qnil));
  rb_ary_push(data, INT2FIX(Ord(Stage)));

  ret := PhiCallProtect(data);
  if ret <> Qnil then DefaultDraw := RTEST(ret);
end;

procedure TPhiHandle.TTBAdvancedCustomDrawBtnEventOnAdvancedCustomDrawButton(Sender: TToolBar; Button: TToolButton; State:
TCustomDrawState; Stage: TCustomDrawStage; var Flags: TTBCustomDrawFlags; var DefaultDraw: Boolean);
var
  recv, data, ret, ary, val: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_advanced_custom_draw_button'));
  rb_ary_push(data, recv);
  ary := rb_ary_new;
  rb_ary_push(ary, ap_Set(Flags));
  rb_ary_push(ary, ap_bool(DefaultDraw));
  rb_ary_push(data, ary);

  rb_ary_push(data, Button.tag);
  rb_ary_push(data, ap_Set(State));
  rb_ary_push(data, INT2FIX(Ord(Stage)));

  ret := PhiCallProtect(data);
  if RTYPE(ret) <> T_ARRAY then Exit;
  val := rb_ary_shift(ret);
  SetOrdProp(Sender, 'Flags', dl_Set(val));
  val := rb_ary_shift(ret);
  DefaultDraw := RTEST(val);
end;

procedure TPhiHandle.TTBCustomDrawEventOnCustomDraw(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);
var
  recv, data, ret: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_custom_draw'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(DefaultDraw));
  rb_ary_push(data, ap_iRect(ARect, Qnil));

  ret := PhiCallProtect(data);
  if ret <> Qnil then DefaultDraw := RTEST(ret);
end;

procedure TPhiHandle.TTBCustomDrawBtnEventOnCustomDrawButton(Sender: TToolBar; Button: TToolButton; State: TCustomDrawState; var
DefaultDraw: Boolean);
var
  recv, data, ret: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_custom_draw_button'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(DefaultDraw));
  rb_ary_push(data, Button.tag);
  rb_ary_push(data, ap_Set(State));

  ret := PhiCallProtect(data);
  if ret <> Qnil then DefaultDraw := RTEST(ret);
end;

procedure TPhiHandle.TTBButtonEventOnCustomizeAdded(Sender: TToolBar; Button: TToolButton);
var
  recv, data: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_customize_added'));
  rb_ary_push(data, recv);
  rb_ary_push(data, Button.tag);
end;

procedure TPhiHandle.TTBButtonEventOnCustomizeDelete(Sender: TToolBar; Button: TToolButton);
var
  recv, data: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_customize_delete'));
  rb_ary_push(data, recv);
  rb_ary_push(data, Button.tag);
end;

procedure TPhiHandle.TTBCustomizeQueryEventOnCustomizeCanDelete(Sender: TToolBar; Index: Integer; var Allow: Boolean);
var
  recv, data, ret: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_customize_can_delete'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Allow));
  rb_ary_push(data, INT2FIX(Index));

  ret := PhiCallProtect(data);
  if ret <> Qnil then Allow := RTEST(ret);
end;

procedure TPhiHandle.TTBCustomizeQueryEventOnCustomizeCanInsert(Sender: TToolBar; Index: Integer; var Allow: Boolean);
var
  recv, data, ret: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_customize_can_insert'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_bool(Allow));
  rb_ary_push(data, INT2FIX(Index));

  ret := PhiCallProtect(data);
  if ret <> Qnil then Allow := RTEST(ret);
end;

procedure TPhiHandle.TTBNewButtonEventOnCustomizeNewButton(Sender: TToolBar; Index: Integer; var Button: TToolButton);
var
  recv, data, ret: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_customize_new_button'));
  rb_ary_push(data, recv);
  rb_ary_push(data, Button.tag);

  ret := PhiCallProtect(data);
  if ret <> Qnil then Button := ap_data_get_struct(ret);
end;

procedure TPhiHandle.TPageScrollEventOnScroll(Sender: TObject; Shift: TShiftState; X, Y: Integer; Orientation:
TPageScrollerOrientation; var Delta: Integer);
var
  recv, data, ret: Tvalue;
begin
  if not  (Sender is TComponent) then Exit;
  recv := (Sender as TComponent).tag;

  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_scroll'));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_Set(Shift));
  rb_ary_push(data, INT2FIX(X));
  rb_ary_push(data, INT2FIX(Y));
  rb_ary_push(data, INT2FIX(Ord(Orientation)));

  ret := PhiCallProtect(data);
  if ret <> Qnil then Delta := FIX2INT(ret);
end;
{$ENDIF}

procedure TPhiHandle.NotifyOnMoved(Sender: TObject);
begin
  doNotify(Sender, 'on_moved');
end;

procedure TPhiHandle.MenuChangeOnChange(Sender: TObject; Source: TMenuItem; Rebuild: Boolean);
var
  recv, data: Tvalue;
begin
  recv := (Sender as TComponent).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_change'));
  rb_ary_push(data, recv);
  if Source = nil then
    rb_ary_push(data, Qnil)
  else
    rb_ary_push(data, ap_iMenuItem(Source, recv));
  rb_ary_push(data, ap_bool(Rebuild));
  PhiCallProtect(data);
end;

end.
