Accueil > > > TREMBLEMENT DE TERRE (EUH, DE FENÊTRES PLUTÔT)
TREMBLEMENT DE TERRE (EUH, DE FENÊTRES PLUTÔT)
Information sur la source
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
- '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
'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
Sources du même auteur
Sources de la même categorie
Commentaires et avis
|
Derniers Blogs
XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE)[HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio
Je m'y prends un peu tard je sais, mais bon je suis développeur web et donc hyper fainéant ! Toujours dans le cadre des technologies émergentes, ici HTML5, parce qu'on aime HTML5 chez Wyg , nous seront présent, le vieux ( Aurélien V.) et moi, pour pr...
Cliquez pour lire la suite de l'article par Gio [WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|