neige

Je pense que le mieux (et moins gourmand) serait de
dessiner directement des pixels !! LOL

Les shape sont un control ActiveX alors c'est normal que
ton system rame si tu as un shape chargé 150 fois en
memoire LOOOOOL

-----Message d'origine-----
bonjour
je voudrais faire de la neige qui tombe sur une partie

de mon ecran (3000

twips de large et env 7000 de haut)
le probleme c'est qu'au bout d'une 150aine de shape

(lol) le pc rame

qqn aurait une idée moins gourmande ?
merci


.

"seb-seb" <sperot51@msn.com> a écrit dans le message de
news:OICzHPzvDHA.560@TK2MSFTNGP11.phx.gbl

bonjour
je voudrais faire de la neige qui tombe sur une partie de mon ecran
(3000 twips de large et env 7000 de haut)
le probleme c'est qu'au bout d'une 150aine de shape (lol) le pc rame
qqn aurait une idée moins gourmande ?
merci

Bonjour/soir,

En complément de ce que t'as dit Franck, je te conseille de dessiner tes
flocons. Mais pour la rapidité et éviter un effet de "clignotement" de
l'image, je te conseiller de dessiner dans un premier temps sur un
picturebox invisible (à l'aide de pset), un backbuffer, et ensuite de copier
ce backbuffer sur un picturebox visible ou sur ta form (front buffer).

Pour encore plus de rapidité, tu peux tracer tes flocons par APIs (GDI) ou
par directX.

--
François Picalausa (MVP VB)
FAQ VB : http://faq.vb.free.fr
MSDN : http://msdn.microsoft.com

Bonjour/soir,

Voici un exemple pour les VBistes de noël ;-)

'Sur un form, form1, borderstyle = 0
' Un picturebox, Picture1
' Un timer, timer1
Option Explicit

'---------------------------------------------------------------
'API
'---------------------------------------------------------------

Private Const GWL_EXSTYLE = (-20)

Private Const WS_EX_LAYERED = &H80000
Private Const WS_EX_TRANSPARENT = &H20&

Private Const LWA_COLORKEY = &H1&

Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONUP = &H202

Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOPMOST = -1

Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Private Declare Function GetWindowLong _
Lib "user32" _
Alias "GetWindowLongA" _
( _
ByVal hWnd As Long, _
ByVal nIndex As Long _
) _
As Long
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" _
( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long _
) _
As Long
Private Declare Function SetLayeredWindowAttributes _
Lib "user32" _
( _
ByVal hWnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long _
) _
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 uFlags As Long _
) _
As Long

Private Declare Function Shell_NotifyIcon _
Lib "shell32" _
( _
ByVal dwMessage As Long, _
lpdata As NOTIFYICONDATA _
) _
As Long

'---------------------------------------------------------------
'Constantes, variables, ... utilisées par le programme
'---------------------------------------------------------------

#Const Win2000XP = 0
#Const PleinLEcran = 0

Const NombreFlocons = 250

Private Type Flocon
X As Long
Y As Long
SpeedX As Integer
SpeedY As Integer
Taille As Long
End Type

Private Flocons(NombreFlocons) As Flocon

Private Sub Form_Click()
#If Not (Win2000XP And PleinLEcran) Then
Unload Me
#End If
End Sub

Private Sub Form_Load()
'on initialise les propriétés
Picture1.Visible = False
Picture1.BorderStyle = 0

Picture1.ScaleMode = 3 'pixels
Me.ScaleMode = 3 'pixels

Picture1.Width = Me.ScaleWidth
Picture1.Height = Me.ScaleHeight

Picture1.ForeColor = vbWhite
Picture1.BackColor = RGB(100, 180, 203)

Dim i As Integer

#If Win2000XP And PleinLEcran Then
' Pour ceux qui ont win 2000/xp
' et qui veulent mettre de la neigne plein leur bureau
' attention, ça peut ramer à cause de la transparence...

Me.WindowState = vbMaximized
Picture1.BackColor = vbRed
Dim lOldStyle As Long

lOldStyle = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
'EX_TRANSPARENT permet que même si on clique sur un flocon
'la fenêtre ne soit pas activée
SetWindowLong Me.hWnd, GWL_EXSTYLE, _
lOldStyle Or WS_EX_LAYERED Or WS_EX_TRANSPARENT
SetLayeredWindowAttributes Me.hWnd, vbRed, 0, LWA_COLORKEY
SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW

'création d'une icôe dans le tray
Dim nid As NOTIFYICONDATA

nid.cbSize = Len(nid)
nid.hIcon = Me.Icon.Handle
nid.hWnd = Me.hWnd
nid.szTip = "Je veux plus de neige" & vbNullChar
nid.uCallbackMessage = WM_MOUSEMOVE
nid.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
nid.uID = 0

