library PhiDialogs;

uses
{$IFDEF WIN32} FastShareMem, {$ENDIF}
  Types,
  Classes,
  ExtDlgs,
{$IFDEF VCL}
  Dialogs,
{$ELSE}
  QDialogs,
{$ENDIF}
  Rubies, uDefUtils,
{$IFDEF PHIEMBED}
  {PhiMainUnit, } uHandle, uAlloc, uProp, uPhi, uConv, uFont, uComponent,
{$ELSE}
  Pythia,
{$ENDIF}
  DialogsHandle;

{$E so}
var
  cCommonDialog, cOpenDialog, cSaveDialog, cColorDialog, cFontDialog, cFindDialog, cPrinterSetupDialog,
  cOpenPictureDialog, cPrintDialog, cReplaceDialog, cSavePictureDialog: Tvalue;

//  message_dlg(mesg, dlg_type=MT_CUSTOM, btns=[MB_OK], help_ctx=0, x=-1, y=-1) : Fixnum
function Phi_message_dlg(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  Mesg: string;
  num: Integer;
  DlgType: TMsgDlgType;
  ary: Tvalue;
  Btns: TMsgDlgButtons;
  HelpCtx: Longint;
  len: Integer;
  ptr: Pvalue;
  n: Integer;
  X, Y: Integer;
  ret: Integer;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;

  mesg := dl_String(args[0]);

  DlgType := mtCustom;
  if argc > 1 then
  begin
    num := FIX2INT(args[1]);
    try
      DlgType := TMsgDlgType(num);
    except
      ap_raise(ap_eArgError, sOut_of_range);
    end;
  end;

  if argc > 2 then
  begin
    ary := args[2];
    Check_Type(ary, T_ARRAY);
    len := ap_ary_len(ary);
    ptr := ap_ary_ptr(ary);
    Btns := [];
    while len > 0 do
    begin
      n := FIX2INT(ptr^);
      try
        Include(Btns, TMsgDlgBtn(n));
      except
        ap_raise(ap_eIndexError, sOut_of_range);
      end;
      Dec(len);
      Inc(ptr);
    end;
  end
  else
    Btns := [mbOK]
  ;

  if argc > 3 then
    HelpCtx := INT2FIX(args[3])
  else
    HelpCtx := 0
  ;

  if argc > 4 then
    X := INT2FIX(args[4])
  else
    X := -1
  ;

  if argc > 5 then
    Y := INT2FIX(args[5])
  else
    Y := -1
  ;

  ret := MessageDlgPos(mesg, DlgType, Btns, HelpCtx, X, Y);
  result := INT2FIX(ret);
end;

function Phi_input_box(This, cap, prompt, v: Tvalue): Tvalue; cdecl;
begin
  result := ap_String(InputBox(dl_String(cap), dl_String(prompt), dl_String(v)));
end;

function Phi_input_query(This, cap, prompt, v: Tvalue): Tvalue; cdecl;
var
  S: string;
begin
  S := dl_String(v);
  result := rb_ary_new;
  rb_ary_push(result, ap_bool(InputQuery(dl_String(cap), dl_String(prompt), S)));
  rb_ary_push(result, ap_String(S));
end;

(**** CommonDialog & subclasses ****)

function CommonDialog_execute(This : Tvalue): Tvalue; cdecl;
var
  real: TCommonDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.Execute);
end;

function CommonDialog_get_handle(This: Tvalue): Tvalue; cdecl;
var
  real: TCommonDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_Handle(ord(real.Handle));
end;

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

procedure OpenDialog_setup(obj: Tvalue; real: TOpenDialog);
begin
//
end;

function OpenDialog_alloc(This: Tvalue; real: TOpenDialog): Tvalue;
begin
  result := ChildAlloc(This, real);
  OpenDialog_setup(result, real);
end;

function ap_iOpenDialog(real: TOpenDialog; owner: Tvalue): Tvalue;
begin
  result := OpenDialog_alloc(cOpenDialog, real);
  ap_owner(result, owner);
end;

function ap_iOpenDialog_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iOpenDialog(TOpenDialog(obj), owner);
end;

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

function OpenDialog_files(This: Tvalue): Tvalue; cdecl;
var
  real: TOpenDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_iStrings(real.Files, This);
end;

