Attribute VB_Name = "Module2"
Public Const CB_GETCURSEL = &H147
Public Const CB_GETCOUNT = &H146
Public Const CB_GETLBTEXT = &H148
Public Const CB_GETLBTEXTLEN = &H149

Public Const WM_COMMAND = &H111

Public Const NORMAL_PRIORITY_CLASS = &H20&
Public Const INFINITE = -1&
Public Const SW_SHOW& = 5 'sets nShowCmd param in ShellExecute API function
Public Const SW_HIDE& = 0
Public Const STARTF_USESHOWWINDOW& = &H1
Public hwnds() As Long
Public rlim As Long

Public Type STARTUPINFO
         cb As Long
         lpReserved As String
         lpDesktop As String
         lpTitle As String
         dwX As Long
         dwY As Long
         dwXSize As Long
         dwYSize As Long
         dwXCountChars As Long
         dwYCountChars As Long
         dwFillAttribute As Long
         dwFlags As Long
         wShowWindow As Integer
         cbReserved2 As Integer
         lpReserved2 As Long
         hStdInput As Long
         hStdOutput As Long
         hStdError As Long
End Type

Public Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessID As Long
   dwThreadID As Long
End Type

Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
   hHandle As Long, ByVal dwMilliseconds As Long) As Long

Public Declare Function CreateProcessA Lib "kernel32" (ByVal _
   lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
   lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
   ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
   ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
   lpStartupInfo As STARTUPINFO, lpProcessInformation As _
   PROCESS_INFORMATION) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal _
   hObject As Long) As Long

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) _
  As Long
Declare Function ClientToScreen Lib "user32" (ByVal hwnd As _
  Long, lpPoint As POINTAPI) As Long
Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
  ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, _
  ByVal dwExtraInfo As Long)

Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long



Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_ABSOLUTE = &H8000

Public Const WM_CLOSE = &H10                    'Closing window
Public Const WM_SETTEXT = &HC                   'Setting text of child window
Public Const WM_GETTEXT = &HD                   'Getting text of child window
Public Const WM_GETTEXTLENGTH = &HE
Public Const EM_GETPASSWORDCHAR = &HD2          'Checking if its a password field or not
Public Const BM_CLICK = &HF5                    'Clicking a button
Public Const SW_MAXIMIZE = 3
Public Const SW_MINIMIZE = 6
Public Const SW_RESTORE = 9
Public Const WM_MDICASCADE = &H227              'Cascading windows
Public Const MDITILE_HORIZONTAL = &H1
Public Const MDITILE_SKIPDISABLED = &H2
Public Const WM_MDITILE = &H226


Public Type POINTAPI
  x As Long
  y As Long
End Type

Public Sub SendMouse(button, x, y, xhwnd)
    Dim pt As POINTAPI, curX As Long, curY As Long
    Dim dstX As Long, dstY As Long

    
    ScaleMode = vbPixels
    
    ClientToScreen xhwnd, pt
  
    dstX = x * 65535 / mainform.ScaleX(Screen.Width, vbTwips, vbPixels)
    dstY = y * 65535 / mainform.ScaleY(Screen.Height, vbTwips, vbPixels)

    If LCase(button) = "left" Then
    mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE + MOUSEEVENTF_LEFTDOWN, dstX, dstY, 0, 0
    loopme = True
    loopcount = Timer
    While loopme = True
        If Timer > loopcount + 1 Then loopme = False
        'DoEvents
    Wend
    mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE + MOUSEEVENTF_LEFTUP, dstX, dstY, 0, 0
    End If
    'mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE + MOUSEEVENTF_RIGHTDOWN + MOUSEEVENTF_RIGHTUP, dstX, dstY, 0, 0

    '27, 492
    
End Sub







Sub openMenu(hwnd)
        keybd_event VK_APPS, 0, 0, 0
        keybd_event VK_APPS, 0, KEYEVENTF_KEYUP, 0
End Sub
Public Sub SendKeyString(Key As String, hwnd As Long)
    Dim i As Long
    Dim temp As String
    
    For i = 1 To Len(Key)
    Select Case Mid(Key, i, 1)
        Case Is = "^"   'next key is control character
            temp = Mid(Key, i + 1, 1)
            SendControlKey temp, hwnd
        Case Is = "%"   'next key is control character
            temp = Mid(Key, i + 1, 2)
            SendAltKey temp, hwnd
        
        Case Is = "{"   'next key is invisble key
            temp = ""
            For j = i + 1 To Len(Key)
                newchar = Mid(Key, j, 1)
                If newchar <> "}" Then
                    temp = temp + newchar
                Else
                    i = j   'set our new position to after the parsed keyword
                    SendInvisibleKey temp, hwnd 'send das key
                    Exit For
                End If
            Next j
            'MsgBox temp
        
        Case Else       'single key
            SendSingleKey Mid(Key, i, 1), hwnd
    End Select
    
    Next
        
