Demande de test

Le
LE TROLL
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
_______________________
.
.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
at
Le #21189701
LE TROLL a émis l'idée suivante :
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,



Dans ce cas fourni un exécutable! Sinon ça marche chez moi, mais il y a
vb d'installé.
LE TROLL
Le #21189841
Bonjour,

Ici tu as une version éval

En bas : Télécharger gratuitement pour essayer


http://irolog.free.fr/irolog_vente/finmonde_v/index.htm

Merci, cordialement ;o)

-
Logiciels, romans, contacts : http://irolog.free.fr
_______________________
.
.


"at" news:4b769be8$0$17482$
LE TROLL a émis l'idée suivante :
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,



Dans ce cas fourni un exécutable! Sinon ça marche chez moi, mais il y a vb
d'installé.




at
Le #21189821
LE TROLL vient de nous annoncer :
Bonjour,

Ici tu as une version éval

En bas : Télécharger gratuitement pour essayer


http://irolog.free.fr/irolog_vente/finmonde_v/index.htm



mais je ne veux pas du setup!
LE TROLL
Le #21189931
Bonjour At,

Si tu n'as pas VB, l'exe ne va pas fonctionner sns certaines dll, c'est
juste du visuel, suffit ensuite de désintaller

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


"at" news:4b76a287$0$932$
LE TROLL vient de nous annoncer :
Bonjour,

Ici tu as une version éval

En bas : Télécharger gratuitement pour essayer


http://irolog.free.fr/irolog_vente/finmonde_v/index.htm



mais je ne veux pas du setup!




at
Le #21190111
LE TROLL a formulé la demande :
Bonjour At,

Si tu n'as pas VB, l'exe ne va pas fonctionner sns certaines dll, c'est
juste du visuel, suffit ensuite de désintaller



Bon j'ai compilé avec tes sources, et aucun problème de visuel sur un
autre pc.

A+
LE TROLL
Le #21190191
Merci chef, juste quelques infos :

PC ou PC notebook ?
OS ?
sp n° ?

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


"at" news:4b76a984$0$17525$
LE TROLL a formulé la demande :
Bonjour At,

Si tu n'as pas VB, l'exe ne va pas fonctionner sns certaines dll,
c'est juste du visuel, suffit ensuite de désintaller



Bon j'ai compilé avec tes sources, et aucun problème de visuel sur un
autre pc.

A+




at
Le #21190381
LE TROLL a formulé ce samedi :
Merci chef, juste quelques infos :

PC ou PC notebook ?
OS ?
sp n° ?




windows xp, notebook, sp3, pentium M
carte graphique ati x700
Jean-marc
Le #21198671
LE TROLL wrote:
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)



Hello,
j'ai testé aussi et n'ai pas non plus noté de macr-pixelisation.
Configuration : Windows XP, SP2, Desktop, GEForce 3700 LE

Je prêche sans doute dans le désert, mais j'ai quand même
réécrit ton code dans un style plus accadémique, pour l'exercice
de style.

Par cusriosité, jette un oeil à l'occasion. Tu noteras que les variables
globales ont disparues, de même que toutes les constantes hard-codées.

Tu noteras aussi que niveau maintenance, on a fait un grand pas en avant :
si demain tu ajoutes un programme de divination par lecture dans
les entrailles de bélier (par exemple), il te suffit d'ajouter
2 lignes dans le Form_load et de modifier la constante NUM_PROGS, et hop,
le tour est joué.

Tu noteras aussi que toutes les répétitions inutiles de code ont
disparues, et qu'une procéure infernale genre ton command1_click est
maintenant réduite à 5 lignes, parfaitement claires et lisibles.

Bref, jette un oeil, même si tu n'es pas convaincu, ça te donnera
peut être une idée ou l'autre :-)

A+



' a mettre dans un module (.bas)
' ------------------------------
'Public Type Process
' Nom As String
' NomExe As String
' processus As Long
'End Type

' Form1
' 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 FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName
As String) As Long
Private Declare Function AnimateWindow Lib "user32" ( _
ByVal hWnd As Long, ByVal dwTime As Long, ByVal
dwFlags As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long)
As Long
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

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const PROCESS_TERMINATE = &H1
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
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

