unit Winlib;

{$IFDEF FPC}
  {$MODE DELPHI} {$H+}
  {$ASMMODE Intel}
{$ENDIF}
 {$INLINE ON}
interface

uses
  Classes, SysUtils, Forms,
  controls, fileutil ,LazUTF8,
  {$IFDEF WINDOWS} Windows,shellapi, mmsystem,{$ENDIF}
  base,base2;
{$IFDEF WINDOWS}
function GetVersion:Longint;
function PlaySound(const s:string; async:boolean):LongBool;
function Play(const s:string; async:boolean):LongBool;    //関連付けでPlay
function UTF8ToWide(s:string):string;
function WideToUTF8(s:string):string;
function WinHandle(const form:string):integer;
 {$ENDIF}



implementation
 uses
 textfrm,locatefrm,locatech,paintfrm,inputdlg,charinp,MyThread;

{$IFDEF WINDOWS}
function GetVersion:Longint; inline;
begin
  result:=longint(Windows.GetVersion);
end;


{
Function PlaySoundA(x1: LPCSTR; x2: HMODULE; x3: DWORD): BOOL; stdcall;
                                        external 'winmm.dll' name 'PlaySoundA';
Function mciSendStringA(x1: LPCSTR; x2: LPSTR; x3: UINT; x4: HWND): DWORD;stdcall;
                                    external 'winmm.dll' name 'mciSendStringA';
}

function PlaySound(const s:string; async:boolean):LongBool;
begin
  result:=PlaySoundA(Pchar(UTF8ToWinCP(s)),0,$20000+ORD(Async))
end;

function ShellExec(const s1,s2,verb:AnsiString; opWaitFor:boolean; state:integer ):longbool;
var
   tsh : TSHELLEXECUTEINFOA;
   lpdwExitCode:dword;
begin

   with tsh do
      begin
            cbSize:=Sizeof(tsh);
            fmask:=SEE_MASK_NOCLOSEPROCESS; // プロセスハンドルをクローズしない
            WND:=TextForm.Handle;
            lpVerb:=pchar(verb);   // open';
            lpFile:=PChar(s1);
            lpParameters:=Pchar(s2);
            lpDirectory:='';
            nShow:=state ;//SW_SHOW;
      end;
   result:=ShellExecuteExA(@tsh);
   if result then
      begin
          // hProcessがシグナル状態になるまで待つ
         if opWaitFor then
               WaitForSingleObject(tsh.hProcess,INFINITE);
         CloseHandle(tsh.hProcess);
      end ;

end;

function Play(const s:string; async:boolean):LongBool;    //関連付けでPlay
begin
   result:= ShellExec(UTF8ToWinCP(s),'', 'Play', not async, sw_ShowNormal)
end;

function WinHandle(const form:string):integer;
var
   s:string;
   w:TWinControl;
begin
   s:=uppercase(form);

   if s='TEXT' then
      w:=TextForm
   else if s='GRAPHICS' then
      w:=PaintForm
   else if s='INPUT' then
      w:=InputDialog
   else if s='CHARACTER INPUT' then
      w:=CharInput
   else if (s='LOCATE') or (s='LOCATEVALUE') then
      w:=LocateForm
   else if s='LOCATECHOICE' then
      w:=LocateChoiceForm
   else
      w:=nil;
   if w<>nil then
      result:=w.Handle
   else
      result:=0
end;


const DLL_Error=-9900;

{***********}
{Wide String}
{***********}

procedure UTF16(var s:string);
var
   ss: UnicodeString;
   i:integer;
   w:word;
begin
  ss:=UTF8ToUTF16(s);
  setlength(s,2*length(ss)+1);
  for i:=1 to length(ss) do
     begin
        w:=word(ss[i]);
        s[2*i-1]:=chr(lo(w));
        s[2*i]:=chr(hi(w));
     end;
  s[length(s)]:=chr(0);
end;

function UTF8ToWide(s:string):string;
begin
  UTF16(s);
  result:=s
end;

(*
procedure ImportUTF16(var s:string);
var
   ss: UnicodeString;
   i:integer;
   w:wordrec;
begin
   setlength(ss,length(s) div 2);
   for i:=1 to length(ss) do
      begin
       w.lo:=byte(s[2*i-1]);
       w.hi:=byte(s[2*i]);
       word(ss[i]):=word(w); //(w.lo+w.hi*256);
      end;
   s:=UTF16ToUTF8(ss)
end;
*)

procedure ImportUTF16(var s:string);
 begin
    s:=UTF16ToUTF8(PWideChar(s))
end;

function WideToUTF8(s:string):string;
begin
  ImportUTF16(s);
  result:=s
end;
{$ENDIF}







end.