End Sub

Sub SendSingleKey(Key As String, hwnd As Long)
           
            oemchar$ = " "
            CharToOem UCase(Key), oemchar$
            lParam = OemKeyScan(Asc(oemchar$)) And &HFF
            wParam = MapVirtualKey(lParam, 1)
            temp = "&H" & Hex(lParam) & "0001"
            lParam = Val(temp)
            'MsgBox Hex(wParam)
            'MsgBox Hex(lParam)
            
            If Key = "*" Then
                wParam = &H6A
                lParam = "&H00" & keyAsterisk & "0001"
            End If
            
            PostMessage hwnd, WM_KEYDOWN, ByVal wParam, ByVal lParam
            lParam = lParam + &HC0000000
            PostMessage hwnd, WM_KEYUP, ByVal wParam, ByVal lParam
End Sub

Sub SendInvisibleKey(Key As String, hwnd As Long)
    
    Select Case UCase(Key)
    Case Is = "UP"
        wParam = vbKeyUp
        lParam = "&H01" & keyArrowUp & "0001"
    Case Is = "DOWN"
        wParam = vbKeyDown
        lParam = "&H01" & keyArrowDown & "0001"
    Case Is = "LEFT"
        wParam = vbKeyLeft
        lParam = "&H01" & keyArrowLeft & "0001"
    Case Is = "RIGHT"
        wParam = vbKeyRight
        lParam = "&H01" & keyArrowRight & "0001"
    
    Case Is = "HOME"
        wParam = vbKeyHome
        lParam = "&H01" & keyHome & "0001"
    Case Is = "END"
        wParam = vbKeyEnd
        lParam = "&H01" & keyEnd & "0001"
    Case Is = "INSERT", "INS"
        wParam = vbKeyInsert
        lParam = "&H01" & keyInsert & "0001"
    Case Is = "DEL", "DELETE"
        wParam = vbKeyDelete
        lParam = "&H01" & keyDelete & "0001"
    Case Is = "PGUP", "PAGEUP"
        wParam = vbKeyPageUp
        lParam = "&H01" & keyPageUp & "0001"
    Case Is = "PGDN", "PAGEDOWN", "PGDOWN", "PAGEDN"
        wParam = vbKeyPageDown
        lParam = "&H01" & keyPageDown & "0001"

    Case Is = "TAB"
        wParam = vbKeyTab
        lParam = "&H01" & keyTab & "0001"


    'not extended codes.........................................
    Case Is = "ESC", "ESCAPE"
        wParam = vbKeyEscape
        lParam = "&H00" & keyEscape & "0001"
    Case Else
        Exit Sub
    End Select
                    
    PostMessage hwnd, WM_KEYDOWN, ByVal wParam, ByVal lParam
    lParam = lParam + &HC0000000    'set the key up bit
    PostMessage hwnd, WM_KEYUP, ByVal wParam, ByVal lParam
            
End Sub
Sub SendShiftKey(Key As String, hwnd As Long)
        
        'SetForegroundWindow hwnd
        'SendKeys ("^" & Key)
        
        'Exit Sub
        
        
        Key = Right(Key, 1)
        oemchar$ = " "
        CharToOem Key, oemchar$
        lParam = OemKeyScan(Asc(oemchar$)) And &HFF
        wParam = MapVirtualKey(lParam, 1)
        
        temp = "&H" & Hex(lParam) & "0001"
        lParam = Val(temp)
       
        'as far as i can tell, the control key just has to be considered
        'down for the whole system, and buzz will recognize that without
        'having the focus set to its window.
        'alt keys seem to be a different matter however :/
        
        keybd_event vbKeyControl, 0, 0, 0
        boo2 = PostMessage(hwnd, WM_KEYDOWN, wParam, lParam)
        lParam = lParam + &HC0000000
        Boo3 = PostMessage(hwnd, WM_KEYUP, wParam, lParam)
        keybd_event vbKeyControl, 0, KEYEVENTF_KEYUP, 0
    
