'**********************************************************************************
'* Les fonctions et procédures déclarées en 'Private' indiquent qu'elles ne
'* peuvent être appellées que dans leur module afin de garantir qu'elles
'* n'interfèrent pas avec des fonctions déclarées par le programme.
'*:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'* Functions and sub procedures declared as "Private" indicates that the procedure
'* is accessible only to other procedures in the module in wich it exists. No other
'* procedure in any other module or program can access to it.
'***********************************************************************************

Option Compare Database
'*********************************************************************
'* Déclaration des Variables du Programme | Variable's declaration
'**********************************************************************
Dim Msg_Defaut As Long
Dim Msg_IconStyle As Long
Dim Msg_CodeMode As Integer
Dim Msg_StyleBouton As Long
Dim Msg_TitreMessage As String
Dim Msg_Message As String
Dim Msg_TexteMessage As String
Dim Msg_Style As Long
Dim Msg_BasePage As Integer
Dim Msg_F As Integer
'*********************************************************************
'* Déclaration des API Windows | API's Windows declaration
'*********************************************************************
Declare Function Msg_LstrCpy Lib "Kernel" Alias "lstrcpy" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function Msg_GlobalAlloc Lib "Kernel" Alias "GlobalAlloc" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
Declare Function Msg_OpenClipboard Lib "User" Alias "OpenClipboard" (ByVal Hwnd As Integer) As Integer
Declare Function Msg_CloseClipboard Lib "User" Alias "CloseClipboard" () As Integer
Declare Function Msg_SetClipboardData Lib "User" Alias "SetClipboardData" (ByVal wFormat As Integer, ByVal hMem As Integer) As Integer
Declare Function Msg_EmptyClipboard Lib "User" Alias "EmptyClipboard" () As Integer
Declare Function Msg_GlobalLock Lib "Kernel" Alias "GlobalLock" (ByVal hMem As Integer) As Long
Declare Function Msg_GlobalUnlock Lib "Kernel" Alias "GlobalUnlock" (ByVal hMem As Integer) As Integer
'*************************************************************************************************************
'* Déclaration des constantes utilisées par les API | API's constants declarations
'************************************************************************************************************
Global Const CF_TEXT = 1
Global Const GHND = &H42
Global Const MAXSIZE = 4096

Function Msg_Aide ()
'*****************************************************
'* Appel des écrans d'aides | Call the Help's Sreens
'*****************************************************
    
  If Msg_BasePage = 1 Then DoCmd OpenForm "Aide1"
  If Msg_BasePage = 2 Then DoCmd OpenForm "Aide2"
End Function

Function Msg_Annule ()
'****************************************************************************************
'* Annulation des opérations et quite l'Assistant | Cancel opérations and Leave the wizard
'*****************************************************************************************

DoCmd Close A_Form, "MsgBox"

End Function

Function Msg_ChangePage (Msg_NumPage As Integer)

'**********************************************************************
'* Gestion des sauts de pages dans le formulaire | Run form's jumps
'***********************************************************************
   
Dim C As Control
Msg_BasePage = Msg_NumPage
If Msg_NumPage = 1 Then
    Msg_BasePage = Msg_BasePage + 1
Else
    Msg_BasePage = Msg_BasePage - 1
End If
DoCmd GoToPage Msg_BasePage

Select Case Msg_BasePage
    Case 1
      Set C = Forms!MsgBox!BouTon61
    Case 2
      Set C = Forms!MsgBox!MTitre
End Select
     
DoCmd GoToControl C.ControlName

'*********************************************************************
'* Activation des boutons suites | Activation off the "Next" buttons
'*********************************************************************
If Msg_BasePage > 1 Then
    Forms.MsgBox.Retour.Enabled = -1
Else
    Forms.MsgBox.Retour.Enabled = 0
End If

End Function

Private Sub Msg_CopiePressePapier (Composition As String)
'*****************************************************
'* Chargement du Presse papier | Set the Clipboard
'*****************************************************
Dim HG As Integer, LP As Long, HC As Integer

'Alloue de la mémoire globale
'Allocate the globary memory
HG = Msg_GlobalAlloc(GHND, Len(Composition) + 1)
'Bloque la plage mémoire | Lock the memory
LP = Msg_GlobalLock(HG)
'Copie la variable chaine en mémoire | Copy the lpString in memory
LP = Msg_LstrCpy(LP, Composition)

'Débloquage de la mémoire une fois la copie éffectuée
'Unlock the memory when the operation is realised
If Msg_GlobalUnlock(HG) <> 0 Then
	MsgBox "Impossible de débloquer la mémoire, copie annulée.", 16, "Assistant MsgBox"
	GoTo ExitCop
	End If

'Charge la variable hw% avec le hwnd de la feuille
'Set the variable "Hw%" with the Hwnd of the form
HW% = Screen.ActiveForm.Hwnd
'Ouvre le Presse Papier | Open the Clipboard
If Msg_OpenClipboard(HW%) = 0 Then
	MsgBox "Impossible d'ouvrir le Presse-Papier.Copie annulée.", 16, "Assistant MsgBox"
	Msg_F = 0
	Exit Sub
	End If
