APPLI RIGOLOTE POUR EXEMPLE DE DÉSACTIVATION DE CONTROL/ALT/SUPPR ET GENERATION DYNAMIQUE DE FORMS

' DANS UNE FEUILLE NOMMEE FLE
'Cette petite appli débile a pour mérite de fournir :
'- quelques exemples de programmation événementielle
'( cour-circuitage de l'évenement "Unload" de la feuille et
'reconnaissance d 'une séquence saisie au clavier sur la feuille,
'mousemove, etc...)
'
'- 2 exemples d'utilisation d'API (Pour conserver la fenêtre
'au premier plan et désactiver Ctrl-alt-suppr -> ne fonctionne pas sous XP)
'
'- 1 exemple de génération dynamique de feuille
'
'- d'autres petits trucs comme positionnement aléatoire de la feuille

Option Explicit

' Déclaration d'API pour CRTL-ALT-SUPPR
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
     (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, _
    ByVal fuWinIni As Long) As Long
' Déclaration de constante
Private Const SPI_SCREENSAVERRUNNING = 97


'API nécessaire pour le mode "toujours visible"
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _
                                ByVal hWndInsertAfter _
                                As Long, ByVal X _
                                As Long, ByVal Y _
                                As Long, ByVal cx _
                                As Long, ByVal cy _
                                As Long, ByVal wFlags _
                                As Long) As Long


 'DEPLACEMENT APIS

Private Sub Form_Load()
    Dim nRet As Long

    ' Dimensions  et coordonnées aléatoires
    Label1.Width = Me.Width
    Label1.Height = Me.Height
    Randomize (Timer)
    Me.Left = Rnd * (Screen.Width - Me.Width)
    Me.Top = Rnd * (Screen.Height - Me.Height)
   
    ' Désactive ctrl_alt_suppr
    CTRL_ALT_SUPPR (False)
       
    ' Toujours visible
    Dim Resultat As Long
    Const Flags = &H2 Or &H1 Or &H40 Or &H10
    Resultat = SetWindowPos(Me.hWnd, -1, 0, 0, 0, 0, Flags)
    Me.SetFocus
    
    ' masquer dans le gestionnaire des tâches
    App.TaskVisible = False

    
End Sub



' FERMETURE IMPOSSIBLE (si KITE = FALSE)

Private Sub Form_Unload(Cancel As Integer)

    ' Test si autorisation de quitter alors fermeture de toutes les feuilles
    If KITE = True Then
        Dim F As Form
        For Each F In Forms
            Unload F
        Next
        Exit Sub
    End If
    
    ' si je suis ici, l'autorisation de fermer est refusée : nouvelle instance de la form FLE
    Dim Nform As Form
    Set Nform = New FLE
    Nform.Show
    Cancel = 1

End Sub


' Cette procédure permet de désactiver (et réactiver) les combinaisons :
' CTRL+ALT+SUPPR, CTRL+ECHAP et ALT+TAB
Public Sub CTRL_ALT_SUPPR(blOFF As Boolean)
    ' Si blOFF = True, désactive CTRL+ALT+SUPPR
    ' Si blOFF = False, active de nouveau CTRL+ALT+SUPPR
    Dim lgRep As Long
    lgRep = SystemParametersInfo(SPI_SCREENSAVERRUNNING, Not blOFF, False, 0)
End Sub


' ECHAPPER A CET ENFER -> saisie de "OUNEUFE" au clavier en aveugle
Private Sub Form_KeyPress(keyascii As Integer)
    ' Rendre Ctrl-alt-suppr à nouveau valide et autorisation de fermeture
    Pass = Pass & Chr(keyascii):
    
    If UCase(Right(Pass, 7)) = "OUNEUFE" Then
    CTRL_ALT_SUPPR (True): KITE = True: Unload Me
    End If
End Sub

'  effet savonnette
Private Sub label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     Randomize (Timer)
     Me.Left = Rnd * (Screen.Width - Me.Width)
     Me.Top = Rnd * (Screen.Height - Me.Height)
End Sub


' DANS UN MODULE
' Ces variable sont globales pour concerner toutes les feuilles créées dynamiquement
Public Pass As String
Public KITE  As Boolean