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
|
Option Explicit
'#Function pour ajouter un icone a la barre de titre
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, _
ByVal lParam As Long) As Long
Private Declare PtrSafe Function ExtractIconA Lib "shell32.dll" _
(ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
'#Fin Function pour ajouter un icone a la barre de titre
'#Function pour masquer la croix
Private Declare PtrSafe Function GetWindowLongA Lib "user32" _
(ByVal hwndd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongA Lib "user32" _
(ByVal hwndd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'#Fin de la function masquer la croix
'#Fin#
Private Sub UserForm_Initialize()
Dim Fichier As String
Dim x As Long
OteCroix Me.Caption
'Chemin et nom du fichier icône à afficher
Fichier = "C:\Camping\IconeApp.ICO"
'Vérifie si le fichier existe
If Dir(Fichier) = "" Then Exit Sub
x = ExtractIconA(0, Fichier, 0)
SendMessageA FindWindow(vbNullString, Me.Caption), &H80, False, x
End Sub
'#Sub#
Private Sub OteCroix(Caption As String)
Dim hwnd As Long
hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") _
& "Frame", Caption)
SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
End Sub |
Partager