function OpenDialog_get_file_edit_style(This: Tvalue): Tvalue; cdecl;
var
  real: TOpenDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.FileEditStyle));
end;

function OpenDialog_set_file_edit_style(This, v: Tvalue): Tvalue; cdecl;
var
  real: TOpenDialog;
begin
  real := ap_data_get_struct(This);
  real.FileEditStyle := TFileEditStyle(dl_Integer(v));
  result := v;
end;

function OpenDialog_get_history_list(This: Tvalue): Tvalue; cdecl;
var
  real: TOpenDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_iStrings(real.HistoryList,This);
end;

function OpenDialog_set_history_list(This, v: Tvalue): Tvalue; cdecl;
var
  real: TOpenDialog;
begin
  real := ap_data_get_struct(This);
  real.HistoryList := ap_data_get_struct(v);
  result := v;
end;

procedure SaveDialog_setup(obj: Tvalue; real: TSaveDialog);
begin
//
end;

function SaveDialog_alloc(This: Tvalue; real: TSaveDialog): Tvalue;
begin
  result := ChildAlloc(This, real);
  SaveDialog_setup(result, real);
end;

function ap_iSaveDialog(real: TSaveDialog; owner: Tvalue): Tvalue;
begin
  result := SaveDialog_alloc(cSaveDialog, real);
  ap_owner(result, owner);
end;

function ap_iSaveDialog_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iSaveDialog(TSaveDialog(obj), owner);
end;

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

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

function ColorDialog_custom_colors(This: Tvalue): Tvalue; cdecl;
var
  real: TColorDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_iStrings(real.CustomColors,This);
end;

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

function FontDialog_set_font(This, v: Tvalue): Tvalue; cdecl;
var
  real: TFontDialog;
begin
  real := ap_data_get_struct(This);
  real.Font := ap_data_get_struct(v);
  result := v;
end;

function FontDialog_get_font(This: Tvalue): Tvalue; cdecl;
var
  real: TFontDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_iFont(real.Font,This);  // uses uFont
end;

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

function FindDialog_execute(This : Tvalue): Tvalue; cdecl; // need. differ from CommonDialog_execute
var
  real: TFindDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.Execute);
end;

function FindDialog_close_dialog(This : Tvalue): Tvalue; cdecl;
var
  real: TFindDialog;
begin
  real := ap_data_get_struct(This);
  real.CloseDialog;
  result := This;
end;

function FindDialog_get_left(This: Tvalue): Tvalue; cdecl;
var
  real: TFindDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.Left);
end;

function FindDialog_set_left(This, v: Tvalue): Tvalue; cdecl;
var
  real: TFindDialog;
begin
  real := ap_data_get_struct(This);
  real.Left := dl_Integer(v);
  result := v;
end;

function FindDialog_get_position(This: Tvalue): Tvalue; cdecl;
var
  real: TFindDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_iPoint(real.Position,This);  // uses uPoint
end;

function FindDialog_set_position(This, v: Tvalue): Tvalue; cdecl;
var
  real: TFindDialog;
begin
  real := ap_data_get_struct(This);
  real.Position := dl_Point(v);
  result := v;
end;

function FindDialog_get_top(This: Tvalue): Tvalue; cdecl;
var
  real: TFindDialog;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.Top);
end;

function FindDialog_set_top(This, v: Tvalue): Tvalue; cdecl;
var
  real: TFindDialog;
begin
  real := ap_data_get_struct(This);
  real.Top := dl_Integer(v);
  result := v;
end;

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

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

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

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

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

procedure Init_dialogs;
begin
  PhiStart;

  DefineConstSetType(ap_mPhi, TypeInfo(TMsgDlgBtn));
  DefineConstSetType(ap_mPhi, TypeInfo(TMsgDlgType));
{$IFDEF VCL}
  DefineConstSetType(ap_mPhi, TypeInfo(TFontDialogOption));
{$ENDIF}
  DefineConstSetType(ap_mPhi, TypeInfo(TOpenOption));

  DefineModuleFunction(ap_mPhi, 'message_dlg', Phi_message_dlg);
  rb_define_module_function(ap_mPhi, 'input_box', @Phi_input_box, 3);
  rb_define_module_function(ap_mPhi, 'input_query', @Phi_input_query, 3);

