Maximiser, Minimiser, Restaurer une fenêtre windows

**ProgElecT** · 01/05/2013, 23h51

Salut

Maximiser, Minimiser, Restaurer une fenêtre windows quand le titre de celle-ci est connue.
Une variante de la FAQ Comment réduire la fenêtre d'une application ?.
Ici il est utilisé l'API GetWindowPlacement et SetWindowPlacement.

Sur un Form, un groupe de 4 OptionButtons (indexé 0 à 3), un Label, un TextBox et un CommandButton.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Option Explicit
 
Private Const SW_RESTORE = 9
Private Const SW_MINIMIZE = 6
Private Const SW_NORMAL = 1
Private Const SW_MAXIMIZE = 3
 
Private Type POINTAPI
        x As Long
        y As Long
End Type
 
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
Private Type WINDOWPLACEMENT
        Length As Long
        flags As Long
        showCmd As Long
        ptMinPosition As POINTAPI
        ptMaxPosition As POINTAPI
        rcNormalPosition As RECT
End Type
 
'Recuperer le Hwnd de la fenêtre du programme
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Recuperer les infos placement de la fenêtre recuperée
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
'Action sur la fenêtre recuperée
Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
 
Dim WinWnd As Long, Action As Long
Private Sub Form_Load()
 
Option1(0).Move 60, 120, 1455, 315: Option1(0).Caption = "SW_RESTORE": Option1(0).Tag = "9"
Option1(0).Value = True: Action = CLng(Option1(0).Tag)
Option1(1).Move 1560, 120, 1455, 315: Option1(1).Caption = "SW_NORMAL": Option1(1).Tag = "1"
Option1(2).Move 3060, 120, 1455, 315: Option1(2).Caption = "SW_MINIMIZE": Option1(2).Tag = "6"
Option1(3).Move 4560, 120, 1455, 315: Option1(3).Caption = "SW_MAXIMIZE": Option1(3).Tag = "3"
 
Label1.Move 1200, 540, 3570, 195: Label1.Caption = "Titre de la fenêtre, ATTENTION sensible à la case"
 
Text1.Move 60, 780, 5955, 315: Text1.Text = ""
 
Command1.Move 2100, 1140, 1815, 375
 
Me.Caption = "Min/Max/Restore une fenêtre programme"
Me.Height = 2145: Me.Width = 6330
End Sub
Private Sub Option1_Click(Index As Integer)
Action = CLng(Option1(Index).Tag)
End Sub
Private Sub Command1_Click()
If Trim(Text1.Text) = "" Then MsgBox "Pas de titre de fenêtre ?...": Exit Sub
    'Recherchez la fenêtre
    'ATTENTION: titre sensible à la case
    WinWnd = FindWindow(vbNullString, Text1.Text)
    DoEvents
    If WinWnd = 0 Then MsgBox "Fenêtre non trouvée ...": Exit Sub
    Actionne
End Sub
Public Sub Actionne()
Dim PlacementWindow As WINDOWPLACEMENT
Dim RectNormal As RECT
Dim RectMin As POINTAPI
Dim RectMax As POINTAPI
Dim Ret As Long
 
    'recupere la position d'une fenêtre même si elle est réduite ou agrandie
    PlacementWindow.Length = Len(PlacementWindow)
    Ret = GetWindowPlacement(WinWnd, PlacementWindow)
    RectNormal = PlacementWindow.rcNormalPosition
    RectMin = PlacementWindow.ptMinPosition
    RectMax = PlacementWindow.ptMaxPosition
 
    PlacementWindow.Length = Len(PlacementWindow)
    PlacementWindow.showCmd = Action 'SW_RESTORE  'SW_NORMAL 'SW_MINIMIZE 'SW_MAXIMIZE
    PlacementWindow.ptMinPosition = RectMin
    PlacementWindow.ptMaxPosition = RectMax
    PlacementWindow.rcNormalPosition = RectNormal
    Ret = SetWindowPlacement(WinWnd, PlacementWindow)
 
End Sub

J'ai indiqué une fenêtre windows, donc cela peut être un programme quelconque, l'explorateur, un navigateur, un exe .....
Restriction, apparemment certains titres de fenêtres avec accents ne sont pas trouvées.

**l_autodidacte** · 06/05/2013, 12h02

Salut ProgElecT et merci pour ce code.

Pour les caractères accentués, aucun problème sur mon PC XP Pro SP2.
Mieux encore, je l'ai testé en bidi(en Arabe) et cela marche également.

EDIT : Pour la casse, il n'y a aucun problème, la fenêtre est toujours trouvée (du moins sur ma configuration actuelle).

@+

**ProgElecT** · 06/05/2013, 12h20

Salut

Merci pour l'information, il est sûr que l'on a vite fait de mal reproduire le titre de la fenêtre.

