Attribute VB_Name = "FonctionsGeneriques"
Private CouleursPerso(0 To 15) As Long
Private Const CC_RGBINIT         As Long = &H1
Private Const CC_FULLOPEN        As Long = &H2
Private Const CC_PREVENTFULLOPEN As Long = &H4
Private Const CC_ENABLEHOOK      As Long = &H10
Private Const CC_SOLIDCOLOR      As Long = &H80
Private Const CC_ANYCOLOR        As Long = &H100
Private Const WM_INITDIALOG As Long = &H110

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

Private Type CHOOSECOLORSTRUCT
   lStructSize     As Long
   hwndOwner       As Long
   hInstance       As Long
   rgbResult       As Long
   lpCustColors    As Long
   flags           As Long
   lCustData       As Long
   lpfnHook        As Long
   lpTemplateName  As String
End Type

Private Declare Function MoveWindow Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal X As Long, _
   ByVal Y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal bRepaint As Long) As Long
   
Private Declare Function GetWindowRect Lib "user32" _
  (ByVal hwnd As Long, _
   lpRect As RECT) As Long

Private Declare Function ChooseColor Lib "comdlg32.dll" _
   Alias "ChooseColorA" _
  (lpcc As CHOOSECOLORSTRUCT) As Long

Private Declare Function SetWindowText Lib "user32" _
   Alias "SetWindowTextA" _
  (ByVal hwnd As Long, _
   ByVal lpString As String) As Long
   Dim TitreFenetre As String
Public r As Long
Public v As Long
Public b As Long
Public Enum Atraiter
    Texte
    fond
End Enum


Public Const INFINITE = &HFFFF
Public Const STARTF_USESHOWWINDOW = &H1

Public Enum enSW
    SW_HIDE = 0
    SW_NORMAL = 1
    SW_MAXIMIZE = 3
    SW_MINIMIZE = 6
End Enum

Public Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

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 Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Public Enum enPriority_Class
    NORMAL_PRIORITY_CLASS = &H20
    IDLE_PRIORITY_CLASS = &H40
    HIGH_PRIORITY_CLASS = &H80
End Enum

Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

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

Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Function LanceApp(Appli As String, _
                         Arg As String, _
                         Timeout As Long, _
                         ByVal StartSize As enSW, _
                         ByVal Priority_Class As enPriority_Class) As Long
' Lance un application et attend la fin pour continuer
    LanceApp = 259
    Dim pclass As Long
    Dim Ret As Long
    Dim cmdline As String
    Dim sinfo As STARTUPINFO
    Dim pinfo As PROCESS_INFORMATION
    Dim sec1 As SECURITY_ATTRIBUTES
    Dim sec2 As SECURITY_ATTRIBUTES
    Dim hMutex As Long
    
    sec1.nLength = Len(sec1)
    sec2.nLength = Len(sec2)
    sinfo.cb = Len(sinfo)
    sinfo.dwFlags = STARTF_USESHOWWINDOW
    sinfo.wShowWindow = StartSize
    pclass = Priority_Class
    test = Left(Right(Arg, Len(Arg) - 1), Len(Right(Arg, Len(Arg) - 1)) - 1)
    If Dir(test) = "" Then
        MsgBox "Fichier inexistant"
        Exit Function
    End If
    cmdline = Appli
    If (Len(Trim$(Arg)) > 0) Then
        cmdline = cmdline & " " & Arg
    End If
    If CreateProcess(vbNullString, cmdline, sec1, sec2, False, pclass, 0&, CurDir$(), sinfo, pinfo) Then
        Ret = 259
        While (Ret = 259)
            WaitForSingleObject pinfo.hProcess, Timeout
            DoEvents
            If (GetExitCodeProcess(pinfo.hProcess, Ret) = 1) Then
                LanceApp = Ret
            Else
            End If
        Wend
    Else
        If Dir(Appli) = "" Then
            MsgBox "Excel Introuvable"
        End If
    End If


End Function
Public Function AffDialogueCouleur(titre As String, objet As Object, quoi As Atraiter)
'Boîte de dialogues couleur


   For cnt = 240 To 15 Step -15
      CouleursPerso((cnt \ 15) - 1) = RGB(cnt, cnt, cnt)
   Next

Dim cc As CHOOSECOLORSTRUCT
TitreFenetre = titre
With cc
    .flags = CC_ANYCOLOR Or CC_PREVENTFULLOPEN Or CC_RGBINIT Or CC_ENABLEHOOK
    If quoi = Texte Then
        .rgbResult = objet.ForeColor
    Else
        .rgbResult = objet.BackColor
    End If
    .lpfnHook = FARPROC(AddressOf ChooseColorProc)
    .lStructSize = Len(cc)
    .lpCustColors = VarPtr(CouleursPerso(0))
End With


If ChooseColor(cc) = 1 Then
    Call RBGFromHEX(cc.rgbResult, r, v, b)
    AffDialogueCouleur = cc.rgbResult
Else
    If quoi = Texte Then
        AffDialogueCouleur = objet.ForeColor
    Else
        AffDialogueCouleur = objet.BackColor
    End If
End If

End Function
Public Sub RBGFromHEX(ByVal clrref As Long, _
                      r As Long, v As Long, b As Long)
' transforme la valeur Hewa de la couleur en rouge, vert bleu
   b = (clrref \ 65536) And &HFF
   v = (clrref \ 256) And &HFF
   r = clrref And &HFF
   
End Sub


Public Function FARPROC(ByVal pfn As Long) As Long
   FARPROC = pfn
End Function


Public Function ChooseColorProc(ByVal hwnd As Long, _
                                ByVal uMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
   Dim rc         As RECT
   Dim hwndctl    As Long
   Dim scrWidth   As Long
   Dim scrHeight  As Long
   Dim dlgWidth   As Long
   Dim dlgHeight  As Long
   
   Select Case uMsg
      Case WM_INITDIALOG
         Call GetWindowRect(hwnd, rc)
         
         scrWidth = (Screen.Width \ Screen.TwipsPerPixelX)
         scrHeight = (Screen.Height \ Screen.TwipsPerPixelY)
         dlgWidth = rc.Right - rc.Left
         dlgHeight = rc.Bottom - rc.Top
         
         Call MoveWindow(hwnd, (scrWidth - dlgWidth) \ 2, _
                               (scrHeight - dlgHeight) \ 2, _
                                dlgWidth, _
                                dlgHeight, 1)
         Call SetWindowText(hwnd, TitreFenetre)
         ChooseColorProc = 1
   End Select
End Function