Private Const MAX_PROGS As Long = 10
Private Const NUM_PROGS As Long = 4

Dim TProcess(MAX_PROGS) As Process

Sub Form_Load()

If App.PrevInstance Then
End
End If

TProcess(1).Nom = "tarotdiv"
TProcess(1).NomExe = App.Path & "tarotdiv.exe"

TProcess(2).Nom = "astrologie"
TProcess(2).NomExe = App.Path & "astro3000.exe"

TProcess(3).Nom = "numerologie"
TProcess(3).NomExe = App.Path & "numerolo.exe"

TProcess(4).Nom = "biorythmes"
TProcess(4).NomExe = App.Path & "biorythmes.exe"

Call AnimateWindow(Me.hWnd, AW_DURATION_DEFAULT, AW_CENTER)

DoEvents

Form1.Enabled = True
End Sub

Sub Command1_Click(Index As Integer)

If deja_ouvert(TProcess(Index).Nom) Then
Exit Sub
Else
TProcess(Index).processus = Shell(TProcess(Index).NomExe, 1)
End If

End Sub

Private Function deja_ouvert(ByVal nomFic As String) As Boolean
Dim hWnd As Long
Dim Titre_Fenetre As String
Dim TitreFen As String
Dim ret As Long
Dim i As Long

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 = Mid$(Titre_Fenetre, 1, InStr(Titre_Fenetre,
Chr$(0)) - 1)
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
End If
Next i

List1.Refresh

For i = 0 To List1.ListCount - 1
If nomFic = Mid(List1.List(i), 1, Len(nomFic)) Then
deja_ouvert = True
Exit Function
End If
Next i
deja_ouvert = False

End Function

Sub m_obs_Click()
Dim lResult As Long

lResult = FindWindow("Notepad", "Tarotobs.txt - Bloc-notes")

If lResult = 0 Then
Call 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(NUM_PROGS) As Boolean
Dim nbPresent As Byte
Dim liste1 As String
Dim m As String
Dim i As Long
Dim j As Long
Dim reponse As VbMsgBoxResult

Cancel = 0

' populate List1
Call deja_ouvert("")

nbPresent = 0
For i = 0 To List1.ListCount - 1
liste1 = Trim(List1.List(i))
For j = 1 To NUM_PROGS
If TProcess(j).NomExe = liste1 Then
present(j) = True
nbPresent = nbPresent + 1
Exit For
End If
Next j
Next i

If nbPresent >= 1 Then
m = "Attention "

If nbPresent = 1 Then
m = m & "un logiciel est ouvert : " & vbCrLf & vbCrLf
Else
m = m & "des logiciels sont ouverts : " & vbCrLf & vbCrLf
End If

m = m & "Pour des raison de sécurité de données nous vous
recommandons :" & vbCrLf

If nbPresent = 1 Then
m = m & "De fermer le logiciel ouvert depuis celui-ci :" &
vbCrLf & vbCrLf
Else
m = m & "De fermer les logiciels ouverts depuis ceux-ci : " &
vbCrLf & vbCrLf
End If

For i = 1 To NUM_PROGS
If present(i) Then
m = m & "- " & TProcess(i).NomExe & " " & vbCrLf
End If
Next i

m = m & vbCrLf
m = m & "Voulez vous forcer la fermeture (déconseillé) " & vbCrLf

reponse = MsgBox(m, vbQuestion + vbYesNo + vbDefaultButton2)

If reponse <> vbYes Then
Cancel = -1
Exit Sub
End If

End If

For i = 1 To NUM_PROGS
If TProcess(i).processus <> 0 Then
hProcess = OpenProcess(PROCESS_TERMINATE, -1&,
TProcess(i).processus)
RC = TerminateProcess(hProcess, 0&)
RC = CloseHandle(hProcess)
End If
Next i

If nbPresent > 0 Then
DoEvents
Sleep 1000
End If

If WindowState <> 1 Then
Call AnimateWindow(Me.hWnd, AW_DURATION_DEFAULT, AW_BLEND Or
AW_HIDE)
End If

Reset

End Sub



--
Jean-marc Noury (jean_marc_n2)
FAQ VB: http://faq.vb.free.fr/
mailto: remove '_no_spam_' ;
Publicité
Poster une réponse
Anonyme