Attribute VB_Name = "modWinAPI"
Option Explicit

'#Const NStandAlone = 1

' This module exists to provide some common and basic functionality
' via the Windows 32bit API.

' Window_SetText::Unicode Form Caption, overcome TextBox 32,000 char. limit.
Private Declare Function SetWindowTextW Lib "user32.dll" _
   (ByVal hwnd As Long, ByVal lpString As Long) As Long

Private Declare Function SendMessageLong Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_USER = &H400
Private Const EM_SETTARGETDEVICE = (WM_USER + 72)

' MsgBox::Unicode MessageBox
Private Declare Function MessageBoxW Lib "user32.dll" _
   (ByVal hwnd As Long, ByVal lpText As Long, _
      ByVal lpCaption As Long, ByVal uType As Long) As Long

Public Enum MB_TYPE_ENUM
   
   ' Note: used my API Viewer with Mr305's API data
   ' to acquire following constant values.
   ' -------------------------------------------------------------------
   
   ' Icons -------------------------------------------------------------
   MB_ICONQUESTION = &H20&
   MB_ICONEXCLAMATION = &H30&
   MB_ICONHAND = &H10&
   MB_ICONERROR = MB_ICONHAND
   MB_ICONASTERISK = &H40&
   MB_ICONWARNING = MB_ICONEXCLAMATION
   MB_ICONINFORMATION = MB_ICONASTERISK
   ' Style -------------------------------------------------------------
   MB_ABORTRETRYIGNORE = &H2&
   MB_CANCELTRYCONTINUE = &H6&
   MB_OK = &H0&
   MB_OKCANCEL = &H1&
   MB_RETRYCANCEL = &H5&
   MB_RIGHT = &H80000
   MB_RTLREADING = &H100000
   MB_YESNO = &H4&
   ' Default button ----------------------------------------------------
   MB_DEFBUTTON1 = &H0&
   MB_DEFBUTTON2 = &H100&
   MB_DEFBUTTON3 = &H200&
   MB_DEFBUTTON4 = &H300&

End Enum

Private Const MB_TASKMODAL As Long = &H2000&

' Window_UserMove::Move a form without dragging the caption bar.
Private Declare Function ReleaseCapture Lib "USER32" () As Long
Private Declare Function SendMessage Lib "USER32" _
   Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

' Memory_Clear::Release memory that is no longer required.
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function EmptyWorkingSet Lib "PSAPI" (ByVal hProcess As Long) As Long

'' XP Themes::see InitCommonControlsVB commented below
'Private Type tagInitCommonControlsEx
'   lngSize As Long
'   lngICC As Long
'End Type
'
'Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
'Private Declare Function InitCommonControlsEx Lib _
'   "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
'
'Private Const ICC_USEREX_CLASSES = &H200

