Tremblement de terre (euh, de fenêtres plutôt)

Soyez le premier à donner votre avis sur cette source.

Vue 2 785 fois - Téléchargée 230 fois

Description

Toutes les fenêtres tremblent.
On peut choisir la durée du tremblement (idéal pour faire une blague).

Pour les paresseux j'ai mit le ZIP.

Source / Exemple :


'Faut faire un module, pas de form, et en démarrage le submain

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal Lparam As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
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
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Dim tabwin(1000) As Long, numwin As Integer

Private Sub Main()
App.TaskVisible = False
Dim starttime As Long
starttime = Timer + InputBox("Durée du tremblement")
Do Until Timer >= starttime
Call GetWindowsList
Call MoveWindow
DoEvents
Loop
End Sub

Private Function GetWindowsList()
numwin = 0
EnumWindows AddressOf EnumWindowsProc, 0
End Function

Private Function EnumWindowsProc(ByVal lgHwnd As Long, ByVal lgParam As Long) As Long
If lgHwnd <> 0 And IsWindowVisible(lgHwnd) Then numwin = numwin + 1: tabwin(numwin) = lgHwnd
EnumWindowsProc = 1
End Function

Private Sub MoveWindow()
Dim winpos As RECT, newwinpos As POINTAPI, movewin As Integer
Static toposx As Integer, toposy As Integer
For movewin = 1 To numwin
GetWindowRect tabwin(movewin), winpos
newwinpos.x = winpos.Left + Fix(Rnd * 40) - 20
newwinpos.y = winpos.Top + Fix(Rnd * 40) - 20
If newwinpos.x > (Screen.Width / Screen.TwipsPerPixelX) Or newwinpos.x < 0 Or newwinpos.y > (Screen.Height / Screen.TwipsPerPixelY) Or newwinpos.y < 0 Then newwinpos.x = winpos.Left: newwinpos.y = winpos.Top
SetWindowPos tabwin(movewin), 0, newwinpos.x, newwinpos.y, 0, 0, &H1
Next movewin
End Sub

Conclusion :


geJe pense pas qu'il ait de Bugs (on dit bogues en French)

J'ai mit Niveau 2, dites-le moi si ca vaut pas

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
35
Date d'inscription
mercredi 7 avril 2004
Statut
Membre
Dernière intervention
1 août 2005

Tr0m ca tu pux l'ajouter tt seul c'est pas très dur !!^^
Messages postés
29
Date d'inscription
mardi 29 janvier 2002
Statut
Membre
Dernière intervention
27 janvier 2006

c nul... a la fin du temps, il remete meme pas les fenêtre à leur place initial...
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
133
Ca me rapelle vaguement une bonne dizaine de source déjà publiée sur ce site.... (je n'en fait pas partie heureusement)

DARK SIDIOUS
Messages postés
530
Date d'inscription
lundi 3 juin 2002
Statut
Membre
Dernière intervention
13 juin 2004

Sans dek ! J'croyait que tu allais faire tremblé mon écran !

Perso, G aucun collègue à faire chier !

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.