Pour ma part, j'ai proposé ce code car il me donne de meilleurs résultats que celui proposé dans la FAQ, d'un OS à l'autre (ou pour le même, mais paramétré différemment) on a des réactions pas forcement identique.

**ProgElecT** · 28/07/2017, 17h11

Salut

Une version combinant l'appel par titre de la fenêtre ou nom de la classe, plus la possibilité de mettre le programme visé Toujours au 1er plan.

Sur un Form, un groupe de 5 OptionButtons (indexé 0 à 4), 1 CheckBox, 1 Label, 1 ComboBox, 2 TextBox et 1 CommandButton,
plus ce

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
Option Explicit
'*******************************************************************************************************************************
Private Const SWP_HIDEWINDOW = &H80
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
 
Private Const SW_RESTORE = 9
Private Const SW_MINIMIZE = 6
Private Const SW_NORMAL = 1
Private Const SW_MAXIMIZE = 3
 
Private Type POINTAPI
        X As Long
        Y As Long
End Type
 
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
 
Private Type WINDOWPLACEMENT
        Length As Long
        flags As Long
        showCmd As Long
        ptMinPosition As POINTAPI
        ptMaxPosition As POINTAPI
        rcNormalPosition As RECT
End Type
 
'Recuperer le Hwnd de la fenêtre du programme
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Recuperer les infos placement de la fenêtre recuperée
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
'Action sur la fenêtre recuperée
Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
 
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
                        ByVal hwndParent As Long, ByVal hwndFille As Long, _
                        ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
                        ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
                        ByVal hwnd As Long, _
                        ByVal lpString As String, _
                        ByVal cch As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private Const WM_CLOSE = &H10
 
' structure de fenêtre XLMAIN / XLDESK / EXCEL7 pour chaque classeur
'EXCEL7 sont des fenêtres de classeur
Private Const gcClassnameMSWord = "OpusApp" 'WINWORD.EXE
Private Const gcClassnameMSExcel = "XLMAIN" 'EXCEL.EXE
Private Const gcClassnameMSIExplorer = "IEFrame"
Private Const gcClassnameMSVBasic = "wndclass_desked_gsk"
Private Const gcClassnameNotePad = "Bloc-notes"
Private Const gcClassnameMyVBApp = "ThunderForm"
 
'CabinetWClass  'fenetre Explorer windos
'Notepad2U   ' Notepad2.exe
'wndclass_desked_gsk   Fenetre VBA d'Excel
'SciCalc CALC.EXE
'CalWndMain Calendar.EXE
'CARDFILE CARDFILE.EXE
'Clipboard Clipboard.EXE
'CLOCK CLOCK.EXE
'CtlPanelClass Control.EXE  'Panneau de configuration\Tous les Panneaux de configuration
'Session MS - DOS.EXE
'NOTEPAD NOTEPAD.EXE
'MSPaintApp          'logiciel de dessin Paint
'pbParent PBRUSH.EXE 'logiciel de dessin Paint
'Pif PIFEDIT.EXE
'PrintManager PRINTMAN.EXE
'Progman PROGMAN.EXE   (Windows Program manager)
'RECORDER RECORDER.EXE
'REVERSI REVERSI.EXE
'#32770  SETUP.EXE
'Solitaire SOL.EXE
'TERMINAL TERMINAL.EXE
'WFS_Frame WINFILE.EXE
'MW_WINHELP WINHELP.EXE
'#32770     WINVER.EXE  (Gestionnaire des tâches de Windows)
'MSWRITE_MENU  WRITE.EXE
 
Dim WinWnd As Long, Action As Long
Dim PlacementWindow As WINDOWPLACEMENT
Dim RectNormal As RECT
Dim RectMin As POINTAPI
Dim RectMax As POINTAPI
Dim Ret As Long
 
'Pour placer la feuille au premier plan ou à l'arrière plan
Private Declare Sub 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)
'Constantes pour l'API -- SetWindowPos --
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Dim Profondeur As Long
 
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
               ByVal wParam As Long, _
               ByVal lParam As Long) As Long
'*******************************************************************************************************************************
Private Sub Form_Load()
 
Option1(0).Move 60, 120, 1455, 315: Option1(0).Caption = "SW_RESTORE": Option1(0).Tag = "9"
Option1(1).Move 1560, 120, 1455, 315: Option1(1).Caption = "SW_NORMAL": Option1(1).Tag = "1"
Option1(2).Move 3060, 120, 1455, 315: Option1(2).Caption = "SW_MINIMIZE": Option1(2).Tag = "6"
Option1(3).Move 4560, 120, 1455, 315: Option1(3).Caption = "SW_MAXIMIZE": Option1(3).Tag = "3"
Option1(4).Move 6060, 120, 1455, 315: Option1(4).Caption = "Aucune action": Option1(4).Tag = "0"
Option1(4).Value = True: Action = CLng(Option1(4).Tag)
 