Shell_NotifyIcon NIM_ADD, nid

Me.Show 'pour que la taille en largeur soit mise à jour
#End If

Debug.Print Me.ScaleWidth
For i = 0 To NombreFlocons
Flocons(i).X = GetRandomNumber(0, Me.ScaleWidth)
Flocons(i).Y = GetRandomNumber(0, Me.ScaleHeight)
Flocons(i).SpeedX = GetRandomNumber(-2, 2)
Flocons(i).SpeedY = GetRandomNumber(1, 3)
Flocons(i).Taille = GetRandomNumber(1, 3)
Next i

Timer1.Enabled = True
Timer1.Interval = 50

Picture1.AutoRedraw = True
End Sub

'Fonction de génération d'un nombre aléatoire
Private Function GetRandomNumber(Min As Long, Max As Long) As Long
GetRandomNumber = Int(Rnd * (Max - Min + 1)) + Min
End Function

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single,
Y As Single)
#If Win2000XP And PleinLEcran Then
'particularité de la transcription du message par VB
If X = WM_LBUTTONUP Then
Unload Me
End If
#End If
End Sub

Private Sub Form_Resize()
'le backbuffer doit avoir la même taille que le front buffer
Picture1.Width = Me.ScaleWidth
Picture1.Height = Me.ScaleHeight
End Sub

Private Sub Form_Unload(Cancel As Integer)
#If Win2000XP And PleinLEcran Then
Dim nid As NOTIFYICONDATA

nid.hWnd = Me.hWnd
nid.uID = 0

Shell_NotifyIcon NIM_DELETE, nid
#End If
End Sub

Private Sub Timer1_Timer()
'Redessine chaque flocon et affiche le résultat à l'écran
Dim i As Integer, xsvar As Long

'efface le backbuffer
Picture1.Cls

'pour chaque flocon
For i = 0 To NombreFlocons
'change la taille du pinceau
Picture1.DrawWidth = Flocons(i).Taille

Picture1.PSet (Flocons(i).X, Flocons(i).Y)

xsvar = GetRandomNumber(-1, 1)

'on change la vitesse x du flocon
If Abs(Flocons(i).SpeedX + xsvar) <= 2 Then Flocons(i).SpeedX Flocons(i).SpeedX + xsvar

'on déplace le flocon
Flocons(i).X = Flocons(i).X + Flocons(i).SpeedX
Flocons(i).Y = Flocons(i).Y + Flocons(i).SpeedY

'et on le remet en haut si nécessaire
If Flocons(i).Y > Me.ScaleHeight Then
Flocons(i).Y = -Flocons(i).Taille
Flocons(i).X = GetRandomNumber(0, Me.ScaleWidth)
End If
Next i

Set Me.Picture = Picture1.Image
End Sub

Ne pas m'en vouloir pour les quelques erreurs de code qui pourraient s'être
cachées... je n'ai pas pris beaucoup de temps pour coder cet exemple ;-)

--
François Picalausa (MVP VB)
FAQ VB : http://faq.vb.free.fr
MSDN : http://msdn.microsoft.com

impressionnant et merci
je vais essayer de trafiquer un peu ca


"François Picalausa" <fpicalausa@chez.com> a écrit dans le message de
news:Oi87kK1vDHA.2540@TK2MSFTNGP10.phx.gbl...

Bonjour/soir,

Voici un exemple pour les VBistes de noël ;-)

'Sur un form, form1, borderstyle = 0
' Un picturebox, Picture1
' Un timer, timer1
Option Explicit

'---------------------------------------------------------------
'API
'---------------------------------------------------------------

Private Const GWL_EXSTYLE = (-20)

Private Const WS_EX_LAYERED = &H80000
Private Const WS_EX_TRANSPARENT = &H20&

Private Const LWA_COLORKEY = &H1&

Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2

Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONUP = &H202

Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOPMOST = -1

Private Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Private Declare Function GetWindowLong _
Lib "user32" _
Alias "GetWindowLongA" _
( _
ByVal hWnd As Long, _
ByVal nIndex As Long _
) _
As Long
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" _
( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long _
) _
As Long
Private Declare Function SetLayeredWindowAttributes _
Lib "user32" _
( _
ByVal hWnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long _
) _
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 uFlags As Long _
) _
As Long

Private Declare Function Shell_NotifyIcon _
Lib "shell32" _
( _
ByVal dwMessage As Long, _
lpdata As NOTIFYICONDATA _
) _
As Long

'---------------------------------------------------------------
'Constantes, variables, ... utilisées par le programme
'---------------------------------------------------------------

#Const Win2000XP = 0
#Const PleinLEcran = 0

Const NombreFlocons = 250

Private Type Flocon
X As Long
Y As Long
SpeedX As Integer
SpeedY As Integer
Taille As Long
End Type