{$IFDEF VCL}
  cCommonDialog := DefinePersistentClass(ap_mPhi, TCommonDialog, ap_cComponent, nil);
{$ELSE}
  cCommonDialog := DefinePersistentClass(ap_mPhi, TQtDialog, ap_cComponent, nil);
{$ENDIF}
  rb_define_method(cCommonDialog, 'execute', @CommonDialog_execute, 0);
  DefineAttrGet(cCommonDialog, 'handle', CommonDialog_get_handle);
  rb_define_method(cCommonDialog, 'event_handle', @CommonDialog_event_handle, 1);

  cOpenDialog := DefinePersistentClass(ap_mPhi, TOpenDialog, cCommonDialog, ap_iOpenDialog_v);
  rb_define_singleton_method(cOpenDialog, 'new', @OpenDialog_new, 0);
  rb_define_method(cOpenDialog, 'files', @OpenDialog_files, 0);
  DefineAttrGet(cOpenDialog, 'file_edit_style', OpenDialog_get_file_edit_style);
  DefineAttrSet(cOpenDialog, 'file_edit_style', OpenDialog_set_file_edit_style);
  DefineAttrGet(cOpenDialog, 'history_list', OpenDialog_get_history_list);
  DefineAttrSet(cOpenDialog, 'history_list', OpenDialog_set_history_list);

  cSaveDialog := DefinePersistentClass(ap_mPhi, TSaveDialog, cCommonDialog, ap_iSaveDialog_v);
  rb_define_singleton_method(cSaveDialog, 'new', @SaveDialog_new, 0);

  cColorDialog := DefinePersistentClass(ap_mPhi, TColorDialog, cCommonDialog, nil);
  rb_define_singleton_method(cColorDialog, 'new', @ColorDialog_new, 0);
  rb_define_method(cColorDialog, 'custom_colors', @ColorDialog_custom_colors, 0);

  cFontDialog := DefinePersistentClass(ap_mPhi, TFontDialog, cCommonDialog, nil);
  rb_define_singleton_method(cFontDialog, 'new', @FontDialog_new, 0);
  DefineAttrSet(cFontDialog, 'font', FontDialog_set_font);
  DefineAttrGet(cFontDialog, 'font', FontDialog_get_font);

  cFindDialog := DefinePersistentClass(ap_mPhi, TFindDialog, cCommonDialog, nil);
  rb_define_singleton_method(cFindDialog, 'new', @FindDialog_new, 0);
  rb_define_method(cFindDialog, 'execute', @FindDialog_execute, 0);
  rb_define_method(cFindDialog, 'close_dialog', @FindDialog_close_dialog, 0);
  DefineAttrGet(cFindDialog, 'left', FindDialog_get_left);
  DefineAttrSet(cFindDialog, 'left', FindDialog_set_left);
  DefineAttrGet(cFindDialog, 'position', FindDialog_get_position);
  DefineAttrSet(cFindDialog, 'position', FindDialog_set_position);
  DefineAttrGet(cFindDialog, 'top', FindDialog_get_top);
  DefineAttrSet(cFindDialog, 'top', FindDialog_set_top);

  cReplaceDialog := DefinePersistentClass(ap_mPhi, TReplaceDialog, cFindDialog, nil);
  rb_define_singleton_method(cReplaceDialog, 'new', @ReplaceDialog_new, 0);

  cPrintDialog := DefinePersistentClass(ap_mPhi, TPrintDialog, cCommonDialog, nil);
  rb_define_singleton_method(cPrintDialog, 'new', @PrintDialog_new, 0);

  cPrinterSetupDialog := DefinePersistentClass(ap_mPhi, TPrinterSetupDialog, cCommonDialog, nil);
  rb_define_singleton_method(cPrinterSetupDialog, 'new', @PrinterSetupDialog_new, 0);

  cOpenPictureDialog := DefinePersistentClass(ap_mPhi, TOpenPictureDialog, cOpenDialog, nil);
  rb_define_singleton_method(cOpenPictureDialog, 'new', @OpenPictureDialog_new, 0);

  cSavePictureDialog := DefinePersistentClass(ap_mPhi, TSavePictureDialog, cOpenPictureDialog, nil);
  rb_define_singleton_method(cSavePictureDialog, 'new', @SavePictureDialog_new, 0);

end;

exports
  Init_dialogs;

end.
