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

Télécharger le projet
Commenter

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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (Bricomix)