#include once "windows.bi"

declare function MainWindow as hwnd
declare sub ShowMessage(as string)
declare function messageDlg(as string,as string,as integer) as integer
declare function SysErrorMessage(as integer=GetLastError) as string
declare function ClassNameIs(as hwnd) as string
declare function ExtractFileName overload(as string) as string
declare function ExtractFilePath(as string) as string
declare function ExtractFileExt(as string) as string
declare function ChangeFileExt(as string,as string) as string
declare function ChangeFilePath(as string,as string) as string
declare function CompareText(as string,as string) as integer
declare function StrFmt cdecl(byref formatstring as string, ...) as string
declare function StringReplace(as string, as string, as string, as boolean=true) as string
declare function Tally overload(Substring as string, Text as string) as integer
declare function Tally overload(n as string,v as byte) as integer

/'SysUtils'/
common shared as hwnd ptr __main

function StringReplace(v as string,from as string,replaced as string,offen as boolean=true) as string
    if v="" then return ""
    if from="" or replaced="" then return v
    dim as integer i=0,c=0
    dim as string result="",s=""
    do
         result &=chr(v[i])
         if from[0]=v[i] then
            s=mid(v,i,len(from))
            if s=from then  :? "found",result
               result +=replaced
               i+=len(from)-1
            end if
         end if
         i+=1
    loop until i>len(v)
    return result
end function

function Tally overload(Substring as string, Text as string) as integer
    dim as integer offset=0,result=0
    result=0
    offset=instr(offset+1, Text, Substring)
    while offset<> 0
       result+=1
       offset=instr(offset+len(Substring), Text,Substring )
    wend
    return result
end function

function Tally overload(n as string,v as byte) as integer
    return Tally(str(v),n)
end function

function comparetext(v as string,vc as string) as integer
    return lcase(v)=lcase(vc)
end function

function EnumThreadWindowsProc(Dlg as hwnd,lParam as lparam) as boolean
    if GetWindowLong(dlg,gwl_exstyle) and ws_ex_appwindow=ws_ex_appwindow then
       *cast(integer ptr,lparam)=cint(dlg)
       exit function
    end if
    return false
end function

function MainWindow as hwnd export
    EnumThreadWindows(GetCurrentThreadId,cast(enumwindowsproc,@EnumThreadWindowsProc),cint(__main))
    return cast(hwnd,*__main)
end function

sub ShowMessage(v as string) export
    dim as string s=string(256,0)
    GetModuleFileName(GetModuleHandle(0),s,256)
    MessageBox(MainWindow,v,ExtractFileName(s),mb_applmodal or mb_topmost)
end sub

function MessageDlg(v as string,c as string,b as integer=mb_ok) as integer export
    return MessageBox(MainWindow,v,c,b or mb_applmodal or mb_topmost)
end function

Function SysErrorMessage(v as integer=GetLastError) As String export
     Dim As zString*256 Buffer
     FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, v, LANG_NEUTRAL, @Buffer, 200, 0)
     Return RTrim(Buffer)
End Function

function ClassNameIs(dlg as hwnd) as string export
    Dim As zString*256 Buffer
    dim as integer l=GetClassName(dlg,Buffer,256)
    return left(Buffer,l)
end function

sub Debug(v as string) export
    ? v
end sub

function ExtractFileName(v as string) as string
    if v="" then return v
    dim as integer x
    for i as integer=1 to len(v)
        if chr(v[i])="/" or chr(v[i])="\" then
           x=i+1
        end if
    next
    return mid(v,x+1,len(v))
end function

function ExtractFilePath(v as string) as string
    if v="" then return v
    dim as integer x
    for i as integer=1 to len(v)
        if chr(v[i])="/" or chr(v[i])="\" then
           x=i+1
        end if
    next
    return mid(v,1,x)
end function

function ExtractFileExt(v as string) as string
    if v="" then return v
    dim as integer x
    for i as integer=1 to len(v)
        if chr(v[i])="." then
           x=i+1
        end if
    next
    return mid(v,x,len(v))
end function

function ChangeFileExt(v as string,e as string) as string
    if v="" then return v
    dim as integer x
    for i as integer=1 to len(v)
        if chr(v[i])="." then
           x=i+1
        end if
    next
    return mid(v,1,x-1)+e
end function

function ChangeFilePath(v as string,p as string) as string
    if v="" then return v
    dim as integer x
    for i as integer=1 to len(v)
        if chr(v[i])="/" or chr(v[i])="\" then
           x=i+1
        end if
    next
    return p+mid(v,x+1,len(v))
end function

function StrFmt cdecl(byref formatstring as string, ...) as string
    dim as string result=""
    dim as Cva_List args
    Cva_Start(args,formatstring)
    dim as UByte Ptr p=strPtr(formatstring)
    dim as Integer todo=Len(formatstring)
    while (todo>0)
        dim as Integer char=*p
        p+=1
        todo-=1
        If (char=asc("%")) then
            If (todo=0) then
                result+="%"
                exit while
            end If
            char=*p
            p+=1
            todo-=1
            select case char
            case asc("i")
                result+=str(Cva_Arg(args,integer))
            case asc("l")
                result+=str(Cva_Arg(args,longint))
            case asc( "f" ),asc( "d" )
                result+=str(Cva_Arg(args,double))
            case asc("s")
                result+=*Cva_Arg(args,zstring Ptr)
            end select
        else
            result+=chr(char)
        end If
    Wend
    Cva_end(args)
    return result
end function


sub sysutils_initialize constructor
     __main=new hwnd
end sub

sub sysutils_finalize destructor
     delete __main
end sub