Private Flocons(NombreFlocons) As Flocon

Private Sub Form_Click()
#If Not (Win2000XP And PleinLEcran) Then
Unload Me
#End If
End Sub

Private Sub Form_Load()
'on initialise les propriétés
Picture1.Visible = False
Picture1.BorderStyle = 0

Picture1.ScaleMode = 3 'pixels
Me.ScaleMode = 3 'pixels

Picture1.Width = Me.ScaleWidth
Picture1.Height = Me.ScaleHeight

Picture1.ForeColor = vbWhite
Picture1.BackColor = RGB(100, 180, 203)

Dim i As Integer

#If Win2000XP And PleinLEcran Then
' Pour ceux qui ont win 2000/xp
' et qui veulent mettre de la neigne plein leur bureau
' attention, ça peut ramer à cause de la transparence...

Me.WindowState = vbMaximized
Picture1.BackColor = vbRed
Dim lOldStyle As Long

lOldStyle = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
'EX_TRANSPARENT permet que même si on clique sur un flocon
'la fenêtre ne soit pas activée
SetWindowLong Me.hWnd, GWL_EXSTYLE, _
lOldStyle Or WS_EX_LAYERED Or WS_EX_TRANSPARENT
SetLayeredWindowAttributes Me.hWnd, vbRed, 0, LWA_COLORKEY
SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, _
SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW

'création d'une icôe dans le tray
Dim nid As NOTIFYICONDATA

nid.cbSize = Len(nid)
nid.hIcon = Me.Icon.Handle
nid.hWnd = Me.hWnd
nid.szTip = "Je veux plus de neige" & vbNullChar
nid.uCallbackMessage = WM_MOUSEMOVE
nid.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
nid.uID = 0

Shell_NotifyIcon NIM_ADD, nid

Me.Show 'pour que la taille en largeur soit mise à jour
#End If

Debug.Print Me.ScaleWidth
For i = 0 To NombreFlocons
Flocons(i).X = GetRandomNumber(0, Me.ScaleWidth)
Flocons(i).Y = GetRandomNumber(0, Me.ScaleHeight)
Flocons(i).SpeedX = GetRandomNumber(-2, 2)
Flocons(i).SpeedY = GetRandomNumber(1, 3)
Flocons(i).Taille = GetRandomNumber(1, 3)
Next i

Timer1.Enabled = True
Timer1.Interval = 50

Picture1.AutoRedraw = True
End Sub

'Fonction de génération d'un nombre aléatoire
Private Function GetRandomNumber(Min As Long, Max As Long) As Long
GetRandomNumber = Int(Rnd * (Max - Min + 1)) + Min
End Function

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As

Single,

Y As Single)
#If Win2000XP And PleinLEcran Then
'particularité de la transcription du message par VB
If X = WM_LBUTTONUP Then
Unload Me
End If
#End If
End Sub

Private Sub Form_Resize()
'le backbuffer doit avoir la même taille que le front buffer
Picture1.Width = Me.ScaleWidth
Picture1.Height = Me.ScaleHeight
End Sub

Private Sub Form_Unload(Cancel As Integer)
#If Win2000XP And PleinLEcran Then
Dim nid As NOTIFYICONDATA

nid.hWnd = Me.hWnd
nid.uID = 0

Shell_NotifyIcon NIM_DELETE, nid
#End If
End Sub

Private Sub Timer1_Timer()
'Redessine chaque flocon et affiche le résultat à l'écran
Dim i As Integer, xsvar As Long

'efface le backbuffer
Picture1.Cls

'pour chaque flocon
For i = 0 To NombreFlocons
'change la taille du pinceau
Picture1.DrawWidth = Flocons(i).Taille

Picture1.PSet (Flocons(i).X, Flocons(i).Y)

xsvar = GetRandomNumber(-1, 1)

'on change la vitesse x du flocon
If Abs(Flocons(i).SpeedX + xsvar) <= 2 Then Flocons(i).SpeedX > Flocons(i).SpeedX + xsvar

'on déplace le flocon
Flocons(i).X = Flocons(i).X + Flocons(i).SpeedX
Flocons(i).Y = Flocons(i).Y + Flocons(i).SpeedY

'et on le remet en haut si nécessaire
If Flocons(i).Y > Me.ScaleHeight Then
Flocons(i).Y = -Flocons(i).Taille
Flocons(i).X = GetRandomNumber(0, Me.ScaleWidth)
End If
Next i

Set Me.Picture = Picture1.Image
End Sub

Ne pas m'en vouloir pour les quelques erreurs de code qui pourraient

s'être

cachées... je n'ai pas pris beaucoup de temps pour coder cet exemple ;-)

--
François Picalausa (MVP VB)
FAQ VB : http://faq.vb.free.fr
MSDN : http://msdn.microsoft.com