Attribute VB_Name = "Utilities"
Option Explicit
Public Declare Function PaintDesktop Lib "user32" (ByVal hdc As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
    (ByVal Hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Const WM_CLOSE = &H10


Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Type POINTAPI
        X As Long
        Y As Long
End Type


Public Screen_On_Picture As Picture

Public Sub SelectInside(ByVal NObject As Object)
    NObject.SelStart = 0
    NObject.SelLength = Len(NObject.Text)
End Sub

Public Function IsSingleClicked(NObject As Object, NForm As Object) As Boolean
    Dim TempCoord As POINTAPI
    Dim DumpyX, DumpyY, XDumpyX, XDumpY As Single
    IsSingleClicked = False
    DumpyX = NObject.Left + NForm.Left
    DumpyY = NObject.Top + NForm.Top
    GetMouseXY TempCoord
    XDumpyX = DumpyX - TempCoord.X
    XDumpY = DumpyY - TempCoord.Y
    If XDumpyX <= 0 And Abs(XDumpyX) < NObject.Width Then
        If XDumpY <= 0 And Abs(XDumpY) < NObject.Height Then
            IsSingleClicked = True
        End If
    End If
End Function

Public Function IsHwndClicked(NHwnd As Long) As Boolean
    Dim TempCoord As POINTAPI
    Dim TempRect As RECT
    IsHwndClicked = False
    GetWindowRect NHwnd, TempRect
    TempRect.Bottom = TempRect.Bottom * Screen.TwipsPerPixelY
    TempRect.Left = TempRect.Left * Screen.TwipsPerPixelX
    TempRect.Right = TempRect.Right * Screen.TwipsPerPixelX
    TempRect.Top = TempRect.Top * Screen.TwipsPerPixelY
    GetMouseXY TempCoord
    If TempCoord.X > TempRect.Left And TempCoord.X < TempRect.Right Then
        If TempCoord.Y > TempRect.Top And TempCoord.Y < TempRect.Bottom Then
            IsHwndClicked = True
        End If
    End If
End Function

Private Function GetMouseXY(Buffer As POINTAPI)
    GetCursorPos Buffer
    Buffer.X = Buffer.X * Screen.TwipsPerPixelX
    Buffer.Y = Buffer.Y * Screen.TwipsPerPixelY
End Function


Public Function IsDoubleClicked(NObject1 As Object, NObject2 As Object, NForm As Object) As Boolean
    Dim TempCoord As POINTAPI
    Dim DumpyX, DumpyY, XDumpyX, XDumpY As Single
    IsDoubleClicked = False
    DumpyX = NObject1.Left + NObject2.Left + NForm.Left
    DumpyY = NObject1.Top + NObject2.Top + NForm.Top
    GetMouseXY TempCoord
    XDumpyX = DumpyX - TempCoord.X
    XDumpY = DumpyY - TempCoord.Y
    If XDumpyX <= 0 And Abs(XDumpyX) < NObject1.Width Then
        If XDumpY <= 0 And Abs(XDumpY) < NObject1.Height Then
            IsDoubleClicked = True
        End If
    End If
End Function

Public Function SuperTrim(eText As String) As String
    Dim ActAsc As Long
    Dim TextLen As Long
    Dim mlCnt As Long
    Dim success As String
    TextLen = Len(eText)
    If TextLen = 0 Then Exit Function
    For mlCnt = 1 To TextLen
        ActAsc = Asc(Mid(eText, mlCnt, 1))
        If ActAsc <= 32 Then
            
        Else
            success = success & Asc(ActAsc)
        End If
    Next mlCnt
    eText = success
    SuperTrim = success
End Function

Public Function DoFadeOut(eHwnd As Long)
    Dim foCnt As Long
    If IsWindowsNTPlus = False Then Exit Function
    EnableWindow eHwnd, 0
    For foCnt = 255 To 80 Step -10
        fSetTranslucency eHwnd, foCnt
        DoEvents
    Next foCnt
    EnableWindow eHwnd, 1
End Function

Public Function DoFadeIn(eHwnd As Long)
    Dim foCnt As Long
    If IsWindowsNTPlus = False Then Exit Function
    EnableWindow eHwnd, 0
    For foCnt = 100 To 200 Step 5
        fSetTranslucency eHwnd, foCnt
        DoEvents
    Next foCnt
    fClearTranslucency eHwnd
    EnableWindow eHwnd, 1
End Function

Public Function RevertBin(ByVal eBin As Long) As Long
    If eBin = 0 Then
        RevertBin = 1
    Else
        RevertBin = 0
    End If
End Function

Public Function GetTimeOnly(ByVal eDate As Date) As Date
    Dim TmpDate As String
    TmpDate = DatePart("h", eDate) & ":" & DatePart("n", eDate) & ":" & DatePart("s", eDate)
    GetTimeOnly = CDate(TmpDate)
End Function

Public Function DateToHexa(ByVal eDate As Date) As String
    DateToHexa = HexaCrypt(CStr(eDate))
End Function

Public Function HexaToDate(ByVal eHexa As String) As Date
    HexaToDate = CDate(HexaUncrypt(eHexa))
End Function

Public Sub SelectListIndexFromText(ByVal sText As String, NListBox As ListBox)
    Dim lCnt As Integer
    If NListBox.ListCount <= 0 Then Exit Sub
    For lCnt = 0 To NListBox.ListCount - 1
        If UCase(Left(NListBox.List(lCnt), Len(sText))) = UCase(sText) Then
            NListBox.ListIndex = lCnt
            Exit Sub
        End If
        DoEvents
    Next lCnt
    NListBox.ListIndex = -1
End Sub

Public Sub SelectListIndexFromTextBox(NTextBox As TextBox, NListBox As ListBox)
    Dim lCnt As Integer
    Dim iTmpVal As Integer
    If NListBox.ListCount <= 0 Then Exit Sub
    For lCnt = 0 To NListBox.ListCount - 1
        If UCase(Left(NListBox.List(lCnt), Len(NTextBox.Text))) = UCase(NTextBox.Text) Then
            NListBox.ListIndex = lCnt
            If Len(NListBox.List(lCnt)) > Len(NTextBox.Text) Then
                iTmpVal = Len(NTextBox.Text)
                NTextBox.Text = NListBox.List(lCnt)
                NTextBox.SelStart = iTmpVal
                NTextBox.SelLength = Len(NListBox.List(lCnt)) - iTmpVal
                Debug.Print NTextBox.SelLength
            End If
            Exit Sub
        End If
        DoEvents
    Next lCnt
    NListBox.ListIndex = -1
End Sub

Public Sub RestrictNumberTextBoxInput(NTextBox As TextBox, Optional ByVal lLowParam As Long = 1, Optional ByVal lHighParam As Long = 10)
    If Val(NTextBox.Text) > lHighParam Or Val(NTextBox.Text) < lLowParam Then
        NTextBox.Text = Left(NTextBox.Text, 1)
    Else
        NTextBox.Text = Val(NTextBox.Text)
    End If
    NTextBox.SelStart = Len(NTextBox.Text)
End Sub

Public Sub RestrictInputToNumbers(NTextBox As TextBox, KeyAscii As Integer)
    Select Case KeyAscii
        Case 48 To 57, 8
        Case Else
            KeyAscii = 0
    End Select
End Sub

Public Sub RestrictInputToLetters(NTextBox As TextBox, KeyAscii As Integer)
    Select Case KeyAscii
        Case 65 To 90, 97 To 122, 8
        Case Else
            KeyAscii = 0
    End Select
End Sub

Public Function IsInListBox(NListBox As ListBox, ByVal sText As String) As Long
    Dim iCnt As Integer
    Dim iListCount As Integer

    iListCount = NListBox.ListCount
    If iListCount <= 0 Then GoTo abortfunction
    For iCnt = 0 To iListCount - 1
        If UCase(sText) = UCase(NListBox.List(iCnt)) Then
            IsInListBox = iCnt
            Exit Function
        End If
    Next iCnt
    IsInListBox = -1
    
abortfunction:
    IsInListBox = -1
    Exit Function
End Function

Public Function IsInTextSingleTable(sTextTable() As String, sText As String) As Long
    Dim iCnt As Integer
    
    For iCnt = LBound(sTextTable) To UBound(sTextTable)
        If UCase(sTextTable(iCnt)) = UCase(sText) Then
            IsInTextSingleTable = iCnt
            Exit Function
        End If
    Next iCnt
    IsInTextSingleTable = -1
End Function

Public Sub SaveText(ByVal sFileName As String, ByVal sText As String)
    Dim MyFile As Integer
    
    MyFile = FreeFile
    On Error GoTo nosave
    Kill sFileName
    On Error GoTo nosave
    Open sFileName For Binary As MyFile
        Put MyFile, , sText
    Close MyFile
    Exit Sub
nosave:
    Exit Sub
End Sub

Public Function CopyFile(ByVal sSourceFileName As String, ByVal sDestinationFileName As String)
    Dim lTotalLen
    Dim XVariable
    Dim iTempCase As Integer
    Dim sTruck As String
    Dim iProgress As Integer
    Const DEFSIZE As Long = 1000
    Dim MyFile1 As Integer
    Dim MyFile2 As Integer
    
    ConnectToProgressForm 0
    
    MyFile1 = FreeFile
    Open sSourceFileName For Binary As #MyFile1
    MyFile2 = FreeFile
    Open sDestinationFileName For Binary As #MyFile2
    
    lTotalLen = LOF(MyFile1)
    XVariable = lTotalLen
    
    Do
        If XVariable < DEFSIZE Then
            iTempCase = XVariable
        Else
            iTempCase = DEFSIZE
        End If
        sTruck = String(iTempCase, " ")
        Get #MyFile1, , sTruck
        Put #MyFile2, , sTruck
        XVariable = lTotalLen - LOF(MyFile2)
        iProgress = (100 * XVariable) / lTotalLen
        On Error Resume Next
        DrawProgress 100 - Int(iProgress), "Copie en cours..."
    Loop Until XVariable <= 0
        
    Close #MyFile1
    Close #MyFile2
    
    DisConnectFromProgressForm 0
End Function