'Vide le Presse Papier| Empty the Clipboard
    X% = Msg_EmptyClipboard()
    'Copie La plage mémoire dans le Presse Papier
    'Set the clipboard with the LpString
    HC = Msg_SetClipboardData(CF_TEXT, HG)
ExitCop:
'Ferme le Presse Papier | Close the Clipboard
    If Msg_CloseClipboard() = 0 Then
	MsgBox "Impossible de fermer le Presse-Papier", 16, "Assistant MsgBox"
	Msg_F = 0
	End If

End Sub

Function Msg_CopyCtl ()

'*******************************************************************************
'* Récupération des options choisis par l'utilisateur pour chargement du Presse papier .
'* Take the options choosed by the user for Clipboard's setting.
'********************************************************************************
    Msg_F = -1
    Q$ = Chr$(34)
    CR$ = Chr$(13) + Chr$(10)
    CR2$ = CR$ + CR$
    CReturn$ = Q$ + " + CR$"
    Msg_CodeMode = Forms![MsgBox]!CodeOpt
    Msg_IconStyle = Forms![MsgBox]!IconOpt
    Msg_StyleBouton = Forms![MsgBox]!BoutOpt
    Msg_Defaut = Forms![MsgBox]!DefautOpt

    If Forms![MsgBox]!MTitre <> "" Then
	If Msg_Vérif_Texte((Forms![MsgBox]!MTitre), 1) = -1 Then
	    Msg_TitreMessage = Forms![MsgBox]!MTitre
	End If
    Else
	Msg_TitreMessage = ""
    End If

    If Forms![MsgBox]!MTexte <> "" Then
	If Msg_Vérif_Texte((Forms![MsgBox]!MTexte), 2) = -1 Then
	Msg_TexteMessage = Forms![MsgBox]!MTexte
	End If
    Else
	Msg_ErrorMtexte
    End If

    If Msg_CodeMode = 1 Then
	Coder$ = "MsgBox Message$, Style, TitreMessage$" + CR$
    Else
	Coder$ = "LaRéponse = MsgBox(Message$, Style, TitreMessage$)" + CR$
    End If

    Msg_Style = Msg_Defaut + Msg_IconStyle + Msg_StyleBouton
    AReturn = InStr(Msg_TexteMessage, Chr$(13))
    If AReturn > 0 Then
	Pass = 0
	While AReturn <> 0
	    If Len(Msg_TexteMessage) > 2 Then
		If Pass = 0 Then
		    Msg_Message = "Message$ = " + Q$ + Left$(Msg_TexteMessage, AReturn - 1) + CReturn$ + CR$
		Else
		    Msg_Message = Msg_Message + "Message$ = Message$ + " + Q$ + Left$(Msg_TexteMessage, AReturn - 1) + CReturn$ + CR$
		End If
		Pass = Pass + 1
		Msg_TexteMessage = Mid$(Msg_TexteMessage, AReturn + 2)
	    End If
	    AReturn = InStr(Msg_TexteMessage, Chr$(13))
	Wend
	Msg_Message = Msg_Message + "Message$ = Message$ + " + Q$ + Msg_TexteMessage + CReturn$ + CR$
    ElseIf Len(Msg_TexteMessage) > 150 Then
	Pass = 0
	While Len(Msg_TexteMessage) > 150
	    If Pass = 0 Then
		Msg_Message = "Message$ = " + Q$ + Left$(Msg_TexteMessage, 150) + Q$ + CR$
	    Else
		Msg_Message = Msg_Message + "Message$ = Message$ + " + Q$ + Left$(Msg_TexteMessage, 150) + Q$ + CR$
	    End If
	    Pass = Pass + 1
	    Msg_TexteMessage = Mid$(Msg_TexteMessage, 151)
	Wend
	Msg_Message = Msg_Message + "Message$ = Message$ + " + Q$ + Msg_TexteMessage + Q$ + CR$
    Else
	Msg_Message = "Message$ = " + Q$ + Msg_TexteMessage + Q$ + CR$
    End If

    Header$ = "CR$ = Chr$(13) + Chr$(10)" + CR$
    Header$ = Header$ + Msg_Message
    Header$ = Header$ + "Style = " + Str$(Msg_Style) + CR$
    Header$ = Header$ + "TitreMessage$ = " + Q$ + Msg_TitreMessage + Q$ + CR$
    Header$ = Header$ + Coder$
    Select Case Msg_StyleBouton
	Case 5
	    Handler$ = "If LaRéponse = 4 Then  'Réponse Répéter" + CR2$
	    Handler$ = Handler$ + "Else     'Réponse Annuler" + CR2$ + "End If" + CR$
	Case 4
	    Handler$ = "If LaRéponse = 6 Then  'Réponse Yes" + CR2$
	    Handler$ = Handler$ + "Else     'Réponse Non" + CR2$ + "End If" + CR$
	Case 3
	    Handler$ = "Select Case LaRéponse" + CR$ + "     Case 7     'Cliqué Non" + CR2$
	    Handler$ = Handler$ + "     Case 6     'Réponse Oui" + CR2$
	    Handler$ = Handler$ + "     Case Else  'Réponse Annuler" + CR2$ + "End Select" + CR$
	Case 2
	    Handler$ = "Select Case LaRéponse" + CR$ + "     Case 5     'Cliqué Ignorer" + CR2$
	    Handler$ = Handler$ + "     Case 4     'Réponse Répeter" + CR2$
	    Handler$ = Handler$ + "     Case Else  'Réponse Anuler" + CR2$ + "End Select" + CR$
	Case 1
	    Handler$ = "If LaRéponse = 1 Then  'Réponse OK" + CR2$
	    Handler$ = Handler$ + "Else     'Réponse Annuler" + CR2$ + "End If" + CR$
	Case Else
	    Handler$ = ""
    End Select

    If Msg_CodeMode <> 1 Then
	Whole$ = Header$ + Handler$
    Else
	Whole$ = Header$
    End If

    Msg_CopiePressePapier Whole$
    If Msg_F = -1 Then DoCmd Close A_Form, "MsgBox"
   
