home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / access / code / mda / msgsrc.txt < prev   
Text File  |  1995-01-14  |  14KB  |  354 lines
  1. '**********************************************************************************
  2. '* Les fonctions et procΘdures dΘclarΘes en 'Private' indiquent qu'elles ne
  3. '* peuvent Ωtre appellΘes que dans leur module afin de garantir qu'elles
  4. '* n'interfΦrent pas avec des fonctions dΘclarΘes par le programme.
  5. '*:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  6. '* Functions and sub procedures declared as "Private" indicates that the procedure
  7. '* is accessible only to other procedures in the module in wich it exists. No other
  8. '* procedure in any other module or program can access to it.
  9. '***********************************************************************************
  10.  
  11. Option Compare Database
  12. '*********************************************************************
  13. '* DΘclaration des Variables du Programme | Variable's declaration
  14. '**********************************************************************
  15. Dim Msg_Defaut As Long
  16. Dim Msg_IconStyle As Long
  17. Dim Msg_CodeMode As Integer
  18. Dim Msg_StyleBouton As Long
  19. Dim Msg_TitreMessage As String
  20. Dim Msg_Message As String
  21. Dim Msg_TexteMessage As String
  22. Dim Msg_Style As Long
  23. Dim Msg_BasePage As Integer
  24. Dim Msg_F As Integer
  25. '*********************************************************************
  26. '* DΘclaration des API Windows | API's Windows declaration
  27. '*********************************************************************
  28. Declare Function Msg_LstrCpy Lib "Kernel" Alias "lstrcpy" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
  29. Declare Function Msg_GlobalAlloc Lib "Kernel" Alias "GlobalAlloc" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
  30. Declare Function Msg_OpenClipboard Lib "User" Alias "OpenClipboard" (ByVal Hwnd As Integer) As Integer
  31. Declare Function Msg_CloseClipboard Lib "User" Alias "CloseClipboard" () As Integer
  32. Declare Function Msg_SetClipboardData Lib "User" Alias "SetClipboardData" (ByVal wFormat As Integer, ByVal hMem As Integer) As Integer
  33. Declare Function Msg_EmptyClipboard Lib "User" Alias "EmptyClipboard" () As Integer
  34. Declare Function Msg_GlobalLock Lib "Kernel" Alias "GlobalLock" (ByVal hMem As Integer) As Long
  35. Declare Function Msg_GlobalUnlock Lib "Kernel" Alias "GlobalUnlock" (ByVal hMem As Integer) As Integer
  36. '*************************************************************************************************************
  37. '* DΘclaration des constantes utilisΘes par les API | API's constants declarations
  38. '************************************************************************************************************
  39. Global Const CF_TEXT = 1
  40. Global Const GHND = &H42
  41. Global Const MAXSIZE = 4096
  42.  
  43. Function Msg_Aide ()
  44. '*****************************************************
  45. '* Appel des Θcrans d'aides | Call the Help's Sreens
  46. '*****************************************************
  47.     
  48.   If Msg_BasePage = 1 Then DoCmd OpenForm "Aide1"
  49.   If Msg_BasePage = 2 Then DoCmd OpenForm "Aide2"
  50. End Function
  51.  
  52. Function Msg_Annule ()
  53. '****************************************************************************************
  54. '* Annulation des opΘrations et quite l'Assistant | Cancel opΘrations and Leave the wizard
  55. '*****************************************************************************************
  56.  
  57. DoCmd Close A_Form, "MsgBox"
  58.  
  59. End Function
  60.  
  61. Function Msg_ChangePage (Msg_NumPage As Integer)
  62.  
  63. '**********************************************************************
  64. '* Gestion des sauts de pages dans le formulaire | Run form's jumps
  65. '***********************************************************************
  66.    
  67. Dim C As Control
  68. Msg_BasePage = Msg_NumPage
  69. If Msg_NumPage = 1 Then
  70.     Msg_BasePage = Msg_BasePage + 1
  71. Else
  72.     Msg_BasePage = Msg_BasePage - 1
  73. End If
  74. DoCmd GoToPage Msg_BasePage
  75.  
  76. Select Case Msg_BasePage
  77.     Case 1
  78.       Set C = Forms!MsgBox!BouTon61
  79.     Case 2
  80.       Set C = Forms!MsgBox!MTitre
  81. End Select
  82.      
  83. DoCmd GoToControl C.ControlName
  84.  
  85. '*********************************************************************
  86. '* Activation des boutons suites | Activation off the "Next" buttons
  87. '*********************************************************************
  88. If Msg_BasePage > 1 Then
  89.     Forms.MsgBox.Retour.Enabled = -1
  90. Else
  91.     Forms.MsgBox.Retour.Enabled = 0
  92. End If
  93.  
  94. End Function
  95.  
  96. Private Sub Msg_CopiePressePapier (Composition As String)
  97. '*****************************************************
  98. '* Chargement du Presse papier | Set the Clipboard
  99. '*****************************************************
  100. Dim HG As Integer, LP As Long, HC As Integer
  101.  
  102. 'Alloue de la mΘmoire globale
  103. 'Allocate the globary memory
  104. HG = Msg_GlobalAlloc(GHND, Len(Composition) + 1)
  105. 'Bloque la plage mΘmoire | Lock the memory
  106. LP = Msg_GlobalLock(HG)
  107. 'Copie la variable chaine en mΘmoire | Copy the lpString in memory
  108. LP = Msg_LstrCpy(LP, Composition)
  109.  
  110. 'DΘbloquage de la mΘmoire une fois la copie ΘffectuΘe
  111. 'Unlock the memory when the operation is realised
  112. If Msg_GlobalUnlock(HG) <> 0 Then
  113.     MsgBox "Impossible de dΘbloquer la mΘmoire, copie annulΘe.", 16, "Assistant MsgBox"
  114.     GoTo ExitCop
  115.     End If
  116.  
  117. 'Charge la variable hw% avec le hwnd de la feuille
  118. 'Set the variable "Hw%" with the Hwnd of the form
  119. HW% = Screen.ActiveForm.Hwnd
  120. 'Ouvre le Presse Papier | Open the Clipboard
  121. If Msg_OpenClipboard(HW%) = 0 Then
  122.     MsgBox "Impossible d'ouvrir le Presse-Papier.Copie annulΘe.", 16, "Assistant MsgBox"
  123.     Msg_F = 0
  124.     Exit Sub
  125.     End If
  126. 'Vide le Presse Papier| Empty the Clipboard
  127.     X% = Msg_EmptyClipboard()
  128.     'Copie La plage mΘmoire dans le Presse Papier
  129.     'Set the clipboard with the LpString
  130.     HC = Msg_SetClipboardData(CF_TEXT, HG)
  131. ExitCop:
  132. 'Ferme le Presse Papier | Close the Clipboard
  133.     If Msg_CloseClipboard() = 0 Then
  134.     MsgBox "Impossible de fermer le Presse-Papier", 16, "Assistant MsgBox"
  135.     Msg_F = 0
  136.     End If
  137.  
  138. End Sub
  139.  
  140. Function Msg_CopyCtl ()
  141.  
  142. '*******************************************************************************
  143. '* RΘcupΘration des options choisis par l'utilisateur pour chargement du Presse papier .
  144. '* Take the options choosed by the user for Clipboard's setting.
  145. '********************************************************************************
  146.     Msg_F = -1
  147.     Q$ = Chr$(34)
  148.     CR$ = Chr$(13) + Chr$(10)
  149.     CR2$ = CR$ + CR$
  150.     CReturn$ = Q$ + " + CR$"
  151.     Msg_CodeMode = Forms![MsgBox]!CodeOpt
  152.     Msg_IconStyle = Forms![MsgBox]!IconOpt
  153.     Msg_StyleBouton = Forms![MsgBox]!BoutOpt
  154.     Msg_Defaut = Forms![MsgBox]!DefautOpt
  155.  
  156.     If Forms![MsgBox]!MTitre <> "" Then
  157.     If Msg_VΘrif_Texte((Forms![MsgBox]!MTitre), 1) = -1 Then
  158.         Msg_TitreMessage = Forms![MsgBox]!MTitre
  159.     End If
  160.     Else
  161.     Msg_TitreMessage = ""
  162.     End If
  163.  
  164.     If Forms![MsgBox]!MTexte <> "" Then
  165.     If Msg_VΘrif_Texte((Forms![MsgBox]!MTexte), 2) = -1 Then
  166.     Msg_TexteMessage = Forms![MsgBox]!MTexte
  167.     End If
  168.     Else
  169.     Msg_ErrorMtexte
  170.     End If
  171.  
  172.     If Msg_CodeMode = 1 Then
  173.     Coder$ = "MsgBox Message$, Style, TitreMessage$" + CR$
  174.     Else
  175.     Coder$ = "LaRΘponse = MsgBox(Message$, Style, TitreMessage$)" + CR$
  176.     End If
  177.  
  178.     Msg_Style = Msg_Defaut + Msg_IconStyle + Msg_StyleBouton
  179.     AReturn = InStr(Msg_TexteMessage, Chr$(13))
  180.     If AReturn > 0 Then
  181.     Pass = 0
  182.     While AReturn <> 0
  183.         If Len(Msg_TexteMessage) > 2 Then
  184.         If Pass = 0 Then
  185.             Msg_Message = "Message$ = " + Q$ + Left$(Msg_TexteMessage, AReturn - 1) + CReturn$ + CR$
  186.         Else
  187.             Msg_Message = Msg_Message + "Message$ = Message$ + " + Q$ + Left$(Msg_TexteMessage, AReturn - 1) + CReturn$ + CR$
  188.         End If
  189.         Pass = Pass + 1
  190.         Msg_TexteMessage = Mid$(Msg_TexteMessage, AReturn + 2)
  191.         End If
  192.         AReturn = InStr(Msg_TexteMessage, Chr$(13))
  193.     Wend
  194.     Msg_Message = Msg_Message + "Message$ = Message$ + " + Q$ + Msg_TexteMessage + CReturn$ + CR$
  195.     ElseIf Len(Msg_TexteMessage) > 150 Then
  196.     Pass = 0
  197.     While Len(Msg_TexteMessage) > 150
  198.         If Pass = 0 Then
  199.         Msg_Message = "Message$ = " + Q$ + Left$(Msg_TexteMessage, 150) + Q$ + CR$
  200.         Else
  201.         Msg_Message = Msg_Message + "Message$ = Message$ + " + Q$ + Left$(Msg_TexteMessage, 150) + Q$ + CR$
  202.         End If
  203.         Pass = Pass + 1
  204.         Msg_TexteMessage = Mid$(Msg_TexteMessage, 151)
  205.     Wend
  206.     Msg_Message = Msg_Message + "Message$ = Message$ + " + Q$ + Msg_TexteMessage + Q$ + CR$
  207.     Else
  208.     Msg_Message = "Message$ = " + Q$ + Msg_TexteMessage + Q$ + CR$
  209.     End If
  210.  
  211.     Header$ = "CR$ = Chr$(13) + Chr$(10)" + CR$
  212.     Header$ = Header$ + Msg_Message
  213.     Header$ = Header$ + "Style = " + Str$(Msg_Style) + CR$
  214.     Header$ = Header$ + "TitreMessage$ = " + Q$ + Msg_TitreMessage + Q$ + CR$
  215.     Header$ = Header$ + Coder$
  216.     Select Case Msg_StyleBouton
  217.     Case 5
  218.         Handler$ = "If LaRΘponse = 4 Then  'RΘponse RΘpΘter" + CR2$
  219.         Handler$ = Handler$ + "Else     'RΘponse Annuler" + CR2$ + "End If" + CR$
  220.     Case 4
  221.         Handler$ = "If LaRΘponse = 6 Then  'RΘponse Yes" + CR2$
  222.         Handler$ = Handler$ + "Else     'RΘponse Non" + CR2$ + "End If" + CR$
  223.     Case 3
  224.         Handler$ = "Select Case LaRΘponse" + CR$ + "     Case 7     'CliquΘ Non" + CR2$
  225.         Handler$ = Handler$ + "     Case 6     'RΘponse Oui" + CR2$
  226.         Handler$ = Handler$ + "     Case Else  'RΘponse Annuler" + CR2$ + "End Select" + CR$
  227.     Case 2
  228.         Handler$ = "Select Case LaRΘponse" + CR$ + "     Case 5     'CliquΘ Ignorer" + CR2$
  229.         Handler$ = Handler$ + "     Case 4     'RΘponse RΘpeter" + CR2$
  230.         Handler$ = Handler$ + "     Case Else  'RΘponse Anuler" + CR2$ + "End Select" + CR$
  231.     Case 1
  232.         Handler$ = "If LaRΘponse = 1 Then  'RΘponse OK" + CR2$
  233.         Handler$ = Handler$ + "Else     'RΘponse Annuler" + CR2$ + "End If" + CR$
  234.     Case Else
  235.         Handler$ = ""
  236.     End Select
  237.  
  238.     If Msg_CodeMode <> 1 Then
  239.     Whole$ = Header$ + Handler$
  240.     Else
  241.     Whole$ = Header$
  242.     End If
  243.  
  244.     Msg_CopiePressePapier Whole$
  245.     If Msg_F = -1 Then DoCmd Close A_Form, "MsgBox"
  246.    
  247. End Function
  248.  
  249. Private Sub Msg_ErrorMtexte ()
  250. '********************************************************************
  251. '* Traitement d'Θrreur de message vide | Display an error message
  252. '********************************************************************
  253.  MsgBox "Le message ne peut pas Ωtre vide!", 16, "Erreur de Texte"
  254.  DoCmd CancelEvent
  255.  Msg_F = 0
  256. End Sub
  257.  
  258. Function Msg_Fermer_Aide ()
  259. '********************************************************
  260. '* Fermeture des fenΩtres d'aide | Close Help's Screens
  261. '********************************************************
  262.  
  263.      If Msg_BasePage = 1 Then DoCmd Close A_Form, "Aide1"
  264.      If Msg_BasePage = 2 Then DoCmd Close A_Form, "Aide2"
  265. End Function
  266.  
  267. Function Msg_Ini ()
  268. '**********************************************************************************
  269. '* Initialisation des variables du Programme | Program's variables initialization
  270. '**********************************************************************************
  271. Msg_F = -1
  272. Msg_BasePage = 1
  273. X% = Msg_ValDef()
  274.  
  275. End Function
  276.  
  277. Function Msg_Start ()
  278. '******************************************************************
  279. '* Initialisation et dΘmarrage de l'Assistant | Start the wizard
  280. '*****************************************************************
  281. DoCmd OpenForm "MsgBox"
  282. End Function
  283.  
  284. Function Msg_ValDef () As Integer
  285. '*********************************************************************************************
  286. '* DΘfinie la visibilitΘ et la valeur des boutons d'options
  287. '* en fonction des choix de l'utilisateur
  288. '* Set if the buttons are visibles and there values after the user's choices.
  289. '*********************************************************************************************
  290. Dim I As Long, J As Long
  291. I = Forms![MsgBox]!BoutOpt
  292. J = Forms![MsgBox]!DefautOpt
  293. Select Case I
  294.     Case 0
  295.     Forms![MsgBox]!Bouton45.Visible = 0
  296.     Forms![MsgBox]!Bouton47.Visible = 0
  297.     If J <> 0 Then Forms![MsgBox]!DefautOpt = 0
  298.     Case 1, 4
  299.     Forms![MsgBox]!Bouton45.Visible = -1
  300.     Forms![MsgBox]!Bouton47.Visible = 0
  301.     If J > 256 Then Forms![MsgBox]!DefautOpt = 0
  302.     Case Else
  303.     Forms![MsgBox]!Bouton45.Visible = -1
  304.     Forms![MsgBox]!Bouton47.Visible = -1
  305. End Select
  306.     
  307. End Function
  308.  
  309. Function Msg_vΘrif (Msg_TypeTexte%)
  310. '*****************************************************************************
  311. '* Lance la vΘrification de longueur des textes | Run the Text_Len checking
  312. '*******************************************************************************
  313. Flag% = 0
  314.  If Msg_TypeTexte% = 1 Then
  315.     If Forms![MsgBox]!MTitre <> "" Then
  316.     V$ = Forms![MsgBox]!MTitre
  317.     Flag% = -1
  318.     End If
  319.  Else
  320.     If Forms![MsgBox]!MTexte <> "" Then
  321.     V$ = Forms![MsgBox]!MTexte
  322.     Flag% = -1
  323.     End If
  324.  End If
  325.  Select Case Flag%
  326.  Case -1
  327.  If Msg_VΘrif_Texte(V$, Msg_TypTexte%) = 0 Then DoCmd CancelEvent
  328.  Case 0
  329.  If Msg_TypeTexte% = 2 Then Msg_ErrorMtexte
  330.  End Select
  331.  
  332.  
  333. End Function
  334.  
  335. Private Function Msg_VΘrif_Texte (Texte As String, TypeTexte As Integer)
  336.  
  337. '***************************************************************************
  338. '* VΘrification de la longueur du titre et du texte de la boite de message
  339. '* Check the len off the title's text and off the message's text
  340. '***************************************************************************
  341.     Msg_VΘrif_Texte = -1
  342.     If Len(Texte) > 255 And TypeTexte = 1 Then
  343.         StrMsg$ = "MsAccess coupera ce titre au 255░ caractΦre! "
  344.         MsgBox StrMsg$, 16, "Erreur de longueur du Titre"
  345.         VΘrif_Texte = 0
  346.     End If
  347.     If Len(Texte) > 1024 And TypeTexte = 2 Then
  348.     LenMsg$ = "MsAccess n'accepte que 1.024 caractΦres dans une boεte de message!"
  349.     MsgBox LenMsg$, 16, "Erreur de longueur du Texte"
  350.     Msg_VΘrif_Texte = 0
  351.     End If
  352. End Function
  353.  
  354.