End Sub

Sub SendControlKey(Key As String, hwnd As Long)
        
        'SetForegroundWindow hwnd
        'SendKeys ("^" & Key)
        
        'Exit Sub
        
        
        Key = Right(Key, 1)
        oemchar$ = " "
        CharToOem Key, oemchar$
        lParam = OemKeyScan(Asc(oemchar$)) And &HFF
        wParam = MapVirtualKey(lParam, 1)
        
        temp = "&H" & Hex(lParam) & "0001"
        lParam = Val(temp)
       
        'as far as i can tell, the control key just has to be considered
        'down for the whole system, and buzz will recognize that without
        'having the focus set to its window.
        'alt keys seem to be a different matter however :/
        
        keybd_event vbKeyControl, 0, 0, 0
        boo2 = PostMessage(hwnd, WM_KEYDOWN, wParam, lParam)
        lParam = lParam + &HC0000000
        If mt_disable = 1 Then DoEvents
        Boo3 = PostMessage(hwnd, WM_KEYUP, wParam, lParam)
        keybd_event vbKeyControl, 0, KEYEVENTF_KEYUP, 0
        
    
End Sub

Sub SendAltKey(Key As String, hwnd As Long)
        SetForegroundWindow hwnd
        
        'SendKeys ("%" & Key)
        
        
        
        'Exit Sub
        
        'Key1 = Left(Key, 1)
        oemchar$ = " "
        CharToOem Key1, oemchar$
        lParam = OemKeyScan(Asc(oemchar$)) And &HFF
        wParam = MapVirtualKey(lParam, 1)
        
        temp = "&H" & Hex(lParam) & "0001"
        lParam = Val(temp)
        
        
        'this stuff doesnt work :(
        keybd_event vbKeyMenu, 0, 0, 0
        boo2 = PostMessage(hwnd, WM_KEYDOWN, wParam, lParam)
        lParam = lParam + &HC0000000
        Boo3 = PostMessage(hwnd, WM_KEYUP, wParam, lParam)
        keybd_event vbKeyMenu, 0, KEYEVENTF_KEYUP, 0
End Sub

Sub SaveSong(path As String, hwnd As Long)
        SetForegroundWindow hwnd
        
        SendKeys ("%FA")
        DoEvents
        SendKeys (path & "{ENTER}")
End Sub

Sub SaveSongbmw(path As String, hwnd As Long)
        SetForegroundWindow hwnd
        
        SendKeys ("%FA")
        DoEvents
        SendKeys (path & "{tab}{down}{down}{enter}{enter}")
End Sub


Sub CopyPattern(PatternName, hwnd As Long)
        SetForegroundWindow hwnd
        
        keybd_event vbKeyControl, 0, 0, 0
        keybd_event vbKeyShift, 0, 0, 0
        keybd_event vbKeyReturn, 0, 0, 0
        
        keybd_event vbKeyReturn, 0, KEYEVENTF_KEYUP, 0
        keybd_event vbKeyShift, 0, KEYEVENTF_KEYUP, 0
        keybd_event vbKeyControl, 0, KEYEVENTF_KEYUP, 0
    
        SendKeys (PatternName & "{ENTER}")
End Sub

Sub AddDel(what As String, where As String, hwnd As Long, Optional title As String)
        SetForegroundWindow hwnd
        
        If UCase(what) = "DEL" Then
            If UCase(where) = "TRACK" Then
                wParam = vbKeySubtract
                lParam = "&H00" & keySubtract & "0001"
            ElseIf UCase(where) = "PATTERN" Then
                wParam = vbKeyDelete
                lParam = "&H00" & keyDelete & "0001"
            End If
        ElseIf UCase(what) = "ADD" Then
            If UCase(where) = "TRACK" Then
                wParam = vbKeyAdd
                lParam = "&H00" & keyAdd & "0001"
            ElseIf UCase(where) = "PATTERN" Then
                wParam = vbKeyReturn
                lParam = "&H00" & keyEnter & "0001"
            End If
        End If
        
        keybd_event vbKeyControl, 0, 0, 0
        PostMessage hwnd, WM_KEYDOWN, ByVal wParam, ByVal lParam
        lParam = lParam + &HC0000000
        PostMessage hwnd, WM_KEYUP, ByVal wParam, ByVal lParam
        keybd_event vbKeyControl, 0, KEYEVENTF_KEYUP, 0

        If UCase(what) = "DEL" Then
            SendKeys "{TAB}{ENTER}"
        ElseIf UCase(what) = "ADD" And UCase(where) = "PATTERN" Then
            SendKeys title & "{ENTER}"
        End If
        
