unit uWin;

interface

uses
  Rubies, Windows, SHellAPI, SysUtils;

procedure Init_win;

implementation

uses uStrUtils, ComObj, uPhi, uPoint, uConv;

function Win_set_capture(This, handle: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(SetCapture(dl_Handle(handle)));
end;

function Win_get_capture(This: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(GetCapture);
end;

function Win_release_capture(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_bool(ReleaseCapture);
end;

function Win_invalidate_rect(This, handle, rect, erase: Tvalue): Tvalue; cdecl;
begin
  result := ap_bool(InvalidateRect(dl_Handle(handle), PRect(ap_data_get_struct(rect)), RTEST(erase)));
end;

function Win_get_cursor_pos(This: Tvalue): Tvalue; cdecl;
var
  point: TPoint;
  v: Tvalue;
begin
  GetCursorPos(point);
  v := ap_iPoint(point, Qnil);
  result := v;
end;

function Win_get_key_state(This, key: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(GetKeyState(FIX2INT(key)));
end;

function Win_set_cursor(This, cur: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(SetCursor(FIX2INT(cur)));
end;

function Win_load_cursor(This, str: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(LoadCursor(HInstance, PChar(dl_String(str))));
end;

function Win_shell_execute(This, handle, op, fname, param, dir, show_cmd: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(ShellExecute(
    dl_Handle(handle),
    PChar(dl_String(op)),
    PChar(dl_String(fname)),
    PChar(dl_String(param)),
    PChar(dl_String(dir)),
    FIX2INT(show_cmd)
  ));
end;

function Win_keybd_event(This, vk, sc, flags, extra: Tvalue): Tvalue; cdecl;
begin
  result := Qnil;
  keybd_event(
    FIX2INT(vk),
    FIX2INT(sc),
    FIX2INT(flags),
    FIX2INT(extra)
  );
end;

function Win_get_computer_name(This: Tvalue): Tvalue; cdecl;
var
  Name: array[0..MAX_COMPUTERNAME_LENGTH] of Char;
  nSize: DWORD;
begin
  nSize := MAX_COMPUTERNAME_LENGTH + 1;
  Win32Check(GetComputerName(Name, nSize));
  result := ap_String(Name);
end;

function Win_create_class_id(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_String(CreateClassID);
end;

function Win_sh_file_operation(
    This,
    handle,
    Func,
    FromPath,
    ToPath,
    Flags,
    ProgressTitle: Tvalue): Tvalue; cdecl;
(*
  not support NameMappings

  Do not validate FOF_WANTMAPPINGHANDLE constant.
  This varsion do not free the system memory allocated by
  FOF_WANTMAPPINGHANDLE.

  In order to NameMapping, you must
  (1) Validate FOF_WANTMAPPINGHANDLE constant
  (2) Test FOF_WANTMAPPINGHANDLE flag and NameMappings := Qnil
      unless flags includes FOF_WANTMAPPINGHANDLE
  (3) NameMappings := rb_ary_new when flags includes
      FOF_WANTMAPPINGHANDLE
  (4) Convert hNameMappings structure into NameMappings
  (5) The handle must be freed by using the SHFreeNameMappings
      function.
  (6) rb_ary_push(result, NameMappings)
*)
var
  shRec : TSHFileOpStruct;
  NameMappings:Tvalue;
begin
  with shRec do
  begin
    wnd    := dl_Handle(handle);
    wFunc  := dl_Integer(Func);
    pFrom  := PChar(dl_Path(FromPath)+#0#0);
    pTo    := PChar(dl_Path(ToPath)+#0#0);
    fFlags := dl_Integer(Flags);
    //fAnyOperationsAborted .. return
    hNameMappings := nil; //.. return
    lpszProgressTitle := PChar(dl_String(ProgressTitle));
  end;
  result := rb_ary_new;
  rb_ary_push(result, ap_Integer( SHFileOperation(shRec)) );
  rb_ary_push(result, ap_Bool(shRec.fAnyOperationsAborted));

  NameMappings := Qnil;
  rb_ary_push(result, NameMappings);

  //if shRec.hNameMappings <> nil
  //  then SHFreeNameMappings( Cardinal(shRec.hNameMappings) );
end;

function Win_expand_unc_file_name(This,v: Tvalue): Tvalue; cdecl;
begin
  result := ap_Path(ExpandUNCFileName(dl_String(v)));
end;

function Win_expand_file_name(This,v: Tvalue): Tvalue; cdecl;
begin
  result := ap_Path(ExpandFileName(dl_String(v)));
end;

//[ap-dev:0921]
function Win_win_exec(argc: integer; argv: Tvalue_array; This: Tvalue): Tvalue; cdecl;
var
  CmdShow : Integer;
begin
  if argc > 2 then ap_raise(ap_eArgError, sToo_many_args);
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  if argc > 1 
    then CmdShow := dl_Integer(argv[1])
    else CmdShow := SW_NORMAL;
  result := ap_Integer(WinExec(PChar(dl_String(argv[0])), CmdShow));
end;

function Win_send_message(This, v1,v2,v3,v4: Tvalue): Tvalue; cdecl;
var
  hWnd,				// handle of destination window
  Msg,				// message to send
  wParam,			// first message parameter
  lParam:Integer; 	// second message parameter
begin
  hWnd := dl_Handle(v1);
  Msg  := dl_Integer(v2);
  wParam := dl_Integer(v3);
  lParam := dl_Integer(v4);
  result := ap_Integer(SendMessage(hWnd,Msg,wParam,lParam));
end;

//[ap-dev:1204]
//function DrawText(hDC: HDC; lpString: PChar; nCount: Integer;
//  var lpRect: TRect; uFormat: UINT): Integer; stdcall;

function Win_draw_text(This,handle,str,count,rect,format:Tvalue):Tvalue; cdecl;
begin
  result := ap_Integer(DrawText(
      dl_Handle(handle),
      PChar(dl_String(str)),
      dl_Integer(count),
      PRect(ap_data_get_struct(rect))^,  //  dl_Rect ??
      dl_Integer(format)));
end;

procedure Init_win;
begin
  rb_define_const(mPhi, 'PLATFORM_WIN32', INT2FIX(Win32Platform));
  rb_define_const(mPhi, 'PLATFORM_WIN32s', INT2FIX(VER_PLATFORM_WIN32s));
  rb_define_const(mPhi, 'PLATFORM_WIN32_WINDOWS', INT2FIX(VER_PLATFORM_WIN32_WINDOWS));
  rb_define_const(mPhi, 'PLATFORM_WIN32_NT', INT2FIX(VER_PLATFORM_WIN32_NT));
  rb_define_const(mPhi, 'LANG', INT2FIX(SysLocale.PriLangID));
  rb_define_const(mPhi, 'LANG_ENGLISH', INT2FIX(LANG_ENGLISH));
  rb_define_const(mPhi, 'LANG_JAPANESE', INT2FIX(LANG_JAPANESE));

  rb_define_const(mPhi, 'MAJOR', INT2FIX(Win32MajorVersion));
  rb_define_const(mPhi, 'MINOR', INT2FIX(Win32MinorVersion));
  rb_define_const(mPhi, 'BUILD', INT2FIX(Win32BuildNumber));
  rb_define_const(mPhi, 'CSD', rb_str_new2(PChar(Win32CSDVersion)));

  rb_define_const(mPhi, 'ETO_CLIPPED', INT2FIX(ETO_CLIPPED));
  rb_define_const(mPhi, 'ETO_OPAQUE', INT2FIX(ETO_OPAQUE));

  rb_define_const(mPhi, 'SW_HIDE', INT2FIX(SW_HIDE));
  rb_define_const(mPhi, 'SW_SHOWNORMAL', INT2FIX(SW_SHOWNORMAL));
  rb_define_const(mPhi, 'SW_NORMAL', INT2FIX(SW_NORMAL));
  rb_define_const(mPhi, 'SW_SHOWMINIMIZED', INT2FIX(SW_SHOWMINIMIZED));
  rb_define_const(mPhi, 'SW_SHOWMAXIMIZED', INT2FIX(SW_SHOWMAXIMIZED));
  rb_define_const(mPhi, 'SW_MAXIMIZE', INT2FIX(SW_MAXIMIZE));
  rb_define_const(mPhi, 'SW_SHOWNOACTIVATE', INT2FIX(SW_SHOWNOACTIVATE));
  rb_define_const(mPhi, 'SW_SHOW', INT2FIX(SW_SHOW));
  rb_define_const(mPhi, 'SW_MINIMIZE', INT2FIX(SW_MINIMIZE));
  rb_define_const(mPhi, 'SW_SHOWMINNOACTIVE', INT2FIX(SW_SHOWMINNOACTIVE));
  rb_define_const(mPhi, 'SW_SHOWNA', INT2FIX(SW_SHOWNA));
  rb_define_const(mPhi, 'SW_RESTORE', INT2FIX(SW_RESTORE));
  rb_define_const(mPhi, 'SW_SHOWDEFAULT', INT2FIX(SW_SHOWDEFAULT));
  rb_define_const(mPhi, 'SW_MAX', INT2FIX(SW_MAX));

  rb_define_const(mPhi, 'CE_FRAME', INT2FIX(CE_FRAME));
  rb_define_const(mPhi, 'CE_OVERRUN', INT2FIX(CE_OVERRUN));
  rb_define_const(mPhi, 'CE_RXPARITY', INT2FIX(CE_RXPARITY));

  rb_define_const(mPhi, 'DMPAPER_A3', INT2FIX(DMPAPER_A3));
  rb_define_const(mPhi, 'DMPAPER_A4', INT2FIX(DMPAPER_A4));
  rb_define_const(mPhi, 'DMPAPER_A5', INT2FIX(DMPAPER_A5));

  rb_define_const(mPhi, 'DMORIENT_PORTRAIT', INT2FIX(DMORIENT_PORTRAIT));
  rb_define_const(mPhi, 'DMORIENT_LANDSCAPE', INT2FIX(DMORIENT_LANDSCAPE));

  rb_define_const(mPhi, 'KEYEVENTF_KEYUP', INT2FIX(KEYEVENTF_KEYUP));

  rb_define_const(mPhi, 'FO_COPY', INT2FIX(FO_COPY));
  rb_define_const(mPhi, 'FO_DELETE', INT2FIX(FO_DELETE));  // 3
  rb_define_const(mPhi, 'FO_MOVE', INT2FIX(FO_MOVE));
  rb_define_const(mPhi, 'FO_RENAME', INT2FIX(FO_RENAME));

  rb_define_const(mPhi, 'FOF_ALLOWUNDO', INT2FIX(FOF_ALLOWUNDO));  // 64
  rb_define_const(mPhi, 'FOF_CONFIRMMOUSE', INT2FIX(FOF_CONFIRMMOUSE));
  rb_define_const(mPhi, 'FOF_FILESONLY', INT2FIX(FOF_FILESONLY)); 
  rb_define_const(mPhi, 'FOF_MULTIDESTFILES', INT2FIX(FOF_MULTIDESTFILES)); 
  rb_define_const(mPhi, 'FOF_NOCONFIRMATION', INT2FIX(FOF_NOCONFIRMATION)); 
  rb_define_const(mPhi, 'FOF_NOCONFIRMMKDIR', INT2FIX(FOF_NOCONFIRMMKDIR)); 
  rb_define_const(mPhi, 'FOF_RENAMEONCOLLISION', INT2FIX(FOF_RENAMEONCOLLISION)); 
  rb_define_const(mPhi, 'FOF_SILENT', INT2FIX(FOF_SILENT)); 
  rb_define_const(mPhi, 'FOF_SIMPLEPROGRESS', INT2FIX(FOF_SIMPLEPROGRESS)); 
  rb_define_const(mPhi, 'FOF_WANTMAPPINGHANDLE', INT2FIX(FOF_WANTMAPPINGHANDLE)); 

  rb_define_module_function(mPhi, 'set_capture', @Win_set_capture, 1);
  rb_define_module_function(mPhi, 'get_capture', @Win_get_capture, 0);
  rb_define_module_function(mPhi, 'release_capture', @Win_release_capture, 0);
  rb_define_module_function(mPhi, 'invalidate_rect', @Win_invalidate_rect, 3);
  rb_define_module_function(mPhi, 'get_cursor_pos', @Win_get_cursor_pos, 0);
  rb_define_module_function(mPhi, 'get_key_state', @Win_get_key_state, 1);
  rb_define_module_function(mPhi, 'set_cursor', @Win_set_cursor, 1);
  rb_define_module_function(mPhi, 'load_cursor', @Win_load_cursor, 1);
  rb_define_module_function(mPhi, 'shell_execute', @Win_shell_execute, 6);
  rb_define_module_function(mPhi, 'keybd_event', @Win_keybd_event, 4);
  rb_define_module_function(mPhi, 'get_computer_name', @Win_get_computer_name, 0);
  rb_define_module_function(mPhi, 'create_class_id', @Win_create_class_id, 0);
  rb_define_module_function(mPhi, 'sh_file_operation', @Win_sh_file_operation, 6);
  rb_define_module_function(mPhi, 'expand_file_name', @Win_expand_file_name, 1);
  rb_define_module_function(mPhi, 'expand_unc_file_name', @Win_expand_unc_file_name, 1);
  rb_define_module_function(mPhi, 'win_exec', @Win_win_exec, -1);
  rb_define_module_function(mPhi, 'send_message', @Win_send_message, 4);

  rb_define_module_function(mPhi, 'draw_text', @Win_draw_text, 5);
  rb_define_const(mPhi, 'DT_TOP', INT2FIX( DT_TOP )); 
  rb_define_const(mPhi, 'DT_LEFT', INT2FIX( DT_LEFT )); 
  rb_define_const(mPhi, 'DT_CENTER', INT2FIX( DT_CENTER )); 
  rb_define_const(mPhi, 'DT_RIGHT', INT2FIX( DT_RIGHT )); 
  rb_define_const(mPhi, 'DT_VCENTER', INT2FIX( DT_VCENTER )); 
  rb_define_const(mPhi, 'DT_BOTTOM', INT2FIX( DT_BOTTOM )); 
  rb_define_const(mPhi, 'DT_WORDBREAK', INT2FIX( DT_WORDBREAK )); 
  rb_define_const(mPhi, 'DT_SINGLELINE', INT2FIX( DT_SINGLELINE )); 
  rb_define_const(mPhi, 'DT_EXPANDTABS', INT2FIX( DT_EXPANDTABS )); 
  rb_define_const(mPhi, 'DT_TABSTOP', INT2FIX( DT_TABSTOP )); 
  rb_define_const(mPhi, 'DT_NOCLIP', INT2FIX( DT_NOCLIP )); 
  rb_define_const(mPhi, 'DT_EXTERNALLEADING', INT2FIX( DT_EXTERNALLEADING )); 
  rb_define_const(mPhi, 'DT_CALCRECT', INT2FIX( DT_CALCRECT )); 
  rb_define_const(mPhi, 'DT_NOPREFIX', INT2FIX( DT_NOPREFIX )); 
  rb_define_const(mPhi, 'DT_INTERNAL', INT2FIX( DT_INTERNAL )); 
  rb_define_const(mPhi, 'DT_HIDEPREFIX', INT2FIX( DT_HIDEPREFIX )); 
  rb_define_const(mPhi, 'DT_PREFIXONLY', INT2FIX( DT_PREFIXONLY )); 
  rb_define_const(mPhi, 'DT_EDITCONTROL', INT2FIX( DT_EDITCONTROL )); 
  rb_define_const(mPhi, 'DT_PATH_ELLIPSIS', INT2FIX( DT_PATH_ELLIPSIS )); 
  rb_define_const(mPhi, 'DT_END_ELLIPSIS', INT2FIX( DT_END_ELLIPSIS )); 
  rb_define_const(mPhi, 'DT_MODIFYSTRING', INT2FIX( DT_MODIFYSTRING )); 
  rb_define_const(mPhi, 'DT_RTLREADING', INT2FIX( DT_RTLREADING )); 
  rb_define_const(mPhi, 'DT_WORD_ELLIPSIS', INT2FIX( DT_WORD_ELLIPSIS )); 
end;

end.