' -------------------------------------------------------------------
' INI File::
' from Win 8 Metro 2.0, have changed, needs attention
Private Declare Function GetPrivateProfileString Lib "kernel32" _
   Alias "GetPrivateProfileStringA" ( _
   ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
   ByVal lpDefault As String, ByVal lpReturnedString As String, _
   ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString Lib "kernel32" _
   Alias "WritePrivateProfileStringA" ( _
   ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
   ByVal lpString As Any, ByVal lpFileName As String) As Long

Private Const IDS_INI_FILE_NAME As String = "Config.ini"

Function INI_Read(ByVal Section As String, ByVal Key As String) As String
   
   ' Note:  If Key is empty then doesn't return whole section
   '        as intended (maybe i gotta change the declaration params
   '        e.g. judiciously use As Any in place of As String).
   
   On Error GoTo ErrHan:
   
   Dim strBuffer As String
   strBuffer = String$(750, Chr(0))
   
   Dim iCharLen As Long
   
   iCharLen = _
      GetPrivateProfileString(Section, Key, "", strBuffer, Len(strBuffer), INI_FILENAME)
   
   INI_Read = Left$(strBuffer, iCharLen)
   
   Exit Function
   
ErrHan:
   
   Error_Manager_Local Err, "INI_Read"
   
End Function

Sub INI_Write(Section As String, Key As String, KeyValue As String)
   
   On Error GoTo ErrHan:
   
   Call WritePrivateProfileString(Section$, UCase$(Key$), KeyValue$, INI_FILENAME$)
   
   Exit Sub

ErrHan:
   
   Error_Manager_Local Err, "INI_Write"
   
End Sub

' extra stuff for original read/write private-profile do dah
Function INI_File_Exists() As Boolean

   If File_Exists(INI_FILENAME) Then _
      INI_File_Exists = True

End Function

Private Function INI_FILENAME() As String
   
   INI_FILENAME = App.Path & "\" & IDS_INI_FILE_NAME

End Function

Private Function File_Exists( _
   FileName As String) As Boolean
   
   On Error GoTo ErrHan:
   
   Dim iAttributes As Long
   iAttributes = GetAttr(FileName)
   
   If iAttributes And vbDirectory Then _
      Exit Function
   
   File_Exists = True
   
   Exit Function
   
ErrHan:
End Function

' -------------------------------------------------------------------

'Sub InitCommonControlsVB()
'
'   Dim ttICC As tagInitCommonControlsEx
'
'   On Error Resume Next
'
'   ttICC.lngSize = LenB(ttICC)
'   ttICC.lngICC = ICC_USEREX_CLASSES
'
'   InitCommonControlsEx ttICC
'
'   If Err Then
'      Err.Clear
'      On Error GoTo 0
'      InitCommonControls
'   End If
'
'End Sub

Sub Memory_Clear()

   ' clear up application memory use
   On Error GoTo ErrHan:
   
   Dim lngProcHandle As Long, lngRet As Long
   lngProcHandle = GetCurrentProcess()
   lngRet = EmptyWorkingSet(lngProcHandle)
   
   Exit Sub
   
ErrHan:
End Sub

Sub Window_SetText( _
   WindowHandle As Long, WindowText As String)
   
   On Error GoTo ErrHan:
   
   SetWindowTextW WindowHandle, StrPtr(WindowText)
      
   Exit Sub
   
ErrHan:

   Error_Manager_Local Err, "Window_SetText"
   
End Sub

Function Window_SetWordwrap( _
   WindowHandle As Long, _
   Optional IsWrapped As Boolean = False) As Long
   
   On Error GoTo ErrHan:
   
   Dim lRet As Long
   lRet = -1
   
   If WindowHandle Then
      Dim iWrap As Long
      If IsWrapped = False Then iWrap = 1
      
      lRet = SendMessageLong(WindowHandle, EM_SETTARGETDEVICE, 0, iWrap)
   
   End If

ResErr:
   Window_SetWordwrap = lRet
   lRet = 0&
   
   Exit Function

ErrHan:
   Error_Manager_Local Err, "Window_SetWordwrap"
   lRet = -1
   Resume ResErr:
   
End Function

Sub Window_UserMove(WindowHandle As Long)
   
   On Error GoTo ErrHan:
   
   Call ReleaseCapture
   
   Dim lRet As Long
   Let lRet = _
      SendMessage(WindowHandle, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
   
   lRet = 0&
   
   Memory_Clear
   
   Exit Sub

ErrHan:
   'Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure Window_UserMove of Module modWinAPI"
   
End Sub

Function MsgBox(Text As String, _
   Optional MsgType As MB_TYPE_ENUM = MB_OK, _
      Optional Title As String, _
         Optional hwnd As Long = 0&) _
   As VbMsgBoxResult

' Note: can create circular reference, :o
' vba.MsgBox instead

   On Error GoTo ErrHan:

   MsgBox = MessageBoxW(hwnd, _
      StrPtr(Text), StrPtr(Title), MsgType Or MB_TASKMODAL)

   Exit Function

ErrHan:

   Error_Manager_Local Err, "MsgBox"

End Function

Private Sub Error_Manager( _
   ErrObject As ErrObject, Source As String)
   
   On Error GoTo ErrHan:
      
   Dim sErrMsg As String
   
   sErrMsg = _
      "Error: " & ErrObject.Number & "\ " & _
         Source & "\ " & _
         ErrObject.Description
            
   Debug.Print sErrMsg
   
   Exit Sub
   
ErrHan:
   Debug.Print "Error in modWinAPI.Error_Manager: " & _
      Err.Description
   
End Sub

' ***********************************************
' Error_Manager_Local <<
' local error handler, passes error onto
'  program error handler
'
' Parameters:
'   ErrObject::ErrObject,
'   Source::String,
'   [ShowErrMsg::Boolean(=false)]
' ***********************************************
Private Sub Error_Manager_Local( _
   ErrObject As ErrObject, Source As String, _
      Optional ShowErrMsg As Boolean = False)

   On Error GoTo ErrHan:
   
   #If NStandAlone Then
   
      modMain.Error_Manager ErrObject, _
         "modWinAPI." & Source, ShowErrMsg

   #Else
   
      Error_Manager ErrObject, "modWinAPI." & Source

   #End If
   
   Exit Sub

ErrHan:

   Debug.Print "Error " & Err.Number & _
      " (" & Err.Description & _
      ") in procedure Error_Manager_Local of Module modWinAPI"

End Sub

