Mettre la calculette toujours écran

c quoi une calculette

La calculatrice Windows XP, pourquoi tu pensais à une machine à laver ???

--
Merci beaucoup, au revoir et à bientôt :o)
------
Site logiciels
http://irolog.free.fr
Mail
http://irolog.free.fr/ecrire/index.htm
Site perso
http://irolog.free.fr/joe/index.htm
Principe d'utilisation des news Groups
http://support.microsoft.com/directory/worldwide/fr/newsgroup/regles.htm
------------------------------------------------------------------------------------
"liberte" <fleurinddina@hotmail.com> a écrit dans le message de news:
1147173018.479476.176220@j73g2000cwa.googlegroups.com...

c quoi une calculette

Bonjour X,
X a écrit :

Bonjour,

Comment appeler la calculette et la mettre toujours à l'écran, puis la
fermer sur commande ???

Si tu veux lancer la calculatrice, et qu'elle reste en premier plan, tu
peux essayer ceci :

Option Explicit

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
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 Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOPMOST = &H8&

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 Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_SHOWWINDOW = &H40

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const WM_CLOSE = &H10

Dim hWndCalc As Long

Private Sub Command1_Click()
LanceCalcOnTop
End Sub

Private Sub Command2_Click()
FermeCalc
End Sub

Private Function LanceCalcOnTop() As Boolean
Dim ExStyle As Long
Dim lResult As Long

lResult = Shell("calc.exe")
DoEvents
hWndCalc = FindWindow("SciCalc", "Calculatrice")
If hWndCalc <> 0 Then
ExStyle = GetWindowLong(hWndCalc, GWL_EXSTYLE)
lResult = SetWindowLong(hWndCalc, GWL_EXSTYLE, _
ExStyle Or WS_EX_TOPMOST)
' SetWindowsPos est nécessaire à la prise en compte
' du nouvel attribut de fenêtre
lResult = SetWindowPos(hWndCalc, HWND_TOPMOST, _
0&, 0&, 0&, 0&, _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
End If
LanceCalcOnTop = (hWndCalc <> 0)
End Function

Public Sub FermeCalc()
If hWndCalc <> 0 Then
SendMessage hWndCalc, WM_CLOSE, 0&, 0&
hWndCalc = 0
End If
End Sub

--
Cordialement,

Jacques.

Merci Jacques, je n'avais pas besoin de refermer, d'autant que si je
referme d'une autre forme c'est plus compliqué...

J'ai fait maigrir:
---------------------------
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) 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 Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_SHOWWINDOW = &H40
'
Dim hWndCalc As Long
Sub Command2_Click() 'calculatrice
Dim lResult As Long
On Error GoTo erreur
lResult = Shell("calc.exe")
hWndCalc = FindWindow("SciCalc", "Calculatrice")
lResult = SetWindowPos(hWndCalc, HWND_TOPMOST, 0&, 0&, 0&, 0&, SWP_NOSIZE
Or SWP_NOMOVE Or SWP_SHOWWINDOW)
Exit Sub
erreur:
If Err = 53 Then MsgBox "La calculatrice n'est pas installée, remédier...
", vbExclamation
On Error Resume Next
End Sub

--
Merci beaucoup, au revoir et à bientôt :o)
------
Site logiciels
http://irolog.free.fr
Mail
http://irolog.free.fr/ecrire/index.htm
Site perso
http://irolog.free.fr/joe/index.htm
Principe d'utilisation des news Groups
http://support.microsoft.com/directory/worldwide/fr/newsgroup/regles.htm
------------------------------------------------------------------------------------
"Jacques93" <jacques@Nospam> a écrit dans le message de news:
OpalY%232cGHA.2188@TK2MSFTNGP05.phx.gbl...

Bonjour X,
X a écrit :

Bonjour,

Comment appeler la calculette et la mettre toujours à l'écran, puis
la fermer sur commande ???

Si tu veux lancer la calculatrice, et qu'elle reste en premier plan, tu
peux essayer ceci :

Option Explicit

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
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 Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOPMOST = &H8&

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 Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_SHOWWINDOW = &H40

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const WM_CLOSE = &H10

Dim hWndCalc As Long

Private Sub Command1_Click()
LanceCalcOnTop
End Sub

Private Sub Command2_Click()
FermeCalc
End Sub

Private Function LanceCalcOnTop() As Boolean
Dim ExStyle As Long
Dim lResult As Long

lResult = Shell("calc.exe")
DoEvents
hWndCalc = FindWindow("SciCalc", "Calculatrice")
If hWndCalc <> 0 Then
ExStyle = GetWindowLong(hWndCalc, GWL_EXSTYLE)
lResult = SetWindowLong(hWndCalc, GWL_EXSTYLE, _
ExStyle Or WS_EX_TOPMOST)
' SetWindowsPos est nécessaire à la prise en compte
' du nouvel attribut de fenêtre
lResult = SetWindowPos(hWndCalc, HWND_TOPMOST, _
0&, 0&, 0&, 0&, _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_SHOWWINDOW)
End If
LanceCalcOnTop = (hWndCalc <> 0)
End Function

Public Sub FermeCalc()
If hWndCalc <> 0 Then
SendMessage hWndCalc, WM_CLOSE, 0&, 0&
hWndCalc = 0
End If
End Sub

--
Cordialement,

Jacques.

Bonjour X,
X a écrit :

Merci Jacques, je n'avais pas besoin de refermer, d'autant que si je
referme d'une autre forme c'est plus compliqué...

J'ai fait maigrir:
---------------------------
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) 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 Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_SHOWWINDOW = &H40
'
Dim hWndCalc As Long
Sub Command2_Click() 'calculatrice
Dim lResult As Long
On Error GoTo erreur
lResult = Shell("calc.exe")
hWndCalc = FindWindow("SciCalc", "Calculatrice")
lResult = SetWindowPos(hWndCalc, HWND_TOPMOST, 0&, 0&, 0&, 0&, SWP_NOSIZE
Or SWP_NOMOVE Or SWP_SHOWWINDOW)
Exit Sub
erreur:
If Err = 53 Then MsgBox "La calculatrice n'est pas installée, remédier...
", vbExclamation
On Error Resume Next
End Sub

Effectivement, le :

WS_EX_TOPMOST dans SetWindowLong

et

HWND_TOPMOST dans SetWindowPos

semblent redondant, des scories d'essais ? peut être un problème avec
une version d'O.S. ? Ou peut être j'utilisais également d'autres flags
dans SetWindowLong. Là, je ne me rappelle pas ...

--
Cordialement,

Jacques.