Demande de test

Bonjour,

Qui veut me tester ce ce programme, c'est juste un affichage graduel
avec une fermeture estompée, ceci sur un PC Windows où il n'y a pas VB, car
certaines personne ont signalé que le dessin qui compose la form devenait
brouillé, avec de gros carrés (sorte de macro pixellisation), ci-joint en
lien (tout petit, une form), merci :o)

http://mesromans.free.fr/Esoterik_srces.zip


Voici le code aussi ici pour vous donner une idée :


' esoterik form1 regroupe logiciels esothérisme
Option Explicit
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" ( _
ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As
Long) As Long
Private Const PROCESS_TERMINATE = &H1
Private Declare Function IsWindowVisible Lib "user32" (ByVal Handle As
Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA"
_
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As
Long
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function AnimateWindow Lib "user32" ( _
ByVal hWnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Long
Private Const AW_HOR_POSITIVE = &H1
Private Const AW_HOR_NEGATIVE = &H2
Private Const AW_VER_POSITIVE = &H4
Private Const AW_VER_NEGATIVE = &H8
Private Const AW_CENTER = &H10
Private Const AW_HIDE = &H10000
Private Const AW_ACTIVATE = &H20000
Private Const AW_SLIDE = &H40000
Private Const AW_BLEND = &H80000
Private Const AW_DURATION_DEFAULT = 2000
'
Dim NumProcess As Long
Dim processus(4) As Long
Dim fic(4) As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim voisListe As Boolean
'

Sub Form_Load()
Dim r As Long
ChDrive App.Path
ChDir App.Path
If App.PrevInstance Then End
voisListe = False
For i = 1 To 4
processus(i) = 0
Next i
r = AnimateWindow(Me.hWnd, AW_DURATION_DEFAULT, AW_CENTER)
DoEvents
Form1.Enabled = True
End Sub


Sub Command1_Click(Index As Integer)
Dim nomFic As String
Dim dejaOuvert As Boolean
Dim hWnd As Long
Dim Titre_Fenetre As String
Dim TitreFen As String
Dim ret As Long
'
If voisListe = True Then
GoSub deja_ouvert
Exit Sub
End If
'
dejaOuvert = True
Select Case Index
Case 1 ' tarot divinatoire
nomFic = "tarotdiv"
fic(1) = nomFic
GoSub deja_ouvert
If dejaOuvert = True Then Exit Sub
nomFic = "tarotdiv.exe"
NumProcess = Shell(nomFic, 1)
processus(1) = NumProcess
Case 2: ' astrologie
nomFic = "astrologie"
fic(2) = nomFic
GoSub deja_ouvert
If dejaOuvert = True Then Exit Sub
nomFic = "astro3000.exe"
NumProcess = Shell(nomFic, 1)
processus(2) = NumProcess
Case 3: ' numérologie
nomFic = "numerologie"
fic(3) = nomFic
GoSub deja_ouvert
If dejaOuvert = True Then Exit Sub
nomFic = "numerolo.exe"
NumProcess = Shell(nomFic, 1)
processus(3) = NumProcess
Case 4: ' biorythmes
nomFic = "biorythmes"
fic(4) = nomFic
GoSub deja_ouvert
If dejaOuvert = True Then Exit Sub
nomFic = "biorythmes.exe"
NumProcess = Shell(nomFic, 1)
processus(4) = NumProcess
End Select
Exit Sub
'
deja_ouvert:
List1.Clear
hWnd = GetDesktopWindow()
hWnd = GetWindow(hWnd, GW_CHILD)
Do While (Not IsNull(hWnd)) And (hWnd <> 0)
Titre_Fenetre = String(255, 0)
ret = GetWindowText(hWnd, Titre_Fenetre, 255)
If Titre_Fenetre <> String(255, 0) Then
TitreFen = Titre_Fenetre
List1.AddItem LCase(Trim(TitreFen))
End If
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop
For i = List1.ListCount - 1 To 1 Step -1
If List1.List(i) = List1.List(i - 1) Then List1.RemoveItem i
Next i
List1.Refresh
If voisListe = True Then Return
For i = 0 To List1.ListCount - 1
If nomFic = Mid(List1.List(i), 1, Len(nomFic)) Then Return
Next i
dejaOuvert = False
Return
End Sub


Sub m_obs_Click()
Dim lResult As Long
Dim rep
'
lResult = FindWindow("Notepad", "Tarotobs.txt - Bloc-notes")
If lResult = 0 Then
rep = Shell("NotePad.exe " & App.Path & "\Tarotobs.txt", 1)
End If
End Sub


Sub Form_Unload(Cancel As Integer)
Dim RC As Long
Dim hProcess As Long
Dim present(4) As Boolean
Dim nbPresent As Byte
Dim liste1 As String
Dim m As String
Dim s
Dim r As Long
'
Cancel = 0
voisListe = True
Call Command1_Click(1)
voisListe = False
For i = 1 To 4
present(i) = False
Next i
nbPresent = 0
For i = 0 To List1.ListCount - 1
For j = 1 To 4
liste1 = Trim(List1.List(i))
If fic(j) = liste1 Then
present(j) = True
nbPresent = nbPresent + 1
Exit For
End If
Next j
Next i
'
If nbPresent < 1 Then GoTo ferme
s = vbLf
m = "Attention "
If nbPresent = 1 Then m = m & "un logiciel est ouvert : " & s & s
If nbPresent > 1 Then m = m & "des logiciels sont ouverts : " & s & s
m = m & "Pour des raison de sécurité de données nous vous recommandons :
" & s
If nbPresent = 1 Then m = m & "De fermer le logiciel ouvert depui celui-ci
: " & s & s
If nbPresent > 1 Then m = m & "De fermer les logiciels ouverts depuis
ceux-ci : " & s & s
For i = 1 To 4
If present(i) = True Then m = m & "- " & UCase(fic(i)) & " " & s
Next i
m = m & s
m = m & "Voulez vous forcer la fermeture (déconseillé) " & s
s = MsgBox(m, vbQuestion + vbYesNo + vbDefaultButton2)
If s <> vbYes Then
Cancel = -1
Exit Sub
End If
'
ferme:
For i = 1 To 4
If processus(i) <> 0 Then
hProcess = OpenProcess(PROCESS_TERMINATE, -1&, processus(i))
RC = TerminateProcess(hProcess, 0&)
RC = CloseHandle(hProcess)
End If
Next i
If nbPresent > 0 Then
DoEvents
Sleep 1000
End If
'
If WindowState <> 1 Then r = AnimateWindow(Me.hWnd, AW_DURATION_DEFAULT,
AW_BLEND Or AW_HIDE)
'
Reset
End
End Sub


---fin du code-----


Cordialement ;o)
-
Logiciels, romans, contacts : http://irolog.free.fr
_______________________
.
.