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 |
Partager