unit uApplication;

interface

uses
{$IFDEF VCL}
  Forms,
{$ELSE}
  QForms,
{$ENDIF}
  Rubies, uPoint;

var
  cApplication: Tvalue;
  vApplication: Tvalue;

function ap_cApplication: Tvalue;
function ap_vApplication: Tvalue;
procedure Init_Application;

implementation

uses
{$IFDEF LINUX}
  Types,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  SysUtils,
{$IFDEF VCL}
  Graphics,
{$ELSE}
  QGraphics,
{$ENDIF}
  uDefUtils, uStrUtils, uHandle, uAlloc, uProp, uPhi, uConv, uIcon, uPersistent, uComponent;

function ap_cApplication: Tvalue;
begin
  result := cApplication;
end;

function ap_vApplication: Tvalue;
begin
  result := vApplication;
end;

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

function Application_set_method(This, v: Tvalue): Tvalue; cdecl;
var
  hash, key: Tvalue;
  name: string;
  id: Tid;
begin
  hash := rb_iv_get(This, '@events');
  name := LowerCase1(rb_id2name(rb_frame_last_func));
  SetLength(name, Length(name)-1); // chop!
  id := rb_intern(PChar(name));
  key := ID2SYM(id);
  rb_hash_aset(hash, key, v);
  result := v;
end;