Check1.Move 75, 420, 795, 255: Check1.Caption = "1° plan": Check1.Enabled = False
ComboTitreClasse.Clear
ComboTitreClasse.AddItem "V Titre de la fenêtre, ATTENTION sensible à la casse V"
ComboTitreClasse.AddItem "V                                Nom de classe                          V"
ComboTitreClasse.Move 960, 480, 4290: ComboTitreClasse.ListIndex = 0
 
Text1.Move 60, 780, 7455, 315: Text1.Text = "": Text1.OLEDropMode = 2
Text2.Move 60, 1140, 7455, 855: Text2.Text = "": Text2.OLEDragMode = 1
 
Command1.Move 2100, 2100, 1815, 375: Command1.Caption = "Go"
 
Me.Caption = "Min/Max/Restore une fenêtre programme"
Me.Width = 12690: Me.Height = 3105
End Sub
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized Then
    Text1.Width = Me.ScaleWidth - (Text1.Left * 2)
    Text2.Width = Me.ScaleWidth - (Text1.Left * 2)
    If Me.ScaleHeight - (Text2.Top + Text2.Left) > 1 Then
        Text2.Height = Me.ScaleHeight - (Text2.Top + (Text2.Left * 2) + Command1.Height)
    End If
    Command1.Top = Text2.Top + Text2.Height + Text2.Left
End If
End Sub
 
Private Sub Option1_Click(Index As Integer)
Action = CLng(Option1(Index).Tag)
If Index = 4 Then Check1.Enabled = False Else Check1.Enabled = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then KeyAscii = 0: Command1_Click
End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbKeyMButton Then Text1.SelStart = 0: Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub Command1_Click()
 
Text1.Text = Trim(Text1.Text)
If Text1.Text = "" Then MsgBox "Pas de titre ou nom de classe ?...": Exit Sub
Text2.Text = ""
'Recherchez la fenêtre
If ComboTitreClasse.ListIndex = 0 Then
    'Par nom de fenêtre, ATTENTION: titre sensible à la case
    WinWnd = FindWindow(vbNullString, Text1.Text)
    Else
    'par nom de classe
    WinWnd = FindWindow(Text1.Text, vbNullString)
End If
 
DoEvents
If WinWnd = 0 Then Text2.Text = "Fenêtre non trouvée ...": Exit Sub
'recupere la position d'une fenêtre même si elle est réduite ou agrandie
PlacementWindow.Length = Len(PlacementWindow)
Ret = GetWindowPlacement(WinWnd, PlacementWindow)
RectNormal = PlacementWindow.rcNormalPosition
RectMin = PlacementWindow.ptMinPosition
RectMax = PlacementWindow.ptMaxPosition
If Action <> 0 Then Actionne WinWnd
 
Dim StrNomClass As String
 
Text2.Text = Affichage(WinWnd, StrNomClass)
 
Dim HwndCtrl As Long
If ComboTitreClasse.ListIndex = 0 Then 'Par nom de fenêtre
    HwndCtrl = FindWindowEx(WinWnd, 0&, vbNullString, vbNullString)
    Else 'Par nom de classe
    HwndCtrl = FindWindowEx(WinWnd, 0&, StrNomClass & vbNullString, vbNullString)
End If
If HwndCtrl = 0 Then Text2.Text = Text2.Text & vbNewLine & "Fenêtre enfant non trouvée": Exit Sub
Text2.Text = Text2.Text & vbNewLine & Affichage(HwndCtrl, StrNomClass)
 
If Action = 1 Or Action = 9 Then
    If Check1.Value = 1 Then Profondeur = HWND_TOPMOST Else Profondeur = HWND_NOTOPMOST
    SetWindowPos WinWnd, Profondeur, RectNormal.Left, _
                    RectNormal.Top, (RectNormal.Right - RectNormal.Left), _
                    (RectNormal.Bottom - RectNormal.Top), SWP_NOACTIVATE Or SWP_SHOWWINDOW
End If
 
End Sub
Public Sub Actionne(HwndProg As Long)
    PlacementWindow.Length = Len(PlacementWindow)
    PlacementWindow.showCmd = Action 'SW_RESTORE  'SW_NORMAL 'SW_MINIMIZE 'SW_MAXIMIZE
    PlacementWindow.ptMinPosition = RectMin
    PlacementWindow.ptMaxPosition = RectMax
    PlacementWindow.rcNormalPosition = RectNormal
    Ret = SetWindowPlacement(HwndProg, PlacementWindow)
End Sub
Public Function Affichage(HwndX As Long, RetourNomClasse) As String
Dim ValRet As Long, Buf As String * 256, StrNomClass As String, StrName As String, StrFormatClass As String
 