End Function

Private Sub Msg_ErrorMtexte ()
'********************************************************************
'* Traitement d'érreur de message vide | Display an error message
'********************************************************************
 MsgBox "Le message ne peut pas être vide!", 16, "Erreur de Texte"
 DoCmd CancelEvent
 Msg_F = 0
End Sub

Function Msg_Fermer_Aide ()
'********************************************************
'* Fermeture des fenêtres d'aide | Close Help's Screens
'********************************************************

     If Msg_BasePage = 1 Then DoCmd Close A_Form, "Aide1"
     If Msg_BasePage = 2 Then DoCmd Close A_Form, "Aide2"
End Function

Function Msg_Ini ()
'**********************************************************************************
'* Initialisation des variables du Programme | Program's variables initialization
'**********************************************************************************
Msg_F = -1
Msg_BasePage = 1
X% = Msg_ValDef()

End Function

Function Msg_Start ()
'******************************************************************
'* Initialisation et démarrage de l'Assistant | Start the wizard
'*****************************************************************
DoCmd OpenForm "MsgBox"
End Function

Function Msg_ValDef () As Integer
'*********************************************************************************************
'* Définie la visibilité et la valeur des boutons d'options
'* en fonction des choix de l'utilisateur
'* Set if the buttons are visibles and there values after the user's choices.
'*********************************************************************************************
Dim I As Long, J As Long
I = Forms![MsgBox]!BoutOpt
J = Forms![MsgBox]!DefautOpt
Select Case I
    Case 0
	Forms![MsgBox]!Bouton45.Visible = 0
	Forms![MsgBox]!Bouton47.Visible = 0
	If J <> 0 Then Forms![MsgBox]!DefautOpt = 0
    Case 1, 4
	Forms![MsgBox]!Bouton45.Visible = -1
	Forms![MsgBox]!Bouton47.Visible = 0
	If J > 256 Then Forms![MsgBox]!DefautOpt = 0
    Case Else
	Forms![MsgBox]!Bouton45.Visible = -1
	Forms![MsgBox]!Bouton47.Visible = -1
End Select
	
End Function

Function Msg_vérif (Msg_TypeTexte%)
'*****************************************************************************
'* Lance la vérification de longueur des textes | Run the Text_Len checking
'*******************************************************************************
Flag% = 0
 If Msg_TypeTexte% = 1 Then
    If Forms![MsgBox]!MTitre <> "" Then
    V$ = Forms![MsgBox]!MTitre
    Flag% = -1
    End If
 Else
    If Forms![MsgBox]!MTexte <> "" Then
    V$ = Forms![MsgBox]!MTexte
    Flag% = -1
    End If
 End If
 Select Case Flag%
 Case -1
 If Msg_Vérif_Texte(V$, Msg_TypTexte%) = 0 Then DoCmd CancelEvent
 Case 0
 If Msg_TypeTexte% = 2 Then Msg_ErrorMtexte
 End Select


End Function

Private Function Msg_Vérif_Texte (Texte As String, TypeTexte As Integer)

'***************************************************************************
'* Vérification de la longueur du titre et du texte de la boite de message
'* Check the len off the title's text and off the message's text
'***************************************************************************
    Msg_Vérif_Texte = -1
    If Len(Texte) > 255 And TypeTexte = 1 Then
	    StrMsg$ = "MsAccess coupera ce titre au 255° caractère! "
	    MsgBox StrMsg$, 16, "Erreur de longueur du Titre"
	    Vérif_Texte = 0
    End If
    If Len(Texte) > 1024 And TypeTexte = 2 Then
	LenMsg$ = "MsAccess n'accepte que 1.024 caractères dans une boîte de message!"
	MsgBox LenMsg$, 16, "Erreur de longueur du Texte"
	Msg_Vérif_Texte = 0
    End If
End Function