function Application_set_on_activate(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  result := Application_set_method(This, v);
  real := ap_data_get_struct(This);
  if @real.OnActivate = nil then
      real.OnActivate := Handle.NotifyOnActivate;
end;

function Application_set_on_exception(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  result := Application_set_method(This, v);
  real := ap_data_get_struct(This);
  if @real.OnException = nil then
      real.OnException := Handle.ExceptionOnException;
end;

function Application_set_on_hint(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  result := Application_set_method(This, v);
  real := ap_data_get_struct(This);
  if @real.OnHint = nil then
      real.OnHint := Handle.NotifyOnHint;
end;

function Application_set_on_idle(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  result := Application_set_method(This, v);
  real := ap_data_get_struct(This);
  if @real.OnIdle = nil then
      real.OnIdle := Handle.IdleOnIdle;
end;

function Application_handle_message(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  real.HandleMessage;
  result := This;
end;

function Application_process_messages(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  real.ProcessMessages;
  result := This;
end;

function Application_get_terminated(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.Terminated);
end;

function Application_set_icon(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
  icon: TIcon;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TIcon, icon);
  real.Icon := icon;
  result := v;
  rb_iv_set(This, '@icon', v);
end;

function Application_set_title(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  real.Title := dl_String(v);
  result := v;
  rb_iv_set(This, '@title', v);
end;

function Application_get_show_hint(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.ShowHint);
end;

function Application_set_show_hint(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  real.ShowHint := dl_Boolean(v);
  result := This;
end;

function Application_get_hint(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.Hint);
end;

function Application_set_hint(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  real.Hint := dl_String(v);
  result := v;
end;

function Application_get_hint_color(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(real.HintColor);
end;

function Application_set_hint_color(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  real.HintColor := dl_Integer(v);
  result := v;
end;

function Application_get_handle(This: Tvalue): Tvalue; cdecl;
{$IFDEF VCL}
var
  real: TApplication;
{$ENDIF}
begin
{$IFDEF VCL}
  real := ap_data_get_struct(This);
  result := ap_Handle(real.Handle);
{$ELSE}
  result := Qnil;
{$ENDIF}
end;

function Application_set_handle(This,v: Tvalue): Tvalue; cdecl;
{$IFDEF VCL}
var
  real: TApplication;
{$ENDIF}
begin
{$IFDEF VCL}
  real := ap_data_get_struct(This);
  real.Handle := dl_Handle(v);
{$ENDIF}
  result := This;
end;

function Application_get_exe_name(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  result := ap_Path(real.ExeName);
end;

function Application_get_active(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.Active);
end;

function Application_get_main_form(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  result := Qnil;
  if Assigned(real.MainForm) then
    result := real.MainForm.tag;
end;

function Application_instance(This: Tvalue): Tvalue; cdecl;
begin
  result := vApplication;
end;

{$IFDEF VCL}
function Application_create_handle(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  real.CreateHandle;
  result := This;
end;
{$ENDIF}

function Application_bring_to_front(This: Tvalue): Tvalue; cdecl;
begin
  result := This;
  TApplication(ap_data_get_struct(This)).BringToFront;
end;

{$IFDEF MSWINDOWS}
{$IFDEF VCL}
function Application_bring_to_front_ex(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
  TopWindow: HWnd;
  ForegroundID, TargetID: Integer;
begin
  result := This;
  real := ap_data_get_struct(This);
  if real.Handle <> 0 then//CLX: HWND -> QApplicationH
  begin
    TopWindow := GetLastActivePopup(real.Handle);
    if  (TopWindow <> 0) 
    and (TopWindow <> real.Handle) 
    and IsWindowVisible(TopWindow) 
    and IsWindowEnabled(TopWindow) 
    then begin
      ForegroundID := GetWindowThreadProcessId(GetForegroundWindow(), nil);
      TargetID := GetWindowThreadProcessId(real.Handle, nil);
      AttachThreadInput(TargetID, ForegroundID, True);
      SetForegroundWindow(TopWindow);
      AttachThreadInput(TargetID, ForegroundID, False);
    end;
  end;
end;
{$ENDIF}
{$ENDIF}

function Application_activate_hint(This, v: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
  p: TPoint;
begin
  real := ap_data_get_struct(This);
  p := TPoint(ap_data_get_struct(v)^);
  real.ActivateHint(p);
  result := This;
end;

function Application_show_exception(This: Tvalue): Tvalue; cdecl;
var
  real: TApplication;
begin
  real := ap_data_get_struct(This);
  real.ShowException(Exception(ExceptObject));
  result := This;
end;

procedure Regist_Application;
var
  real: TApplication;
  obj: Tvalue;
begin
  real := Application;
//  if real.handle = 0 then real.CreateHandle;
  obj := ChildAlloc(cApplication, real);
  vApplication := obj;
  rb_define_const(mPhi, 'APPLICATION', obj);
  rb_iv_set(obj, '@icon', ap_iIcon(real.Icon, obj));
  rb_iv_set(obj, '@title', ap_String(real.Title));
end;

procedure Init_Application;
begin
  cApplication := OutputPersistentClass(mPhi, TApplication, cComponent, nil);
  rb_define_method(cApplication, 'event_handle', @Application_event_handle, 1);

  rb_undef_method(CLASS_OF(cApplication), 'new');
  rb_define_singleton_method(cApplication, 'instance', @Application_instance, 0);

  rb_define_method(ap_cApplication, 'handle_message', @Application_handle_message, 0);
  rb_define_method(ap_cApplication, 'process_messages', @Application_process_messages, 0);
  DefineAttrGet(cApplication, 'terminated', Application_get_terminated);
  DefineAttrSet(cApplication, 'icon', Application_set_icon);
  DefineAttrSet(cApplication, 'title', Application_set_title);
  rb_define_attr(cApplication, 'icon', 1, 0);
  rb_define_attr(cApplication, 'title', 1, 0);
  DefineAttrGet(cApplication, 'show_hint', Application_get_show_hint);
  DefineAttrSet(cApplication, 'show_hint', Application_set_show_hint);
  DefineAttrGet(cApplication, 'hint', Application_get_hint);
  DefineAttrSet(cApplication, 'hint', Application_set_hint);
  DefineAttrGet(cApplication, 'hint_color', Application_get_hint_color);
  DefineAttrSet(cApplication, 'hint_color', Application_set_hint_color);

  DefineAttrGet(cApplication, 'handle', Application_get_handle);
  DefineAttrSet(cApplication, 'handle', Application_set_handle);
  DefineAttrGet(cApplication, 'exe_name', Application_get_exe_name);
  DefineAttrGet(cApplication, 'active', Application_get_active);

  DefineAttrGet(cApplication, 'main_form', Application_get_main_form);
{$IFDEF VCL}
  rb_define_method(cApplication, 'create_handle', @Application_create_handle, 0);
{$ENDIF}
  rb_define_method(cApplication, 'bring_to_front', @Application_bring_to_front, 0);
{$IFDEF MSWINDOWS}
{$IFDEF VCL}
  rb_define_method(cApplication, 'bring_to_front_ex', @Application_bring_to_front_ex, 0);
{$ENDIF}
{$ENDIF}
  rb_define_method(cApplication, 'activate_hint', @Application_activate_hint, 1);
  rb_define_method(cApplication, 'show_exception', @Application_show_exception, 0);

  DefineAttrSet(cApplication, 'on_activate', Application_set_on_activate);
  rb_define_method(cApplication, 'on_activate', @retnil, -1);
  DefineAttrSet(cApplication, 'on_exception', Application_set_on_exception);
  rb_define_method(cApplication, 'on_exception', @retnil, -1);
  DefineAttrSet(cApplication, 'on_hint', Application_set_on_hint);
  rb_define_method(cApplication, 'on_hint', @retnil, -1);
  DefineAttrSet(cApplication, 'on_idle', Application_set_on_idle);
  rb_define_method(cApplication, 'on_idle', @retnil, -1);

  Regist_Application;
end;

end.