ValRet = GetWindowText(HwndX, Buf, 256): StrName = Left$(Buf, ValRet)
ValRet = GetClassName(HwndX, Buf, 256): StrNomClass = Left$(Buf, ValRet)
RetourNomClasse = StrNomClass
If Len(StrNomClass) < 25 Then
    StrFormatClass = StrNomClass & String(25 - Len(StrNomClass), " ")
    Else
    StrFormatClass = Trim(StrNomClass)
End If
If StrName = "" Then StrName = "Non renseigné"
 
Affichage = "HWND: " & FormatStr(HwndX, 0, 7) & " / nom de la classe: " & StrFormatClass & " / nom de la fenêtre: " & StrName
End Function
Public Function FormatStr(Valeur As Variant, Optional NbrDecimale As Integer = 0, Optional NbrCaractConteneur As Integer = 0) As String
Dim T As Integer, PoS As Integer ' pour la boucle, pour position (utilisé dans la fonction  InStr())
Dim EntierStr As String, DecimalStr As String ' partie entière, partie décimale
 
'*-*-*-*-* Utile si la donnée "Valeur" provient par exemple d'une Base de données ou lecture d'un automatisme
'en bref n'est pas un chiffre
If Valeur = vbNull Or Valeur = vbNullChar Or Valeur = vbNullString Then Valeur = 0 '*-*-*-*-*
If Trim(FormatStr) = "" Then FormatStr = "0" '*-*-*-*-*
 
FormatStr = CStr(Valeur) 'force la variable d'entrée en String
FormatStr = Replace(FormatStr, " ", "") '*-*-*-*-*
FormatStr = Replace(FormatStr, ",", ".") '*-*-*-*-*
FormatStr = Trim(FormatStr) 'supprime les éventuels espaces à gauche et à droite '*-*-*-*-*
 
FormatStr = Val(FormatStr) ' extraction du chiffre, si juste un point ou non un chiffre, FormatStr = "0"
If FormatStr = "0" Then If NbrDecimale <> 0 Then FormatStr = "0." & String(NbrDecimale, "0")
 
FormatStr = Replace(FormatStr, ",", ".") 'Val() peut avoir transformé le point en virgule suivant le séparateur système
 
PoS = InStr(1, FormatStr, ".", vbTextCompare) ' vérification de la position du point décimale
If PoS <> 0 Then
    EntierStr = Left(FormatStr, PoS - 1) 'récupère la partie entière
    For T = 1 To Len(EntierStr) ' élimine les zéro non significatif de la partie entière
        If Mid(EntierStr, T, 1) = "0" Then EntierStr = Right(EntierStr, 1) Else Exit For
    Next T
    If EntierStr = "" Then EntierStr = "0"
    DecimalStr = Right(FormatStr, Len(FormatStr) - PoS) 'récupère la partie décimale
    If Len(DecimalStr) > NbrDecimale Then DecimalStr = Left(DecimalStr, NbrDecimale) ' ajout de zéro à la partie décimale
    Else
    EntierStr = FormatStr ' "Valeur" est un entier
End If
If NbrDecimale = 0 Then FormatStr = EntierStr Else FormatStr = EntierStr & "." & DecimalStr
 
FormatStr = StrReverse(FormatStr) ' retourne le chiffre pour avoir les décimales à gauche
PoS = InStr(1, FormatStr, ".", vbTextCompare) ' vérification de la position du point décimale
'PoS, pour 1 décimales devrait être égal à 2, pour 2 décimales, devrait être égal à 3, pour 3 décimales, devrait être égal à 4 .....
If NbrDecimale <> 0 Then 'ajoute éventuellement les décimales pour être égal à NbrDecimale
    If PoS <= NbrDecimale Then FormatStr = String((NbrDecimale + 1) - PoS, "0") & FormatStr
End If
FormatStr = StrReverse(FormatStr) ' retourne le chiffre
 
'Formatage, purement pour l'affichage à gauche
If NbrCaractConteneur <> 0 Then
    'formatage avec déplacement du chiffre vers la droite suivant le NbrCaract max du contrôle conteneur
    If NbrCaractConteneur >= Len(FormatStr) Then
        FormatStr = String(NbrCaractConteneur - Len(FormatStr), " ") & FormatStr
    End If
End If
End Function

Une recherche par nom de la fenêtre permet d'avoir le nom de la classe.
Une recherche par nom de la classe permet d'avoir le nom de la fenêtre.
Possibilité de faire du Drag And Drop entre les 2 TextBoxs, pour par exemple rechercher dans un premier temps par nom de fenêtre puis par nom de classe (et inversement).

Maximiser, Minimiser, Restaurer une fenêtre windows

Vos contributions VB6

Discussions similaires

Partager

Partager