unit RDBHandle;

interface

uses
{$IFDEF LINUX}
  Types,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  SysUtils, Classes,
{$IFDEF VCL}
  Controls, Forms, DBGrids, Grids,
{$ELSE}
  QControls, QForms, QDBGrids, QGrids,
{$ENDIF}
  contnrs, DB,
  Rubies;

type
  TRDBHandle = class(TObject)
  public
    procedure doDataSetNotify(DataSet: TDataSet; name: PChar);
    procedure doDBGridClick(Column: TColumn; name: PChar);
    procedure doDataSetError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction; name: PChar);
  published
    procedure DataSetNotifyAfterCancel(DataSet: TDataSet);
    procedure DataSetNotifyAfterClose(DataSet: TDataSet);
    procedure DataSetNotifyAfterDelete(DataSet: TDataSet);
    procedure DataSetNotifyAfterEdit(DataSet: TDataSet);
    procedure DataSetNotifyAfterInsert(DataSet: TDataSet);
    procedure DataSetNotifyAfterOpen(DataSet: TDataSet);
    procedure DataSetNotifyAfterPost(DataSet: TDataSet);
    procedure DataSetNotifyAfterRefresh(DataSet: TDataSet);
    procedure DataSetNotifyAfterScroll(DataSet: TDataSet);
    procedure DataSetNotifyBeforeCancel(DataSet: TDataSet);
    procedure DataSetNotifyBeforeClose(DataSet: TDataSet);
    procedure DataSetNotifyBeforeDelete(DataSet: TDataSet);
    procedure DataSetNotifyBeforeEdit(DataSet: TDataSet);
    procedure DataSetNotifyBeforeInsert(DataSet: TDataSet);
    procedure DataSetNotifyBeforeOpen(DataSet: TDataSet);
    procedure DataSetNotifyBeforePost(DataSet: TDataSet);
    procedure DataSetNotifyBeforeScroll(DataSet: TDataSet);
    procedure DataSetNotifyBeforeRefresh(DataSet: TDataSet);
    procedure DataSetNotifyOnCalcFields(DataSet: TDataSet);
    procedure DataSetNotifyOnNewRecord(DataSet: TDataSet);
    procedure DataSetErrorOnDeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
    procedure DataSetErrorOnEditError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
    procedure DataSetErrorOnPostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
    procedure FilterRecordOnFilterRecord(DataSet: TDataSet; var Accept: Boolean);
    procedure UpdateRecordOnUpdateRecord(DataSet: TDataSet; UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
    { DataSource }
    procedure DataChangeOnDataChange(Sender: TObject; Field: TField);
    procedure NotifyOnStateChange(Sender: TObject);
    procedure NotifyOnUpdateData(Sender: TObject);
    { TDBGrid }
    procedure DrawColumnCellOnDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGridClickOnCellClick(Column: TColumn);
    procedure DBGridClickOnTitleClick(Column: TColumn);
    procedure NotifyOnColEnter(Sender: TObject);
    procedure NotifyOnColExit(Sender: TObject);
    procedure NotifyOnEditButtonClick(Sender: TObject);
  end;

function retnil(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
function retval(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;

implementation

uses
  Pythia,
{$IFDEF RDBEMBED}
  uRDB, uColumn, uDBGrid;
{$ELSE}
  uRDBExt;
{$ENDIF}

function retnil(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
begin
  result := Qnil;
end;

function retval(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
begin
  if argc > 0 then
    result := Pvalue(argv)^
  else
    result := Qnil
  ;
end;

procedure ap_dispose(p: Pointer); cdecl;
begin
  try
    Dispose(p);
  except
    on E: Exception do;
  end;
end;

procedure TRDBHandle.doDataSetNotify(DataSet: TDataSet; name: PChar);
var
  recv, data: Tvalue;
begin
  recv := DataSet.tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  PhiCallProtect(data);
end;

procedure TRDBHandle.DataSetNotifyAfterCancel(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'after_cancel');
end;

procedure TRDBHandle.DataSetNotifyAfterClose(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'after_close');
end;

procedure TRDBHandle.DataSetNotifyAfterDelete(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'after_delete');
end;

procedure TRDBHandle.DataSetNotifyAfterEdit(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'after_edit');
end;

procedure TRDBHandle.DataSetNotifyAfterInsert(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'after_insert');
end;

procedure TRDBHandle.DataSetNotifyAfterOpen(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'after_open');
end;

procedure TRDBHandle.DataSetNotifyAfterPost(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'after_post');
end;

procedure TRDBHandle.DataSetNotifyAfterRefresh(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'after_refresh');
end;

procedure TRDBHandle.DataSetNotifyAfterScroll(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'after_scroll');
end;

procedure TRDBHandle.DataSetNotifyBeforeCancel(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'before_cancel');
end;

procedure TRDBHandle.DataSetNotifyBeforeClose(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'before_close');
end;

procedure TRDBHandle.DataSetNotifyBeforeDelete(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'before_delete');
end;

procedure TRDBHandle.DataSetNotifyBeforeEdit(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'before_edit');
end;

procedure TRDBHandle.DataSetNotifyBeforeInsert(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'before_insert');
end;

procedure TRDBHandle.DataSetNotifyBeforeOpen(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'before_open');
end;

procedure TRDBHandle.DataSetNotifyBeforePost(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'before_post');
end;

procedure TRDBHandle.DataSetNotifyBeforeScroll(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'before_scroll');
end;

procedure TRDBHandle.DataSetNotifyBeforeRefresh(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'before_refresh');
end;

procedure TRDBHandle.DataSetNotifyOnCalcFields(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'on_calc_fields');
end;

procedure TRDBHandle.DataSetNotifyOnNewRecord(DataSet: TDataSet);
begin
  doDataSetNotify(DataSet, 'on_new_record');
end;

procedure TRDBHandle.doDataSetError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction; name: PChar);
var
  recv, data: Tvalue;
  ret: Tvalue;
begin
  recv := DataSet.tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Ord(Action)));
  rb_ary_push(data, rb_exc_new2(ap_eDatabaseError, PChar(E.Message)));
  ret := PhiCallProtect(data);
  if ret <> Qnil then Action := TDataAction(FIX2INT(ret));
end;

procedure TRDBHandle.DataSetErrorOnDeleteError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
  doDataSetError(dataSet, E, Action, 'on_delete_error');
end;

procedure TRDBHandle.DataSetErrorOnEditError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
  doDataSetError(dataSet, E, Action, 'on_edit_error');
end;

procedure TRDBHandle.DataSetErrorOnPostError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
begin
  doDataSetError(dataSet, E, Action, 'on_post_error');
end;

procedure TRDBHandle.FilterRecordOnFilterRecord(DataSet: TDataSet; var Accept: Boolean);
var
  recv, data: Tvalue;
  ret: Tvalue;
begin
  recv := DataSet.tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_filter_record'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Ord(Accept)));
  ret := PhiCallProtect(data);
  if ret <> Qnil then Accept := RTEST(ret);
end;

procedure TRDBHandle.UpdateRecordOnUpdateRecord(DataSet: TDataSet; UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction);
var
  recv, data: Tvalue;
  ret: Tvalue;
begin
  recv := DataSet.tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_update_record'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Ord(UpdateKind)));
  rb_ary_push(data, INT2FIX(Ord(UpdateAction)));
  ret := PhiCallProtect(data);
  if ret <> Qnil then
  try
    UpdateAction := TUpdateAction(dl_Integer(ret));
  except
    ap_raise(ap_eIndexError, sOut_of_range);
  end;
end;

procedure TRDBHandle.DataChangeOnDataChange(Sender: TObject; Field: TField);
var
  recv, data: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_data_change'));
  rb_ary_push(data, recv);
  if Field = nil then
    rb_ary_push(data, Qnil)
  else
    rb_ary_push(data, Field.tag);
  PhiCallProtect(data);
end;

procedure TRDBHandle.NotifyOnStateChange(Sender: TObject);
begin
  PhiGetHandle.doNotify(Sender, 'on_state_change');
end;

procedure TRDBHandle.NotifyOnUpdateData(Sender: TObject);
begin
  PhiGetHandle.doNotify(Sender, 'on_update_data');
end;

procedure TRDBHandle.DrawColumnCellOnDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  recv, data: Tvalue;
  rectp: PRect;
  rectv: Tvalue;
begin
  recv := TComponent(Sender).tag;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_draw_column_cell'));
  rb_ary_push(data, recv);
  new(rectp);
  rectv := rb_data_object_alloc(ap_cRect, rectp, nil, @ap_dispose);
  rb_ary_push(data, rectv);
  rectp^.TopLeft := Rect.TopLeft;
  rectp^.BottomRight := Rect.BottomRight;
  rb_ary_push(data, INT2FIX(DataCol));
  rb_ary_push(data, ap_iColumn(Column, recv));
  rb_ary_push(data, ap_Set(State));
  PhiCallProtect(data);
end;

procedure TRDBHandle.doDBGridClick(Column: TColumn; name: PChar);
var
  recv, data: Tvalue;
begin
  recv := Tvalue(Column.Grid.tag);
  data := rb_ary_new;
  rb_ary_push(data, rb_intern(name));
  rb_ary_push(data, recv);
  rb_ary_push(data, ap_iColumn(Column, recv));
  PhiCallProtect(data);
end;

procedure TRDBHandle.DBGridClickOnCellClick(Column: TColumn);
begin
  doDBGridClick(Column, 'on_cell_click');
end;

procedure TRDBHandle.DBGridClickOnTitleClick(Column: TColumn);
begin
  doDBGridClick(Column, 'on_title_click');
end;

procedure TRDBHandle.NotifyOnColEnter(Sender: TObject);
begin
  PhiGetHandle.doNotify(Sender, 'on_col_enter');
end;

procedure TRDBHandle.NotifyOnColExit(Sender: TObject);
begin
  PhiGetHandle.doNotify(Sender, 'on_col_exit');
end;

procedure TRDBHandle.NotifyOnEditButtonClick(Sender: TObject);
begin
  PhiGetHandle.doNotify(Sender, 'on_edit_button_click');
end;

end.