End Sub


Public Sub OpenProcess(cmdline$) 'takes path to shelled app as a parameter
   Dim start As STARTUPINFO
   Dim proc As PROCESS_INFORMATION
   Dim lngreturn As Long

   ' Initialize the STARTUPINFO structure:
   start.cb = Len(start)
   start.dwFlags = STARTF_USESHOWWINDOW 'forces functn to use wShowWindow param below
   start.wShowWindow = SW_SHOW 'shelled process is HIDDEN. Use SW_SHOW etc to run visible

   ' Start the shelled application:
   lngreturn = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

   ' Wait for the shelled application to finish:
   lngreturn = WaitForSingleObject(proc.hProcess, INFINITE)
   lngreturn = CloseHandle(proc.hProcess)
End Sub

Function GetMachineName() As String
    Dim txt As String
    idx = SendMessage(PatternEditorMachineName, CB_GETCURSEL, 0, 0)

    If idx < 0 Then GetMachineName = "Not Avaiable": Exit Function

    textlen = SendMessage(PatternEditorMachineName, CB_GETLBTEXTLEN, idx, 0)
    txt = Space(textlen)
    itemcount = SendMessage(PatternEditorMachineName, CB_GETCOUNT, idx, 0)
    SendMessage PatternEditorMachineName, CB_GETLBTEXT, idx, ByVal txt

    GetMachineName = txt
    'MsgBox txt
End Function

Function GetPatternName() As String
    Dim txt As String
    idx = SendMessage(PatternEditorPatternName, CB_GETCURSEL, 0, 0)

    If idx < 0 Then GetPatternName = "Not Avaiable": Exit Function

    textlen = SendMessage(PatternEditorPatternName, CB_GETLBTEXTLEN, idx, 0)
    txt = Space(textlen)
    itemcount = SendMessage(PatternEditorPatternName, CB_GETCOUNT, idx, 0)
    SendMessage PatternEditorPatternName, CB_GETLBTEXT, idx, ByVal txt
    GetPatternName = txt
End Function

Function GetWaveName() As String
    Dim txt As String
    idx = SendMessage(PatternEditorWaveName, CB_GETCURSEL, 0, 0)

    If idx < 0 Then GetWaveName = "Not Avaiable": Exit Function

    textlen = SendMessage(PatternEditorWaveName, CB_GETLBTEXTLEN, idx, 0)
    txt = Space(textlen)
    itemcount = SendMessage(PatternEditorWaveName, CB_GETCOUNT, idx, 0)
    SendMessage PatternEditorWaveName, CB_GETLBTEXT, idx, ByVal txt
    GetWaveName = txt

End Function


Function GetBaseOctave() As String
    Dim txt As String
    idx = SendMessage(PatternEditorBaseOctave, CB_GETCURSEL, 0, 0)

    If idx < 0 Then GetBaseOctave = "Not Avaiable": Exit Function

    textlen = SendMessage(PatternEditorBaseOctave, CB_GETLBTEXTLEN, idx, 0)
    txt = Space(textlen)
    itemcount = SendMessage(PatternEditorBaseOctave, CB_GETCOUNT, idx, 0)
    SendMessage PatternEditorBaseOctave, CB_GETLBTEXT, idx, ByVal txt
    GetBaseOctave = txt
End Function

Function GetBPM() As String
    Dim txt As String
    Dim textlen As Long
    textlen = SendMessage(BPMHandle, WM_GETTEXTLENGTH, 0, 0)
    txt = Space(textlen)
    SendMessage BPMHandle, WM_GETTEXT, textlen, ByVal txt
    GetBPM = txt
End Function

Function GetTPB() As String
    Dim txt As String
    Dim textlen As Long
    textlen = SendMessage(TPBHandle, WM_GETTEXTLENGTH, 0, 0)
    txt = Space(textlen)
    SendMessage TPBHandle, WM_GETTEXT, textlen, ByVal txt
    GetTPB = txt
End Function

Sub SetBPM(txt As String)
    SendMessage BPMHandle, WM_SETTEXT, 0, ByVal txt
End Sub

Sub SetTPB(txt As String)
    SendMessage TPBHandle, WM_SETTEXT, 0, ByVal txt
End Sub


